|
1 # |
|
2 # Copyright 2004-2006 Intel Corporation |
|
3 # |
|
4 # Licensed under the Apache License, Version 2.0 (the "License"); |
|
5 # you may not use this file except in compliance with the License. |
|
6 # You may obtain a copy of the License at |
|
7 # |
|
8 # http://www.apache.org/licenses/LICENSE-2.0 |
|
9 # |
|
10 # Unless required by applicable law or agreed to in writing, software |
|
11 # distributed under the License is distributed on an "AS IS" BASIS, |
|
12 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
|
13 # See the License for the specific language governing permissions and |
|
14 # limitations under the License. |
|
15 # |
|
16 |
|
17 # |
|
18 # Simple client/server code that scans a directory for new data and sends |
|
19 # that data to a remote host. |
|
20 # |
|
21 # usage: simple_ftp server <dir> <logfile> |
|
22 # usage: simple_ftp client <dir> <logfile> <host> |
|
23 # |
|
24 # |
|
25 |
|
26 |
|
27 # after 1000 |
|
28 # set y [clock clicks -milliseconds] |
|
29 # set f [expr $y - $x] |
|
30 |
|
31 |
|
32 |
|
33 set port 17600 |
|
34 set period 1000 |
|
35 |
|
36 set blocksz 8192 |
|
37 set debugging 1 |
|
38 |
|
39 |
|
40 proc logdebug {name} { |
|
41 if {$debugging} { |
|
42 puts $name |
|
43 } |
|
44 } |
|
45 |
|
46 proc time {} { |
|
47 global starttime |
|
48 return " [clock seconds] :: [expr [clock clicks -milliseconds] - $starttime] :: " |
|
49 } |
|
50 |
|
51 proc timef {} { |
|
52 return [clock format [clock seconds]] |
|
53 } |
|
54 |
|
55 proc scan_dir {host dir} { |
|
56 global period |
|
57 global begin_time |
|
58 |
|
59 puts "scanning dir $dir..." |
|
60 set files [glob -nocomplain -- "$dir/*"] |
|
61 |
|
62 set begin_time "[time]" |
|
63 |
|
64 foreach file $files { |
|
65 file stat $file file_stat |
|
66 |
|
67 if {$file_stat(type) != "file"} { |
|
68 continue |
|
69 } |
|
70 |
|
71 set len $file_stat(size) |
|
72 if {$len == 0} { |
|
73 continue |
|
74 } |
|
75 |
|
76 set sent_file 0 |
|
77 while {$sent_file != 1} { |
|
78 set sent_file [send_file $host $file] |
|
79 if {$sent_file != 1} { after 2000 } |
|
80 } |
|
81 |
|
82 file delete -force $file |
|
83 } |
|
84 |
|
85 after $period scan_dir $host $dir |
|
86 } |
|
87 |
|
88 proc ack_arrived {sock} { |
|
89 |
|
90 global got_ack ack_timer |
|
91 |
|
92 after cancel $ack_timer |
|
93 set got_ack 1 |
|
94 |
|
95 |
|
96 if {[catch { |
|
97 set ack [gets $sock] |
|
98 }]} { |
|
99 puts " [time] ack arrived but cant read on socket!" |
|
100 set got_ack 0 |
|
101 fileevent $sock readable "" |
|
102 catch {close $sock} |
|
103 return |
|
104 } |
|
105 |
|
106 if [eof $sock] { |
|
107 puts " [time] EOF arrived instead of ack!" |
|
108 set got_ack 0 |
|
109 fileevent $sock readable "" |
|
110 catch {close $sock} |
|
111 return |
|
112 } |
|
113 |
|
114 if {$ack != "ACK"} { |
|
115 puts "[time] ERROR in ack_arrived: got '$ack', expected ACK" |
|
116 set got_ack 0 |
|
117 fileevent $sock readable "" |
|
118 return |
|
119 } |
|
120 |
|
121 } |
|
122 |
|
123 proc ack_timeout {} { |
|
124 global got_ack |
|
125 set got_ack 0 |
|
126 puts " [time] ack_timeout" |
|
127 } |
|
128 |
|
129 proc send_file {host file} { |
|
130 global port |
|
131 global logfd |
|
132 global blocksz |
|
133 global got_ack |
|
134 global ack_timer |
|
135 global sock |
|
136 global begin_time |
|
137 |
|
138 set fd [open $file] |
|
139 |
|
140 puts "[time] trying to send file $file size [file size $file]" |
|
141 set start_send_time "[time]" |
|
142 |
|
143 if {! [info exists sock]} { |
|
144 while { [ catch {socket $host $port } sock] } { |
|
145 puts "[time] Trying failed, will try again after 2 seconds " |
|
146 after 2000 |
|
147 puts "[time] Trying again " |
|
148 } |
|
149 puts "[time] Successfull new connection " |
|
150 fconfigure $sock -translation binary |
|
151 fconfigure $sock -encoding binary |
|
152 |
|
153 |
|
154 if [catch { |
|
155 puts $sock "SYN" |
|
156 flush $sock |
|
157 }] { |
|
158 catch { close $sock } |
|
159 unset sock |
|
160 close $fd |
|
161 return -1 |
|
162 } |
|
163 |
|
164 |
|
165 ## Send SYN |
|
166 puts "[time] sending handshake ack" |
|
167 |
|
168 # read the handshake ack |
|
169 fconfigure $sock -blocking 0 |
|
170 set got_ack -1 |
|
171 fileevent $sock readable "ack_arrived $sock" |
|
172 set ack_timer [after 20000 ack_timeout] |
|
173 vwait got_ack |
|
174 |
|
175 if {!$got_ack} { |
|
176 puts "[time] timeout waiting for handshake ack" |
|
177 close $fd |
|
178 catch { close $sock } |
|
179 unset sock |
|
180 return -1 |
|
181 } else { |
|
182 puts "[time] got handshake ack" |
|
183 } |
|
184 } |
|
185 |
|
186 |
|
187 fconfigure $sock -blocking 1 |
|
188 |
|
189 |
|
190 ## Send the filename and size |
|
191 if [catch { |
|
192 puts $sock "[file tail $file] [file size $file]" |
|
193 flush $sock |
|
194 }] { |
|
195 catch { close $sock } |
|
196 unset sock |
|
197 close $fd |
|
198 return -1 |
|
199 } |
|
200 |
|
201 set index 0 |
|
202 ## Send the payload |
|
203 while {![eof $fd]} { |
|
204 if {[catch { |
|
205 set payload [read $fd $blocksz] |
|
206 #puts "[time] $index sending [string length $payload] byte chunk" |
|
207 puts -nonewline $sock $payload |
|
208 flush $sock |
|
209 incr index |
|
210 } ]} { |
|
211 catch { close $sock } |
|
212 unset sock |
|
213 close $fd |
|
214 return -1 |
|
215 } |
|
216 } |
|
217 |
|
218 close $fd |
|
219 |
|
220 # wait for an ack or timeout |
|
221 puts "[time] sent whole file, waiting for ack" |
|
222 fconfigure $sock -blocking 0 |
|
223 set got_ack -1 |
|
224 fileevent $sock readable "ack_arrived $sock" |
|
225 set ack_timer [after 55000 ack_timeout] |
|
226 vwait got_ack |
|
227 |
|
228 if {$got_ack} { |
|
229 puts "[time] :: file actually sent $file" |
|
230 puts $logfd "$start_send_time $begin_time :: file actually sent [file tail $file] " |
|
231 flush $logfd |
|
232 |
|
233 return 1 |
|
234 } else { |
|
235 puts "[time] :: file sent but not acked" |
|
236 catch { close $sock } |
|
237 unset sock |
|
238 return -1 |
|
239 } |
|
240 } |
|
241 |
|
242 proc recv_files {dest_dir} { |
|
243 global port |
|
244 global conns |
|
245 puts "[time] waiting for files: $dest_dir" |
|
246 set conns(main) [socket -server "new_client $dest_dir" $port] |
|
247 } |
|
248 |
|
249 |
|
250 proc new_client {dest_dir sock addr port} { |
|
251 global conns |
|
252 |
|
253 puts " Accept $sock from $addr port $port" |
|
254 |
|
255 # Used for debugging |
|
256 set conns(addr,$sock) [list $addr $port] |
|
257 |
|
258 fconfigure $sock -translation binary |
|
259 fconfigure $sock -encoding binary |
|
260 fconfigure $sock -blocking 0 |
|
261 |
|
262 fileevent $sock readable "syn_arrived $dest_dir $sock" |
|
263 } |
|
264 |
|
265 |
|
266 proc syn_arrived {dest_dir sock} { |
|
267 |
|
268 global length_remaining |
|
269 global conns |
|
270 |
|
271 if {[eof $sock]} { |
|
272 puts "[time] Close $conns(addr,$sock) EOF SYN received" |
|
273 catch { close $sock } |
|
274 unset conns(addr,$sock) |
|
275 return |
|
276 } |
|
277 |
|
278 if {[catch { |
|
279 set L [gets $sock] |
|
280 }]} { |
|
281 catch { close $sock } |
|
282 unset conns(addr,$sock) |
|
283 return |
|
284 } |
|
285 |
|
286 while {$L == ""} { |
|
287 puts "[time] partial syn received... waiting for more" |
|
288 after 20 |
|
289 if {[catch { |
|
290 set L [gets $sock] |
|
291 }]} { |
|
292 catch { close $sock } |
|
293 unset conns(addr,$sock) |
|
294 return |
|
295 } |
|
296 } |
|
297 |
|
298 # Check if this is really a SYN |
|
299 puts "[time] got SYN" |
|
300 puts $sock "ACK" |
|
301 flush $sock |
|
302 |
|
303 fileevent $sock readable "header_arrived $dest_dir $sock" |
|
304 |
|
305 } |
|
306 |
|
307 |
|
308 proc header_arrived {dest_dir sock} { |
|
309 global length_remaining |
|
310 global conns |
|
311 |
|
312 puts "[time] header arrived" |
|
313 |
|
314 if {[catch { |
|
315 set L [gets $sock] |
|
316 }]} { |
|
317 catch { close $sock } |
|
318 unset conns(addr,$sock) |
|
319 return |
|
320 } |
|
321 |
|
322 if {[eof $sock]} { |
|
323 puts "[time] Close $conns(addr,$sock) EOF received" |
|
324 catch { close $sock } |
|
325 unset conns(addr,$sock) |
|
326 return |
|
327 } |
|
328 |
|
329 while {$L == ""} { |
|
330 if {[eof $sock]} { puts "Unexpected EOF reached, check check" } |
|
331 puts "[time] partial header line received... waiting for more " |
|
332 after 20 |
|
333 if {[catch { |
|
334 set L [gets $sock] |
|
335 }]} { |
|
336 catch { close $sock } |
|
337 unset conns(addr,$sock) |
|
338 return |
|
339 } |
|
340 |
|
341 } |
|
342 |
|
343 foreach {filename length} $L {} |
|
344 |
|
345 puts "[time] getting file $filename length is: $length" |
|
346 set to_fd [open "$dest_dir/$filename" w] |
|
347 set length_remaining($sock) $length |
|
348 |
|
349 fileevent $sock readable "file_arrived $filename $to_fd $dest_dir $sock" |
|
350 } |
|
351 |
|
352 |
|
353 proc file_arrived {file to_fd dest_dir sock} { |
|
354 |
|
355 global logfd |
|
356 global conns |
|
357 global length_remaining |
|
358 |
|
359 |
|
360 if {[eof $sock]} { |
|
361 puts "[time] Close $conns(addr,$sock) EOF received" |
|
362 catch { close $sock } |
|
363 unset conns(addr,$sock) |
|
364 return |
|
365 } |
|
366 |
|
367 if {[catch { |
|
368 set payload [read $sock $length_remaining($sock)] |
|
369 }]} { |
|
370 catch { close $sock } |
|
371 unset conns(addr,$sock) |
|
372 return |
|
373 } |
|
374 |
|
375 puts -nonewline $to_fd $payload |
|
376 set got [string length $payload] |
|
377 set todo [expr $length_remaining($sock) - $got] |
|
378 # puts "got $got byte chunk ($todo to go)" |
|
379 |
|
380 if {$todo < 0} { |
|
381 error "negative todo" |
|
382 } |
|
383 |
|
384 if {$todo == 0} { |
|
385 puts $sock "ACK" |
|
386 flush $sock |
|
387 puts "[time] sending ack for file $file" |
|
388 |
|
389 fileevent $sock readable "header_arrived $dest_dir $sock" |
|
390 puts $logfd "[time] :: got file [file tail $file] at [timef]" |
|
391 close $to_fd |
|
392 flush $logfd |
|
393 } |
|
394 |
|
395 set length_remaining($sock) $todo |
|
396 } |
|
397 |
|
398 |
|
399 # Define a bgerror proc to print the error stack when errors occur in |
|
400 # event handlers |
|
401 proc bgerror {err} { |
|
402 global errorInfo |
|
403 puts "tcl error: $err\n$errorInfo" |
|
404 } |
|
405 |
|
406 proc usage {} { |
|
407 puts "usage: simple_ftp server <dir> <logfile>" |
|
408 puts "usage: simple_ftp client <dir> <logfile> <host>" |
|
409 exit -1 |
|
410 } |
|
411 |
|
412 set argc [llength $argv] |
|
413 if {$argc < 3} { |
|
414 usage |
|
415 } |
|
416 |
|
417 set mode [lindex $argv 0] |
|
418 set dir [lindex $argv 1] |
|
419 set logfile [lindex $argv 2] |
|
420 set logfd [open $logfile w] |
|
421 |
|
422 set starttime [clock clicks -milliseconds] |
|
423 puts "Starting in $mode, dir is $dir at [timef]" |
|
424 |
|
425 |
|
426 if {$mode == "server"} { |
|
427 recv_files $dir |
|
428 } elseif {$mode == "client"} { |
|
429 set host [lindex $argv 3] |
|
430 scan_dir $host $dir |
|
431 } else { |
|
432 error "unknown mode $mode" |
|
433 } |
|
434 |
|
435 vwait forever |