#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."