#A simple comm port to TCP/IP server. # # Copyright (C) 2003 Pascal Scheffers <[email protected]> # and placed in the public domain. # # No restrictions on this code. Use as you will. No warranties either. # Note that this code is *not* safe for internet use. Use at your own peril. # # Protocol: # 1. Client connects. # 2. Client sends password # 3. Server either closes connection or continues #Configuration: set tcpport 1026 ;# this is where the server listens set password somethingsecret set comport /dev/ttyS0 set comopts {-mode 4800,n,8,1 -handshake none} set serveonce 1 ;# terminate the server once one client has connected #End configuration options # Sample usage: (put this bit where your [open com1:] would have # been) # # puts "Trying $server:$port..." # set conn [socket $server $port] # puts "Logging in..." # puts $conn $password # flush $conn # set login [gets $conn] # if { $login ne "Ok" } { # error $login # } # puts "Connected." # fconfigure $conn -blocking 0 -buffering none -translation binary set client [list] set server "" set serial "" proc startServer { port } { global server set server [socket -server acceptConnection $port] } proc acceptConnection { channel peer peerport } { global client global password global serial puts "Connection from $peer" if { $client ne "" } { puts "Kindly refusing." puts $channel "Sorry, already have a client" close $channel return } set clientpass [gets $channel] if { $clientpass ne $password } { puts "Incorrect password" puts $channel "Sorry." close $channel return } set client $channel puts $client "Ok" flush $client fconfigure $client -blocking 0 -buffering none -translation binary set serial [open $::comport r+] fconfigure $serial -blocking 0 -buffering none -translation binary foreach {opt val} $::comopts { fconfigure $serial $opt $val } fileevent $client readable "passData $client $serial" fileevent $serial readable "passData $serial $client" puts "Client connected." } proc passData { in out } { # CL suspects that this is backwards. [eof] needs to # be tested *after* reading. if { ![eof $in] } { puts -nonewline $out [read $in] } else { puts "Client disconnected." close $in close $out set ::client "" if {$::serveonce} { set ::forever now } } } startServer $tcpport puts "Now listening on $tcpport" vwait forever puts "Done."
See also: tcptty