Posted to tcl by kostix at Sat Nov 28 14:40:27 GMT 2009view raw

  1. proc usage {{error ""}} {
  2. if {$error != ""} {
  3. puts stderr $error
  4. }
  5. puts stderr "Usage: [file tail [info name]] REMOTE_HOST:REMOTE_PORT\
  6. \[LOCAL_HOST:\]LOCAL_PORT"
  7. }
  8.  
  9. if {[llength $argv] != 2} {
  10. usage "Wrong number of arguments"
  11. exit 1
  12. }
  13.  
  14. foreach {rhost rport} [split [lindex $argv 0] :] break
  15. foreach {lhost lport} [split [lindex $argv 1] :] break
  16. if {$rhost == "" || $rport == ""} {
  17. usage "Destination host or port missing"
  18. exit 1
  19. }
  20. if {$lhost == ""} {
  21. if {$lport == ""} {
  22. usage "Missing local port"
  23. exit 1
  24. } else {
  25. set lhost localhost
  26. }
  27. } else {
  28. if {$lport == ""} {
  29. if {[llength [split [lindex $argv 1] :]] == 1} {
  30. # "non-empty string w/o :" case:
  31. set lport $lhost
  32. set lhost localhost
  33. } else {
  34. usage "Missing local port"
  35. exit 1
  36. }
  37. }
  38. }
  39.  
  40. puts dest=<$rhost>:<$rport>,src=<$lhost>:<$lport>
  41.  
  42. proc accept {rhost rport local chost cport} {
  43. if {[catch {socket $rhost $rport} remote]} {
  44. close $local
  45. } else {
  46. foreach sock {local remote} {
  47. fconfigure [set $sock] -blocking no -buffering none -translation binary
  48. fileevent $local readable [list pass $local $remote]
  49. fileevent $remote readable [list pass $remote $local]
  50. }
  51. }
  52. }
  53.  
  54. proc pass {from to} {
  55. if {[eof $from]} {
  56. close $from
  57. close $to
  58. } else {
  59. puts -nonewline $to [read $from]
  60. }
  61. }
  62.  
  63. socket -server [list accept $rhost $rport] -myaddr $lhost $lport
  64.  
  65. vwait forever
  66.