|
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 |
|
38 proc time {} { |
|
39 global starttime |
|
40 return " [clock seconds] :: [expr [clock clicks -milliseconds] - $starttime] :: " |
|
41 } |
|
42 |
|
43 proc timef {} { |
|
44 return [clock format [clock seconds]] |
|
45 } |
|
46 |
|
47 proc scan_dir {host dir} { |
|
48 global period |
|
49 |
|
50 puts "scanning dir $dir..." |
|
51 set files [glob -nocomplain -- "$dir/*"] |
|
52 |
|
53 foreach file $files { |
|
54 file stat $file file_stat |
|
55 |
|
56 if {$file_stat(type) != "file"} { |
|
57 continue |
|
58 } |
|
59 |
|
60 set len $file_stat(size) |
|
61 if {$len == 0} { |
|
62 continue |
|
63 } |
|
64 |
|
65 set sent_file 0 |
|
66 while {$sent_file != 1} { |
|
67 set sent_file [send_file $host $file] |
|
68 if {$sent_file != 1} { after 2000 } |
|
69 } |
|
70 |
|
71 file delete -force $file |
|
72 } |
|
73 |
|
74 after $period scan_dir $host $dir |
|
75 } |
|
76 |
|
77 proc ack_arrived {sock} { |
|
78 global got_ack ack_timer |
|
79 after cancel $ack_timer |
|
80 set got_ack 1 |
|
81 |
|
82 set ack [gets $sock] |
|
83 if [eof $sock] { |
|
84 puts " [time] eof waiting for ack!" |
|
85 set got_ack 0 |
|
86 fileevent $sock readable "" |
|
87 catch {close $sock} |
|
88 return |
|
89 } |
|
90 if {$ack != "ACK"} { |
|
91 puts "[time] ERROR in ack_arrived: got '$ack', expected ACK" |
|
92 set got_ack 0 |
|
93 fileevent $sock readable "" |
|
94 return |
|
95 } |
|
96 } |
|
97 |
|
98 proc ack_timeout {} { |
|
99 global got_ack |
|
100 set got_ack 0 |
|
101 puts " [time] ack_timeout" |
|
102 } |
|
103 |
|
104 proc send_file {host file} { |
|
105 global port |
|
106 global logfd |
|
107 global blocksz |
|
108 global got_ack |
|
109 global ack_timer |
|
110 global sock |
|
111 set fd [open $file] |
|
112 |
|
113 puts "[time] trying to send file $file size [file size $file]" |
|
114 |
|
115 if {! [info exists sock]} { |
|
116 while { [ catch {socket $host $port } sock] } { |
|
117 puts "[time] Trying to connect, will try again after 2 seconds " |
|
118 after 2000 |
|
119 } |
|
120 |
|
121 fconfigure $sock -translation binary |
|
122 fconfigure $sock -encoding binary |
|
123 } |
|
124 |
|
125 if [catch { |
|
126 puts $sock "[file tail $file] [file size $file]" |
|
127 flush $sock |
|
128 }] { |
|
129 close $sock |
|
130 unset sock |
|
131 close $fd |
|
132 return -1 |
|
133 } |
|
134 |
|
135 # read the handshake ack |
|
136 set got_ack -1 |
|
137 fileevent $sock readable "ack_arrived $sock" |
|
138 set ack_timer [after 10000 ack_timeout] |
|
139 vwait got_ack |
|
140 |
|
141 if {!$got_ack} { |
|
142 puts "[time] timeout waiting for handshake ack" |
|
143 close $fd |
|
144 catch {close $sock} |
|
145 unset sock |
|
146 return -1 |
|
147 } |
|
148 |
|
149 puts "[time] got handshake ack" |
|
150 |
|
151 while {![eof $fd]} { |
|
152 if {[catch { |
|
153 set payload [read $fd $blocksz] |
|
154 # puts "sending [string length $payload] byte chunk" |
|
155 puts -nonewline $sock $payload |
|
156 flush $sock |
|
157 } ]} { |
|
158 close $sock |
|
159 unset sock |
|
160 close $fd |
|
161 return -1 |
|
162 } |
|
163 } |
|
164 |
|
165 close $fd |
|
166 |
|
167 # wait for an ack or timeout |
|
168 puts "[time] sent whole file, waiting for ack" |
|
169 fconfigure $sock -blocking 0 |
|
170 set got_ack -1 |
|
171 fileevent $sock readable "ack_arrived $sock" |
|
172 set ack_timer [after 5000 ack_timeout] |
|
173 vwait got_ack |
|
174 |
|
175 if {$got_ack} { |
|
176 puts "[time] :: file actually sent $file" |
|
177 puts $logfd "[time] :: file actually sent [file tail $file] " |
|
178 flush $logfd |
|
179 |
|
180 return 1 |
|
181 } else { |
|
182 puts "[time] :: file sent but not acked" |
|
183 catch {close $sock} |
|
184 unset sock |
|
185 return -1 |
|
186 } |
|
187 } |
|
188 |
|
189 proc recv_files {dest_dir} { |
|
190 global port |
|
191 global conns |
|
192 puts "[time] waiting for files: $dest_dir" |
|
193 set conns(main) [socket -server "new_client $dest_dir" $port] |
|
194 } |
|
195 |
|
196 |
|
197 proc new_client {dest_dir sock addr port} { |
|
198 global conns |
|
199 |
|
200 puts " Accept $sock from $addr port $port" |
|
201 |
|
202 # Used for debugging |
|
203 set conns(addr,$sock) [list $addr $port] |
|
204 |
|
205 fconfigure $sock -translation binary |
|
206 fconfigure $sock -encoding binary |
|
207 fconfigure $sock -blocking 0 |
|
208 |
|
209 fileevent $sock readable "header_arrived $dest_dir $sock" |
|
210 } |
|
211 |
|
212 proc header_arrived {dest_dir sock} { |
|
213 global length_remaining |
|
214 global conns |
|
215 global partial |
|
216 |
|
217 puts "[time] header arrived" |
|
218 |
|
219 |
|
220 |
|
221 if {[eof $sock]} { |
|
222 puts "[time] Close $conns(addr,$sock) EOF received" |
|
223 close $sock |
|
224 unset conns(addr,$sock) |
|
225 return |
|
226 } |
|
227 |
|
228 |
|
229 |
|
230 set L [gets $sock] |
|
231 while {$L == ""} { |
|
232 puts "[time] partial header line received... waiting for more" |
|
233 after 20 |
|
234 set L [gets $sock] |
|
235 } |
|
236 |
|
237 if {[info exists partial($sock)]} { |
|
238 puts "[time] merging partial line '$partial($sock)' with '$L'" |
|
239 set L "$partial($sock)$L" |
|
240 unset partial($sock) |
|
241 } |
|
242 |
|
243 foreach {filename length} $L {} |
|
244 |
|
245 puts "[time] getting file $filename length $length" |
|
246 |
|
247 puts $sock "ACK" |
|
248 flush $sock |
|
249 |
|
250 set to_fd [open "$dest_dir/$filename" w] |
|
251 set length_remaining($sock) $length |
|
252 |
|
253 fileevent $sock readable "file_arrived $filename $to_fd $dest_dir $sock" |
|
254 } |
|
255 |
|
256 |
|
257 proc file_arrived {file to_fd dest_dir sock} { |
|
258 |
|
259 global logfd |
|
260 global conns |
|
261 global length_remaining |
|
262 |
|
263 if {[eof $sock]} { |
|
264 puts "[time] Close $conns(addr,$sock) EOF received" |
|
265 close $sock |
|
266 unset conns(addr,$sock) |
|
267 return |
|
268 } |
|
269 |
|
270 |
|
271 |
|
272 set payload [read $sock] |
|
273 puts -nonewline $to_fd $payload |
|
274 set got [string length $payload] |
|
275 set todo [expr $length_remaining($sock) - $got] |
|
276 puts "got $got byte chunk ($todo to go)" |
|
277 |
|
278 if {$todo < 0} { |
|
279 error "negative todo" |
|
280 } |
|
281 |
|
282 if {$todo == 0} { |
|
283 puts $sock "ACK" |
|
284 flush $sock |
|
285 puts "[time] sending ack for file $file" |
|
286 |
|
287 fileevent $sock readable "header_arrived $dest_dir $sock" |
|
288 puts $logfd "[time] :: got file [file tail $file] at [timef]" |
|
289 close $to_fd |
|
290 flush $logfd |
|
291 } |
|
292 |
|
293 set length_remaining($sock) $todo |
|
294 } |
|
295 |
|
296 |
|
297 # Define a bgerror proc to print the error stack when errors occur in |
|
298 # event handlers |
|
299 proc bgerror {err} { |
|
300 global errorInfo |
|
301 puts "tcl error: $err\n$errorInfo" |
|
302 } |
|
303 |
|
304 proc usage {} { |
|
305 puts "usage: simple_ftp server <dir> <logfile>" |
|
306 puts "usage: simple_ftp client <dir> <logfile> <host>" |
|
307 exit -1 |
|
308 } |
|
309 |
|
310 set argc [llength $argv] |
|
311 if {$argc < 3} { |
|
312 usage |
|
313 } |
|
314 |
|
315 set mode [lindex $argv 0] |
|
316 set dir [lindex $argv 1] |
|
317 set logfile [lindex $argv 2] |
|
318 set logfd [open $logfile w] |
|
319 |
|
320 set starttime [clock clicks -milliseconds] |
|
321 puts "Starting in $mode, dir is $dir at [timef]" |
|
322 |
|
323 |
|
324 if {$mode == "server"} { |
|
325 recv_files $dir |
|
326 } elseif {$mode == "client"} { |
|
327 set host [lindex $argv 3] |
|
328 scan_dir $host $dir |
|
329 } else { |
|
330 error "unknown mode $mode" |
|
331 } |
|
332 |
|
333 vwait forever |