#!/bin/sh
#
# tcptty.tcl (version 0.2)
#
# Copyright 2005 Andy Goth <unununium@openverse.com>
# See http://ioioio.net/devel/tcptty/ for the latest version.
# Or use the Wiki!  http://wiki.tcl.tk/tcptty
#
#
#
# tcptty is a simple program to make a serial port accessible to TCP clients.
# It has a bare-bones GUI allowing you to configure the parameters of the serial
# port and the TCP server.  Connect to it using a TCP-enabled terminal emulator
# such as PuTTY in raw mode or netcat running in an xterm.  (You will want to
# disable local line editing and echoing, if these features are provided by the
# remote host.)
#
# Device is the name of your serial port, for instance COM1: (MS-Windows) or
# /dev/ttyS0 (Unix).
#
# Bit Rate is the number of bits per second to use, also known as baud rate.
# Common values include 2400, 9600, 38400, and 115200.
#
# Data Bits specifies the number of bits per character.  Options include 5, 6,
# 7, and 8.
#
# Parity is an error checking mechanism.  It can be set to n (none), o (odd), e
# (even), m (mark), or s (space).
#
# Stop Bits gives the delay between characters.  It should be set to 1 or 2.
#
# TCP Port is the port number on which tcptty listens.  This provides very weak
# security, since an attacker can obtain this value by port scanning.
#
# TCP Addr determines which interface tcptty will accept connections on.  Set
# this to localhost to reduce the threat from the outside Internet, or set to
# 0.0.0.0 to accept connections from everywhere.  Note that attackers may
# already have access to your machine, perhaps legitimately (they may have login
# accounts!), so only accepting from localhost doesn't guarantee security.
#
# The Client Max limits the number of concurrent clients, so if you set this to
# 1 (default) and you are connected you know no one else is; or set this to 0 to
# allow any number of connections.
#
#
#
# Changelog:
#
# Wed, Sep 21, 2005:
# - Added error handling for serial reads and writes.
# - Version 0.2
#
# Mon, Sep 19, 2005:
# - Initial coding
# - Created Wiki
# - Version 0.1
#
#
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# A copy of the GNU General Public License can be obtained online at URL:
# http://www.gnu.org./licenses/gpl.txt
# or write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
# Boston, MA  02110-1301  USA
#
#
#
# Restart with tclsh \
exec tclsh "$0" ${1+"$@"}

package require Tcl 8.4
package require Tk

# Accept an incoming TCP connection.
proc accept {chan addr port} {
    global clients clientcur clientmax

    if {$clientmax > 0 && $clientcur == $clientmax} {
        # Go away; we're full.
        puts $chan "Error: client limit exceeded"
        close $chan
    } else {
        # Add to the list of connected clients.
        lappend clients $chan
        incr clientcur

        # Configure the socket.
        fconfigure $chan -blocking false -buffering none -translation binary

        # When data is received from the socket, send to the serial port.
        fileevent $chan readable [list transfer $chan]
    }
}

# Transfer data between the serial port and the client sockets.
proc transfer {source} {
    global clientcur serial clients

    if {[string equal $source $serial]} {
        # Received data from the serial port.  Broadcast to all clients.
        if {[catch {set data [read $serial]}]} {
            # Error; lost connection.
            disconnect
            tk_messageBox -title Error -message $::errorInfo -icon error\
                    -type ok
        } else {
            foreach chan $clients {
                puts -nonewline $chan $data
            }
        }
    } else {
        # Received data from a client socket.
        set data [read $source]
        if {[eof $source]} {
            # The client disconnected.
            close $source

            # Remove from the list of clients.
            set index [lsearch -exact $clients $source]
            set clients [lreplace $clients $index $index]
            incr clientcur -1
        } else {
            # Send to the serial port.
            if {[catch {puts -nonewline $serial $data}]} {
                # Error; lost connection.
                disconnect
                tk_messageBox -title Error -message $::errorInfo -icon error\
                        -type ok
            }
        }
    }
}

# Connect to the serial port and begin listening for client connections.
proc connect {} {
    global device rate data parity stop tcpport tcpaddr serial server

    if {[catch {
        # Open the serial port.
        set serial [open $device r+]

        # Configure the serial port.
        fconfigure $serial -mode $rate,$parity,$data,$stop
        fconfigure $serial -blocking false -buffering none -translation binary

        # Open a TCP server socket.
        set server [socket -server accept -myaddr $tcpaddr $tcpport]
    } result]} {
        # Uh oh; error.  Let the user know.
        tk_messageBox -title Error -message $::errorInfo -icon error -type ok
        catch {close $serial}
        catch {close $server}
    } else {
        # Success!  Gray out the configuration widgets.
        foreach param {device rate data parity stop tcpport tcpaddr clientmax} {
            .$param-l configure -state disabled
            .$param-e configure -state disabled
        }

        # Change the action button to "Disconnect".
        .action configure -text Disconnect -command disconnect

        # When data is available from the serial port, broadcast to the clients.
        fileevent $serial readable [list transfer $serial]
    }
}

# Disconnect from the serial port, close the server, and kick all the clients.
proc disconnect {} {
    global clientcur serial server clients

    # Close everything.
    foreach chan [concat [list $serial $server] $clients] {
        catch {close $chan}
    }
    set clients [list]
    set clientcur 0

    # Reactivate the configuration widgets.
    foreach param {device rate data parity stop tcpport tcpaddr clientmax} {
        .$param-l configure -state normal
        .$param-e configure -state normal
    }

    # Restore the action button to "Connect".
    .action configure -text Connect -command connect
}

# Create the GUI.
proc main {} {
    global device rate data parity stop tcpport tcpaddr clientcur clientmax\
           clients

    # Initially, we have no clients.
    set clients [list]
    set clientcur 0
    set clientmax 1

    # Create the configuration widgets.
    foreach {name param def} {
            Device        device  COM1:
            "Bit Rate"    rate    115200
            "Data Bits"   data    8
            Parity        parity  n
            "Stop Bits"   stop    1
            "TCP Port"    tcpport 9876
            "TCP Addr"    tcpaddr localhost} {
        set ::$param $def
        label .$param-l -text $name -anchor w
        entry .$param-e -textvariable $param -width 10
        grid .$param-l .$param-e -sticky ew -padx 4 -pady 2
    }

    # Create the current and maximum client count widgets.
    label .clientmax-l -text Clients -anchor w
    frame .clientmax-f
    entry .clientmax-f.current -textvariable clientcur -width 3 -state disabled
    label .clientmax-f.of -text of -state disabled
    entry .clientmax-e -textvariable clientmax -width 3
    pack .clientmax-f.current -side left -fill x -expand true
    pack .clientmax-f.of -side left
    pack .clientmax-e -in .clientmax-f -side left -fill x -expand true
    grid .clientmax-l .clientmax-f -sticky ew -padx 4 -pady 2

    # Create the action button.
    button .action -text Connect -command connect
    grid .action -columnspan 2 -sticky ew -padx 4 -pady 2

    # Window configuration.
    wm title . tcptty
    wm resizable . 0 0
}

# Do it.
main

# vim: set ts=4 sts=4 sw=4 tw=80 et: