|
1 #!/usr/bin/tclsh |
|
2 |
|
3 # |
|
4 # Copyright 2005-2008 Intel Corporation |
|
5 # |
|
6 # Licensed under the Apache License, Version 2.0 (the "License"); |
|
7 # you may not use this file except in compliance with the License. |
|
8 # You may obtain a copy of the License at |
|
9 # |
|
10 # http://www.apache.org/licenses/LICENSE-2.0 |
|
11 # |
|
12 # Unless required by applicable law or agreed to in writing, software |
|
13 # distributed under the License is distributed on an "AS IS" BASIS, |
|
14 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
|
15 # See the License for the specific language governing permissions and |
|
16 # limitations under the License. |
|
17 # |
|
18 |
|
19 # |
|
20 # Simple client/server file transfer protocol |
|
21 # |
|
22 |
|
23 proc usage {} { |
|
24 puts "usage: simple_ftp server [opts]" |
|
25 puts "usage: simple_ftp client <file> <copies> <host> [opts]" |
|
26 exit 1 |
|
27 } |
|
28 |
|
29 set port 17600 |
|
30 set blocksz 1024 |
|
31 set delay 1000 |
|
32 set data_timeout 10000 |
|
33 |
|
34 set debug 0 |
|
35 proc log {msg} { |
|
36 global debug |
|
37 if {$debug} { |
|
38 puts "[clock seconds]: $msg" |
|
39 } |
|
40 } |
|
41 |
|
42 proc start_file {} { |
|
43 global file sent copies |
|
44 if {$sent == $copies} { |
|
45 log "start_file: $sent copies already sent..." |
|
46 return |
|
47 } |
|
48 |
|
49 global fd |
|
50 if [info exists fd] { |
|
51 catch {close $fd} |
|
52 } |
|
53 if [catch { |
|
54 set fd [open $file r] |
|
55 } err] { |
|
56 puts "error opening file $file: $err" |
|
57 exit 1 |
|
58 } |
|
59 |
|
60 global sock host port delay |
|
61 if {! [info exists sock]} { |
|
62 if { [catch { |
|
63 set sock [socket $host $port] |
|
64 } err] } { |
|
65 puts "[clock seconds]: failed to connect... will try again after $delay ms" |
|
66 after $delay start_file |
|
67 return |
|
68 } |
|
69 |
|
70 log "connected..." |
|
71 fconfigure $sock -translation binary |
|
72 fconfigure $sock -encoding binary |
|
73 fconfigure $sock -buffering none |
|
74 fconfigure $sock -blocking false |
|
75 } |
|
76 |
|
77 # send the header |
|
78 set length [file size $file] |
|
79 puts $sock "[file tail $file] [expr $sent + 1] $length" |
|
80 |
|
81 fileevent $sock writable send_data |
|
82 fileevent $sock readable handle_data |
|
83 |
|
84 global data_timeout no_data_timer |
|
85 if {$data_timeout != 0 && ![info exists no_data_timer]} { |
|
86 set no_data_timer [after $data_timeout handle_data_timeout] |
|
87 } |
|
88 } |
|
89 |
|
90 proc send_data {} { |
|
91 global sock fd blocksz sent delay |
|
92 |
|
93 set data [read $fd $blocksz] |
|
94 |
|
95 if {[string length $data] != 0} { |
|
96 log "sending [string length $data] byte chunk" |
|
97 puts -nonewline $sock $data |
|
98 } |
|
99 |
|
100 if [eof $fd] { |
|
101 puts "[clock seconds]: file $sent transmitted" |
|
102 close $fd |
|
103 fileevent $sock writable "" |
|
104 incr sent |
|
105 after $delay start_file |
|
106 return |
|
107 } |
|
108 |
|
109 } |
|
110 |
|
111 proc handle_data {} { |
|
112 global sock |
|
113 if [catch { |
|
114 set data [gets $sock] |
|
115 } err] { |
|
116 log "data arrived but error reading from socket!" |
|
117 close_and_restart |
|
118 return |
|
119 } |
|
120 |
|
121 if {[eof $sock]} { |
|
122 puts "[clock seconds] EOF on socket" |
|
123 close_and_restart |
|
124 return |
|
125 } |
|
126 |
|
127 global data_timeout no_data_timer |
|
128 if {$data_timeout != 0} { |
|
129 after cancel $no_data_timer |
|
130 set no_data_timer [after $data_timeout handle_data_timeout] |
|
131 } |
|
132 |
|
133 if {$data == ""} { |
|
134 log "warning: got empty data" |
|
135 return |
|
136 } |
|
137 |
|
138 if {$data == "."} { |
|
139 log "KEEPALIVE" |
|
140 return |
|
141 } |
|
142 |
|
143 if {[lindex $data 0] != "ack"} { |
|
144 log "ERROR in ack_arrived: got '$data', expected ack" |
|
145 exit 1 |
|
146 } |
|
147 |
|
148 set num [lindex $data 1] |
|
149 puts "[clock seconds]: file $num acked" |
|
150 |
|
151 global acked copies |
|
152 if {$num != [expr $acked + 1]} { |
|
153 log "sync error... ack for $num but acked == $acked" |
|
154 } |
|
155 |
|
156 set acked $num |
|
157 |
|
158 if {$acked == $copies} { |
|
159 puts "[clock seconds]: all $copies copies sent and acked" |
|
160 exit 0 |
|
161 } |
|
162 } |
|
163 |
|
164 |
|
165 proc handle_data_timeout {} { |
|
166 puts "[clock seconds]: timeout waiting for incoming data" |
|
167 close_and_restart |
|
168 } |
|
169 |
|
170 proc cleanup_sock {sock} { |
|
171 catch { |
|
172 fileevent $sock writable "" |
|
173 fileevent $sock readable "" |
|
174 close $sock |
|
175 } |
|
176 } |
|
177 |
|
178 proc close_and_restart {} { |
|
179 global sock sent acked no_data_timer delay |
|
180 |
|
181 if [info exists sock] { |
|
182 cleanup_sock $sock |
|
183 unset sock |
|
184 } |
|
185 |
|
186 # be careful... at this point we need to change the sent |
|
187 # marker to equal the acked marker so that we properly re-send |
|
188 # the files |
|
189 set sent $acked |
|
190 |
|
191 if [info exists no_data_timer] { |
|
192 after cancel $no_data_timer |
|
193 unset no_data_timer |
|
194 } |
|
195 |
|
196 after $delay start_file |
|
197 } |
|
198 |
|
199 proc start_server {} { |
|
200 global port |
|
201 puts "[clock seconds]: starting server om port $port..." |
|
202 socket -server "new_client" $port |
|
203 } |
|
204 |
|
205 proc new_client {sock addr port} { |
|
206 puts "[clock seconds]: new client from $addr port $port" |
|
207 |
|
208 fconfigure $sock -translation binary |
|
209 fconfigure $sock -encoding binary |
|
210 fconfigure $sock -blocking false |
|
211 fconfigure $sock -buffering none |
|
212 |
|
213 fileevent $sock readable "header_arrived $sock" |
|
214 } |
|
215 |
|
216 proc header_arrived {sock} { |
|
217 set l [gets $sock] |
|
218 if [eof $sock] { |
|
219 log "eof on socket $sock" |
|
220 fileevent $sock readable "" |
|
221 close $sock |
|
222 return |
|
223 } |
|
224 |
|
225 if {$l == ""} { |
|
226 log "warning: got empty line..." |
|
227 return |
|
228 } |
|
229 |
|
230 if {[llength $l] != 3} { |
|
231 log "protocol error: got header line $l" |
|
232 exit 1 |
|
233 } |
|
234 |
|
235 log "incoming file $l" |
|
236 set file [lindex $l 0] |
|
237 set num [lindex $l 1] |
|
238 set length [lindex $l 2] |
|
239 |
|
240 set fd [open "$file.$num" w] |
|
241 global todo |
|
242 set todo($sock) $length |
|
243 fileevent $sock readable "data_arrived $sock $file $fd $num $length" |
|
244 } |
|
245 |
|
246 proc data_arrived {sock file fd num length} { |
|
247 global todo |
|
248 |
|
249 if [catch { |
|
250 set data [read $sock $todo($sock)] |
|
251 } err] { |
|
252 log "error reading from $sock: $err" |
|
253 cleanup_sock $sock |
|
254 return |
|
255 } |
|
256 |
|
257 if {[eof $sock]} { |
|
258 puts "[clock seconds]: eof on $sock" |
|
259 cleanup_sock $sock |
|
260 return |
|
261 } |
|
262 |
|
263 set rcvd [string length $data] |
|
264 puts -nonewline $fd $data |
|
265 |
|
266 incr todo($sock) -$rcvd |
|
267 log "got ${rcvd}/${length} bytes ($todo($sock) todo)" |
|
268 |
|
269 if {$todo($sock) < 0} { |
|
270 error "negative todo" |
|
271 } |
|
272 |
|
273 if {$todo($sock) == 0} { |
|
274 puts "[clock seconds] got complete file '$file' copy $num... sending ack" |
|
275 close $fd |
|
276 puts $sock "ack $num" |
|
277 fileevent $sock readable "header_arrived $sock" |
|
278 } |
|
279 } |
|
280 |
|
281 # Define a bgerror proc to print the error stack when errors occur in |
|
282 # event handlers |
|
283 proc bgerror {err} { |
|
284 global errorInfo |
|
285 puts "tcl error: $err\n$errorInfo" |
|
286 } |
|
287 |
|
288 # ARGS |
|
289 set argc [llength $argv] |
|
290 if {$argc < 1} { |
|
291 usage |
|
292 } |
|
293 |
|
294 proc parse_opts {opts} { |
|
295 foreach {var val} $opts { |
|
296 if {$var == "-port"} { |
|
297 global port |
|
298 set port $val |
|
299 |
|
300 } elseif {$var == "-timeout"} { |
|
301 global data_timeout |
|
302 set data_timeout $val |
|
303 |
|
304 } else { |
|
305 error "invalid option $var" |
|
306 } |
|
307 } |
|
308 } |
|
309 |
|
310 set mode [lindex $argv 0] |
|
311 if {$mode == "server"} { |
|
312 parse_opts [lrange $argv 1 end] |
|
313 start_server |
|
314 } elseif {$mode == "client"} { |
|
315 set file [lindex $argv 1] |
|
316 set copies [lindex $argv 2] |
|
317 set host [lindex $argv 3] |
|
318 parse_opts [lrange $argv 4 end] |
|
319 |
|
320 set sent 0 |
|
321 set acked 0 |
|
322 puts "[clock seconds]: client sending $copies copies of $file to $host:$port" |
|
323 start_file |
|
324 } else { |
|
325 error "unknown mode $mode" |
|
326 } |
|
327 |
|
328 vwait forever |