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