I don't think trying to bracket the hires time with lores
[p5sagit/p5-mst-13.2.git] / lib / ftp.pl
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 <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
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 <err@cinops.xerox.com>
36 # Added  ftp'delete from Aaron Wohl <aw0g+@andrew.cmu.edu>
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 require 'chat2.pl';     # into main
101 eval "require 'socket.ph'" || eval "require 'sys/socket.ph'"
102         || die "socket.ph missing: $!\n";
103
104
105 package ftp;
106
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;
112 }
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;
119 }
120
121 # If the remote ftp daemon doesn't respond within this time presume its dead
122 # or something.
123 $timeout = 30;
124
125 # Timeout a read if I don't get data back within this many seconds
126 $timeout_read = 20 * $timeout;
127
128 # Timeout an open
129 $timeout_open = $timeout;
130
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.
136
137 # The size of block to be read or written when talking to the remote
138 # ftp server
139 $ftp'ftpbufsize = 4096;
140
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;
145
146 # If a proxy connection then who am I really talking to?
147 $real_site = "";
148
149 # This is just a tracing aid.
150 $ftp_show = 0;
151 sub ftp'debug
152 {
153         $ftp_show = $_[0];
154 #       if( $ftp_show ){
155 #               print STDERR "ftp debugging on\n";
156 #       }
157 }
158
159 sub ftp'set_timeout
160 {
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";
166         }
167 }
168
169
170 sub ftp'open_alarm
171 {
172         die "timeout: open";
173 }
174
175 sub ftp'timed_open
176 {
177         local( $site, $ftp_port, $retry_call, $attempts ) = @_;
178         local( $connect_site, $connect_port );
179         local( $res );
180
181         alarm( $timeout_open );
182
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]";
189                         }
190                         print STDERR "\n";
191                 }
192                 
193                 if( $proxy ) {
194                         if( ! $proxy_gateway ) {
195                                 # if not otherwise set
196                                 $proxy_gateway = "internet-gateway";
197                         }
198                         if( $debug ) {
199                                 print STDERR "using proxy services of $proxy_gateway, ";
200                                 print STDERR "at $proxy_ftp_port\n";
201                         }
202                         $connect_site = $proxy_gateway;
203                         $connect_port = $proxy_ftp_port;
204                         $real_site = $site;
205                 }
206                 else {
207                         $connect_site = $site;
208                         $connect_port = $ftp_port;
209                 }
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;
214                         }
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;
219                         }
220                 }
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;
228                 }
229                 return 1;
230         }
231         continue {
232                 print STDERR "Pausing between retries\n";
233                 sleep( $retry_pause );
234         }
235         return 0;
236 }
237
238 sub ftp'open
239 {
240         local( $site, $ftp_port, $retry_call, $attempts ) = @_;
241
242         $SIG{ 'ALRM' } = "ftp\'open_alarm";
243
244         local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
245         alarm( 0 );
246
247         if( $@ =~ /^timeout/ ){
248                 return -1;
249         }
250         return $ret;
251 }
252
253 sub ftp'login
254 {
255         local( $remote_user, $remote_password ) = @_;
256
257         if( $proxy ){
258                 &ftp'send( "USER $remote_user\@$site" );
259         }
260         else {
261                 &ftp'send( "USER $remote_user" );
262         }
263         local( $val ) =
264                &ftp'expect($timeout,
265                    230, "$remote_user logged in", 1,
266                    331, "send password for $remote_user", 2,
267
268                    500, "syntax error", 0,
269                    501, "syntax error", 0,
270                    530, "not logged in", 0,
271                    332, "account for login not supported", 0,
272
273                    421, "service unavailable, closing connection", 0);
274         if( $val == 1 ){
275                 return 1;
276         }
277         if( $val == 2 ){
278                 # A password is needed
279                 &ftp'send( "PASS $remote_password" );
280
281                 $val = &ftp'expect( $timeout,
282                    230, "$remote_user logged in", 1,
283
284                    202, "command not implemented", 0,
285                    332, "account for login not supported", 0,
286
287                    530, "not logged in", 0,
288                    500, "syntax error", 0,
289                    501, "syntax error", 0,
290                    503, "bad sequence of commands", 0, 
291
292                    421, "service unavailable, closing connection", 0);
293                 if( $val == 1){
294                         # Logged in
295                         return 1;
296                 }
297         }
298         # If I got here I failed to login
299         return 0;
300 }
301
302 sub ftp'close
303 {
304         &ftp'quit();
305         &chat'close();
306 }
307
308 # Change directory
309 # return 1 if successful
310 # 0 on a failure
311 sub ftp'cwd
312 {
313         local( $dir ) = @_;
314
315         &ftp'send( "CWD $dir" );
316
317         return &ftp'expect( $timeout,
318                 200, "working directory = $dir", 1,
319                 250, "working directory = $dir", 1,
320
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 );
327 }
328
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 you can send it some extra options (eg: -lRa)
334 # return 1 if sucessful and 0 on a failure
335 sub ftp'dir_open
336 {
337         local( $options ) = @_;
338         local( $ret );
339         
340         if( ! &ftp'open_data_socket() ){
341                 return 0;
342         }
343         
344         if( $options ){
345                 &ftp'send( "LIST $options" );
346         }
347         else {
348                 &ftp'send( "LIST" );
349         }
350         
351         $ret = &ftp'expect( $timeout,
352                 150, "reading directory", 1,
353         
354                 125, "data connection already open?", 0,
355         
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,
361         
362                    421, "service unavailable, closing connection", 0 );
363         if( ! $ret ){
364                 &ftp'close_data_socket;
365                 return 0;
366         }
367         
368         # 
369         # the data should be coming at us now
370         #
371         
372         # now accept
373         accept(NS,S) || die "accept failed $!";
374         
375         return 1;
376 }
377
378
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
382 {
383         local( $ret );
384
385         # read the close
386         #
387         $ret = &ftp'expect($timeout,
388                 226, "", 1,     # transfer complete, closing connection
389                 250, "", 1,     # action completed
390
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);
395
396         # shut down our end of the socket
397         &ftp'close_data_socket;
398
399         if( ! $ret ){
400                 return 0;
401         }
402
403         return 1;
404 }
405
406 # Quit from the remote ftp server
407 # return 1 if successful and 0 on failure
408 sub ftp'quit
409 {
410         $site_command_check = 0;
411         @site_command_list = ();
412
413         &ftp'send("QUIT");
414
415         return &ftp'expect($timeout, 
416                 221, "Goodbye", 1,     # transfer complete, closing connection
417         
418                 500, "error quitting??", 0);
419 }
420
421 sub ftp'read_alarm
422 {
423         die "timeout: read";
424 }
425
426 sub ftp'timed_read
427 {
428         alarm( $timeout_read );
429         return sysread( NS, $buf, $ftpbufsize );
430 }
431
432 sub ftp'read
433 {
434         $SIG{ 'ALRM' } = "ftp\'read_alarm";
435
436         local( $ret ) = eval '&timed_read()';
437         alarm( 0 );
438
439         if( $@ =~ /^timeout/ ){
440                 return -1;
441         }
442         return $ret;
443 }
444
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
449 {
450         local($rem_fname, $loc_fname, $restart ) = @_;
451         
452         if ($loc_fname eq "") {
453                 $loc_fname = $rem_fname;
454         }
455         
456         if( ! &ftp'open_data_socket() ){
457                 print STDERR "Cannot open data socket\n";
458                 return 0;
459         }
460
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 );
468                 }
469                 else {
470                         $restart = 0;
471                         unlink( $loc_fname );
472                 }
473         }
474
475         &ftp'send( "RETR $rem_fname" );
476         
477         local( $ret ) =
478                 &ftp'expect($timeout, 
479                    150, "receiving $rem_fname", 1,
480
481                    125, "data connection already open?", 0,
482
483                    450, "file unavailable", 2,
484                    550, "file unavailable", 2,
485
486                    500, "syntax error", 0,
487                    501, "syntax error", 0,
488                    530, "not logged in", 0,
489
490                    421, "service unavailable, closing connection", 0);
491         if( $ret != 1 ){
492                 print STDERR "Failure on RETR command\n";
493
494                 # shut down our end of the socket
495                 &ftp'close_data_socket;
496
497                 return 0;
498         }
499
500         # 
501         # the data should be coming at us now
502         #
503
504         # now accept
505         accept(NS,S) || die "accept failed: $!";
506
507         #
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";
512
513                 # shut down our end of the socket
514                 &ftp'close_data_socket;
515
516                 return 0;
517         }
518
519 #    while (<NS>) {
520 #        print FH ;
521 #    }
522
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;
529                 }
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";
537                                 }
538                         }
539                 }
540                 if( ! print FH $ftp'buf ){
541                         print STDERR "\nfailed to write data";
542                         return 0;
543                 }
544         }
545         close( FH );
546
547         # shut down our end of the socket
548         &ftp'close_data_socket;
549
550         if( $len < 0 ){
551                 print STDERR "\ntimed out reading data!\n";
552
553                 return 0;
554         }
555                 
556         if( $ftp_show ){
557                 if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
558                         print STDERR "\n";
559                 }
560                 local( $secs ) = (time - $start_time);
561                 if( $secs <= 0 ){
562                         $secs = 1; # To avoid a divide by zero;
563                 }
564
565                 local( $rate ) = int( $bytes / $secs );
566                 print STDERR "Got $bytes bytes ($rate bytes/sec)\n";
567         }
568
569         #
570         # read the close
571         #
572
573         $ret = &ftp'expect($timeout, 
574                 226, "Got file", 1,     # transfer complete, closing connection
575                 250, "Got file", 1,     # action completed
576         
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);
582
583         return $ret;
584 }
585
586 sub ftp'delete
587 {
588         local( $rem_fname, $val ) = @_;
589
590         &ftp'send("DELE $rem_fname" );
591         $val = &ftp'expect( $timeout, 
592                            250,"Deleted $rem_fname", 1,
593                            550,"Permission denied",0
594                            );
595         return $val == 1;
596 }
597
598 sub ftp'deldir
599 {
600     local( $fname ) = @_;
601
602     # not yet implemented
603     # RMD
604 }
605
606 # UPDATE ME!!!!!!
607 # Add in the hash printing and newline conversion
608 sub ftp'put
609 {
610         local( $loc_fname, $rem_fname ) = @_;
611         local( $strip_cr );
612         
613         if ($loc_fname eq "") {
614                 $loc_fname = $rem_fname;
615         }
616         
617         if( ! &ftp'open_data_socket() ){
618                 return 0;
619         }
620         
621         &ftp'send("STOR $rem_fname");
622         
623         # 
624         # the data should be coming at us now
625         #
626         
627         local( $ret ) =
628         &ftp'expect($timeout, 
629                 150, "sending $loc_fname", 1,
630
631                 125, "data connection already open?", 0,
632                 450, "file unavailable", 0,
633
634                 532, "need account for storing files", 0,
635                 452, "insufficient storage on system", 0,
636                 553, "file name not allowed", 0,
637
638                 500, "syntax error", 0,
639                 501, "syntax error", 0,
640                 530, "not logged in", 0,
641
642                 421, "service unavailable, closing connection", 0);
643
644         if( $ret != 1 ){
645                 # shut down our end of the socket
646                 &ftp'close_data_socket;
647
648                 return 0;
649         }
650
651
652         # 
653         # the data should be coming at us now
654         #
655         
656         # now accept
657         accept(NS,S) || die "accept failed: $!";
658         
659         #
660         #  open the local fname
661         #
662         if( !open(FH, "<$loc_fname") ){
663                 print STDERR "Cannot open local file $loc_fname\n";
664
665                 # shut down our end of the socket
666                 &ftp'close_data_socket;
667
668                 return 0;
669         }
670         
671         while (<FH>) {
672                 print NS ;
673         }
674         close(FH);
675         
676         # shut down our end of the socket to signal EOF
677         &ftp'close_data_socket;
678         
679         #
680         # read the close
681         #
682         
683         $ret = &ftp'expect($timeout, 
684                 226, "file put", 1,     # transfer complete, closing connection
685                 250, "file put", 1,     # action completed
686         
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,
693         
694                 421, "service unavailable, closing connection", 0);
695         if( ! $ret ){
696                 print STDERR "error putting $loc_fname\n";
697         }
698         return $ret;
699 }
700
701 sub ftp'restart
702 {
703         local( $restart_point, $ret ) = @_;
704
705         &ftp'send("REST $restart_point");
706
707         # 
708         # see what they say
709
710         $ret = &ftp'expect($timeout, 
711                            350, "restarting at $restart_point", 1,
712                            
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,
718                            
719                            421, "service unavailable, closing connection", 0);
720         return $ret;
721 }
722
723 # Set the file transfer type
724 sub ftp'type
725 {
726         local( $type ) = @_;
727
728         &ftp'send("TYPE $type");
729
730         # 
731         # see what they say
732
733         $ret = &ftp'expect($timeout, 
734                            200, "file type set to $type", 1,
735                            
736                            500, "syntax error", 0,
737                            501, "syntax error", 0,
738                            504, "Invalid form or byte size for type $type", 0,
739                            
740                            421, "service unavailable, closing connection", 0);
741         return $ret;
742 }
743
744 $site_command_check = 0;
745 @site_command_list = ();
746
747 # routine to query the remote server for 'SITE' commands supported
748 sub ftp'site_commands
749 {
750         local( $ret );
751         
752         # if we havent sent a 'HELP SITE', send it now
753         if( !$site_command_check ){
754         
755                 $site_command_check = 1;
756         
757                 &ftp'send( "HELP SITE" );
758         
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" );
765         
766                 if( $ret eq "0" ){
767                         print STDERR "No response from HELP SITE\n" if( $ftp_show );
768                 }
769         
770                 @site_command_list = split(/\s+/, $ret);
771         }
772         
773         return @site_command_list;
774 }
775
776 # return the pwd, or null if we can't get the pwd
777 sub ftp'pwd
778 {
779         local( $ret, $cwd );
780
781         &ftp'send( "PWD" );
782
783         # 
784         # see what they say
785
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,
792
793                            421, "service unavailable, closing connection", 0 );
794         if( $ret ){
795                 if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
796                         $cwd = $1;
797                 }
798         }
799         return $cwd;
800 }
801
802 # return 1 for success, 0 for failure
803 sub ftp'mkdir
804 {
805         local( $path ) = @_;
806         local( $ret );
807
808         &ftp'send( "MKD $path" );
809
810         # 
811         # see what they say
812
813         $ret = &ftp'expect( $timeout, 
814                            257, "made directory $path", 1,
815                            
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,
821
822                            421, "service unavailable, closing connection", 0 );
823         return $ret;
824 }
825
826 # return 1 for success, 0 for failure
827 sub ftp'chmod
828 {
829         local( $path, $mode ) = @_;
830         local( $ret );
831
832         &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
833
834         # 
835         # see what they say
836
837         $ret = &ftp'expect( $timeout, 
838                            200, "chmod $mode $path succeeded", 1,
839                            
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,
845
846                            421, "service unavailable, closing connection", 0 );
847         return $ret;
848 }
849
850 # rename a file
851 sub ftp'rename
852 {
853         local( $old_name, $new_name ) = @_;
854         local( $ret );
855
856         &ftp'send( "RNFR $old_name" );
857
858         # 
859         # see what they say
860
861         $ret = &ftp'expect( $timeout, 
862                            350, "", 1,
863                            
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,
870                            
871                            421, "service unavailable, closing connection", 0);
872
873
874         # check if the "rename from" occurred ok
875         if( $ret ) {
876                 &ftp'send( "RNTO $new_name" );
877         
878                 # 
879                 # see what they say
880         
881                 $ret = &ftp'expect( $timeout, 
882                                    250, "rename $old_name to $new_name", 1, 
883
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,
891                                    
892                                    421, "service unavailable, closing connection", 0);
893         }
894
895         return $ret;
896 }
897
898
899 sub ftp'quote
900 {
901       local( $cmd ) = @_;
902
903       &ftp'send( $cmd );
904
905       return &ftp'expect( $timeout, 
906               200, "Remote '$cmd' OK", 1,
907               500, "error in remote '$cmd'", 0 );
908 }
909
910 # ------------------------------------------------------------------------------
911 # These are the lower level support routines
912
913 sub ftp'expectgot
914 {
915         ($ftp'response, $ftp'fatalerror) = @_;
916         if( $ftp_show ){
917                 print STDERR "$ftp'response\n";
918         }
919 }
920
921 #
922 #  create the list of parameters for chat'expect
923 #
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
927 #
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.
931 #
932 sub ftp'expect {
933         local( $ret );
934         local( $time_out );
935         local( $expect_args );
936         
937         $ftp'response = '';
938         $ftp'fatalerror = 0;
939
940         @expect_args = ();
941         
942         $time_out = shift(@_);
943         
944         while( @_ ){
945                 local( $code ) = shift( @_ );
946                 local( $pre ) = '^';
947                 if( $code =~ /^\d/ ){
948                         $pre =~ "[.|\n]*^";
949                 }
950                 push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
951                 shift( @_ );
952                 push( @expect_args, 
953                         "&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
954         }
955         
956         # Treat all unrecognised lines as continuations
957         push( @expect_args, "^(.*)\\015\\n" );
958         push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
959         
960         # add patterns TIMEOUT and EOF
961         
962         push( @expect_args, 'TIMEOUT' );
963         push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
964         
965         push( @expect_args, 'EOF' );
966         push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
967         
968         if( $ftp_show > 9 ){
969                 &printargs( $time_out, @expect_args );
970         }
971         
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" );
977         
978                 while( $ret == 100 ){
979                         $ret = &chat'expect( $time_out, @expect_args );
980                 }
981         }
982         
983         return $ret;
984 }
985
986 #
987 #  opens NS for io
988 #
989 sub ftp'open_data_socket
990 {
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 );
996         
997         
998         $sockaddr = 'S n a4 x8';
999         chop( $hostname = `hostname` );
1000         
1001         $port = "ftp";
1002         
1003         ($name, $aliases, $proto) = getprotobyname( 'tcp' );
1004         ($name, $aliases, $port) = getservbyname( $port, 'tcp' );
1005         
1006 #       ($name, $aliases, $type, $len, $thisaddr) =
1007 #       gethostbyname( $hostname );
1008         ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
1009         
1010 #       $this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
1011         $this = $chat'thisproc;
1012         
1013         socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!";
1014         bind(S, $this) || die "bind: $!";
1015         
1016         # get the port number
1017         $mysockaddr = getsockname(S);
1018         ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
1019         
1020         $hi = ($port >> 8) & 0x00ff;
1021         $lo = $port & 0x00ff;
1022         
1023         #
1024         # we MUST do a listen before sending the port otherwise
1025         # the PORT may fail
1026         #
1027         listen( S, 5 ) || die "listen";
1028         
1029         &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
1030         
1031         return &ftp'expect($timeout,
1032                 200, "PORT command successful", 1,
1033                 250, "PORT command successful", 1 ,
1034
1035                 500, "syntax error", 0,
1036                 501, "syntax error", 0,
1037                 530, "not logged in", 0,
1038
1039                 421, "service unavailable, closing connection", 0);
1040 }
1041         
1042 sub ftp'close_data_socket
1043 {
1044         close(NS);
1045 }
1046
1047 sub ftp'send
1048 {
1049         local($send_cmd) = @_;
1050         if( $send_cmd =~ /\n/ ){
1051                 print STDERR "ERROR, \\n in send string for $send_cmd\n";
1052         }
1053         
1054         if( $ftp_show ){
1055                 local( $sc ) = $send_cmd;
1056
1057                 if( $send_cmd =~ /^PASS/){
1058                         $sc = "PASS <somestring>";
1059                 }
1060                 print STDERR "---> $sc\n";
1061         }
1062         
1063         &chat'print( "$send_cmd\r\n" );
1064 }
1065
1066 sub ftp'printargs
1067 {
1068         while( @_ ){
1069                 print STDERR shift( @_ ) . "\n";
1070         }
1071 }
1072
1073 sub ftp'filesize
1074 {
1075         local( $fname ) = @_;
1076
1077         if( ! -f $fname ){
1078                 return -1;
1079         }
1080
1081         return (stat( _ ))[ 7 ];
1082         
1083 }
1084
1085 # make this package return true
1086 1;