File Coverage

blib/lib/ftp.pl
Criterion Covered Total %
statement 6 306 1.9
branch 0 126 0.0
condition 0 9 0.0
subroutine 2 35 5.7
pod n/a
total 8 476 1.6


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