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