123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110 |
- #!/usr/bin/tclsh
- set read_running 0
- set write_running 0
- set read_eof 0
- set theend 0
- set nread 0
- set nwritten 0
- proc ReadBack {fd} {
- if { !$::write_running } {
- puts stderr "ERROR: connection closed unexpectedly!"
- set ::theend 1
- return
- }
- set r [read $fd 4096]
- if {$r == ""} {
- if {[eof $fd]} {
- puts stderr "EOF on socket"
- set ::read_running 0
- return
- }
- # --- puts stderr "SPURIOUS, not reading"
- return
- }
- # --- puts stderr "REPRINTING [string bytelength $r] bytes"
- puts -nonewline stdout $r
- incr ::nwritten [string bytelength $r]
- # --- puts stderr "DONE"
- set remain [expr {$::nread - $::nwritten}]
- if { $::read_eof } {
- puts stderr "Finishing... read=$::nread written=$::nwritten diff=[expr {$::nwritten - $::nread}] - [expr {100.0*$remain/$::nread}]%"
- }
- # Nothing more to read
- if {$remain == 0} {
- puts stderr "NOTHING MORE TO BE WRITTEN - exiting"
- set ::theend 1
- return
- }
- after idle "ReadBack $fd"
- }
- proc SendToSocket {fd} {
- global theend
- if { !$::write_running } {
- # --- puts stderr "SERVER DOWN, not reading"
- fileevent stdin readable {}
- return
- }
- if { $::read_eof } {
- # Don't read, already EOF.
- }
- # --- puts stderr "READING cin"
- set r [read stdin 4096]
- if {$r == ""} {
- if {[eof stdin]} {
- if {!$::read_eof} {
- puts stderr "EOF, setting server off"
- set ::read_eof 1
- }
- # Just enough when the next SendToSocket will
- # not be scheduled.
- return
- }
- # --- puts stderr "SPURIOUS, not reading"
- return
- }
- # --- puts stderr "SENDING [string bytelength $r] bytes"
- # Set blocking for a short moment of sending
- # in order to prevent losing data that must wait
- fconfigure $fd -blocking yes
- puts -nonewline $fd $r
- incr ::nread [string bytelength $r]
- fconfigure $fd -blocking no
- # --- if {[fblocked stdin]} {
- # --- # Nothing more to read
- # --- return
- # --- }
- after idle "SendToSocket $fd"
- }
- set fd [socket {*}$argv]
- fconfigure $fd -encoding binary -translation binary -blocking no -buffering none
- fileevent $fd readable "ReadBack $fd"
- fconfigure stdin -encoding binary -translation binary -blocking no
- fconfigure stdout -encoding binary -translation binary
- fileevent stdin readable "SendToSocket $fd"
- # --- puts stderr "READY, sending"
- set read_running 1
- set write_running 1
- vwait theend
- close $fd
|