#A simple comm port to TCP/IP server.
#
# Copyright (C) 2003 Pascal Scheffers <pascal@scheffers.net>
# 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

