Merge branch 'master' of http://repo.or.cz/r/msysgit into devel
[msysgit/historical-msysgit.git] / lib / perl5 / 5.6.1 / ftp.pl
blob3f0af1a8d7fa1431e3c82dafd711b0edad8e6f17
1 #-*-perl-*-
3 # This library is no longer being maintained, and is included for backward
4 # compatibility with Perl 4 programs which may require it.
6 # In particular, this should not be used as an example of modern Perl
7 # programming techniques.
9 # Suggested alternative: Net::FTP
11 # This is a wrapper to the chat2.pl routines that make life easier
12 # to do ftp type work.
13 # Mostly by Lee McLoughlin <lmjm@doc.ic.ac.uk>
14 # based on original version by Alan R. Martello <al@ee.pitt.edu>
15 # And by A.Macpherson@bnr.co.uk for multi-homed hosts
17 # $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 $
18 # $Log: ftp.pl,v $
19 # Revision 1.17 1993/04/21 10:06:54 lmjm
20 # Send all status reports to STDERR not to STDOUT (to allow use by ftpcat).
21 # Allow target file to be '-' meaning STDOUT
22 # Added ftp'quote
24 # Revision 1.16 1993/01/28 18:59:05 lmjm
25 # Allow socket arguemtns to come from main.
26 # Minor cleanups - removed old comments.
28 # Revision 1.15 1992/11/25 21:09:30 lmjm
29 # Added another REST return code.
31 # Revision 1.14 1992/08/12 14:33:42 lmjm
32 # Fail ftp'write if out of space.
34 # Revision 1.13 1992/03/20 21:01:03 lmjm
35 # Added in the proxy ftp code from Edwards Reed <err@cinops.xerox.com>
36 # Added ftp'delete from Aaron Wohl <aw0g+@andrew.cmu.edu>
38 # Revision 1.12 1992/02/06 23:25:56 lmjm
39 # Moved code around so can use this as a lib for both mirror and ftpmail.
40 # Time out opens. In case Unix doesn't bother to.
42 # Revision 1.11 1991/11/27 22:05:57 lmjm
43 # Match the response code number at the start of a line allowing
44 # for any leading junk.
46 # Revision 1.10 1991/10/23 22:42:20 lmjm
47 # Added better timeout code.
48 # Tried to optimise file transfer
49 # Moved open/close code to not leak file handles.
50 # Cleaned up the alarm code.
51 # Added $fatalerror to show wether the ftp link is really dead.
53 # Revision 1.9 1991/10/07 18:30:35 lmjm
54 # Made the timeout-read code work.
55 # Added restarting file gets.
56 # Be more verbose if ever have to call die.
58 # Revision 1.8 1991/09/17 22:53:16 lmjm
59 # Spot when open_data_socket fails and return a failure rather than dying.
61 # Revision 1.7 1991/09/12 22:40:25 lmjm
62 # Added Andrew Macpherson's patches for hosts without ip forwarding.
64 # Revision 1.6 1991/09/06 19:53:52 lmjm
65 # Relaid out the code the way I like it!
66 # Changed the debuggin to produce more "appropriate" messages
67 # Fixed bugs in the ordering of put and dir listing.
68 # Allow for hash printing when getting files (a la ftp).
69 # Added the new commands from Al.
70 # Don't print passwords in debugging.
72 # Revision 1.5 1991/08/29 16:23:49 lmjm
73 # Timeout reads from the remote ftp server.
74 # No longer call die expect on fatal errors. Just return fail codes.
75 # Changed returns so higher up routines can tell whats happening.
76 # Get expect/accept in correct order for dir listing.
77 # When ftp_show is set then print hashes every 1k transferred (like ftp).
78 # Allow for stripping returns out of incoming data.
79 # Save last error in a global string.
81 # Revision 1.4 1991/08/14 21:04:58 lmjm
82 # ftp'get now copes with ungetable files.
83 # ftp'expect code changed such that the string_to_print is
84 # ignored and the string sent back from the remote system is printed
85 # instead.
86 # Implemented patches from al. Removed spuiours tracing statements.
88 # Revision 1.3 1991/08/09 21:32:18 lmjm
89 # Allow for another ok code on cwd's
90 # Rejigger the log levels
91 # Send \r\n for some odd ftp daemons
93 # Revision 1.2 1991/08/09 18:07:37 lmjm
94 # Don't print messages unless ftp_show says to.
96 # Revision 1.1 1991/08/08 20:31:00 lmjm
97 # Initial revision
100 require 'chat2.pl'; # into main
101 eval "require 'socket.ph'" || eval "require 'sys/socket.ph'"
102 || die "socket.ph missing: $!\n";
105 package ftp;
107 if( defined( &main'PF_INET ) ){
108 $pf_inet = &main'PF_INET;
109 $sock_stream = &main'SOCK_STREAM;
110 local($name, $aliases, $proto) = getprotobyname( 'tcp' );
111 $tcp_proto = $proto;
113 else {
114 # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
115 # but who the heck would change these anyway? (:-)
116 $pf_inet = 2;
117 $sock_stream = 1;
118 $tcp_proto = 6;
121 # If the remote ftp daemon doesn't respond within this time presume its dead
122 # or something.
123 $timeout = 30;
125 # Timeout a read if I don't get data back within this many seconds
126 $timeout_read = 20 * $timeout;
128 # Timeout an open
129 $timeout_open = $timeout;
131 # This is a "global" it contains the last response from the remote ftp server
132 # for use in error messages
133 $ftp'response = "";
134 # Also ftp'NS is the socket containing the data coming in from the remote ls
135 # command.
137 # The size of block to be read or written when talking to the remote
138 # ftp server
139 $ftp'ftpbufsize = 4096;
141 # How often to print a hash out, when debugging
142 $ftp'hashevery = 1024;
143 # Output a newline after this many hashes to prevent outputing very long lines
144 $ftp'hashnl = 70;
146 # If a proxy connection then who am I really talking to?
147 $real_site = "";
149 # This is just a tracing aid.
150 $ftp_show = 0;
151 sub ftp'debug
153 $ftp_show = $_[0];
154 # if( $ftp_show ){
155 # print STDERR "ftp debugging on\n";
159 sub ftp'set_timeout
161 $timeout = $_[0];
162 $timeout_open = $timeout;
163 $timeout_read = 20 * $timeout;
164 if( $ftp_show ){
165 print STDERR "ftp timeout set to $timeout\n";
170 sub ftp'open_alarm
172 die "timeout: open";
175 sub ftp'timed_open
177 local( $site, $ftp_port, $retry_call, $attempts ) = @_;
178 local( $connect_site, $connect_port );
179 local( $res );
181 alarm( $timeout_open );
183 while( $attempts-- ){
184 if( $ftp_show ){
185 print STDERR "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
186 print STDERR "Connecting to $site";
187 if( $ftp_port != 21 ){
188 print STDERR " [port $ftp_port]";
190 print STDERR "\n";
193 if( $proxy ) {
194 if( ! $proxy_gateway ) {
195 # if not otherwise set
196 $proxy_gateway = "internet-gateway";
198 if( $debug ) {
199 print STDERR "using proxy services of $proxy_gateway, ";
200 print STDERR "at $proxy_ftp_port\n";
202 $connect_site = $proxy_gateway;
203 $connect_port = $proxy_ftp_port;
204 $real_site = $site;
206 else {
207 $connect_site = $site;
208 $connect_port = $ftp_port;
210 if( ! &chat'open_port( $connect_site, $connect_port ) ){
211 if( $retry_call ){
212 print STDERR "Failed to connect\n" if $ftp_show;
213 next;
215 else {
216 print STDERR "proxy connection failed " if $proxy;
217 print STDERR "Cannot open ftp to $connect_site\n" if $ftp_show;
218 return 0;
221 $res = &ftp'expect( $timeout,
222 120, "service unavailable to $site", 0,
223 220, "ready for login to $site", 1,
224 421, "service unavailable to $site, closing connection", 0);
225 if( ! $res ){
226 &chat'close();
227 next;
229 return 1;
231 continue {
232 print STDERR "Pausing between retries\n";
233 sleep( $retry_pause );
235 return 0;
238 sub ftp'open
240 local( $site, $ftp_port, $retry_call, $attempts ) = @_;
242 $SIG{ 'ALRM' } = "ftp\'open_alarm";
244 local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
245 alarm( 0 );
247 if( $@ =~ /^timeout/ ){
248 return -1;
250 return $ret;
253 sub ftp'login
255 local( $remote_user, $remote_password ) = @_;
257 if( $proxy ){
258 &ftp'send( "USER $remote_user\@$site" );
260 else {
261 &ftp'send( "USER $remote_user" );
263 local( $val ) =
264 &ftp'expect($timeout,
265 230, "$remote_user logged in", 1,
266 331, "send password for $remote_user", 2,
268 500, "syntax error", 0,
269 501, "syntax error", 0,
270 530, "not logged in", 0,
271 332, "account for login not supported", 0,
273 421, "service unavailable, closing connection", 0);
274 if( $val == 1 ){
275 return 1;
277 if( $val == 2 ){
278 # A password is needed
279 &ftp'send( "PASS $remote_password" );
281 $val = &ftp'expect( $timeout,
282 230, "$remote_user logged in", 1,
284 202, "command not implemented", 0,
285 332, "account for login not supported", 0,
287 530, "not logged in", 0,
288 500, "syntax error", 0,
289 501, "syntax error", 0,
290 503, "bad sequence of commands", 0,
292 421, "service unavailable, closing connection", 0);
293 if( $val == 1){
294 # Logged in
295 return 1;
298 # If I got here I failed to login
299 return 0;
302 sub ftp'close
304 &ftp'quit();
305 &chat'close();
308 # Change directory
309 # return 1 if successful
310 # 0 on a failure
311 sub ftp'cwd
313 local( $dir ) = @_;
315 &ftp'send( "CWD $dir" );
317 return &ftp'expect( $timeout,
318 200, "working directory = $dir", 1,
319 250, "working directory = $dir", 1,
321 500, "syntax error", 0,
322 501, "syntax error", 0,
323 502, "command not implemented", 0,
324 530, "not logged in", 0,
325 550, "cannot change directory", 0,
326 421, "service unavailable, closing connection", 0 );
329 # Get a full directory listing:
330 # &ftp'dir( remote LIST options )
331 # Start a list goin with the given options.
332 # Presuming that the remote deamon uses the ls command to generate the
333 # data to send back then then you can send it some extra options (eg: -lRa)
334 # return 1 if sucessful and 0 on a failure
335 sub ftp'dir_open
337 local( $options ) = @_;
338 local( $ret );
340 if( ! &ftp'open_data_socket() ){
341 return 0;
344 if( $options ){
345 &ftp'send( "LIST $options" );
347 else {
348 &ftp'send( "LIST" );
351 $ret = &ftp'expect( $timeout,
352 150, "reading directory", 1,
354 125, "data connection already open?", 0,
356 450, "file unavailable", 0,
357 500, "syntax error", 0,
358 501, "syntax error", 0,
359 502, "command not implemented", 0,
360 530, "not logged in", 0,
362 421, "service unavailable, closing connection", 0 );
363 if( ! $ret ){
364 &ftp'close_data_socket;
365 return 0;
369 # the data should be coming at us now
372 # now accept
373 accept(NS,S) || die "accept failed $!";
375 return 1;
379 # Close down reading the result of a remote ls command
380 # return 1 if successful and 0 on failure
381 sub ftp'dir_close
383 local( $ret );
385 # read the close
387 $ret = &ftp'expect($timeout,
388 226, "", 1, # transfer complete, closing connection
389 250, "", 1, # action completed
391 425, "can't open data connection", 0,
392 426, "connection closed, transfer aborted", 0,
393 451, "action aborted, local error", 0,
394 421, "service unavailable, closing connection", 0);
396 # shut down our end of the socket
397 &ftp'close_data_socket;
399 if( ! $ret ){
400 return 0;
403 return 1;
406 # Quit from the remote ftp server
407 # return 1 if successful and 0 on failure
408 sub ftp'quit
410 $site_command_check = 0;
411 @site_command_list = ();
413 &ftp'send("QUIT");
415 return &ftp'expect($timeout,
416 221, "Goodbye", 1, # transfer complete, closing connection
418 500, "error quitting??", 0);
421 sub ftp'read_alarm
423 die "timeout: read";
426 sub ftp'timed_read
428 alarm( $timeout_read );
429 return sysread( NS, $buf, $ftpbufsize );
432 sub ftp'read
434 $SIG{ 'ALRM' } = "ftp\'read_alarm";
436 local( $ret ) = eval '&timed_read()';
437 alarm( 0 );
439 if( $@ =~ /^timeout/ ){
440 return -1;
442 return $ret;
445 # Get a remote file back into a local file.
446 # If no loc_fname passed then uses rem_fname.
447 # returns 1 on success and 0 on failure
448 sub ftp'get
450 local($rem_fname, $loc_fname, $restart ) = @_;
452 if ($loc_fname eq "") {
453 $loc_fname = $rem_fname;
456 if( ! &ftp'open_data_socket() ){
457 print STDERR "Cannot open data socket\n";
458 return 0;
461 if( $loc_fname ne '-' ){
462 # Find the size of the target file
463 local( $restart_at ) = &ftp'filesize( $loc_fname );
464 if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
465 $restart = 1;
466 # Make sure the file can be updated
467 chmod( 0644, $loc_fname );
469 else {
470 $restart = 0;
471 unlink( $loc_fname );
475 &ftp'send( "RETR $rem_fname" );
477 local( $ret ) =
478 &ftp'expect($timeout,
479 150, "receiving $rem_fname", 1,
481 125, "data connection already open?", 0,
483 450, "file unavailable", 2,
484 550, "file unavailable", 2,
486 500, "syntax error", 0,
487 501, "syntax error", 0,
488 530, "not logged in", 0,
490 421, "service unavailable, closing connection", 0);
491 if( $ret != 1 ){
492 print STDERR "Failure on RETR command\n";
494 # shut down our end of the socket
495 &ftp'close_data_socket;
497 return 0;
501 # the data should be coming at us now
504 # now accept
505 accept(NS,S) || die "accept failed: $!";
508 # open the local fname
509 # concatenate on the end if restarting, else just overwrite
510 if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){
511 print STDERR "Cannot create local file $loc_fname\n";
513 # shut down our end of the socket
514 &ftp'close_data_socket;
516 return 0;
519 # while (<NS>) {
520 # print FH ;
523 local( $start_time ) = time;
524 local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
525 while( ($len = &ftp'read()) > 0 ){
526 $bytes += $len;
527 if( $strip_cr ){
528 $ftp'buf =~ s/\r//g;
530 if( $ftp_show ){
531 while( $bytes > ($lasthash + $ftp'hashevery) ){
532 print STDERR '#';
533 $lasthash += $ftp'hashevery;
534 $hashes++;
535 if( ($hashes % $ftp'hashnl) == 0 ){
536 print STDERR "\n";
540 if( ! print FH $ftp'buf ){
541 print STDERR "\nfailed to write data";
542 return 0;
545 close( FH );
547 # shut down our end of the socket
548 &ftp'close_data_socket;
550 if( $len < 0 ){
551 print STDERR "\ntimed out reading data!\n";
553 return 0;
556 if( $ftp_show ){
557 if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
558 print STDERR "\n";
560 local( $secs ) = (time - $start_time);
561 if( $secs <= 0 ){
562 $secs = 1; # To avoid a divide by zero;
565 local( $rate ) = int( $bytes / $secs );
566 print STDERR "Got $bytes bytes ($rate bytes/sec)\n";
570 # read the close
573 $ret = &ftp'expect($timeout,
574 226, "Got file", 1, # transfer complete, closing connection
575 250, "Got file", 1, # action completed
577 110, "restart not supported", 0,
578 425, "can't open data connection", 0,
579 426, "connection closed, transfer aborted", 0,
580 451, "action aborted, local error", 0,
581 421, "service unavailable, closing connection", 0);
583 return $ret;
586 sub ftp'delete
588 local( $rem_fname, $val ) = @_;
590 &ftp'send("DELE $rem_fname" );
591 $val = &ftp'expect( $timeout,
592 250,"Deleted $rem_fname", 1,
593 550,"Permission denied",0
595 return $val == 1;
598 sub ftp'deldir
600 local( $fname ) = @_;
602 # not yet implemented
603 # RMD
606 # UPDATE ME!!!!!!
607 # Add in the hash printing and newline conversion
608 sub ftp'put
610 local( $loc_fname, $rem_fname ) = @_;
611 local( $strip_cr );
613 if ($loc_fname eq "") {
614 $loc_fname = $rem_fname;
617 if( ! &ftp'open_data_socket() ){
618 return 0;
621 &ftp'send("STOR $rem_fname");
624 # the data should be coming at us now
627 local( $ret ) =
628 &ftp'expect($timeout,
629 150, "sending $loc_fname", 1,
631 125, "data connection already open?", 0,
632 450, "file unavailable", 0,
634 532, "need account for storing files", 0,
635 452, "insufficient storage on system", 0,
636 553, "file name not allowed", 0,
638 500, "syntax error", 0,
639 501, "syntax error", 0,
640 530, "not logged in", 0,
642 421, "service unavailable, closing connection", 0);
644 if( $ret != 1 ){
645 # shut down our end of the socket
646 &ftp'close_data_socket;
648 return 0;
653 # the data should be coming at us now
656 # now accept
657 accept(NS,S) || die "accept failed: $!";
660 # open the local fname
662 if( !open(FH, "<$loc_fname") ){
663 print STDERR "Cannot open local file $loc_fname\n";
665 # shut down our end of the socket
666 &ftp'close_data_socket;
668 return 0;
671 while (<FH>) {
672 print NS ;
674 close(FH);
676 # shut down our end of the socket to signal EOF
677 &ftp'close_data_socket;
680 # read the close
683 $ret = &ftp'expect($timeout,
684 226, "file put", 1, # transfer complete, closing connection
685 250, "file put", 1, # action completed
687 110, "restart not supported", 0,
688 425, "can't open data connection", 0,
689 426, "connection closed, transfer aborted", 0,
690 451, "action aborted, local error", 0,
691 551, "page type unknown", 0,
692 552, "storage allocation exceeded", 0,
694 421, "service unavailable, closing connection", 0);
695 if( ! $ret ){
696 print STDERR "error putting $loc_fname\n";
698 return $ret;
701 sub ftp'restart
703 local( $restart_point, $ret ) = @_;
705 &ftp'send("REST $restart_point");
708 # see what they say
710 $ret = &ftp'expect($timeout,
711 350, "restarting at $restart_point", 1,
713 500, "syntax error", 0,
714 501, "syntax error", 0,
715 502, "REST not implemented", 2,
716 530, "not logged in", 0,
717 554, "REST not implemented", 2,
719 421, "service unavailable, closing connection", 0);
720 return $ret;
723 # Set the file transfer type
724 sub ftp'type
726 local( $type ) = @_;
728 &ftp'send("TYPE $type");
731 # see what they say
733 $ret = &ftp'expect($timeout,
734 200, "file type set to $type", 1,
736 500, "syntax error", 0,
737 501, "syntax error", 0,
738 504, "Invalid form or byte size for type $type", 0,
740 421, "service unavailable, closing connection", 0);
741 return $ret;
744 $site_command_check = 0;
745 @site_command_list = ();
747 # routine to query the remote server for 'SITE' commands supported
748 sub ftp'site_commands
750 local( $ret );
752 # if we havent sent a 'HELP SITE', send it now
753 if( !$site_command_check ){
755 $site_command_check = 1;
757 &ftp'send( "HELP SITE" );
759 # assume the line in the HELP SITE response with the 'HELP'
760 # command is the one for us
761 $ret = &ftp'expect( $timeout,
762 ".*HELP.*", "", "\$1",
763 214, "", "0",
764 202, "", "0" );
766 if( $ret eq "0" ){
767 print STDERR "No response from HELP SITE\n" if( $ftp_show );
770 @site_command_list = split(/\s+/, $ret);
773 return @site_command_list;
776 # return the pwd, or null if we can't get the pwd
777 sub ftp'pwd
779 local( $ret, $cwd );
781 &ftp'send( "PWD" );
784 # see what they say
786 $ret = &ftp'expect( $timeout,
787 257, "working dir is", 1,
788 500, "syntax error", 0,
789 501, "syntax error", 0,
790 502, "PWD not implemented", 0,
791 550, "file unavailable", 0,
793 421, "service unavailable, closing connection", 0 );
794 if( $ret ){
795 if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
796 $cwd = $1;
799 return $cwd;
802 # return 1 for success, 0 for failure
803 sub ftp'mkdir
805 local( $path ) = @_;
806 local( $ret );
808 &ftp'send( "MKD $path" );
811 # see what they say
813 $ret = &ftp'expect( $timeout,
814 257, "made directory $path", 1,
816 500, "syntax error", 0,
817 501, "syntax error", 0,
818 502, "MKD not implemented", 0,
819 530, "not logged in", 0,
820 550, "file unavailable", 0,
822 421, "service unavailable, closing connection", 0 );
823 return $ret;
826 # return 1 for success, 0 for failure
827 sub ftp'chmod
829 local( $path, $mode ) = @_;
830 local( $ret );
832 &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
835 # see what they say
837 $ret = &ftp'expect( $timeout,
838 200, "chmod $mode $path succeeded", 1,
840 500, "syntax error", 0,
841 501, "syntax error", 0,
842 502, "CHMOD not implemented", 0,
843 530, "not logged in", 0,
844 550, "file unavailable", 0,
846 421, "service unavailable, closing connection", 0 );
847 return $ret;
850 # rename a file
851 sub ftp'rename
853 local( $old_name, $new_name ) = @_;
854 local( $ret );
856 &ftp'send( "RNFR $old_name" );
859 # see what they say
861 $ret = &ftp'expect( $timeout,
862 350, "", 1,
864 500, "syntax error", 0,
865 501, "syntax error", 0,
866 502, "RNFR not implemented", 0,
867 530, "not logged in", 0,
868 550, "file unavailable", 0,
869 450, "file unavailable", 0,
871 421, "service unavailable, closing connection", 0);
874 # check if the "rename from" occurred ok
875 if( $ret ) {
876 &ftp'send( "RNTO $new_name" );
879 # see what they say
881 $ret = &ftp'expect( $timeout,
882 250, "rename $old_name to $new_name", 1,
884 500, "syntax error", 0,
885 501, "syntax error", 0,
886 502, "RNTO not implemented", 0,
887 503, "bad sequence of commands", 0,
888 530, "not logged in", 0,
889 532, "need account for storing files", 0,
890 553, "file name not allowed", 0,
892 421, "service unavailable, closing connection", 0);
895 return $ret;
899 sub ftp'quote
901 local( $cmd ) = @_;
903 &ftp'send( $cmd );
905 return &ftp'expect( $timeout,
906 200, "Remote '$cmd' OK", 1,
907 500, "error in remote '$cmd'", 0 );
910 # ------------------------------------------------------------------------------
911 # These are the lower level support routines
913 sub ftp'expectgot
915 ($ftp'response, $ftp'fatalerror) = @_;
916 if( $ftp_show ){
917 print STDERR "$ftp'response\n";
922 # create the list of parameters for chat'expect
924 # ftp'expect(time_out, {value, string_to_print, return value});
925 # if the string_to_print is "" then nothing is printed
926 # the last response is stored in $ftp'response
928 # NOTE: lmjm has changed this code such that the string_to_print is
929 # ignored and the string sent back from the remote system is printed
930 # instead.
932 sub ftp'expect {
933 local( $ret );
934 local( $time_out );
935 local( $expect_args );
937 $ftp'response = '';
938 $ftp'fatalerror = 0;
940 @expect_args = ();
942 $time_out = shift(@_);
944 while( @_ ){
945 local( $code ) = shift( @_ );
946 local( $pre ) = '^';
947 if( $code =~ /^\d/ ){
948 $pre =~ "[.|\n]*^";
950 push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
951 shift( @_ );
952 push( @expect_args,
953 "&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
956 # Treat all unrecognised lines as continuations
957 push( @expect_args, "^(.*)\\015\\n" );
958 push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
960 # add patterns TIMEOUT and EOF
962 push( @expect_args, 'TIMEOUT' );
963 push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
965 push( @expect_args, 'EOF' );
966 push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
968 if( $ftp_show > 9 ){
969 &printargs( $time_out, @expect_args );
972 $ret = &chat'expect( $time_out, @expect_args );
973 if( $ret == 100 ){
974 # we saw a continuation line, wait for the end
975 push( @expect_args, "^.*\n" );
976 push( @expect_args, "100" );
978 while( $ret == 100 ){
979 $ret = &chat'expect( $time_out, @expect_args );
983 return $ret;
987 # opens NS for io
989 sub ftp'open_data_socket
991 local( $ret );
992 local( $hostname );
993 local( $sockaddr, $name, $aliases, $proto, $port );
994 local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
995 local( $mysockaddr, $family, $hi, $lo );
998 $sockaddr = 'S n a4 x8';
999 chop( $hostname = `hostname` );
1001 $port = "ftp";
1003 ($name, $aliases, $proto) = getprotobyname( 'tcp' );
1004 ($name, $aliases, $port) = getservbyname( $port, 'tcp' );
1006 # ($name, $aliases, $type, $len, $thisaddr) =
1007 # gethostbyname( $hostname );
1008 ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
1010 # $this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
1011 $this = $chat'thisproc;
1013 socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!";
1014 bind(S, $this) || die "bind: $!";
1016 # get the port number
1017 $mysockaddr = getsockname(S);
1018 ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
1020 $hi = ($port >> 8) & 0x00ff;
1021 $lo = $port & 0x00ff;
1024 # we MUST do a listen before sending the port otherwise
1025 # the PORT may fail
1027 listen( S, 5 ) || die "listen";
1029 &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
1031 return &ftp'expect($timeout,
1032 200, "PORT command successful", 1,
1033 250, "PORT command successful", 1 ,
1035 500, "syntax error", 0,
1036 501, "syntax error", 0,
1037 530, "not logged in", 0,
1039 421, "service unavailable, closing connection", 0);
1042 sub ftp'close_data_socket
1044 close(NS);
1047 sub ftp'send
1049 local($send_cmd) = @_;
1050 if( $send_cmd =~ /\n/ ){
1051 print STDERR "ERROR, \\n in send string for $send_cmd\n";
1054 if( $ftp_show ){
1055 local( $sc ) = $send_cmd;
1057 if( $send_cmd =~ /^PASS/){
1058 $sc = "PASS <somestring>";
1060 print STDERR "---> $sc\n";
1063 &chat'print( "$send_cmd\r\n" );
1066 sub ftp'printargs
1068 while( @_ ){
1069 print STDERR shift( @_ ) . "\n";
1073 sub ftp'filesize
1075 local( $fname ) = @_;
1077 if( ! -f $fname ){
1078 return -1;
1081 return (stat( _ ))[ 7 ];
1085 # make this package return true