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
92 eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" || die "socket.ph missing: $!\n";
97 if( defined( &main'PF_INET ) ){
98 $pf_inet = &main'PF_INET;
99 $sock_stream = &main'SOCK_STREAM;
100 local($name, $aliases, $proto) = getprotobyname( 'tcp' );
104 # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
105 # but who the heck would change these anyway? (:-)
111 # If the remote ftp daemon doesn't respond within this time presume its dead
115 # Timeout a read if I don't get data back within this many seconds
116 $timeout_read = 20 * $timeout;
119 $timeout_open = $timeout;
121 # This is a "global" it contains the last response from the remote ftp server
122 # for use in error messages
124 # Also ftp'NS is the socket containing the data coming in from the remote ls
127 # The size of block to be read or written when talking to the remote
129 $ftp'ftpbufsize = 4096;
131 # How often to print a hash out, when debugging
132 $ftp'hashevery = 1024;
133 # Output a newline after this many hashes to prevent outputing very long lines
136 # If a proxy connection then who am I really talking to?
139 # This is just a tracing aid.
145 # print STDERR "ftp debugging on\n";
152 $timeout_open = $timeout;
153 $timeout_read = 20 * $timeout;
155 print STDERR "ftp timeout set to $timeout\n";
167 local( $site, $ftp_port, $retry_call, $attempts ) = @_;
168 local( $connect_site, $connect_port );
171 alarm( $timeout_open );
173 while( $attempts-- ){
175 print STDERR "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
176 print STDERR "Connecting to $site";
177 if( $ftp_port != 21 ){
178 print STDERR " [port $ftp_port]";
184 if( ! $proxy_gateway ) {
185 # if not otherwise set
186 $proxy_gateway = "internet-gateway";
189 print STDERR "using proxy services of $proxy_gateway, ";
190 print STDERR "at $proxy_ftp_port\n";
192 $connect_site = $proxy_gateway;
193 $connect_port = $proxy_ftp_port;
197 $connect_site = $site;
198 $connect_port = $ftp_port;
200 if( ! &chat'open_port( $connect_site, $connect_port ) ){
202 print STDERR "Failed to connect\n" if $ftp_show;
206 print STDERR "proxy connection failed " if $proxy;
207 print STDERR "Cannot open ftp to $connect_site\n" if $ftp_show;
211 $res = &ftp'expect( $timeout,
212 120, "service unavailable to $site", 0,
213 220, "ready for login to $site", 1,
214 421, "service unavailable to $site, closing connection", 0);
222 print STDERR "Pausing between retries\n";
223 sleep( $retry_pause );
230 local( $site, $ftp_port, $retry_call, $attempts ) = @_;
232 $SIG{ 'ALRM' } = "ftp\'open_alarm";
234 local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
237 if( $@ =~ /^timeout/ ){
245 local( $remote_user, $remote_password ) = @_;
248 &ftp'send( "USER $remote_user\@$site" );
251 &ftp'send( "USER $remote_user" );
254 &ftp'expect($timeout,
255 230, "$remote_user logged in", 1,
256 331, "send password for $remote_user", 2,
258 500, "syntax error", 0,
259 501, "syntax error", 0,
260 530, "not logged in", 0,
261 332, "account for login not supported", 0,
263 421, "service unavailable, closing connection", 0);
268 # A password is needed
269 &ftp'send( "PASS $remote_password" );
271 $val = &ftp'expect( $timeout,
272 230, "$remote_user logged in", 1,
274 202, "command not implemented", 0,
275 332, "account for login not supported", 0,
277 530, "not logged in", 0,
278 500, "syntax error", 0,
279 501, "syntax error", 0,
280 503, "bad sequence of commands", 0,
282 421, "service unavailable, closing connection", 0);
288 # If I got here I failed to login
299 # return 1 if successful
305 &ftp'send( "CWD $dir" );
307 return &ftp'expect( $timeout,
308 200, "working directory = $dir", 1,
309 250, "working directory = $dir", 1,
311 500, "syntax error", 0,
312 501, "syntax error", 0,
313 502, "command not implemented", 0,
314 530, "not logged in", 0,
315 550, "cannot change directory", 0,
316 421, "service unavailable, closing connection", 0 );
319 # Get a full directory listing:
320 # &ftp'dir( remote LIST options )
321 # Start a list goin with the given options.
322 # Presuming that the remote deamon uses the ls command to generate the
323 # data to send back then then you can send it some extra options (eg: -lRa)
324 # return 1 if sucessful and 0 on a failure
327 local( $options ) = @_;
330 if( ! &ftp'open_data_socket() ){
335 &ftp'send( "LIST $options" );
341 $ret = &ftp'expect( $timeout,
342 150, "reading directory", 1,
344 125, "data connection already open?", 0,
346 450, "file unavailable", 0,
347 500, "syntax error", 0,
348 501, "syntax error", 0,
349 502, "command not implemented", 0,
350 530, "not logged in", 0,
352 421, "service unavailable, closing connection", 0 );
354 &ftp'close_data_socket;
359 # the data should be coming at us now
363 accept(NS,S) || die "accept failed $!";
369 # Close down reading the result of a remote ls command
370 # return 1 if successful and 0 on failure
377 $ret = &ftp'expect($timeout,
378 226, "", 1, # transfer complete, closing connection
379 250, "", 1, # action completed
381 425, "can't open data connection", 0,
382 426, "connection closed, transfer aborted", 0,
383 451, "action aborted, local error", 0,
384 421, "service unavailable, closing connection", 0);
386 # shut down our end of the socket
387 &ftp'close_data_socket;
396 # Quit from the remote ftp server
397 # return 1 if successful and 0 on failure
400 $site_command_check = 0;
401 @site_command_list = ();
405 return &ftp'expect($timeout,
406 221, "Goodbye", 1, # transfer complete, closing connection
408 500, "error quitting??", 0);
418 alarm( $timeout_read );
419 return sysread( NS, $buf, $ftpbufsize );
424 $SIG{ 'ALRM' } = "ftp\'read_alarm";
426 local( $ret ) = eval '&timed_read()';
429 if( $@ =~ /^timeout/ ){
435 # Get a remote file back into a local file.
436 # If no loc_fname passed then uses rem_fname.
437 # returns 1 on success and 0 on failure
440 local($rem_fname, $loc_fname, $restart ) = @_;
442 if ($loc_fname eq "") {
443 $loc_fname = $rem_fname;
446 if( ! &ftp'open_data_socket() ){
447 print STDERR "Cannot open data socket\n";
451 if( $loc_fname ne '-' ){
452 # Find the size of the target file
453 local( $restart_at ) = &ftp'filesize( $loc_fname );
454 if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
456 # Make sure the file can be updated
457 chmod( 0644, $loc_fname );
461 unlink( $loc_fname );
465 &ftp'send( "RETR $rem_fname" );
468 &ftp'expect($timeout,
469 150, "receiving $rem_fname", 1,
471 125, "data connection already open?", 0,
473 450, "file unavailable", 2,
474 550, "file unavailable", 2,
476 500, "syntax error", 0,
477 501, "syntax error", 0,
478 530, "not logged in", 0,
480 421, "service unavailable, closing connection", 0);
482 print STDERR "Failure on RETR command\n";
484 # shut down our end of the socket
485 &ftp'close_data_socket;
491 # the data should be coming at us now
495 accept(NS,S) || die "accept failed: $!";
498 # open the local fname
499 # concatenate on the end if restarting, else just overwrite
500 if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){
501 print STDERR "Cannot create local file $loc_fname\n";
503 # shut down our end of the socket
504 &ftp'close_data_socket;
513 local( $start_time ) = time;
514 local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
515 while( ($len = &ftp'read()) > 0 ){
521 while( $bytes > ($lasthash + $ftp'hashevery) ){
523 $lasthash += $ftp'hashevery;
525 if( ($hashes % $ftp'hashnl) == 0 ){
530 if( ! print FH $ftp'buf ){
531 print STDERR "\nfailed to write data";
537 # shut down our end of the socket
538 &ftp'close_data_socket;
541 print STDERR "\ntimed out reading data!\n";
547 if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
550 local( $secs ) = (time - $start_time);
552 $secs = 1; # To avoid a divide by zero;
555 local( $rate ) = int( $bytes / $secs );
556 print STDERR "Got $bytes bytes ($rate bytes/sec)\n";
563 $ret = &ftp'expect($timeout,
564 226, "Got file", 1, # transfer complete, closing connection
565 250, "Got file", 1, # action completed
567 110, "restart not supported", 0,
568 425, "can't open data connection", 0,
569 426, "connection closed, transfer aborted", 0,
570 451, "action aborted, local error", 0,
571 421, "service unavailable, closing connection", 0);
578 local( $rem_fname, $val ) = @_;
580 &ftp'send("DELE $rem_fname" );
581 $val = &ftp'expect( $timeout,
582 250,"Deleted $rem_fname", 1,
583 550,"Permission denied",0
590 local( $fname ) = @_;
592 # not yet implemented
597 # Add in the hash printing and newline conversion
600 local( $loc_fname, $rem_fname ) = @_;
603 if ($loc_fname eq "") {
604 $loc_fname = $rem_fname;
607 if( ! &ftp'open_data_socket() ){
611 &ftp'send("STOR $rem_fname");
614 # the data should be coming at us now
618 &ftp'expect($timeout,
619 150, "sending $loc_fname", 1,
621 125, "data connection already open?", 0,
622 450, "file unavailable", 0,
624 532, "need account for storing files", 0,
625 452, "insufficient storage on system", 0,
626 553, "file name not allowed", 0,
628 500, "syntax error", 0,
629 501, "syntax error", 0,
630 530, "not logged in", 0,
632 421, "service unavailable, closing connection", 0);
635 # shut down our end of the socket
636 &ftp'close_data_socket;
643 # the data should be coming at us now
647 accept(NS,S) || die "accept failed: $!";
650 # open the local fname
652 if( !open(FH, "<$loc_fname") ){
653 print STDERR "Cannot open local file $loc_fname\n";
655 # shut down our end of the socket
656 &ftp'close_data_socket;
666 # shut down our end of the socket to signal EOF
667 &ftp'close_data_socket;
673 $ret = &ftp'expect($timeout,
674 226, "file put", 1, # transfer complete, closing connection
675 250, "file put", 1, # action completed
677 110, "restart not supported", 0,
678 425, "can't open data connection", 0,
679 426, "connection closed, transfer aborted", 0,
680 451, "action aborted, local error", 0,
681 551, "page type unknown", 0,
682 552, "storage allocation exceeded", 0,
684 421, "service unavailable, closing connection", 0);
686 print STDERR "error putting $loc_fname\n";
693 local( $restart_point, $ret ) = @_;
695 &ftp'send("REST $restart_point");
700 $ret = &ftp'expect($timeout,
701 350, "restarting at $restart_point", 1,
703 500, "syntax error", 0,
704 501, "syntax error", 0,
705 502, "REST not implemented", 2,
706 530, "not logged in", 0,
707 554, "REST not implemented", 2,
709 421, "service unavailable, closing connection", 0);
713 # Set the file transfer type
718 &ftp'send("TYPE $type");
723 $ret = &ftp'expect($timeout,
724 200, "file type set to $type", 1,
726 500, "syntax error", 0,
727 501, "syntax error", 0,
728 504, "Invalid form or byte size for type $type", 0,
730 421, "service unavailable, closing connection", 0);
734 $site_command_check = 0;
735 @site_command_list = ();
737 # routine to query the remote server for 'SITE' commands supported
738 sub ftp'site_commands
742 # if we havent sent a 'HELP SITE', send it now
743 if( !$site_command_check ){
745 $site_command_check = 1;
747 &ftp'send( "HELP SITE" );
749 # assume the line in the HELP SITE response with the 'HELP'
750 # command is the one for us
751 $ret = &ftp'expect( $timeout,
752 ".*HELP.*", "", "\$1",
757 print STDERR "No response from HELP SITE\n" if( $ftp_show );
760 @site_command_list = split(/\s+/, $ret);
763 return @site_command_list;
766 # return the pwd, or null if we can't get the pwd
776 $ret = &ftp'expect( $timeout,
777 257, "working dir is", 1,
778 500, "syntax error", 0,
779 501, "syntax error", 0,
780 502, "PWD not implemented", 0,
781 550, "file unavailable", 0,
783 421, "service unavailable, closing connection", 0 );
785 if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
792 # return 1 for success, 0 for failure
798 &ftp'send( "MKD $path" );
803 $ret = &ftp'expect( $timeout,
804 257, "made directory $path", 1,
806 500, "syntax error", 0,
807 501, "syntax error", 0,
808 502, "MKD not implemented", 0,
809 530, "not logged in", 0,
810 550, "file unavailable", 0,
812 421, "service unavailable, closing connection", 0 );
816 # return 1 for success, 0 for failure
819 local( $path, $mode ) = @_;
822 &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
827 $ret = &ftp'expect( $timeout,
828 200, "chmod $mode $path succeeded", 1,
830 500, "syntax error", 0,
831 501, "syntax error", 0,
832 502, "CHMOD not implemented", 0,
833 530, "not logged in", 0,
834 550, "file unavailable", 0,
836 421, "service unavailable, closing connection", 0 );
843 local( $old_name, $new_name ) = @_;
846 &ftp'send( "RNFR $old_name" );
851 $ret = &ftp'expect( $timeout,
854 500, "syntax error", 0,
855 501, "syntax error", 0,
856 502, "RNFR not implemented", 0,
857 530, "not logged in", 0,
858 550, "file unavailable", 0,
859 450, "file unavailable", 0,
861 421, "service unavailable, closing connection", 0);
864 # check if the "rename from" occurred ok
866 &ftp'send( "RNTO $new_name" );
871 $ret = &ftp'expect( $timeout,
872 250, "rename $old_name to $new_name", 1,
874 500, "syntax error", 0,
875 501, "syntax error", 0,
876 502, "RNTO not implemented", 0,
877 503, "bad sequence of commands", 0,
878 530, "not logged in", 0,
879 532, "need account for storing files", 0,
880 553, "file name not allowed", 0,
882 421, "service unavailable, closing connection", 0);
895 return &ftp'expect( $timeout,
896 200, "Remote '$cmd' OK", 1,
897 500, "error in remote '$cmd'", 0 );
900 # ------------------------------------------------------------------------------
901 # These are the lower level support routines
905 ($ftp'response, $ftp'fatalerror) = @_;
907 print STDERR "$ftp'response\n";
912 # create the list of parameters for chat'expect
914 # ftp'expect(time_out, {value, string_to_print, return value});
915 # if the string_to_print is "" then nothing is printed
916 # the last response is stored in $ftp'response
918 # NOTE: lmjm has changed this code such that the string_to_print is
919 # ignored and the string sent back from the remote system is printed
925 local( $expect_args );
932 $time_out = shift(@_);
935 local( $code ) = shift( @_ );
937 if( $code =~ /^\d/ ){
940 push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
943 "&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
946 # Treat all unrecognised lines as continuations
947 push( @expect_args, "^(.*)\\015\\n" );
948 push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
950 # add patterns TIMEOUT and EOF
952 push( @expect_args, 'TIMEOUT' );
953 push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
955 push( @expect_args, 'EOF' );
956 push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
959 &printargs( $time_out, @expect_args );
962 $ret = &chat'expect( $time_out, @expect_args );
964 # we saw a continuation line, wait for the end
965 push( @expect_args, "^.*\n" );
966 push( @expect_args, "100" );
968 while( $ret == 100 ){
969 $ret = &chat'expect( $time_out, @expect_args );
979 sub ftp'open_data_socket
983 local( $sockaddr, $name, $aliases, $proto, $port );
984 local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
985 local( $mysockaddr, $family, $hi, $lo );
988 $sockaddr = 'S n a4 x8';
989 chop( $hostname = `hostname` );
993 ($name, $aliases, $proto) = getprotobyname( 'tcp' );
994 ($name, $aliases, $port) = getservbyname( $port, 'tcp' );
996 # ($name, $aliases, $type, $len, $thisaddr) =
997 # gethostbyname( $hostname );
998 ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
1000 # $this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
1001 $this = $chat'thisproc;
1003 socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!";
1004 bind(S, $this) || die "bind: $!";
1006 # get the port number
1007 $mysockaddr = getsockname(S);
1008 ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
1010 $hi = ($port >> 8) & 0x00ff;
1011 $lo = $port & 0x00ff;
1014 # we MUST do a listen before sending the port otherwise
1017 listen( S, 5 ) || die "listen";
1019 &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
1021 return &ftp'expect($timeout,
1022 200, "PORT command successful", 1,
1023 250, "PORT command successful", 1 ,
1025 500, "syntax error", 0,
1026 501, "syntax error", 0,
1027 530, "not logged in", 0,
1029 421, "service unavailable, closing connection", 0);
1032 sub ftp'close_data_socket
1039 local($send_cmd) = @_;
1040 if( $send_cmd =~ /\n/ ){
1041 print STDERR "ERROR, \\n in send string for $send_cmd\n";
1045 local( $sc ) = $send_cmd;
1047 if( $send_cmd =~ /^PASS/){
1048 $sc = "PASS <somestring>";
1050 print STDERR "---> $sc\n";
1053 &chat'print( "$send_cmd\r\n" );
1059 print STDERR shift( @_ ) . "\n";
1065 local( $fname ) = @_;
1071 return (stat( _ ))[ 7 ];
1075 # make this package return true