Commit | Line | Data |
79072805 |
1 | #-*-perl-*- |
2 | # This is a wrapper to the chat2.pl routines that make life easier |
3 | # to do ftp type work. |
4 | # Mostly by Lee McLoughlin <lmjm@doc.ic.ac.uk> |
5 | # based on original version by Alan R. Martello <al@ee.pitt.edu> |
6 | # And by A.Macpherson@bnr.co.uk for multi-homed hosts |
7 | # |
8 | # $Header: /a/swan/home/swan/staff/csg/lmjm/src/perl/mirror/RCS/ftp.pl,v 1.17 1993/04/21 10:06:54 lmjm Exp lmjm $ |
9 | # $Log: ftp.pl,v $ |
10 | # Revision 1.17 1993/04/21 10:06:54 lmjm |
11 | # Send all status reports to STDERR not to STDOUT (to allow use by ftpcat). |
12 | # Allow target file to be '-' meaning STDOUT |
13 | # Added ftp'quote |
14 | # |
15 | # Revision 1.16 1993/01/28 18:59:05 lmjm |
16 | # Allow socket arguemtns to come from main. |
17 | # Minor cleanups - removed old comments. |
18 | # |
19 | # Revision 1.15 1992/11/25 21:09:30 lmjm |
20 | # Added another REST return code. |
21 | # |
22 | # Revision 1.14 1992/08/12 14:33:42 lmjm |
23 | # Fail ftp'write if out of space. |
24 | # |
25 | # Revision 1.13 1992/03/20 21:01:03 lmjm |
26 | # Added in the proxy ftp code from Edwards Reed <err@cinops.xerox.com> |
27 | # Added ftp'delete from Aaron Wohl <aw0g+@andrew.cmu.edu> |
28 | # |
29 | # Revision 1.12 1992/02/06 23:25:56 lmjm |
30 | # Moved code around so can use this as a lib for both mirror and ftpmail. |
31 | # Time out opens. In case Unix doesn't bother to. |
32 | # |
33 | # Revision 1.11 1991/11/27 22:05:57 lmjm |
34 | # Match the response code number at the start of a line allowing |
35 | # for any leading junk. |
36 | # |
37 | # Revision 1.10 1991/10/23 22:42:20 lmjm |
38 | # Added better timeout code. |
39 | # Tried to optimise file transfer |
40 | # Moved open/close code to not leak file handles. |
41 | # Cleaned up the alarm code. |
42 | # Added $fatalerror to show wether the ftp link is really dead. |
43 | # |
44 | # Revision 1.9 1991/10/07 18:30:35 lmjm |
45 | # Made the timeout-read code work. |
46 | # Added restarting file gets. |
47 | # Be more verbose if ever have to call die. |
48 | # |
49 | # Revision 1.8 1991/09/17 22:53:16 lmjm |
50 | # Spot when open_data_socket fails and return a failure rather than dying. |
51 | # |
52 | # Revision 1.7 1991/09/12 22:40:25 lmjm |
53 | # Added Andrew Macpherson's patches for hosts without ip forwarding. |
54 | # |
55 | # Revision 1.6 1991/09/06 19:53:52 lmjm |
56 | # Relaid out the code the way I like it! |
57 | # Changed the debuggin to produce more "appropriate" messages |
58 | # Fixed bugs in the ordering of put and dir listing. |
59 | # Allow for hash printing when getting files (a la ftp). |
60 | # Added the new commands from Al. |
61 | # Don't print passwords in debugging. |
62 | # |
63 | # Revision 1.5 1991/08/29 16:23:49 lmjm |
64 | # Timeout reads from the remote ftp server. |
65 | # No longer call die expect on fatal errors. Just return fail codes. |
66 | # Changed returns so higher up routines can tell whats happening. |
67 | # Get expect/accept in correct order for dir listing. |
68 | # When ftp_show is set then print hashes every 1k transfered (like ftp). |
69 | # Allow for stripping returns out of incoming data. |
70 | # Save last error in a global string. |
71 | # |
72 | # Revision 1.4 1991/08/14 21:04:58 lmjm |
73 | # ftp'get now copes with ungetable files. |
74 | # ftp'expect code changed such that the string_to_print is |
75 | # ignored and the string sent back from the remote system is printed |
76 | # instead. |
77 | # Implemented patches from al. Removed spuiours tracing statements. |
78 | # |
79 | # Revision 1.3 1991/08/09 21:32:18 lmjm |
80 | # Allow for another ok code on cwd's |
81 | # Rejigger the log levels |
82 | # Send \r\n for some odd ftp daemons |
83 | # |
84 | # Revision 1.2 1991/08/09 18:07:37 lmjm |
85 | # Don't print messages unless ftp_show says to. |
86 | # |
87 | # Revision 1.1 1991/08/08 20:31:00 lmjm |
88 | # Initial revision |
89 | # |
90 | |
84902520 |
91 | require 'chat2.pl'; # into main |
92 | eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" |
93 | || die "socket.ph missing: $!\n"; |
79072805 |
94 | |
95 | |
96 | package ftp; |
97 | |
98 | if( defined( &main'PF_INET ) ){ |
99 | $pf_inet = &main'PF_INET; |
100 | $sock_stream = &main'SOCK_STREAM; |
101 | local($name, $aliases, $proto) = getprotobyname( 'tcp' ); |
102 | $tcp_proto = $proto; |
103 | } |
104 | else { |
105 | # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp' |
106 | # but who the heck would change these anyway? (:-) |
107 | $pf_inet = 2; |
108 | $sock_stream = 1; |
109 | $tcp_proto = 6; |
110 | } |
111 | |
112 | # If the remote ftp daemon doesn't respond within this time presume its dead |
113 | # or something. |
114 | $timeout = 30; |
115 | |
116 | # Timeout a read if I don't get data back within this many seconds |
117 | $timeout_read = 20 * $timeout; |
118 | |
119 | # Timeout an open |
120 | $timeout_open = $timeout; |
121 | |
122 | # This is a "global" it contains the last response from the remote ftp server |
123 | # for use in error messages |
124 | $ftp'response = ""; |
125 | # Also ftp'NS is the socket containing the data coming in from the remote ls |
126 | # command. |
127 | |
128 | # The size of block to be read or written when talking to the remote |
129 | # ftp server |
130 | $ftp'ftpbufsize = 4096; |
131 | |
132 | # How often to print a hash out, when debugging |
133 | $ftp'hashevery = 1024; |
134 | # Output a newline after this many hashes to prevent outputing very long lines |
135 | $ftp'hashnl = 70; |
136 | |
137 | # If a proxy connection then who am I really talking to? |
138 | $real_site = ""; |
139 | |
140 | # This is just a tracing aid. |
141 | $ftp_show = 0; |
142 | sub ftp'debug |
143 | { |
40da2db3 |
144 | $ftp_show = $_[0]; |
79072805 |
145 | # if( $ftp_show ){ |
146 | # print STDERR "ftp debugging on\n"; |
147 | # } |
148 | } |
149 | |
150 | sub ftp'set_timeout |
151 | { |
40da2db3 |
152 | $timeout = $_[0]; |
79072805 |
153 | $timeout_open = $timeout; |
154 | $timeout_read = 20 * $timeout; |
155 | if( $ftp_show ){ |
156 | print STDERR "ftp timeout set to $timeout\n"; |
157 | } |
158 | } |
159 | |
160 | |
161 | sub ftp'open_alarm |
162 | { |
163 | die "timeout: open"; |
164 | } |
165 | |
166 | sub ftp'timed_open |
167 | { |
168 | local( $site, $ftp_port, $retry_call, $attempts ) = @_; |
169 | local( $connect_site, $connect_port ); |
170 | local( $res ); |
171 | |
172 | alarm( $timeout_open ); |
173 | |
174 | while( $attempts-- ){ |
175 | if( $ftp_show ){ |
176 | print STDERR "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy; |
177 | print STDERR "Connecting to $site"; |
178 | if( $ftp_port != 21 ){ |
179 | print STDERR " [port $ftp_port]"; |
180 | } |
181 | print STDERR "\n"; |
182 | } |
183 | |
184 | if( $proxy ) { |
185 | if( ! $proxy_gateway ) { |
186 | # if not otherwise set |
187 | $proxy_gateway = "internet-gateway"; |
188 | } |
189 | if( $debug ) { |
190 | print STDERR "using proxy services of $proxy_gateway, "; |
191 | print STDERR "at $proxy_ftp_port\n"; |
192 | } |
193 | $connect_site = $proxy_gateway; |
194 | $connect_port = $proxy_ftp_port; |
195 | $real_site = $site; |
196 | } |
197 | else { |
198 | $connect_site = $site; |
199 | $connect_port = $ftp_port; |
200 | } |
201 | if( ! &chat'open_port( $connect_site, $connect_port ) ){ |
202 | if( $retry_call ){ |
203 | print STDERR "Failed to connect\n" if $ftp_show; |
204 | next; |
205 | } |
206 | else { |
207 | print STDERR "proxy connection failed " if $proxy; |
208 | print STDERR "Cannot open ftp to $connect_site\n" if $ftp_show; |
209 | return 0; |
210 | } |
211 | } |
212 | $res = &ftp'expect( $timeout, |
213 | 120, "service unavailable to $site", 0, |
214 | 220, "ready for login to $site", 1, |
215 | 421, "service unavailable to $site, closing connection", 0); |
216 | if( ! $res ){ |
217 | &chat'close(); |
218 | next; |
219 | } |
220 | return 1; |
221 | } |
222 | continue { |
223 | print STDERR "Pausing between retries\n"; |
224 | sleep( $retry_pause ); |
225 | } |
226 | return 0; |
227 | } |
228 | |
229 | sub ftp'open |
230 | { |
231 | local( $site, $ftp_port, $retry_call, $attempts ) = @_; |
232 | |
233 | $SIG{ 'ALRM' } = "ftp\'open_alarm"; |
234 | |
235 | local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )"; |
236 | alarm( 0 ); |
237 | |
238 | if( $@ =~ /^timeout/ ){ |
239 | return -1; |
240 | } |
241 | return $ret; |
242 | } |
243 | |
244 | sub ftp'login |
245 | { |
246 | local( $remote_user, $remote_password ) = @_; |
247 | |
248 | if( $proxy ){ |
2ad7ff01 |
249 | &ftp'send( "USER $remote_user\@$site" ); |
79072805 |
250 | } |
251 | else { |
252 | &ftp'send( "USER $remote_user" ); |
253 | } |
254 | local( $val ) = |
255 | &ftp'expect($timeout, |
256 | 230, "$remote_user logged in", 1, |
257 | 331, "send password for $remote_user", 2, |
258 | |
259 | 500, "syntax error", 0, |
260 | 501, "syntax error", 0, |
261 | 530, "not logged in", 0, |
262 | 332, "account for login not supported", 0, |
263 | |
264 | 421, "service unavailable, closing connection", 0); |
265 | if( $val == 1 ){ |
266 | return 1; |
267 | } |
268 | if( $val == 2 ){ |
269 | # A password is needed |
270 | &ftp'send( "PASS $remote_password" ); |
271 | |
272 | $val = &ftp'expect( $timeout, |
273 | 230, "$remote_user logged in", 1, |
274 | |
275 | 202, "command not implemented", 0, |
276 | 332, "account for login not supported", 0, |
277 | |
278 | 530, "not logged in", 0, |
279 | 500, "syntax error", 0, |
280 | 501, "syntax error", 0, |
281 | 503, "bad sequence of commands", 0, |
282 | |
283 | 421, "service unavailable, closing connection", 0); |
284 | if( $val == 1){ |
285 | # Logged in |
286 | return 1; |
287 | } |
288 | } |
289 | # If I got here I failed to login |
290 | return 0; |
291 | } |
292 | |
293 | sub ftp'close |
294 | { |
295 | &ftp'quit(); |
296 | &chat'close(); |
297 | } |
298 | |
299 | # Change directory |
300 | # return 1 if successful |
301 | # 0 on a failure |
302 | sub ftp'cwd |
303 | { |
304 | local( $dir ) = @_; |
305 | |
306 | &ftp'send( "CWD $dir" ); |
307 | |
308 | return &ftp'expect( $timeout, |
309 | 200, "working directory = $dir", 1, |
310 | 250, "working directory = $dir", 1, |
311 | |
312 | 500, "syntax error", 0, |
313 | 501, "syntax error", 0, |
314 | 502, "command not implemented", 0, |
315 | 530, "not logged in", 0, |
316 | 550, "cannot change directory", 0, |
317 | 421, "service unavailable, closing connection", 0 ); |
318 | } |
319 | |
320 | # Get a full directory listing: |
321 | # &ftp'dir( remote LIST options ) |
322 | # Start a list goin with the given options. |
323 | # Presuming that the remote deamon uses the ls command to generate the |
324 | # data to send back then then you can send it some extra options (eg: -lRa) |
325 | # return 1 if sucessful and 0 on a failure |
326 | sub ftp'dir_open |
327 | { |
328 | local( $options ) = @_; |
329 | local( $ret ); |
330 | |
331 | if( ! &ftp'open_data_socket() ){ |
332 | return 0; |
333 | } |
334 | |
335 | if( $options ){ |
336 | &ftp'send( "LIST $options" ); |
337 | } |
338 | else { |
339 | &ftp'send( "LIST" ); |
340 | } |
341 | |
342 | $ret = &ftp'expect( $timeout, |
343 | 150, "reading directory", 1, |
344 | |
345 | 125, "data connection already open?", 0, |
346 | |
347 | 450, "file unavailable", 0, |
348 | 500, "syntax error", 0, |
349 | 501, "syntax error", 0, |
350 | 502, "command not implemented", 0, |
351 | 530, "not logged in", 0, |
352 | |
353 | 421, "service unavailable, closing connection", 0 ); |
354 | if( ! $ret ){ |
355 | &ftp'close_data_socket; |
356 | return 0; |
357 | } |
358 | |
359 | # |
360 | # the data should be coming at us now |
361 | # |
362 | |
363 | # now accept |
364 | accept(NS,S) || die "accept failed $!"; |
365 | |
366 | return 1; |
367 | } |
368 | |
369 | |
370 | # Close down reading the result of a remote ls command |
371 | # return 1 if successful and 0 on failure |
372 | sub ftp'dir_close |
373 | { |
374 | local( $ret ); |
375 | |
376 | # read the close |
377 | # |
378 | $ret = &ftp'expect($timeout, |
379 | 226, "", 1, # transfer complete, closing connection |
380 | 250, "", 1, # action completed |
381 | |
382 | 425, "can't open data connection", 0, |
383 | 426, "connection closed, transfer aborted", 0, |
384 | 451, "action aborted, local error", 0, |
385 | 421, "service unavailable, closing connection", 0); |
386 | |
387 | # shut down our end of the socket |
388 | &ftp'close_data_socket; |
389 | |
390 | if( ! $ret ){ |
391 | return 0; |
392 | } |
393 | |
394 | return 1; |
395 | } |
396 | |
397 | # Quit from the remote ftp server |
398 | # return 1 if successful and 0 on failure |
399 | sub ftp'quit |
400 | { |
401 | $site_command_check = 0; |
402 | @site_command_list = (); |
403 | |
404 | &ftp'send("QUIT"); |
405 | |
406 | return &ftp'expect($timeout, |
407 | 221, "Goodbye", 1, # transfer complete, closing connection |
408 | |
409 | 500, "error quitting??", 0); |
410 | } |
411 | |
412 | sub ftp'read_alarm |
413 | { |
414 | die "timeout: read"; |
415 | } |
416 | |
417 | sub ftp'timed_read |
418 | { |
419 | alarm( $timeout_read ); |
420 | return sysread( NS, $buf, $ftpbufsize ); |
421 | } |
422 | |
423 | sub ftp'read |
424 | { |
425 | $SIG{ 'ALRM' } = "ftp\'read_alarm"; |
426 | |
427 | local( $ret ) = eval '&timed_read()'; |
428 | alarm( 0 ); |
429 | |
430 | if( $@ =~ /^timeout/ ){ |
431 | return -1; |
432 | } |
433 | return $ret; |
434 | } |
435 | |
436 | # Get a remote file back into a local file. |
437 | # If no loc_fname passed then uses rem_fname. |
438 | # returns 1 on success and 0 on failure |
439 | sub ftp'get |
440 | { |
441 | local($rem_fname, $loc_fname, $restart ) = @_; |
442 | |
443 | if ($loc_fname eq "") { |
444 | $loc_fname = $rem_fname; |
445 | } |
446 | |
447 | if( ! &ftp'open_data_socket() ){ |
448 | print STDERR "Cannot open data socket\n"; |
449 | return 0; |
450 | } |
451 | |
452 | if( $loc_fname ne '-' ){ |
453 | # Find the size of the target file |
454 | local( $restart_at ) = &ftp'filesize( $loc_fname ); |
455 | if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){ |
456 | $restart = 1; |
457 | # Make sure the file can be updated |
458 | chmod( 0644, $loc_fname ); |
459 | } |
460 | else { |
461 | $restart = 0; |
462 | unlink( $loc_fname ); |
463 | } |
464 | } |
465 | |
466 | &ftp'send( "RETR $rem_fname" ); |
467 | |
468 | local( $ret ) = |
469 | &ftp'expect($timeout, |
470 | 150, "receiving $rem_fname", 1, |
471 | |
472 | 125, "data connection already open?", 0, |
473 | |
474 | 450, "file unavailable", 2, |
475 | 550, "file unavailable", 2, |
476 | |
477 | 500, "syntax error", 0, |
478 | 501, "syntax error", 0, |
479 | 530, "not logged in", 0, |
480 | |
481 | 421, "service unavailable, closing connection", 0); |
482 | if( $ret != 1 ){ |
483 | print STDERR "Failure on RETR command\n"; |
484 | |
485 | # shut down our end of the socket |
486 | &ftp'close_data_socket; |
487 | |
488 | return 0; |
489 | } |
490 | |
491 | # |
492 | # the data should be coming at us now |
493 | # |
494 | |
495 | # now accept |
496 | accept(NS,S) || die "accept failed: $!"; |
497 | |
498 | # |
499 | # open the local fname |
500 | # concatenate on the end if restarting, else just overwrite |
501 | if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){ |
502 | print STDERR "Cannot create local file $loc_fname\n"; |
503 | |
504 | # shut down our end of the socket |
505 | &ftp'close_data_socket; |
506 | |
507 | return 0; |
508 | } |
509 | |
510 | # while (<NS>) { |
511 | # print FH ; |
512 | # } |
513 | |
514 | local( $start_time ) = time; |
515 | local( $bytes, $lasthash, $hashes ) = (0, 0, 0); |
516 | while( ($len = &ftp'read()) > 0 ){ |
517 | $bytes += $len; |
518 | if( $strip_cr ){ |
519 | $ftp'buf =~ s/\r//g; |
520 | } |
521 | if( $ftp_show ){ |
522 | while( $bytes > ($lasthash + $ftp'hashevery) ){ |
523 | print STDERR '#'; |
524 | $lasthash += $ftp'hashevery; |
525 | $hashes++; |
526 | if( ($hashes % $ftp'hashnl) == 0 ){ |
527 | print STDERR "\n"; |
528 | } |
529 | } |
530 | } |
531 | if( ! print FH $ftp'buf ){ |
532 | print STDERR "\nfailed to write data"; |
533 | return 0; |
534 | } |
535 | } |
536 | close( FH ); |
537 | |
538 | # shut down our end of the socket |
539 | &ftp'close_data_socket; |
540 | |
541 | if( $len < 0 ){ |
542 | print STDERR "\ntimed out reading data!\n"; |
543 | |
544 | return 0; |
545 | } |
546 | |
547 | if( $ftp_show ){ |
548 | if( $hashes && ($hashes % $ftp'hashnl) != 0 ){ |
549 | print STDERR "\n"; |
550 | } |
551 | local( $secs ) = (time - $start_time); |
552 | if( $secs <= 0 ){ |
553 | $secs = 1; # To avoid a divide by zero; |
554 | } |
555 | |
556 | local( $rate ) = int( $bytes / $secs ); |
557 | print STDERR "Got $bytes bytes ($rate bytes/sec)\n"; |
558 | } |
559 | |
560 | # |
561 | # read the close |
562 | # |
563 | |
564 | $ret = &ftp'expect($timeout, |
565 | 226, "Got file", 1, # transfer complete, closing connection |
566 | 250, "Got file", 1, # action completed |
567 | |
568 | 110, "restart not supported", 0, |
569 | 425, "can't open data connection", 0, |
570 | 426, "connection closed, transfer aborted", 0, |
571 | 451, "action aborted, local error", 0, |
572 | 421, "service unavailable, closing connection", 0); |
573 | |
574 | return $ret; |
575 | } |
576 | |
577 | sub ftp'delete |
578 | { |
579 | local( $rem_fname, $val ) = @_; |
580 | |
581 | &ftp'send("DELE $rem_fname" ); |
582 | $val = &ftp'expect( $timeout, |
583 | 250,"Deleted $rem_fname", 1, |
584 | 550,"Permission denied",0 |
585 | ); |
586 | return $val == 1; |
587 | } |
588 | |
589 | sub ftp'deldir |
590 | { |
591 | local( $fname ) = @_; |
592 | |
593 | # not yet implemented |
594 | # RMD |
595 | } |
596 | |
597 | # UPDATE ME!!!!!! |
598 | # Add in the hash printing and newline conversion |
599 | sub ftp'put |
600 | { |
601 | local( $loc_fname, $rem_fname ) = @_; |
602 | local( $strip_cr ); |
603 | |
604 | if ($loc_fname eq "") { |
605 | $loc_fname = $rem_fname; |
606 | } |
607 | |
608 | if( ! &ftp'open_data_socket() ){ |
609 | return 0; |
610 | } |
611 | |
612 | &ftp'send("STOR $rem_fname"); |
613 | |
614 | # |
615 | # the data should be coming at us now |
616 | # |
617 | |
618 | local( $ret ) = |
619 | &ftp'expect($timeout, |
620 | 150, "sending $loc_fname", 1, |
621 | |
622 | 125, "data connection already open?", 0, |
623 | 450, "file unavailable", 0, |
624 | |
625 | 532, "need account for storing files", 0, |
626 | 452, "insufficient storage on system", 0, |
627 | 553, "file name not allowed", 0, |
628 | |
629 | 500, "syntax error", 0, |
630 | 501, "syntax error", 0, |
631 | 530, "not logged in", 0, |
632 | |
633 | 421, "service unavailable, closing connection", 0); |
634 | |
635 | if( $ret != 1 ){ |
636 | # shut down our end of the socket |
637 | &ftp'close_data_socket; |
638 | |
639 | return 0; |
640 | } |
641 | |
642 | |
643 | # |
644 | # the data should be coming at us now |
645 | # |
646 | |
647 | # now accept |
648 | accept(NS,S) || die "accept failed: $!"; |
649 | |
650 | # |
651 | # open the local fname |
652 | # |
653 | if( !open(FH, "<$loc_fname") ){ |
654 | print STDERR "Cannot open local file $loc_fname\n"; |
655 | |
656 | # shut down our end of the socket |
657 | &ftp'close_data_socket; |
658 | |
659 | return 0; |
660 | } |
661 | |
662 | while (<FH>) { |
663 | print NS ; |
664 | } |
665 | close(FH); |
666 | |
667 | # shut down our end of the socket to signal EOF |
668 | &ftp'close_data_socket; |
669 | |
670 | # |
671 | # read the close |
672 | # |
673 | |
674 | $ret = &ftp'expect($timeout, |
675 | 226, "file put", 1, # transfer complete, closing connection |
676 | 250, "file put", 1, # action completed |
677 | |
678 | 110, "restart not supported", 0, |
679 | 425, "can't open data connection", 0, |
680 | 426, "connection closed, transfer aborted", 0, |
681 | 451, "action aborted, local error", 0, |
682 | 551, "page type unknown", 0, |
683 | 552, "storage allocation exceeded", 0, |
684 | |
685 | 421, "service unavailable, closing connection", 0); |
686 | if( ! $ret ){ |
687 | print STDERR "error putting $loc_fname\n"; |
688 | } |
689 | return $ret; |
690 | } |
691 | |
692 | sub ftp'restart |
693 | { |
694 | local( $restart_point, $ret ) = @_; |
695 | |
696 | &ftp'send("REST $restart_point"); |
697 | |
698 | # |
699 | # see what they say |
700 | |
701 | $ret = &ftp'expect($timeout, |
702 | 350, "restarting at $restart_point", 1, |
703 | |
704 | 500, "syntax error", 0, |
705 | 501, "syntax error", 0, |
706 | 502, "REST not implemented", 2, |
707 | 530, "not logged in", 0, |
708 | 554, "REST not implemented", 2, |
709 | |
710 | 421, "service unavailable, closing connection", 0); |
711 | return $ret; |
712 | } |
713 | |
714 | # Set the file transfer type |
715 | sub ftp'type |
716 | { |
717 | local( $type ) = @_; |
718 | |
719 | &ftp'send("TYPE $type"); |
720 | |
721 | # |
722 | # see what they say |
723 | |
724 | $ret = &ftp'expect($timeout, |
725 | 200, "file type set to $type", 1, |
726 | |
727 | 500, "syntax error", 0, |
728 | 501, "syntax error", 0, |
729 | 504, "Invalid form or byte size for type $type", 0, |
730 | |
731 | 421, "service unavailable, closing connection", 0); |
732 | return $ret; |
733 | } |
734 | |
735 | $site_command_check = 0; |
736 | @site_command_list = (); |
737 | |
738 | # routine to query the remote server for 'SITE' commands supported |
739 | sub ftp'site_commands |
740 | { |
741 | local( $ret ); |
742 | |
743 | # if we havent sent a 'HELP SITE', send it now |
744 | if( !$site_command_check ){ |
745 | |
746 | $site_command_check = 1; |
747 | |
748 | &ftp'send( "HELP SITE" ); |
749 | |
750 | # assume the line in the HELP SITE response with the 'HELP' |
751 | # command is the one for us |
752 | $ret = &ftp'expect( $timeout, |
753 | ".*HELP.*", "", "\$1", |
754 | 214, "", "0", |
755 | 202, "", "0" ); |
756 | |
757 | if( $ret eq "0" ){ |
758 | print STDERR "No response from HELP SITE\n" if( $ftp_show ); |
759 | } |
760 | |
761 | @site_command_list = split(/\s+/, $ret); |
762 | } |
763 | |
764 | return @site_command_list; |
765 | } |
766 | |
767 | # return the pwd, or null if we can't get the pwd |
768 | sub ftp'pwd |
769 | { |
770 | local( $ret, $cwd ); |
771 | |
772 | &ftp'send( "PWD" ); |
773 | |
774 | # |
775 | # see what they say |
776 | |
777 | $ret = &ftp'expect( $timeout, |
778 | 257, "working dir is", 1, |
779 | 500, "syntax error", 0, |
780 | 501, "syntax error", 0, |
781 | 502, "PWD not implemented", 0, |
782 | 550, "file unavailable", 0, |
783 | |
784 | 421, "service unavailable, closing connection", 0 ); |
785 | if( $ret ){ |
786 | if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){ |
787 | $cwd = $1; |
788 | } |
789 | } |
790 | return $cwd; |
791 | } |
792 | |
793 | # return 1 for success, 0 for failure |
794 | sub ftp'mkdir |
795 | { |
796 | local( $path ) = @_; |
797 | local( $ret ); |
798 | |
799 | &ftp'send( "MKD $path" ); |
800 | |
801 | # |
802 | # see what they say |
803 | |
804 | $ret = &ftp'expect( $timeout, |
805 | 257, "made directory $path", 1, |
806 | |
807 | 500, "syntax error", 0, |
808 | 501, "syntax error", 0, |
809 | 502, "MKD not implemented", 0, |
810 | 530, "not logged in", 0, |
811 | 550, "file unavailable", 0, |
812 | |
813 | 421, "service unavailable, closing connection", 0 ); |
814 | return $ret; |
815 | } |
816 | |
817 | # return 1 for success, 0 for failure |
818 | sub ftp'chmod |
819 | { |
820 | local( $path, $mode ) = @_; |
821 | local( $ret ); |
822 | |
823 | &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) ); |
824 | |
825 | # |
826 | # see what they say |
827 | |
828 | $ret = &ftp'expect( $timeout, |
829 | 200, "chmod $mode $path succeeded", 1, |
830 | |
831 | 500, "syntax error", 0, |
832 | 501, "syntax error", 0, |
833 | 502, "CHMOD not implemented", 0, |
834 | 530, "not logged in", 0, |
835 | 550, "file unavailable", 0, |
836 | |
837 | 421, "service unavailable, closing connection", 0 ); |
838 | return $ret; |
839 | } |
840 | |
841 | # rename a file |
842 | sub ftp'rename |
843 | { |
844 | local( $old_name, $new_name ) = @_; |
845 | local( $ret ); |
846 | |
847 | &ftp'send( "RNFR $old_name" ); |
848 | |
849 | # |
850 | # see what they say |
851 | |
852 | $ret = &ftp'expect( $timeout, |
853 | 350, "", 1, |
854 | |
855 | 500, "syntax error", 0, |
856 | 501, "syntax error", 0, |
857 | 502, "RNFR not implemented", 0, |
858 | 530, "not logged in", 0, |
859 | 550, "file unavailable", 0, |
860 | 450, "file unavailable", 0, |
861 | |
862 | 421, "service unavailable, closing connection", 0); |
863 | |
864 | |
865 | # check if the "rename from" occurred ok |
866 | if( $ret ) { |
867 | &ftp'send( "RNTO $new_name" ); |
868 | |
869 | # |
870 | # see what they say |
871 | |
872 | $ret = &ftp'expect( $timeout, |
873 | 250, "rename $old_name to $new_name", 1, |
874 | |
875 | 500, "syntax error", 0, |
876 | 501, "syntax error", 0, |
877 | 502, "RNTO not implemented", 0, |
878 | 503, "bad sequence of commands", 0, |
879 | 530, "not logged in", 0, |
880 | 532, "need account for storing files", 0, |
881 | 553, "file name not allowed", 0, |
882 | |
883 | 421, "service unavailable, closing connection", 0); |
884 | } |
885 | |
886 | return $ret; |
887 | } |
888 | |
889 | |
890 | sub ftp'quote |
891 | { |
892 | local( $cmd ) = @_; |
893 | |
894 | &ftp'send( $cmd ); |
895 | |
896 | return &ftp'expect( $timeout, |
897 | 200, "Remote '$cmd' OK", 1, |
898 | 500, "error in remote '$cmd'", 0 ); |
899 | } |
900 | |
901 | # ------------------------------------------------------------------------------ |
902 | # These are the lower level support routines |
903 | |
904 | sub ftp'expectgot |
905 | { |
906 | ($ftp'response, $ftp'fatalerror) = @_; |
907 | if( $ftp_show ){ |
908 | print STDERR "$ftp'response\n"; |
909 | } |
910 | } |
911 | |
912 | # |
913 | # create the list of parameters for chat'expect |
914 | # |
915 | # ftp'expect(time_out, {value, string_to_print, return value}); |
916 | # if the string_to_print is "" then nothing is printed |
917 | # the last response is stored in $ftp'response |
918 | # |
919 | # NOTE: lmjm has changed this code such that the string_to_print is |
920 | # ignored and the string sent back from the remote system is printed |
921 | # instead. |
922 | # |
923 | sub ftp'expect { |
924 | local( $ret ); |
925 | local( $time_out ); |
926 | local( $expect_args ); |
927 | |
928 | $ftp'response = ''; |
929 | $ftp'fatalerror = 0; |
930 | |
931 | @expect_args = (); |
932 | |
933 | $time_out = shift(@_); |
934 | |
935 | while( @_ ){ |
936 | local( $code ) = shift( @_ ); |
937 | local( $pre ) = '^'; |
938 | if( $code =~ /^\d/ ){ |
939 | $pre =~ "[.|\n]*^"; |
940 | } |
941 | push( @expect_args, "$pre(" . $code . " .*)\\015\\n" ); |
942 | shift( @_ ); |
943 | push( @expect_args, |
944 | "&ftp'expectgot( \$1, 0 ); " . shift( @_ ) ); |
945 | } |
946 | |
947 | # Treat all unrecognised lines as continuations |
948 | push( @expect_args, "^(.*)\\015\\n" ); |
949 | push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" ); |
950 | |
951 | # add patterns TIMEOUT and EOF |
952 | |
953 | push( @expect_args, 'TIMEOUT' ); |
954 | push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" ); |
955 | |
956 | push( @expect_args, 'EOF' ); |
957 | push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" ); |
958 | |
959 | if( $ftp_show > 9 ){ |
960 | &printargs( $time_out, @expect_args ); |
961 | } |
962 | |
963 | $ret = &chat'expect( $time_out, @expect_args ); |
964 | if( $ret == 100 ){ |
965 | # we saw a continuation line, wait for the end |
966 | push( @expect_args, "^.*\n" ); |
967 | push( @expect_args, "100" ); |
968 | |
969 | while( $ret == 100 ){ |
970 | $ret = &chat'expect( $time_out, @expect_args ); |
971 | } |
972 | } |
973 | |
974 | return $ret; |
975 | } |
976 | |
977 | # |
978 | # opens NS for io |
979 | # |
980 | sub ftp'open_data_socket |
981 | { |
982 | local( $ret ); |
983 | local( $hostname ); |
984 | local( $sockaddr, $name, $aliases, $proto, $port ); |
985 | local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d ); |
986 | local( $mysockaddr, $family, $hi, $lo ); |
987 | |
988 | |
989 | $sockaddr = 'S n a4 x8'; |
990 | chop( $hostname = `hostname` ); |
991 | |
992 | $port = "ftp"; |
993 | |
994 | ($name, $aliases, $proto) = getprotobyname( 'tcp' ); |
995 | ($name, $aliases, $port) = getservbyname( $port, 'tcp' ); |
996 | |
997 | # ($name, $aliases, $type, $len, $thisaddr) = |
998 | # gethostbyname( $hostname ); |
999 | ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr ); |
1000 | |
1001 | # $this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr ); |
1002 | $this = $chat'thisproc; |
1003 | |
1004 | socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!"; |
1005 | bind(S, $this) || die "bind: $!"; |
1006 | |
1007 | # get the port number |
1008 | $mysockaddr = getsockname(S); |
1009 | ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr ); |
1010 | |
1011 | $hi = ($port >> 8) & 0x00ff; |
1012 | $lo = $port & 0x00ff; |
1013 | |
1014 | # |
1015 | # we MUST do a listen before sending the port otherwise |
1016 | # the PORT may fail |
1017 | # |
1018 | listen( S, 5 ) || die "listen"; |
1019 | |
1020 | &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" ); |
1021 | |
1022 | return &ftp'expect($timeout, |
1023 | 200, "PORT command successful", 1, |
1024 | 250, "PORT command successful", 1 , |
1025 | |
1026 | 500, "syntax error", 0, |
1027 | 501, "syntax error", 0, |
1028 | 530, "not logged in", 0, |
1029 | |
1030 | 421, "service unavailable, closing connection", 0); |
1031 | } |
1032 | |
1033 | sub ftp'close_data_socket |
1034 | { |
1035 | close(NS); |
1036 | } |
1037 | |
1038 | sub ftp'send |
1039 | { |
1040 | local($send_cmd) = @_; |
1041 | if( $send_cmd =~ /\n/ ){ |
1042 | print STDERR "ERROR, \\n in send string for $send_cmd\n"; |
1043 | } |
1044 | |
1045 | if( $ftp_show ){ |
1046 | local( $sc ) = $send_cmd; |
1047 | |
1048 | if( $send_cmd =~ /^PASS/){ |
1049 | $sc = "PASS <somestring>"; |
1050 | } |
1051 | print STDERR "---> $sc\n"; |
1052 | } |
1053 | |
1054 | &chat'print( "$send_cmd\r\n" ); |
1055 | } |
1056 | |
1057 | sub ftp'printargs |
1058 | { |
1059 | while( @_ ){ |
1060 | print STDERR shift( @_ ) . "\n"; |
1061 | } |
1062 | } |
1063 | |
1064 | sub ftp'filesize |
1065 | { |
1066 | local( $fname ) = @_; |
1067 | |
1068 | if( ! -f $fname ){ |
1069 | return -1; |
1070 | } |
1071 | |
1072 | return (stat( _ ))[ 7 ]; |
1073 | |
1074 | } |
1075 | |
1076 | # make this package return true |
1077 | 1; |