source: trunk/third/perl/lib/ftp.pl @ 14545

Revision 14545, 23.5 KB checked in by ghudson, 24 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r14544, which included commits to RCS files with non-trunk default branches.
Line 
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: /afs/dev.mit.edu/source/repository/third/perl/lib/ftp.pl,v 1.1.1.2 2000-04-07 20:41:15 ghudson Exp $
18# $Log: not supported by cvs2svn $
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 transfered (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
100require 'chat2.pl';     # into main
101eval "require 'socket.ph'" || eval "require 'sys/socket.ph'"
102        || die "socket.ph missing: $!\n";
103
104
105package ftp;
106
107if( 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}
113else {
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;
151sub ftp'debug
152{
153        $ftp_show = $_[0];
154#       if( $ftp_show ){
155#               print STDERR "ftp debugging on\n";
156#       }
157}
158
159sub 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
170sub ftp'open_alarm
171{
172        die "timeout: open";
173}
174
175sub 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
238sub 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
253sub 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
302sub ftp'close
303{
304        &ftp'quit();
305        &chat'close();
306}
307
308# Change directory
309# return 1 if successful
310# 0 on a failure
311sub 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 then you can send it some extra options (eg: -lRa)
334# return 1 if sucessful and 0 on a failure
335sub 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
381sub 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
408sub 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
421sub ftp'read_alarm
422{
423        die "timeout: read";
424}
425
426sub ftp'timed_read
427{
428        alarm( $timeout_read );
429        return sysread( NS, $buf, $ftpbufsize );
430}
431
432sub 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
448sub 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
586sub 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
598sub 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
608sub 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
701sub 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
724sub 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
748sub 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
777sub 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
803sub 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
827sub 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
851sub 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
899sub 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
913sub 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#
932sub 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#
989sub 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       
1042sub ftp'close_data_socket
1043{
1044        close(NS);
1045}
1046
1047sub 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
1066sub ftp'printargs
1067{
1068        while( @_ ){
1069                print STDERR shift( @_ ) . "\n";
1070        }
1071}
1072
1073sub 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
10861;
Note: See TracBrowser for help on using the repository browser.