#!/usr/bin/tcl
# Do we enable debugging? (genenerally a bad idea)
set DEBUG 0

# What port should we use as the control port (must be the same on
# rdatapipe)?
set controlport 4500

#############################################################################
#############################################################################
#############################################################################
# This is my mess. ##########################################################
#############################################################################


set dataport [lindex $argv 1]
set clientlist [lindex $argv 0]
set remotehost [lindex $argv 2]
if {$clientlist==""} { puts "Usage:\n\t$argv0 <local-port> \[<remote-prot> \[<remote-host>\] \]"; exit }
if {$dataport==""} { set dataport $clientlist }
if {$remotehost==""} { set remotehost 127.0.0.1 }
if {!$DEBUG} {
  if {[fork]!=0} { exit }
}


# Background errors, blah.
proc bgerror {error} { puts "Error: $error"; return }


# When the rdatapiped server contacts us, store its file descriptor.
proc HaveControl {s a p} {
  global controlId DEBUG
  set controlId $s
  fileevent $s readable "checkcontrol $s"
  if {$DEBUG} { puts "Have control" }
}

# When we get a connection from a client, communicate with
# rdatapiped and setup the pipes
proc HaveConnection {s a p} {
  global dataport controlId ForwardTable DEBUG remotehost
  random seed [expr abs([clock clicks])]
  if {[fork]!=0} { 
    wait
    close $s; return 
  }
  if {[fork]!=0} { exit }
  set listport [expr [random 60000]+2048]
  set r [socket -server HaveFinalConnect $listport]
  set ForwardTable($listport) "$s $r"
  puts $controlId "datapipe $dataport $listport $remotehost"
  flush $controlId
}

proc HaveFinalConnect {s a p} {
  global ForwardTable perm
  set wrk $ForwardTable([lindex [fconfigure $s -sockname] 2])
  set src [lindex $wrk 0]
  set dest $s
  fileevent $src readable "datapipe $src $dest"
  fileevent $dest readable "datapipe $dest $src"
  vwait perm
  catch { 
    flush $src
    close $src 
    fileevent $src readable ""

    puts "Closing $src"
  }
  catch {
    flush $dest
    close $dest
    fileevent $dest readable ""
    puts "Closing $dest"
  }
  exit
}

proc datapipe {src dest} {
  global perm DEBUG
  fconfigure $src -blocking 0 -translation binary
  fconfigure $dest -translation binary
  set check 0
  set ln ""
  catch { set ln [read $src] }
  puts -nonewline $dest $ln
  flush $dest
  if {$DEBUG} { puts -nonewline "$ln"; flush stdout }
  if {[eof $src] || [eof $dest]} {
    if {$DEBUG} { puts "\[$src ,  $dest\] Dead" }
    catch { close $src }
    catch { close $dest }
    set perm 1
  }
}


proc checkcontrol {sockId} {
  global controlport controlList controlId
  gets $sockId ln
  if {$ln!=""} { return }
  fileevent $sockId readable ""
  close $sockId
  set controlList [socket -server HaveControl $controlport]
  vwait controlId
  close $controlList 
}


proc SendKeepAlive {} {
  global controlId DEBUG
  alarm 30
  catch {
    puts  $controlId "keepalive"
    flush $controlId
  }
  if {$DEBUG} { puts "Sending keepalive" }
}


set controlList [socket -server HaveControl $controlport]
vwait controlId
signal trap SIGALRM SendKeepAlive
alarm 30
close $controlList
socket -server HaveConnection $clientlist
vwait forever
