1: #!/usr/bin/tcl 2: # Do we enable debugging? (genenerally a bad idea) 3: set DEBUG 0 4: 5: # What port should we use as the control port (must be the same on 6: # rdatapipe)? 7: set controlport 4500 8: 9: ############################################################################# 10: ############################################################################# 11: ############################################################################# 12: # This is my mess. ########################################################## 13: ############################################################################# 14: 15: 16: set dataport [lindex $argv 1] 17: set clientlist [lindex $argv 0] 18: set remotehost [lindex $argv 2] 19: if {$clientlist==""} { puts "Usage:\n\t$argv0 <local-port> \[<remote-prot> \[<remote-host>\] \]"; exit } 20: if {$dataport==""} { set dataport $clientlist } 21: if {$remotehost==""} { set remotehost 127.0.0.1 } 22: if {!$DEBUG} { 23: if {[fork]!=0} { exit } 24: } 25: 26: 27: # Background errors, blah. 28: proc bgerror {error} { puts "Error: $error"; return } 29: 30: 31: # When the rdatapiped server contacts us, store its file descriptor. 32: proc HaveControl {s a p} { 33: global controlId DEBUG 34: set controlId $s 35: fileevent $s readable "checkcontrol $s" 36: if {$DEBUG} { puts "Have control" } 37: } 38: 39: # When we get a connection from a client, communicate with 40: # rdatapiped and setup the pipes 41: proc HaveConnection {s a p} { 42: global dataport controlId ForwardTable DEBUG remotehost 43: random seed [expr abs([clock clicks])] 44: if {[fork]!=0} { 45: wait 46: close $s; return 47: } 48: if {[fork]!=0} { exit } 49: set listport [expr [random 60000]+2048] 50: set r [socket -server HaveFinalConnect $listport] 51: set ForwardTable($listport) "$s $r" 52: puts $controlId "datapipe $dataport $listport $remotehost" 53: flush $controlId 54: } 55: 56: proc HaveFinalConnect {s a p} { 57: global ForwardTable perm 58: set wrk $ForwardTable([lindex [fconfigure $s -sockname] 2]) 59: set src [lindex $wrk 0] 60: set dest $s 61: fileevent $src readable "datapipe $src $dest" 62: fileevent $dest readable "datapipe $dest $src" 63: vwait perm 64: catch { 65: flush $src 66: close $src 67: fileevent $src readable "" 68: 69: puts "Closing $src" 70: } 71: catch { 72: flush $dest 73: close $dest 74: fileevent $dest readable "" 75: puts "Closing $dest" 76: } 77: exit 78: } 79: 80: proc datapipe {src dest} { 81: global perm DEBUG 82: fconfigure $src -blocking 0 -translation binary 83: fconfigure $dest -translation binary 84: set check 0 85: set ln "" 86: catch { set ln [read $src] } 87: puts -nonewline $dest $ln 88: flush $dest 89: if {$DEBUG} { puts -nonewline "$ln"; flush stdout } 90: if {[eof $src] || [eof $dest]} { 91: if {$DEBUG} { puts "\[$src , $dest\] Dead" } 92: catch { close $src } 93: catch { close $dest } 94: set perm 1 95: } 96: } 97: 98: 99: proc checkcontrol {sockId} { 100: global controlport controlList controlId 101: gets $sockId ln 102: if {$ln!=""} { return } 103: fileevent $sockId readable "" 104: close $sockId 105: set controlList [socket -server HaveControl $controlport] 106: vwait controlId 107: close $controlList 108: } 109: 110: 111: proc SendKeepAlive {} { 112: global controlId DEBUG 113: alarm 30 114: catch { 115: puts $controlId "keepalive" 116: flush $controlId 117: } 118: if {$DEBUG} { puts "Sending keepalive" } 119: } 120: 121: 122: set controlList [socket -server HaveControl $controlport] 123: vwait controlId 124: signal trap SIGALRM SendKeepAlive 125: alarm 30 126: close $controlList 127: socket -server HaveConnection $clientlist 128: vwait forever rdatapipe.tcl is the client (unfirewalled) side of rdatapipe. |