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 require 'chat2.pl'; # into main
92 eval "require 'socket.ph'" || eval "require 'sys/socket.ph'"
93 || die "socket.ph missing: $!\n";
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' );
105 # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
106 # but who the heck would change these anyway? (:-)
112 # If the remote ftp daemon doesn't respond within this time presume its dead
116 # Timeout a read if I don't get data back within this many seconds
117 $timeout_read = 20 * $timeout;
120 $timeout_open = $timeout;
122 # This is a "global" it contains the last response from the remote ftp server
123 # for use in error messages
125 # Also ftp'NS is the socket containing the data coming in from the remote ls
128 # The size of block to be read or written when talking to the remote
130 $ftp'ftpbufsize = 4096;
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
137 # If a proxy connection then who am I really talking to?
140 # This is just a tracing aid.
146 # print STDERR "ftp debugging on\n";
153 $timeout_open = $timeout;
154 $timeout_read = 20 * $timeout;
156 print STDERR "ftp timeout set to $timeout\n";
168 local( $site, $ftp_port, $retry_call, $attempts ) = @_;
169 local( $connect_site, $connect_port );
172 alarm( $timeout_open );
174 while( $attempts-- ){
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]";
185 if( ! $proxy_gateway ) {
186 # if not otherwise set
187 $proxy_gateway = "internet-gateway";
190 print STDERR "using proxy services of $proxy_gateway, ";
191 print STDERR "at $proxy_ftp_port\n";
193 $connect_site = $proxy_gateway;
194 $connect_port = $proxy_ftp_port;
198 $connect_site = $site;
199 $connect_port = $ftp_port;
201 if( ! &chat'open_port( $connect_site, $connect_port ) ){
203 print STDERR "Failed to connect\n" if $ftp_show;
207 print STDERR "proxy connection failed " if $proxy;
208 print STDERR "Cannot open ftp to $connect_site\n" if $ftp_show;
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);
223 print STDERR "Pausing between retries\n";
224 sleep( $retry_pause );
231 local( $site, $ftp_port, $retry_call, $attempts ) = @_;
233 $SIG{ 'ALRM' } = "ftp\'open_alarm";
235 local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
238 if( $@ =~ /^timeout/ ){
246 local( $remote_user, $remote_password ) = @_;
249 &ftp'send( "USER $remote_user\@$site" );
252 &ftp'send( "USER $remote_user" );
255 &ftp'expect($timeout,
256 230, "$remote_user logged in", 1,
257 331, "send password for $remote_user", 2,
259 500, "syntax error", 0,
260 501, "syntax error", 0,
261 530, "not logged in", 0,
262 332, "account for login not supported", 0,
264 421, "service unavailable, closing connection", 0);
269 # A password is needed
270 &ftp'send( "PASS $remote_password" );
272 $val = &ftp'expect( $timeout,
273 230, "$remote_user logged in", 1,
275 202, "command not implemented", 0,
276 332, "account for login not supported", 0,
278 530, "not logged in", 0,
279 500, "syntax error", 0,
280 501, "syntax error", 0,
281 503, "bad sequence of commands", 0,
283 421, "service unavailable, closing connection", 0);
289 # If I got here I failed to login
300 # return 1 if successful
306 &ftp'send( "CWD $dir" );
308 return &ftp'expect( $timeout,
309 200, "working directory = $dir", 1,
310 250, "working directory = $dir", 1,
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 );
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
328 local( $options ) = @_;
331 if( ! &ftp'open_data_socket() ){
336 &ftp'send( "LIST $options" );
342 $ret = &ftp'expect( $timeout,
343 150, "reading directory", 1,
345 125, "data connection already open?", 0,
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,
353 421, "service unavailable, closing connection", 0 );
355 &ftp'close_data_socket;
360 # the data should be coming at us now
364 accept(NS,S) || die "accept failed $!";
370 # Close down reading the result of a remote ls command
371 # return 1 if successful and 0 on failure
378 $ret = &ftp'expect($timeout,
379 226, "", 1, # transfer complete, closing connection
380 250, "", 1, # action completed
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);
387 # shut down our end of the socket
388 &ftp'close_data_socket;
397 # Quit from the remote ftp server
398 # return 1 if successful and 0 on failure
401 $site_command_check = 0;
402 @site_command_list = ();
406 return &ftp'expect($timeout,
407 221, "Goodbye", 1, # transfer complete, closing connection
409 500, "error quitting??", 0);
419 alarm( $timeout_read );
420 return sysread( NS, $buf, $ftpbufsize );
425 $SIG{ 'ALRM' } = "ftp\'read_alarm";
427 local( $ret ) = eval '&timed_read()';
430 if( $@ =~ /^timeout/ ){
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
441 local($rem_fname, $loc_fname, $restart ) = @_;
443 if ($loc_fname eq "") {
444 $loc_fname = $rem_fname;
447 if( ! &ftp'open_data_socket() ){
448 print STDERR "Cannot open data socket\n";
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 ) ){
457 # Make sure the file can be updated
458 chmod( 0644, $loc_fname );
462 unlink( $loc_fname );
466 &ftp'send( "RETR $rem_fname" );
469 &ftp'expect($timeout,
470 150, "receiving $rem_fname", 1,
472 125, "data connection already open?", 0,
474 450, "file unavailable", 2,
475 550, "file unavailable", 2,
477 500, "syntax error", 0,
478 501, "syntax error", 0,
479 530, "not logged in", 0,
481 421, "service unavailable, closing connection", 0);
483 print STDERR "Failure on RETR command\n";
485 # shut down our end of the socket
486 &ftp'close_data_socket;
492 # the data should be coming at us now
496 accept(NS,S) || die "accept failed: $!";
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";
504 # shut down our end of the socket
505 &ftp'close_data_socket;
514 local( $start_time ) = time;
515 local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
516 while( ($len = &ftp'read()) > 0 ){
522 while( $bytes > ($lasthash + $ftp'hashevery) ){
524 $lasthash += $ftp'hashevery;
526 if( ($hashes % $ftp'hashnl) == 0 ){
531 if( ! print FH $ftp'buf ){
532 print STDERR "\nfailed to write data";
538 # shut down our end of the socket
539 &ftp'close_data_socket;
542 print STDERR "\ntimed out reading data!\n";
548 if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
551 local( $secs ) = (time - $start_time);
553 $secs = 1; # To avoid a divide by zero;
556 local( $rate ) = int( $bytes / $secs );
557 print STDERR "Got $bytes bytes ($rate bytes/sec)\n";
564 $ret = &ftp'expect($timeout,
565 226, "Got file", 1, # transfer complete, closing connection
566 250, "Got file", 1, # action completed
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);
579 local( $rem_fname, $val ) = @_;
581 &ftp'send("DELE $rem_fname" );
582 $val = &ftp'expect( $timeout,
583 250,"Deleted $rem_fname", 1,
584 550,"Permission denied",0
591 local( $fname ) = @_;
593 # not yet implemented
598 # Add in the hash printing and newline conversion
601 local( $loc_fname, $rem_fname ) = @_;
604 if ($loc_fname eq "") {
605 $loc_fname = $rem_fname;
608 if( ! &ftp'open_data_socket() ){
612 &ftp'send("STOR $rem_fname");
615 # the data should be coming at us now
619 &ftp'expect($timeout,
620 150, "sending $loc_fname", 1,
622 125, "data connection already open?", 0,
623 450, "file unavailable", 0,
625 532, "need account for storing files", 0,
626 452, "insufficient storage on system", 0,
627 553, "file name not allowed", 0,
629 500, "syntax error", 0,
630 501, "syntax error", 0,
631 530, "not logged in", 0,
633 421, "service unavailable, closing connection", 0);
636 # shut down our end of the socket
637 &ftp'close_data_socket;
644 # the data should be coming at us now
648 accept(NS,S) || die "accept failed: $!";
651 # open the local fname
653 if( !open(FH, "<$loc_fname") ){
654 print STDERR "Cannot open local file $loc_fname\n";
656 # shut down our end of the socket
657 &ftp'close_data_socket;
667 # shut down our end of the socket to signal EOF
668 &ftp'close_data_socket;
674 $ret = &ftp'expect($timeout,
675 226, "file put", 1, # transfer complete, closing connection
676 250, "file put", 1, # action completed
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,
685 421, "service unavailable, closing connection", 0);
687 print STDERR "error putting $loc_fname\n";
694 local( $restart_point, $ret ) = @_;
696 &ftp'send("REST $restart_point");
701 $ret = &ftp'expect($timeout,
702 350, "restarting at $restart_point", 1,
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,
710 421, "service unavailable, closing connection", 0);
714 # Set the file transfer type
719 &ftp'send("TYPE $type");
724 $ret = &ftp'expect($timeout,
725 200, "file type set to $type", 1,
727 500, "syntax error", 0,
728 501, "syntax error", 0,
729 504, "Invalid form or byte size for type $type", 0,
731 421, "service unavailable, closing connection", 0);
735 $site_command_check = 0;
736 @site_command_list = ();
738 # routine to query the remote server for 'SITE' commands supported
739 sub ftp'site_commands
743 # if we havent sent a 'HELP SITE', send it now
744 if( !$site_command_check ){
746 $site_command_check = 1;
748 &ftp'send( "HELP SITE" );
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",
758 print STDERR "No response from HELP SITE\n" if( $ftp_show );
761 @site_command_list = split(/\s+/, $ret);
764 return @site_command_list;
767 # return the pwd, or null if we can't get the pwd
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,
784 421, "service unavailable, closing connection", 0 );
786 if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
793 # return 1 for success, 0 for failure
799 &ftp'send( "MKD $path" );
804 $ret = &ftp'expect( $timeout,
805 257, "made directory $path", 1,
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,
813 421, "service unavailable, closing connection", 0 );
817 # return 1 for success, 0 for failure
820 local( $path, $mode ) = @_;
823 &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
828 $ret = &ftp'expect( $timeout,
829 200, "chmod $mode $path succeeded", 1,
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,
837 421, "service unavailable, closing connection", 0 );
844 local( $old_name, $new_name ) = @_;
847 &ftp'send( "RNFR $old_name" );
852 $ret = &ftp'expect( $timeout,
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,
862 421, "service unavailable, closing connection", 0);
865 # check if the "rename from" occurred ok
867 &ftp'send( "RNTO $new_name" );
872 $ret = &ftp'expect( $timeout,
873 250, "rename $old_name to $new_name", 1,
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,
883 421, "service unavailable, closing connection", 0);
896 return &ftp'expect( $timeout,
897 200, "Remote '$cmd' OK", 1,
898 500, "error in remote '$cmd'", 0 );
901 # ------------------------------------------------------------------------------
902 # These are the lower level support routines
906 ($ftp'response, $ftp'fatalerror) = @_;
908 print STDERR "$ftp'response\n";
913 # create the list of parameters for chat'expect
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
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
926 local( $expect_args );
933 $time_out = shift(@_);
936 local( $code ) = shift( @_ );
938 if( $code =~ /^\d/ ){
941 push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
944 "&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
947 # Treat all unrecognised lines as continuations
948 push( @expect_args, "^(.*)\\015\\n" );
949 push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
951 # add patterns TIMEOUT and EOF
953 push( @expect_args, 'TIMEOUT' );
954 push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
956 push( @expect_args, 'EOF' );
957 push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
960 &printargs( $time_out, @expect_args );
963 $ret = &chat'expect( $time_out, @expect_args );
965 # we saw a continuation line, wait for the end
966 push( @expect_args, "^.*\n" );
967 push( @expect_args, "100" );
969 while( $ret == 100 ){
970 $ret = &chat'expect( $time_out, @expect_args );
980 sub ftp'open_data_socket
984 local( $sockaddr, $name, $aliases, $proto, $port );
985 local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
986 local( $mysockaddr, $family, $hi, $lo );
989 $sockaddr = 'S n a4 x8';
990 chop( $hostname = `hostname` );
994 ($name, $aliases, $proto) = getprotobyname( 'tcp' );
995 ($name, $aliases, $port) = getservbyname( $port, 'tcp' );
997 # ($name, $aliases, $type, $len, $thisaddr) =
998 # gethostbyname( $hostname );
999 ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
1001 # $this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
1002 $this = $chat'thisproc;
1004 socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!";
1005 bind(S, $this) || die "bind: $!";
1007 # get the port number
1008 $mysockaddr = getsockname(S);
1009 ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
1011 $hi = ($port >> 8) & 0x00ff;
1012 $lo = $port & 0x00ff;
1015 # we MUST do a listen before sending the port otherwise
1018 listen( S, 5 ) || die "listen";
1020 &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
1022 return &ftp'expect($timeout,
1023 200, "PORT command successful", 1,
1024 250, "PORT command successful", 1 ,
1026 500, "syntax error", 0,
1027 501, "syntax error", 0,
1028 530, "not logged in", 0,
1030 421, "service unavailable, closing connection", 0);
1033 sub ftp'close_data_socket
1040 local($send_cmd) = @_;
1041 if( $send_cmd =~ /\n/ ){
1042 print STDERR "ERROR, \\n in send string for $send_cmd\n";
1046 local( $sc ) = $send_cmd;
1048 if( $send_cmd =~ /^PASS/){
1049 $sc = "PASS <somestring>";
1051 print STDERR "---> $sc\n";
1054 &chat'print( "$send_cmd\r\n" );
1060 print STDERR shift( @_ ) . "\n";
1066 local( $fname ) = @_;
1072 return (stat( _ ))[ 7 ];
1076 # make this package return true