1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
#!/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
|
