#! /bin/sh

# The next lines are a comment to Tcl \
    P=/opt/bin:$PATH ; for i in /opt/tcl* ; do P=$i/bin:$P ; done ; \
            PATH=$P ; export PATH ; exec tclsh $0 "$@"

if {$tcl_version < 8.0} {
    puts stderr "Sorry, $argv0 requires Tcl 8.0 or above."
    exit 1
}
#
# USAGE: use "pathrelay -h"
#
proc shortUsage {} {
    puts "Use:
    
    $::Prog \[option...] path...

$::Prog copies data between all the path arguments.
Use -h for more detailed info."
}

proc longUsage {} {
    puts "Use:
    
    $::Prog \[ \[option...] path]...

$::Prog copies data between all the path arguments.  That is, any
data that are read from one path are written to all the others.
Options can precede each path, and apply only to the immediately following path.

Path arguments:
    o  If the form is hostname:portnum, a (client) socket connection is
	made to that host and port.

    o  If the form is just a portnum, $::Prog acts as a server, accepting
	client connections on that port.

    o  Otherwise, the file is treated as a path in the filesystem.

Options:

    -conns nnn
    	When acting as a server (ie path is just a port number),
	$::Prog will limit the number of simultaneous clients to nnn.

    -allow globpat
	When acting as a server (ie path is just a port number),
	$::Prog will only accept clients whose ip address (not name)
	matches this glob pattern.

    -mode baud,parity,data,stop
	For serial devices, sets the I/O mode as indicated, using a set of
	up to 4 comma-separated values; the order of fields doesn't matter:
	    baud:   the integer baud rate.
	    parity: any abbreviation of: odd, even, mark, space, or none.
	    data:   the number of data bits; valid values are 5, 6, 7, or 8.
	    stop:   the number of stop bits; valid values are 1 or 2."
}


proc setupListenPort {port maxconns} {
    if {[catch {socket -server [list new_client $port] $port} handle]} {
	puts "$::Prog: can't start listening on port $port: $handle"
	exit 1
    }
    fconfigure $handle -blocking 0 -translation binary
    set ::Connections($port) 0
    set ::MaxConnections($port) $maxconns
    set ::AmServer 1
}

proc setupClientSock {host_port} {
    if {[regexp "^(.+):(\[0-9]+)\$" $host_port junk host port] != 1} {
	puts "$::Prog: $host_port has a colon,\
				but it's not in the form host:portnum"
	exit 1
    }
    if {[catch {socket $host $port} handle]} {
	puts "$::Prog: can't connect to host:port $host:$port: $handle"
	exit 1
    }
    config_handle $host_port $handle
}

proc setupFile {path {mode ""}} {
    if {![file exists $path]} {
	puts "$::Prog: no such path as $path"
	shortUsage
	exit 1
    }
    if {[catch {open $path r+} handle]} {
	puts "$::Prog: can't open $path for read/write: $handle"
	exit 1
    }
    if {[string compare $mode ""]} {
	change_mode $path $handle $mode
    }
    config_handle $path $handle
}

#
# Change the baud,parity,databits,stopbits for a device.
#
proc change_mode {name handle mode} {
    if {[catch {fconfigure $handle -mode} oldmode]} {
	puts "$::Prog: changing mode is not supported for path $name"
	exit 1
    }
    foreach {baud parity databits stopbits} [split $oldmode ,] {break}
    foreach item [split $mode ,] {
	if {[string match $item* none]} { set parity n
	} elseif {[string match $item* mark]} { set parity m
	} elseif {[string match $item* space]} { set parity s
	} elseif {[string match $item* odd]} { set parity o
	} elseif {[string match $item* even]} { set parity e
	} elseif {[string compare $item 1] == 0} { set stopbits 1
	} elseif {[string compare $item 2] == 0} { set stopbits 2
	} elseif {[string compare $item 5] == 0} { set databits 5
	} elseif {[string compare $item 6] == 0} { set databits 6
	} elseif {[string compare $item 7] == 0} { set databits 7
	} elseif {[string compare $item 8] == 0} { set databits 8
	} elseif {[string is integer $item] && $item >= 300} {
	    set baud $item
	} else {
	    puts "$::Prog: unknown mode item $item\
			    (mode string = $mode) for path $name"
	    puts "$::Prog: current mode is: $oldmode"
	    exit 1
	}
    }
    set mode "$baud,$parity,$databits,$stopbits"
    if {[catch {fconfigure $handle -mode $mode} result]} {
	puts "$::Prog: couldn't set mode to $mode for path $name: $result"
	puts "$::Prog: current mode is [fconfigure $handle -mode]"
	exit 1
    } else {
	puts "$::Prog: mode of $name is now [fconfigure $handle -mode]"
    }
}

