Reference Manual

HOW TO use TCL sockets:

The TCL help Page documents the special features of the NAT32 implementation of TCL (including sockets).

The following TCL scripts serve as examples for using TCL to write scripts which can be invoked from the NAT32 Console or from within the file startup.txt.

Sample HTTP Daemon

#!tcl

#
# HTTP Daemon
#

if {$argc == 1} {
    set port [lindex $argv 0]
} else {
    set port 8000
}

set s [socket -p $port 1]

while {1} {
    set ns [$s accept]

    set data [$ns gets 512]

    set fname [lindex $data 1]
    set fname [concat [pwd]$fname]

    if {[file exists $fname]} {
        set len [file size $fname]
    } else {
        set r [string first "cmd?COMMAND=" $fname]
        if {$r != -1} {
            set cmd [split $fname =]
            set cmd [lindex $cmd 1]
            set cmd [split $cmd +]
            set command [lindex $cmd 0]
            set arg1 [lindex $cmd 1]
            set arg2 [lindex $cmd 2]
            set arg3 [lindex $cmd 3]
            set arg4 [lindex $cmd 4]
            set arg5 [lindex $cmd 5]
            $ns puts "HTTP/1.0 200 OK\n"
            $ns puts "Content-type: text/plain\n"
            $ns puts "Expires: Thu, 01 Dec 1994 16:00:00 GMT\n"
            $ns puts "\n"
            if {$cmd == "exit"} {
                $ns puts "Goodbye.\nHTTPD terminated.\n"
                rename $ns {}
                break
            }
            if {$cmd == "termin"} {
                $ns puts "Goodbye.\nHTTPD terminated.\n"
                rename $ns {}
                break
            }
            set result [exec $command $arg1 $arg2 $arg3 $arg4 $arg5]
            $ns puts $result
            $ns puts "\n"
            rename $ns {}
            continue
        } else {
            $ns puts "HTTP/1.0 200 OK\n"
            $ns puts "Content-type: text/plain\n"
            $ns puts "Expires: Thu, 01 Dec 1994 16:00:00 GMT\n"
            $ns puts "\n"
            set result "Page not available"
            $ns puts $result
            $ns puts "\n"
            rename $ns {}
            continue
        }
    }
    $ns puts "HTTP/1.0 200 OK\n"
#    $ns puts "Content-type: text/plain\n"
    $ns puts "Expires: Thu, 01 Dec 1994 16:00:00 GMT\n"
    $ns puts "\n"
    set len [$ns putf $fname]
    rename $ns {}
}

rename $s {}

Sample HTTP Proxy

#!tcl

#
# Simple HTTP Proxy
#

if {$argc == 0} {
    error {Usage: proxy address [port]}
}
set addr [lindex $argv 0]
set port 80

if {$argc == 2} {
    set port [lindex $argv 1]
}
 

# Listen at Port for connection requests

set s [socket -p $port 1]

while {1} {

# accept an incoming request

    set ns [$s accept]

# got one, now read it

    set data [$ns gets 512]

# check the requested filename

    set fname [lindex $data 1]

    if {$fname == "/exit"} {
        $ns puts "NAT32 HTTP proxy terminated.\n"
        rename $ns {}
        echo "*** NAT32 HTTP roxy terminated by remote user ***"
        break
    }

# open a socket to the WEB server

    set cs [socket $addr 80]

# send the request to that WEB server

    $cs puts $data

# read the response to file temp

    $cs getf temp

# close the socket

    rename $cs {}

# write file temp to the WEB
 
    $ns putf temp

#close the socket and loop for the next request

    rename $ns {}
}

rename $s {}

SEE ALSO

shell, tcl
Edit this page