#!/usr/bin/tcl
# Enable debugging?  (generally a bad idea)
set DEBUG 0

# What port should be used as the control port (must be the same as the
# rdatapipe server)?
set controlport 4500





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



set host [lindex $argv 0]
if {$host==""} { puts "Usage:\n\t$argv0 <host>"; exit }


if {!$DEBUG} {
  if {[fork]!=0} { exit 1 }
}


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 HandleCommand {sock} {
  global forever host DEBUG
  gets $sock ln
  set cmd [lindex $ln 0]
  set arg [lrange $ln 1 end]
  switch -- $cmd {
    "datapipe" {
      if {[fork]!=0} { wait; return }
      if {[fork]!=0} { exit }
      set SelfPort [lindex $arg 0]
      set DestPort [lindex $arg 1]
      set RemtHost [lindex $arg 2]
      set DestHost [lindex $arg 3]
      if {$DestHost==""} { set DestHost $host }
      if {$RemtHost==""} { set RemtHost 127.0.0.1 }
      catch { 
        set selfId [socket $RemtHost $SelfPort]
        fconfigure $selfId -blocking 0
        set destId [socket $DestHost $DestPort]
        fconfigure $destId -blocking 0

      }
      if {![info exists selfId] || ![info exists destId]} {
        if {$DEBUG} { puts "Connection failed." }
        catch { close $selfId }
        catch { close $destId }
        exit
      }
      if {$DEBUG} { puts "\[$selfId ,  $destId\] Connection completed." }
      fileevent $selfId readable "datapipe $selfId $destId"
      fileevent $destId readable "datapipe $destId $selfId"
      flush $destId
      vwait perm
      exit
    }
    "keepalive" { 
      if {$DEBUG} { puts "Recieved keepalive [clock seconds]" }
    }
    default {
      if {$DEBUG && $cmd!=""} { puts "Unknown command: $cmd -- $arg" }
    }
  }
  if {[eof $sock]} { set forever 1 }
}

proc bgerror {error} { puts "Error: $error"; return }

while {1} {
  set sockId ""
  catch { set sockId [socket $host $controlport] }
  if {$sockId!=""} {
    fconfigure $sockId -blocking 0
    fileevent $sockId readable "HandleCommand $sockId"
    vwait forever
    close $sockId
  } else {
    sleep 30
  }
}
