![]() |
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