proc clear_opts {} {
    uplevel {
	set maxconns 99999
	set allow {}
	set mode ""
    }
}

proc main {} {
    set ::Prog [file tail $::argv0]

    set ::AmServer 0

    array set ::MaxConns {}
    array set ::Allow {}
    clear_opts
    while {[llength $::argv]} {
	set arg [lindex $::argv 0]
	set ::argv [lrange $::argv 1 end]
	if {[string match -* [set opt $arg]]} {
	    set val [lindex $::argv 0]
	    set ::argv [lrange $::argv 1 end]
	    if {[string match $opt* -conns]}  {
		set maxconns $val
	    } elseif {[string match $opt* -allow]}  {
		lappend allow $val
	    } elseif {[string match $opt* -mode]}  {
		set mode $val
	    } elseif {[string match $opt* -help]} {
		longUsage
		exit 0
	    } else {
		puts "$::Prog: unknown option $opt\n"
		shortUsage
		exit 1
	    }
	} else {
	    set ::MaxConns($arg) $maxconns
	    if {[llength $allow] == 0} {
		set allow "*"	; # default is to allow all
	    }
	    set ::Allow($arg) $allow
	    set ::MaxConns($arg) $maxconns
	    if {[regexp "^\[0-9]+\$" $arg]} {
		setupListenPort $arg $maxconns

	    } elseif {[regexp "^.*:\[0-9]+\$" $arg]} {
		setupClientSock $arg

	    } else {
		setupFile $arg $mode
	    }
	    clear_opts
	}
    }
    if {[array size ::Handle] <= 1 && !$::AmServer} {
	if {[array size ::Handle] == 0} {
	    puts "$::Prog: you have to open some paths, eh?  (See $::Prog -h)"
	} else {
	    puts "$::Prog: not listening on any ports,\
	    			and only 1 path is open.  (See $::Prog -h)"
	}
	exit 1
    }
    vwait forever
}

proc new_client {listen_port cl_handle cl_address cl_port} {
    set ok 0
    foreach pat $::Allow($listen_port) {
	if {[string match $pat $cl_address]} {
	    set ok 1
	    break
	}
    }
    if {!$ok} {
	puts $cl_handle "$::Prog: connections not allowed from your IP."
	set okpats [join $::Allow($listen_port) " or "]
	puts "$::Prog: connection attempt disallowed from $cl_address\
				(valid addresses must match $okpats)"
	close $cl_handle
	return
    }
    if {$::Connections($listen_port) == $::MaxConns($listen_port)} {
	puts $cl_handle "$::Prog: ERROR -- reached maximum\
		number of simultaneous connections\
		($::MaxConns($listen_port)) on port $listen_port."
	puts "$::Prog: ERROR -- couldn't accept connection from $cl_address:\
		reached maximum number of simultaneous connections\
		($::MaxConns($listen_port)) on port $listen_port."
	close $cl_handle
	return
    }
    incr ::Connections($listen_port)
    set ::BelongsTo($cl_handle) $listen_port
    config_handle $cl_address:$cl_port $cl_handle
}

proc config_handle {name handle} {
    set ::Handle($handle) 1
    set ::NameOf($handle) $name
    fconfigure $handle -blocking 0 -translation binary
    fileevent $handle readable [list read_handle $handle]
}

proc close_handle {handle} {
    catch {close $handle}
    if {[info exists ::BelongsTo($handle)]} {
	# This connection was made to one of our server ports
	set owner $::BelongsTo($handle)
	incr ::Connections($owner) -1
    }
    if {[info exists ::Handle($handle)]} {
	unset ::Handle($handle)
    }

    if {!$::AmServer} {
	if {[array size ::Handle] == 0} {
	    puts "$::Prog exiting: we have no open files,\
	    		and we aren't listening for any new connections"
	} elseif {[array size ::Handle] == 1} {
	    puts "$::Prog exiting: just one open file left,\
	    		and we aren't listening for any new connections"
	exit 0
	}
    }
}

proc read_handle {this_handle} {
    if {[eof $this_handle]} {
	puts "$::Prog: EOF on $::NameOf($this_handle)"
	close_handle $this_handle
	return
    }

    set data [read $this_handle]

    foreach handle [array names ::Handle] {
	if {[string compare $this_handle $handle] == 0} {
	    # Don't send back to ourselves
	    continue
	} elseif {[fblocked $handle]} {
	    # Client didn't keep up with us.
	    close_handle $handle
	} else {
	    puts -nonewline $handle $data
	    flush $handle
	}
    }
}

main