2 # This is a wrapper to the chat2.pl routines that make life easier
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
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 $
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
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.
19 # Revision 1.15 1992/11/25 21:09:30 lmjm
20 # Added another REST return code.
22 # Revision 1.14 1992/08/12 14:33:42 lmjm
23 # Fail ftp'write if out of space.
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>
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.
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.
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.
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.
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.
52 # Revision 1.7 1991/09/12 22:40:25 lmjm
53 # Added Andrew Macpherson's patches for hosts without ip forwarding.
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.
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.
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
77 # Implemented patches from al. Removed spuiours tracing statements.
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
84 # Revision 1.2 1991/08/09 18:07:37 lmjm
85 # Don't print messages unless ftp_show says to.
87 # Revision 1.1 1991/08/08 20:31:00 lmjm
91 eval { require 'chat2.pl' };
93 The obsolete and problematic chat2.pl library has been removed from the
94 Perl distribution at the request of it's author. You can either get a
95 copy yourself or, preferably, fetch the new and much better Net::FTP
96 package from a CPAN ftp site.
97 } if $@ && $@ =~ /locate chat2.pl/;
99 eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" || die "socket.ph missing: $!\n";
104 if( defined( &main'PF_INET ) ){
105 $pf_inet = &main'PF_INET;
106 $sock_stream = &main'SOCK_STREAM;
107 local($name, $aliases, $proto) = getprotobyname( 'tcp' );
111 # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
112 # but who the heck would change these anyway? (:-)
118 # If the remote ftp daemon doesn't respond within this time presume its dead
122 # Timeout a read if I don't get data back within this many seconds
123 $timeout_read = 20 * $timeout;
126 $timeout_open = $timeout;
128 # This is a "global" it contains the last response from the remote ftp server
129 # for use in error messages
131 # Also ftp'NS is the socket containing the data coming in from the remote ls
134 # The size of block to be read or written when talking to the remote
136 $ftp'ftpbufsize = 4096;
138 # How often to print a hash out, when debugging
139 $ftp'hashevery = 1024;
140 # Output a newline after this many hashes to prevent outputing very long lines
143 # If a proxy connection then who am I really talking to?
146 # This is just a tracing aid.
152 # print STDERR "ftp debugging on\n";
159 $timeout_open = $timeout;
160 $timeout_read = 20 * $timeout;
162 print STDERR "ftp timeout set to $timeout\n";
174 local( $site, $ftp_port, $retry_call, $attempts ) = @_;
175 local( $connect_site, $connect_port );
178 alarm( $timeout_open );
180 while( $attempts-- ){
182 print STDERR "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
183 print STDERR "Connecting to $site";
184 if( $ftp_port != 21 ){
185 print STDERR " [port $ftp_port]";
191 if( ! $proxy_gateway ) {
192 # if not otherwise set
193 $proxy_gateway = "internet-gateway";
196 print STDERR "using proxy services of $proxy_gateway, ";
197 print STDERR "at $proxy_ftp_port\n";
199 $connect_site = $proxy_gateway;
200 $connect_port = $proxy_ftp_port;
204 $connect_site = $site;
205 $connect_port = $ftp_port;
207 if( ! &chat'open_port( $connect_site, $connect_port ) ){
209 print STDERR "Failed to connect\n" if $ftp_show;
213 print STDERR "proxy connection failed " if $proxy;
214 print STDERR "Cannot open ftp to $connect_site\n" if $ftp_show;
218 $res = &ftp'expect( $timeout,
219 120, "service unavailable to $site", 0,
220 220, "ready for login to $site", 1,
221 421, "service unavailable to $site, closing connection", 0);
229 print STDERR "Pausing between retries\n";
230 sleep( $retry_pause );
237 local( $site, $ftp_port, $retry_call, $attempts ) = @_;
239 $SIG{ 'ALRM' } = "ftp\'open_alarm";
241 local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
244 if( $@ =~ /^timeout/ ){
252 local( $remote_user, $remote_password ) = @_;
255 &ftp'send( "USER $remote_user\@$site" );
258 &ftp'send( "USER $remote_user" );
261 &ftp'expect($timeout,
262 230, "$remote_user logged in", 1,
263 331, "send password for $remote_user", 2,
265 500, "syntax error", 0,
266 501, "syntax error", 0,
267 530, "not logged in", 0,
268 332, "account for login not supported", 0,
270 421, "service unavailable, closing connection", 0);
275 # A password is needed
276 &ftp'send( "PASS $remote_password" );
278 $val = &ftp'expect( $timeout,
279 230, "$remote_user logged in", 1,
281 202, "command not implemented", 0,
282 332, "account for login not supported", 0,
284 530, "not logged in", 0,
285 500, "syntax error", 0,
286 501, "syntax error", 0,
287 503, "bad sequence of commands", 0,
289 421, "service unavailable, closing connection", 0);
295 # If I got here I failed to login
306 # return 1 if successful
312 &ftp'send( "CWD $dir" );
314 return &ftp'expect( $timeout,
315 200, "working directory = $dir", 1,
316 250, "working directory = $dir", 1,
318 500, "syntax error", 0,
319 501, "syntax error", 0,
320 502, "command not implemented", 0,
321 530, "not logged in", 0,
322 550, "cannot change directory", 0,
323 421, "service unavailable, closing connection", 0 );
326 # Get a full directory listing:
327 # &ftp'dir( remote LIST options )
328 # Start a list goin with the given options.
329 # Presuming that the remote deamon uses the ls command to generate the
330 # data to send back then then you can send it some extra options (eg: -lRa)
331 # return 1 if sucessful and 0 on a failure
334 local( $options ) = @_;
337 if( ! &ftp'open_data_socket() ){
342 &ftp'send( "LIST $options" );
348 $ret = &ftp'expect( $timeout,
349 150, "reading directory", 1,
351 125, "data connection already open?", 0,
353 450, "file unavailable", 0,
354 500, "syntax error", 0,
355 501, "syntax error", 0,
356 502, "command not implemented", 0,
357 530, "not logged in", 0,
359 421, "service unavailable, closing connection", 0 );
361 &ftp'close_data_socket;
366 # the data should be coming at us now
370 accept(NS,S) || die "accept failed $!";
376 # Close down reading the result of a remote ls command
377 # return 1 if successful and 0 on failure
384 $ret = &ftp'expect($timeout,
385 226, "", 1, # transfer complete, closing connection
386 250, "", 1, # action completed
388 425, "can't open data connection", 0,
389 426, "connection closed, transfer aborted", 0,
390 451, "action aborted, local error", 0,
391 421, "service unavailable, closing connection", 0);
393 # shut down our end of the socket
394 &ftp'close_data_socket;
403 # Quit from the remote ftp server
404 # return 1 if successful and 0 on failure
407 $site_command_check = 0;
408 @site_command_list = ();
412 return &ftp'expect($timeout,
413 221, "Goodbye", 1, # transfer complete, closing connection
415 500, "error quitting??", 0);
425 alarm( $timeout_read );
426 return sysread( NS, $buf, $ftpbufsize );
431 $SIG{ 'ALRM' } = "ftp\'read_alarm";
433 local( $ret ) = eval '&timed_read()';
436 if( $@ =~ /^timeout/ ){
442 # Get a remote file back into a local file.
443 # If no loc_fname passed then uses rem_fname.
444 # returns 1 on success and 0 on failure
447 local($rem_fname, $loc_fname, $restart ) = @_;
449 if ($loc_fname eq "") {
450 $loc_fname = $rem_fname;
453 if( ! &ftp'open_data_socket() ){
454 print STDERR "Cannot open data socket\n";
458 if( $loc_fname ne '-' ){
459 # Find the size of the target file
460 local( $restart_at ) = &ftp'filesize( $loc_fname );
461 if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
463 # Make sure the file can be updated
464 chmod( 0644, $loc_fname );
468 unlink( $loc_fname );
472 &ftp'send( "RETR $rem_fname" );
475 &ftp'expect($timeout,
476 150, "receiving $rem_fname", 1,
478 125, "data connection already open?", 0,
480 450, "file unavailable", 2,
481 550, "file unavailable", 2,
483 500, "syntax error", 0,
484 501, "syntax error", 0,
485 530, "not logged in", 0,
487 421, "service unavailable, closing connection", 0);
489 print STDERR "Failure on RETR command\n";
491 # shut down our end of the socket
492 &ftp'close_data_socket;
498 # the data should be coming at us now
502 accept(NS,S) || die "accept failed: $!";
505 # open the local fname
506 # concatenate on the end if restarting, else just overwrite
507 if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){
508 print STDERR "Cannot create local file $loc_fname\n";
510 # shut down our end of the socket
511 &ftp'close_data_socket;
520 local( $start_time ) = time;
521 local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
522 while( ($len = &ftp'read()) > 0 ){
528 while( $bytes > ($lasthash + $ftp'hashevery) ){
530 $lasthash += $ftp'hashevery;
532 if( ($hashes % $ftp'hashnl) == 0 ){
537 if( ! print FH $ftp'buf ){
538 print STDERR "\nfailed to write data";
544 # shut down our end of the socket
545 &ftp'close_data_socket;
548 print STDERR "\ntimed out reading data!\n";
554 if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
557 local( $secs ) = (time - $start_time);
559 $secs = 1; # To avoid a divide by zero;
562 local( $rate ) = int( $bytes / $secs );
563 print STDERR "Got $bytes bytes ($rate bytes/sec)\n";
570 $ret = &ftp'expect($timeout,
571 226, "Got file", 1, # transfer complete, closing connection
572 250, "Got file", 1, # action completed
574 110, "restart not supported", 0,
575 425, "can't open data connection", 0,
576 426, "connection closed, transfer aborted", 0,
577 451, "action aborted, local error", 0,
578 421, "service unavailable, closing connection", 0);
585 local( $rem_fname, $val ) = @_;
587 &ftp'send("DELE $rem_fname" );
588 $val = &ftp'expect( $timeout,
589 250,"Deleted $rem_fname", 1,
590 550,"Permission denied",0
597 local( $fname ) = @_;
599 # not yet implemented
604 # Add in the hash printing and newline conversion
607 local( $loc_fname, $rem_fname ) = @_;
610 if ($loc_fname eq "") {
611 $loc_fname = $rem_fname;
614 if( ! &ftp'open_data_socket() ){
618 &ftp'send("STOR $rem_fname");
621 # the data should be coming at us now
625 &ftp'expect($timeout,
626 150, "sending $loc_fname", 1,
628 125, "data connection already open?", 0,
629 450, "file unavailable", 0,
631 532, "need account for storing files", 0,
632 452, "insufficient storage on system", 0,
633 553, "file name not allowed", 0,
635 500, "syntax error", 0,
636 501, "syntax error", 0,
637 530, "not logged in", 0,
639 421, "service unavailable, closing connection", 0);
642 # shut down our end of the socket
643 &ftp'close_data_socket;
650 # the data should be coming at us now
654 accept(NS,S) || die "accept failed: $!";
657 # open the local fname
659 if( !open(FH, "<$loc_fname") ){
660 print STDERR "Cannot open local file $loc_fname\n";
662 # shut down our end of the socket
663 &ftp'close_data_socket;
673 # shut down our end of the socket to signal EOF
674 &ftp'close_data_socket;
680 $ret = &ftp'expect($timeout,
681 226, "file put", 1, # transfer complete, closing connection
682 250, "file put", 1, # action completed
684 110, "restart not supported", 0,
685 425, "can't open data connection", 0,
686 426, "connection closed, transfer aborted", 0,
687 451, "action aborted, local error", 0,
688 551, "page type unknown", 0,
689 552, "storage allocation exceeded", 0,
691 421, "service unavailable, closing connection", 0);
693 print STDERR "error putting $loc_fname\n";
700 local( $restart_point, $ret ) = @_;
702 &ftp'send("REST $restart_point");
707 $ret = &ftp'expect($timeout,
708 350, "restarting at $restart_point", 1,
710 500, "syntax error", 0,
711 501, "syntax error", 0,
712 502, "REST not implemented", 2,
713 530, "not logged in", 0,
714 554, "REST not implemented", 2,
716 421, "service unavailable, closing connection", 0);
720 # Set the file transfer type
725 &ftp'send("TYPE $type");
730 $ret = &ftp'expect($timeout,
731 200, "file type set to $type", 1,
733 500, "syntax error", 0,
734 501, "syntax error", 0,
735 504, "Invalid form or byte size for type $type", 0,
737 421, "service unavailable, closing connection", 0);
741 $site_command_check = 0;
742 @site_command_list = ();
744 # routine to query the remote server for 'SITE' commands supported
745 sub ftp'site_commands
749 # if we havent sent a 'HELP SITE', send it now
750 if( !$site_command_check ){
752 $site_command_check = 1;
754 &ftp'send( "HELP SITE" );
756 # assume the line in the HELP SITE response with the 'HELP'
757 # command is the one for us
758 $ret = &ftp'expect( $timeout,
759 ".*HELP.*", "", "\$1",
764 print STDERR "No response from HELP SITE\n" if( $ftp_show );
767 @site_command_list = split(/\s+/, $ret);
770 return @site_command_list;
773 # return the pwd, or null if we can't get the pwd
783 $ret = &ftp'expect( $timeout,
784 257, "working dir is", 1,
785 500, "syntax error", 0,
786 501, "syntax error", 0,
787 502, "PWD not implemented", 0,
788 550, "file unavailable", 0,
790 421, "service unavailable, closing connection", 0 );
792 if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
799 # return 1 for success, 0 for failure
805 &ftp'send( "MKD $path" );
810 $ret = &ftp'expect( $timeout,
811 257, "made directory $path", 1,
813 500, "syntax error", 0,
814 501, "syntax error", 0,
815 502, "MKD not implemented", 0,
816 530, "not logged in", 0,
817 550, "file unavailable", 0,
819 421, "service unavailable, closing connection", 0 );
823 # return 1 for success, 0 for failure
826 local( $path, $mode ) = @_;
829 &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
834 $ret = &ftp'expect( $timeout,
835 200, "chmod $mode $path succeeded", 1,
837 500, "syntax error", 0,
838 501, "syntax error", 0,
839 502, "CHMOD not implemented", 0,
840 530, "not logged in", 0,
841 550, "file unavailable", 0,
843 421, "service unavailable, closing connection", 0 );
850 local( $old_name, $new_name ) = @_;
853 &ftp'send( "RNFR $old_name" );
858 $ret = &ftp'expect( $timeout,
861 500, "syntax error", 0,
862 501, "syntax error", 0,
863 502, "RNFR not implemented", 0,
864 530, "not logged in", 0,
865 550, "file unavailable", 0,
866 450, "file unavailable", 0,
868 421, "service unavailable, closing connection", 0);
871 # check if the "rename from" occurred ok
873 &ftp'send( "RNTO $new_name" );
878 $ret = &ftp'expect( $timeout,
879 250, "rename $old_name to $new_name", 1,
881 500, "syntax error", 0,
882 501, "syntax error", 0,
883 502, "RNTO not implemented", 0,
884 503, "bad sequence of commands", 0,
885 530, "not logged in", 0,
886 532, "need account for storing files", 0,
887 553, "file name not allowed", 0,
889 421, "service unavailable, closing connection", 0);
902 return &ftp'expect( $timeout,
903 200, "Remote '$cmd' OK", 1,
904 500, "error in remote '$cmd'", 0 );
907 # ------------------------------------------------------------------------------
908 # These are the lower level support routines
912 ($ftp'response, $ftp'fatalerror) = @_;
914 print STDERR "$ftp'response\n";
919 # create the list of parameters for chat'expect
921 # ftp'expect(time_out, {value, string_to_print, return value});
922 # if the string_to_print is "" then nothing is printed
923 # the last response is stored in $ftp'response
925 # NOTE: lmjm has changed this code such that the string_to_print is
926 # ignored and the string sent back from the remote system is printed
932 local( $expect_args );
939 $time_out = shift(@_);
942 local( $code ) = shift( @_ );
944 if( $code =~ /^\d/ ){
947 push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
950 "&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
953 # Treat all unrecognised lines as continuations
954 push( @expect_args, "^(.*)\\015\\n" );
955 push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
957 # add patterns TIMEOUT and EOF
959 push( @expect_args, 'TIMEOUT' );
960 push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
962 push( @expect_args, 'EOF' );
963 push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
966 &printargs( $time_out, @expect_args );
969 $ret = &chat'expect( $time_out, @expect_args );
971 # we saw a continuation line, wait for the end
972 push( @expect_args, "^.*\n" );
973 push( @expect_args, "100" );
975 while( $ret == 100 ){
976 $ret = &chat'expect( $time_out, @expect_args );
986 sub ftp'open_data_socket
990 local( $sockaddr, $name, $aliases, $proto, $port );
991 local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
992 local( $mysockaddr, $family, $hi, $lo );
995 $sockaddr = 'S n a4 x8';
996 chop( $hostname = `hostname` );
1000 ($name, $aliases, $proto) = getprotobyname( 'tcp' );
1001 ($name, $aliases, $port) = getservbyname( $port, 'tcp' );
1003 # ($name, $aliases, $type, $len, $thisaddr) =
1004 # gethostbyname( $hostname );
1005 ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
1007 # $this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
1008 $this = $chat'thisproc;
1010 socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!";
1011 bind(S, $this) || die "bind: $!";
1013 # get the port number
1014 $mysockaddr = getsockname(S);
1015 ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
1017 $hi = ($port >> 8) & 0x00ff;
1018 $lo = $port & 0x00ff;
1021 # we MUST do a listen before sending the port otherwise
1024 listen( S, 5 ) || die "listen";
1026 &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
1028 return &ftp'expect($timeout,
1029 200, "PORT command successful", 1,
1030 250, "PORT command successful", 1 ,
1032 500, "syntax error", 0,
1033 501, "syntax error", 0,
1034 530, "not logged in", 0,
1036 421, "service unavailable, closing connection", 0);
1039 sub ftp'close_data_socket
1046 local($send_cmd) = @_;
1047 if( $send_cmd =~ /\n/ ){
1048 print STDERR "ERROR, \\n in send string for $send_cmd\n";
1052 local( $sc ) = $send_cmd;
1054 if( $send_cmd =~ /^PASS/){
1055 $sc = "PASS <somestring>";
1057 print STDERR "---> $sc\n";
1060 &chat'print( "$send_cmd\r\n" );
1066 print STDERR shift( @_ ) . "\n";
1072 local( $fname ) = @_;
1078 return (stat( _ ))[ 7 ];
1082 # make this package return true