projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
[ PATCH ] mymalloc on HP-UX
[p5sagit/p5-mst-13.2.git] / lib / ftp.pl
CommitLineData
79072805 1#-*-perl-*-
a6d71656 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#
79072805 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.
3a26a986 77# When ftp_show is set then print hashes every 1k transferred (like ftp).
79072805 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
84902520 100require 'chat2.pl'; # into main
101eval "require 'socket.ph'" || eval "require 'sys/socket.ph'"
102 || die "socket.ph missing: $!\n";
79072805 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{
40da2db3 153 $ftp_show = $_[0];
79072805 154# if( $ftp_show ){
155# print STDERR "ftp debugging on\n";
156# }
157}
158
159sub ftp'set_timeout
160{
40da2db3 161 $timeout = $_[0];
79072805 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 ){
2ad7ff01 258 &ftp'send( "USER $remote_user\@$site" );
79072805 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
d1be9408 333# data to send back then you can send it some extra options (eg: -lRa)
79072805 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;
Unnamed repository; edit this file to name it for gitweb.