Move libnet Net::* to the top level, to mirror the CPAN distribution.
[perl.git] / ext / libnet / Net / FTP.pm
1 # Net::FTP.pm
2 #
3 # Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
4 # This program is free software; you can redistribute it and/or
5 # modify it under the same terms as Perl itself.
6 #
7 # Documentation (at end) improved 1996 by Nathan Torkington <gnat@frii.com>.
8
9 package Net::FTP;
10
11 require 5.001;
12
13 use strict;
14 use vars qw(@ISA $VERSION);
15 use Carp;
16
17 use Socket 1.3;
18 use IO::Socket;
19 use Time::Local;
20 use Net::Cmd;
21 use Net::Config;
22 use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC);
23
24 $VERSION = '2.77';
25 @ISA     = qw(Exporter Net::Cmd IO::Socket::INET);
26
27 # Someday I will "use constant", when I am not bothered to much about
28 # compatability with older releases of perl
29
30 use vars qw($TELNET_IAC $TELNET_IP $TELNET_DM);
31 ($TELNET_IAC, $TELNET_IP, $TELNET_DM) = (255, 244, 242);
32
33
34 BEGIN {
35
36   # make a constant so code is fast'ish
37   my $is_os390 = $^O eq 'os390';
38   *trEBCDIC = sub () {$is_os390}
39 }
40
41
42 sub new {
43   my $pkg = shift;
44   my ($peer, %arg);
45   if (@_ % 2) {
46     $peer = shift;
47     %arg  = @_;
48   }
49   else {
50     %arg  = @_;
51     $peer = delete $arg{Host};
52   }
53
54   my $host      = $peer;
55   my $fire      = undef;
56   my $fire_type = undef;
57
58   if (exists($arg{Firewall}) || Net::Config->requires_firewall($peer)) {
59          $fire = $arg{Firewall}
60       || $ENV{FTP_FIREWALL}
61       || $NetConfig{ftp_firewall}
62       || undef;
63
64     if (defined $fire) {
65       $peer = $fire;
66       delete $arg{Port};
67            $fire_type = $arg{FirewallType}
68         || $ENV{FTP_FIREWALL_TYPE}
69         || $NetConfig{firewall_type}
70         || undef;
71     }
72   }
73
74   my $ftp = $pkg->SUPER::new(
75     PeerAddr  => $peer,
76     PeerPort  => $arg{Port} || 'ftp(21)',
77     LocalAddr => $arg{'LocalAddr'},
78     Proto     => 'tcp',
79     Timeout   => defined $arg{Timeout}
80     ? $arg{Timeout}
81     : 120
82     )
83     or return undef;
84
85   ${*$ftp}{'net_ftp_host'}    = $host;                             # Remote hostname
86   ${*$ftp}{'net_ftp_type'}    = 'A';                               # ASCII/binary/etc mode
87   ${*$ftp}{'net_ftp_blksize'} = abs($arg{'BlockSize'} || 10240);
88
89   ${*$ftp}{'net_ftp_localaddr'} = $arg{'LocalAddr'};
90
91   ${*$ftp}{'net_ftp_firewall'} = $fire
92     if (defined $fire);
93   ${*$ftp}{'net_ftp_firewall_type'} = $fire_type
94     if (defined $fire_type);
95
96   ${*$ftp}{'net_ftp_passive'} =
97       int exists $arg{Passive} ? $arg{Passive}
98     : exists $ENV{FTP_PASSIVE} ? $ENV{FTP_PASSIVE}
99     : defined $fire            ? $NetConfig{ftp_ext_passive}
100     : $NetConfig{ftp_int_passive};    # Whew! :-)
101
102   $ftp->hash(exists $arg{Hash} ? $arg{Hash} : 0, 1024);
103
104   $ftp->autoflush(1);
105
106   $ftp->debug(exists $arg{Debug} ? $arg{Debug} : undef);
107
108   unless ($ftp->response() == CMD_OK) {
109     $ftp->close();
110     $@ = $ftp->message;
111     undef $ftp;
112   }
113
114   $ftp;
115 }
116
117 ##
118 ## User interface methods
119 ##
120
121
122 sub host {
123   my $me = shift;
124   ${*$me}{'net_ftp_host'};
125 }
126
127
128 sub hash {
129   my $ftp = shift;    # self
130
131   my ($h, $b) = @_;
132   unless ($h) {
133     delete ${*$ftp}{'net_ftp_hash'};
134     return [\*STDERR, 0];
135   }
136   ($h, $b) = (ref($h) ? $h : \*STDERR, $b || 1024);
137   select((select($h), $| = 1)[0]);
138   $b = 512 if $b < 512;
139   ${*$ftp}{'net_ftp_hash'} = [$h, $b];
140 }
141
142
143 sub quit {
144   my $ftp = shift;
145
146   $ftp->_QUIT;
147   $ftp->close;
148 }
149
150
151 sub DESTROY { }
152
153
154 sub ascii  { shift->type('A', @_); }
155 sub binary { shift->type('I', @_); }
156
157
158 sub ebcdic {
159   carp "TYPE E is unsupported, shall default to I";
160   shift->type('E', @_);
161 }
162
163
164 sub byte {
165   carp "TYPE L is unsupported, shall default to I";
166   shift->type('L', @_);
167 }
168
169 # Allow the user to send a command directly, BE CAREFUL !!
170
171
172 sub quot {
173   my $ftp = shift;
174   my $cmd = shift;
175
176   $ftp->command(uc $cmd, @_);
177   $ftp->response();
178 }
179
180
181 sub site {
182   my $ftp = shift;
183
184   $ftp->command("SITE", @_);
185   $ftp->response();
186 }
187
188
189 sub mdtm {
190   my $ftp  = shift;
191   my $file = shift;
192
193   # Server Y2K bug workaround
194   #
195   # sigh; some idiotic FTP servers use ("19%d",tm.tm_year) instead of
196   # ("%d",tm.tm_year+1900).  This results in an extra digit in the
197   # string returned. To account for this we allow an optional extra
198   # digit in the year. Then if the first two digits are 19 we use the
199   # remainder, otherwise we subtract 1900 from the whole year.
200
201   $ftp->_MDTM($file)
202     && $ftp->message =~ /((\d\d)(\d\d\d?))(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
203     ? timegm($8, $7, $6, $5, $4 - 1, $2 eq '19' ? $3 : ($1 - 1900))
204     : undef;
205 }
206
207
208 sub size {
209   my $ftp  = shift;
210   my $file = shift;
211   my $io;
212   if ($ftp->supported("SIZE")) {
213     return $ftp->_SIZE($file)
214       ? ($ftp->message =~ /(\d+)\s*(bytes?\s*)?$/)[0]
215       : undef;
216   }
217   elsif ($ftp->supported("STAT")) {
218     my @msg;
219     return undef
220       unless $ftp->_STAT($file) && (@msg = $ftp->message) == 3;
221     my $line;
222     foreach $line (@msg) {
223       return (split(/\s+/, $line))[4]
224         if $line =~ /^[-rwxSsTt]{10}/;
225     }
226   }
227   else {
228     my @files = $ftp->dir($file);
229     if (@files) {
230       return (split(/\s+/, $1))[4]
231         if $files[0] =~ /^([-rwxSsTt]{10}.*)$/;
232     }
233   }
234   undef;
235 }
236
237
238 sub login {
239   my ($ftp, $user, $pass, $acct) = @_;
240   my ($ok, $ruser, $fwtype);
241
242   unless (defined $user) {
243     require Net::Netrc;
244
245     my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'});
246
247     ($user, $pass, $acct) = $rc->lpa()
248       if ($rc);
249   }
250
251   $user ||= "anonymous";
252   $ruser = $user;
253
254   $fwtype = ${*$ftp}{'net_ftp_firewall_type'}
255     || $NetConfig{'ftp_firewall_type'}
256     || 0;
257
258   if ($fwtype && defined ${*$ftp}{'net_ftp_firewall'}) {
259     if ($fwtype == 1 || $fwtype == 7) {
260       $user .= '@' . ${*$ftp}{'net_ftp_host'};
261     }
262     else {
263       require Net::Netrc;
264
265       my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
266
267       my ($fwuser, $fwpass, $fwacct) = $rc ? $rc->lpa() : ();
268
269       if ($fwtype == 5) {
270         $user = join('@', $user, $fwuser, ${*$ftp}{'net_ftp_host'});
271         $pass = $pass . '@' . $fwpass;
272       }
273       else {
274         if ($fwtype == 2) {
275           $user .= '@' . ${*$ftp}{'net_ftp_host'};
276         }
277         elsif ($fwtype == 6) {
278           $fwuser .= '@' . ${*$ftp}{'net_ftp_host'};
279         }
280
281         $ok = $ftp->_USER($fwuser);
282
283         return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
284
285         $ok = $ftp->_PASS($fwpass || "");
286
287         return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
288
289         $ok = $ftp->_ACCT($fwacct)
290           if defined($fwacct);
291
292         if ($fwtype == 3) {
293           $ok = $ftp->command("SITE", ${*$ftp}{'net_ftp_host'})->response;
294         }
295         elsif ($fwtype == 4) {
296           $ok = $ftp->command("OPEN", ${*$ftp}{'net_ftp_host'})->response;
297         }
298
299         return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
300       }
301     }
302   }
303
304   $ok = $ftp->_USER($user);
305
306   # Some dumb firewalls don't prefix the connection messages
307   $ok = $ftp->response()
308     if ($ok == CMD_OK && $ftp->code == 220 && $user =~ /\@/);
309
310   if ($ok == CMD_MORE) {
311     unless (defined $pass) {
312       require Net::Netrc;
313
314       my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}, $ruser);
315
316       ($ruser, $pass, $acct) = $rc->lpa()
317         if ($rc);
318
319       $pass = '-anonymous@'
320         if (!defined $pass && (!defined($ruser) || $ruser =~ /^anonymous/o));
321     }
322
323     $ok = $ftp->_PASS($pass || "");
324   }
325
326   $ok = $ftp->_ACCT($acct)
327     if (defined($acct) && ($ok == CMD_MORE || $ok == CMD_OK));
328
329   if ($fwtype == 7 && $ok == CMD_OK && defined ${*$ftp}{'net_ftp_firewall'}) {
330     my ($f, $auth, $resp) = _auth_id($ftp);
331     $ftp->authorize($auth, $resp) if defined($resp);
332   }
333
334   $ok == CMD_OK;
335 }
336
337
338 sub account {
339   @_ == 2 or croak 'usage: $ftp->account( ACCT )';
340   my $ftp  = shift;
341   my $acct = shift;
342   $ftp->_ACCT($acct) == CMD_OK;
343 }
344
345
346 sub _auth_id {
347   my ($ftp, $auth, $resp) = @_;
348
349   unless (defined $resp) {
350     require Net::Netrc;
351
352     $auth ||= eval { (getpwuid($>))[0] } || $ENV{NAME};
353
354     my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}, $auth)
355       || Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
356
357     ($auth, $resp) = $rc->lpa()
358       if ($rc);
359   }
360   ($ftp, $auth, $resp);
361 }
362
363
364 sub authorize {
365   @_ >= 1 || @_ <= 3 or croak 'usage: $ftp->authorize( [AUTH [, RESP]])';
366
367   my ($ftp, $auth, $resp) = &_auth_id;
368
369   my $ok = $ftp->_AUTH($auth || "");
370
371   $ok = $ftp->_RESP($resp || "")
372     if ($ok == CMD_MORE);
373
374   $ok == CMD_OK;
375 }
376
377
378 sub rename {
379   @_ == 3 or croak 'usage: $ftp->rename(FROM, TO)';
380
381   my ($ftp, $from, $to) = @_;
382
383   $ftp->_RNFR($from)
384     && $ftp->_RNTO($to);
385 }
386
387
388 sub type {
389   my $ftp    = shift;
390   my $type   = shift;
391   my $oldval = ${*$ftp}{'net_ftp_type'};
392
393   return $oldval
394     unless (defined $type);
395
396   return undef
397     unless ($ftp->_TYPE($type, @_));
398
399   ${*$ftp}{'net_ftp_type'} = join(" ", $type, @_);
400
401   $oldval;
402 }
403
404
405 sub alloc {
406   my $ftp    = shift;
407   my $size   = shift;
408   my $oldval = ${*$ftp}{'net_ftp_allo'};
409
410   return $oldval
411     unless (defined $size);
412
413   return undef
414     unless ($ftp->_ALLO($size, @_));
415
416   ${*$ftp}{'net_ftp_allo'} = join(" ", $size, @_);
417
418   $oldval;
419 }
420
421
422 sub abort {
423   my $ftp = shift;
424
425   send($ftp, pack("CCC", $TELNET_IAC, $TELNET_IP, $TELNET_IAC), MSG_OOB);
426
427   $ftp->command(pack("C", $TELNET_DM) . "ABOR");
428
429   ${*$ftp}{'net_ftp_dataconn'}->close()
430     if defined ${*$ftp}{'net_ftp_dataconn'};
431
432   $ftp->response();
433
434   $ftp->status == CMD_OK;
435 }
436
437
438 sub get {
439   my ($ftp, $remote, $local, $where) = @_;
440
441   my ($loc, $len, $buf, $resp, $data);
442   local *FD;
443
444   my $localfd = ref($local) || ref(\$local) eq "GLOB";
445
446   ($local = $remote) =~ s#^.*/##
447     unless (defined $local);
448
449   croak("Bad remote filename '$remote'\n")
450     if $remote =~ /[\r\n]/s;
451
452   ${*$ftp}{'net_ftp_rest'} = $where if defined $where;
453   my $rest = ${*$ftp}{'net_ftp_rest'};
454
455   delete ${*$ftp}{'net_ftp_port'};
456   delete ${*$ftp}{'net_ftp_pasv'};
457
458   $data = $ftp->retr($remote)
459     or return undef;
460
461   if ($localfd) {
462     $loc = $local;
463   }
464   else {
465     $loc = \*FD;
466
467     unless (sysopen($loc, $local, O_CREAT | O_WRONLY | ($rest ? O_APPEND: O_TRUNC))) {
468       carp "Cannot open Local file $local: $!\n";
469       $data->abort;
470       return undef;
471     }
472   }
473
474   if ($ftp->type eq 'I' && !binmode($loc)) {
475     carp "Cannot binmode Local file $local: $!\n";
476     $data->abort;
477     close($loc) unless $localfd;
478     return undef;
479   }
480
481   $buf = '';
482   my ($count, $hashh, $hashb, $ref) = (0);
483
484   ($hashh, $hashb) = @$ref
485     if ($ref = ${*$ftp}{'net_ftp_hash'});
486
487   my $blksize = ${*$ftp}{'net_ftp_blksize'};
488   local $\;    # Just in case
489
490   while (1) {
491     last unless $len = $data->read($buf, $blksize);
492
493     if (trEBCDIC && $ftp->type ne 'I') {
494       $buf = $ftp->toebcdic($buf);
495       $len = length($buf);
496     }
497
498     if ($hashh) {
499       $count += $len;
500       print $hashh "#" x (int($count / $hashb));
501       $count %= $hashb;
502     }
503     unless (print $loc $buf) {
504       carp "Cannot write to Local file $local: $!\n";
505       $data->abort;
506       close($loc)
507         unless $localfd;
508       return undef;
509     }
510   }
511
512   print $hashh "\n" if $hashh;
513
514   unless ($localfd) {
515     unless (close($loc)) {
516       carp "Cannot close file $local (perhaps disk space) $!\n";
517       return undef;
518     }
519   }
520
521   unless ($data->close())    # implied $ftp->response
522   {
523     carp "Unable to close datastream";
524     return undef;
525   }
526
527   return $local;
528 }
529
530
531 sub cwd {
532   @_ == 1 || @_ == 2 or croak 'usage: $ftp->cwd( [ DIR ] )';
533
534   my ($ftp, $dir) = @_;
535
536   $dir = "/" unless defined($dir) && $dir =~ /\S/;
537
538   $dir eq ".."
539     ? $ftp->_CDUP()
540     : $ftp->_CWD($dir);
541 }
542
543
544 sub cdup {
545   @_ == 1 or croak 'usage: $ftp->cdup()';
546   $_[0]->_CDUP;
547 }
548
549
550 sub pwd {
551   @_ == 1 || croak 'usage: $ftp->pwd()';
552   my $ftp = shift;
553
554   $ftp->_PWD();
555   $ftp->_extract_path;
556 }
557
558 # rmdir( $ftp, $dir, [ $recurse ] )
559 #
560 # Removes $dir on remote host via FTP.
561 # $ftp is handle for remote host
562 #
563 # If $recurse is TRUE, the directory and deleted recursively.
564 # This means all of its contents and subdirectories.
565 #
566 # Initial version contributed by Dinkum Software
567 #
568 sub rmdir {
569   @_ == 2 || @_ == 3 or croak('usage: $ftp->rmdir( DIR [, RECURSE ] )');
570
571   # Pick off the args
572   my ($ftp, $dir, $recurse) = @_;
573   my $ok;
574
575   return $ok
576     if $ok = $ftp->_RMD($dir)
577     or !$recurse;
578
579   # Try to delete the contents
580   # Get a list of all the files in the directory
581   my @filelist = grep { !/^\.{1,2}$/ } $ftp->ls($dir);
582
583   return undef
584     unless @filelist;    # failed, it is probably not a directory
585
586   # Go thru and delete each file or the directory
587   my $file;
588   foreach $file (map { m,/, ? $_ : "$dir/$_" } @filelist) {
589     next                 # successfully deleted the file
590       if $ftp->delete($file);
591
592     # Failed to delete it, assume its a directory
593     # Recurse and ignore errors, the final rmdir() will
594     # fail on any errors here
595     return $ok
596       unless $ok = $ftp->rmdir($file, 1);
597   }
598
599   # Directory should be empty
600   # Try to remove the directory again
601   # Pass results directly to caller
602   # If any of the prior deletes failed, this
603   # rmdir() will fail because directory is not empty
604   return $ftp->_RMD($dir);
605 }
606
607
608 sub restart {
609   @_ == 2 || croak 'usage: $ftp->restart( BYTE_OFFSET )';
610
611   my ($ftp, $where) = @_;
612
613   ${*$ftp}{'net_ftp_rest'} = $where;
614
615   return undef;
616 }
617
618
619 sub mkdir {
620   @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )';
621
622   my ($ftp, $dir, $recurse) = @_;
623
624   $ftp->_MKD($dir) || $recurse
625     or return undef;
626
627   my $path = $dir;
628
629   unless ($ftp->ok) {
630     my @path = split(m#(?=/+)#, $dir);
631
632     $path = "";
633
634     while (@path) {
635       $path .= shift @path;
636
637       $ftp->_MKD($path);
638
639       $path = $ftp->_extract_path($path);
640     }
641
642     # If the creation of the last element was not successful, see if we
643     # can cd to it, if so then return path
644
645     unless ($ftp->ok) {
646       my ($status, $message) = ($ftp->status, $ftp->message);
647       my $pwd = $ftp->pwd;
648
649       if ($pwd && $ftp->cwd($dir)) {
650         $path = $dir;
651         $ftp->cwd($pwd);
652       }
653       else {
654         undef $path;
655       }
656       $ftp->set_status($status, $message);
657     }
658   }
659
660   $path;
661 }
662
663
664 sub delete {
665   @_ == 2 || croak 'usage: $ftp->delete( FILENAME )';
666
667   $_[0]->_DELE($_[1]);
668 }
669
670
671 sub put        { shift->_store_cmd("stor", @_) }
672 sub put_unique { shift->_store_cmd("stou", @_) }
673 sub append     { shift->_store_cmd("appe", @_) }
674
675
676 sub nlst { shift->_data_cmd("NLST", @_) }
677 sub list { shift->_data_cmd("LIST", @_) }
678 sub retr { shift->_data_cmd("RETR", @_) }
679 sub stor { shift->_data_cmd("STOR", @_) }
680 sub stou { shift->_data_cmd("STOU", @_) }
681 sub appe { shift->_data_cmd("APPE", @_) }
682
683
684 sub _store_cmd {
685   my ($ftp, $cmd, $local, $remote) = @_;
686   my ($loc, $sock, $len, $buf);
687   local *FD;
688
689   my $localfd = ref($local) || ref(\$local) eq "GLOB";
690
691   unless (defined $remote) {
692     croak 'Must specify remote filename with stream input'
693       if $localfd;
694
695     require File::Basename;
696     $remote = File::Basename::basename($local);
697   }
698   if (defined ${*$ftp}{'net_ftp_allo'}) {
699     delete ${*$ftp}{'net_ftp_allo'};
700   }
701   else {
702
703     # if the user hasn't already invoked the alloc method since the last
704     # _store_cmd call, figure out if the local file is a regular file(not
705     # a pipe, or device) and if so get the file size from stat, and send
706     # an ALLO command before sending the STOR, STOU, or APPE command.
707     my $size = do { local $^W; -f $local && -s _ };    # no ALLO if sending data from a pipe
708     $ftp->_ALLO($size) if $size;
709   }
710   croak("Bad remote filename '$remote'\n")
711     if $remote =~ /[\r\n]/s;
712
713   if ($localfd) {
714     $loc = $local;
715   }
716   else {
717     $loc = \*FD;
718
719     unless (sysopen($loc, $local, O_RDONLY)) {
720       carp "Cannot open Local file $local: $!\n";
721       return undef;
722     }
723   }
724
725   if ($ftp->type eq 'I' && !binmode($loc)) {
726     carp "Cannot binmode Local file $local: $!\n";
727     return undef;
728   }
729
730   delete ${*$ftp}{'net_ftp_port'};
731   delete ${*$ftp}{'net_ftp_pasv'};
732
733   $sock = $ftp->_data_cmd($cmd, $remote)
734     or return undef;
735
736   $remote = ($ftp->message =~ /FILE:\s*(.*)/)[0]
737     if 'STOU' eq uc $cmd;
738
739   my $blksize = ${*$ftp}{'net_ftp_blksize'};
740
741   my ($count, $hashh, $hashb, $ref) = (0);
742
743   ($hashh, $hashb) = @$ref
744     if ($ref = ${*$ftp}{'net_ftp_hash'});
745
746   while (1) {
747     last unless $len = read($loc, $buf = "", $blksize);
748
749     if (trEBCDIC && $ftp->type ne 'I') {
750       $buf = $ftp->toascii($buf);
751       $len = length($buf);
752     }
753
754     if ($hashh) {
755       $count += $len;
756       print $hashh "#" x (int($count / $hashb));
757       $count %= $hashb;
758     }
759
760     my $wlen;
761     unless (defined($wlen = $sock->write($buf, $len)) && $wlen == $len) {
762       $sock->abort;
763       close($loc)
764         unless $localfd;
765       print $hashh "\n" if $hashh;
766       return undef;
767     }
768   }
769
770   print $hashh "\n" if $hashh;
771
772   close($loc)
773     unless $localfd;
774
775   $sock->close()
776     or return undef;
777
778   if ('STOU' eq uc $cmd and $ftp->message =~ m/unique\s+file\s*name\s*:\s*(.*)\)|"(.*)"/) {
779     require File::Basename;
780     $remote = File::Basename::basename($+);
781   }
782
783   return $remote;
784 }
785
786
787 sub port {
788   @_ == 1 || @_ == 2 or croak 'usage: $ftp->port([PORT])';
789
790   my ($ftp, $port) = @_;
791   my $ok;
792
793   delete ${*$ftp}{'net_ftp_intern_port'};
794
795   unless (defined $port) {
796
797     # create a Listen socket at same address as the command socket
798
799     ${*$ftp}{'net_ftp_listen'} ||= IO::Socket::INET->new(
800       Listen    => 5,
801       Proto     => 'tcp',
802       Timeout   => $ftp->timeout,
803       LocalAddr => $ftp->sockhost,
804     );
805
806     my $listen = ${*$ftp}{'net_ftp_listen'};
807
808     my ($myport, @myaddr) = ($listen->sockport, split(/\./, $listen->sockhost));
809
810     $port = join(',', @myaddr, $myport >> 8, $myport & 0xff);
811
812     ${*$ftp}{'net_ftp_intern_port'} = 1;
813   }
814
815   $ok = $ftp->_PORT($port);
816
817   ${*$ftp}{'net_ftp_port'} = $port;
818
819   $ok;
820 }
821
822
823 sub ls  { shift->_list_cmd("NLST", @_); }
824 sub dir { shift->_list_cmd("LIST", @_); }
825
826
827 sub pasv {
828   @_ == 1 or croak 'usage: $ftp->pasv()';
829
830   my $ftp = shift;
831
832   delete ${*$ftp}{'net_ftp_intern_port'};
833
834   $ftp->_PASV && $ftp->message =~ /(\d+(,\d+)+)/
835     ? ${*$ftp}{'net_ftp_pasv'} = $1
836     : undef;
837 }
838
839
840 sub unique_name {
841   my $ftp = shift;
842   ${*$ftp}{'net_ftp_unique'} || undef;
843 }
844
845
846 sub supported {
847   @_ == 2 or croak 'usage: $ftp->supported( CMD )';
848   my $ftp  = shift;
849   my $cmd  = uc shift;
850   my $hash = ${*$ftp}{'net_ftp_supported'} ||= {};
851
852   return $hash->{$cmd}
853     if exists $hash->{$cmd};
854
855   return $hash->{$cmd} = 0
856     unless $ftp->_HELP($cmd);
857
858   my $text = $ftp->message;
859   if ($text =~ /following\s+commands/i) {
860     $text =~ s/^.*\n//;
861     while ($text =~ /(\*?)(\w+)(\*?)/sg) {
862       $hash->{"\U$2"} = !length("$1$3");
863     }
864   }
865   else {
866     $hash->{$cmd} = $text !~ /unimplemented/i;
867   }
868
869   $hash->{$cmd} ||= 0;
870 }
871
872 ##
873 ## Deprecated methods
874 ##
875
876
877 sub lsl {
878   carp "Use of Net::FTP::lsl deprecated, use 'dir'"
879     if $^W;
880   goto &dir;
881 }
882
883
884 sub authorise {
885   carp "Use of Net::FTP::authorise deprecated, use 'authorize'"
886     if $^W;
887   goto &authorize;
888 }
889
890
891 ##
892 ## Private methods
893 ##
894
895
896 sub _extract_path {
897   my ($ftp, $path) = @_;
898
899   # This tries to work both with and without the quote doubling
900   # convention (RFC 959 requires it, but the first 3 servers I checked
901   # didn't implement it).  It will fail on a server which uses a quote in
902   # the message which isn't a part of or surrounding the path.
903   $ftp->ok
904     && $ftp->message =~ /(?:^|\s)\"(.*)\"(?:$|\s)/
905     && ($path = $1) =~ s/\"\"/\"/g;
906
907   $path;
908 }
909
910 ##
911 ## Communication methods
912 ##
913
914
915 sub _dataconn {
916   my $ftp  = shift;
917   my $data = undef;
918   my $pkg  = "Net::FTP::" . $ftp->type;
919
920   eval "require " . $pkg;
921
922   $pkg =~ s/ /_/g;
923
924   delete ${*$ftp}{'net_ftp_dataconn'};
925
926   if (defined ${*$ftp}{'net_ftp_pasv'}) {
927     my @port = map { 0 + $_ } split(/,/, ${*$ftp}{'net_ftp_pasv'});
928
929     $data = $pkg->new(
930       PeerAddr  => join(".", @port[0 .. 3]),
931       PeerPort  => $port[4] * 256 + $port[5],
932       LocalAddr => ${*$ftp}{'net_ftp_localaddr'},
933       Proto     => 'tcp'
934     );
935   }
936   elsif (defined ${*$ftp}{'net_ftp_listen'}) {
937     $data = ${*$ftp}{'net_ftp_listen'}->accept($pkg);
938     close(delete ${*$ftp}{'net_ftp_listen'});
939   }
940
941   if ($data) {
942     ${*$data} = "";
943     $data->timeout($ftp->timeout);
944     ${*$ftp}{'net_ftp_dataconn'} = $data;
945     ${*$data}{'net_ftp_cmd'}     = $ftp;
946     ${*$data}{'net_ftp_blksize'} = ${*$ftp}{'net_ftp_blksize'};
947   }
948
949   $data;
950 }
951
952
953 sub _list_cmd {
954   my $ftp = shift;
955   my $cmd = uc shift;
956
957   delete ${*$ftp}{'net_ftp_port'};
958   delete ${*$ftp}{'net_ftp_pasv'};
959
960   my $data = $ftp->_data_cmd($cmd, @_);
961
962   return
963     unless (defined $data);
964
965   require Net::FTP::A;
966   bless $data, "Net::FTP::A";    # Force ASCII mode
967
968   my $databuf = '';
969   my $buf     = '';
970   my $blksize = ${*$ftp}{'net_ftp_blksize'};
971
972   while ($data->read($databuf, $blksize)) {
973     $buf .= $databuf;
974   }
975
976   my $list = [split(/\n/, $buf)];
977
978   $data->close();
979
980   if (trEBCDIC) {
981     for (@$list) { $_ = $ftp->toebcdic($_) }
982   }
983
984   wantarray
985     ? @{$list}
986     : $list;
987 }
988
989
990 sub _data_cmd {
991   my $ftp   = shift;
992   my $cmd   = uc shift;
993   my $ok    = 1;
994   my $where = delete ${*$ftp}{'net_ftp_rest'} || 0;
995   my $arg;
996
997   for $arg (@_) {
998     croak("Bad argument '$arg'\n")
999       if $arg =~ /[\r\n]/s;
1000   }
1001
1002   if ( ${*$ftp}{'net_ftp_passive'}
1003     && !defined ${*$ftp}{'net_ftp_pasv'}
1004     && !defined ${*$ftp}{'net_ftp_port'})
1005   {
1006     my $data = undef;
1007
1008     $ok = defined $ftp->pasv;
1009     $ok = $ftp->_REST($where)
1010       if $ok && $where;
1011
1012     if ($ok) {
1013       $ftp->command($cmd, @_);
1014       $data = $ftp->_dataconn();
1015       $ok   = CMD_INFO == $ftp->response();
1016       if ($ok) {
1017         $data->reading
1018           if $data && $cmd =~ /RETR|LIST|NLST/;
1019         return $data;
1020       }
1021       $data->_close
1022         if $data;
1023     }
1024     return undef;
1025   }
1026
1027   $ok = $ftp->port
1028     unless (defined ${*$ftp}{'net_ftp_port'}
1029     || defined ${*$ftp}{'net_ftp_pasv'});
1030
1031   $ok = $ftp->_REST($where)
1032     if $ok && $where;
1033
1034   return undef
1035     unless $ok;
1036
1037   $ftp->command($cmd, @_);
1038
1039   return 1
1040     if (defined ${*$ftp}{'net_ftp_pasv'});
1041
1042   $ok = CMD_INFO == $ftp->response();
1043
1044   return $ok
1045     unless exists ${*$ftp}{'net_ftp_intern_port'};
1046
1047   if ($ok) {
1048     my $data = $ftp->_dataconn();
1049
1050     $data->reading
1051       if $data && $cmd =~ /RETR|LIST|NLST/;
1052
1053     return $data;
1054   }
1055
1056
1057   close(delete ${*$ftp}{'net_ftp_listen'});
1058
1059   return undef;
1060 }
1061
1062 ##
1063 ## Over-ride methods (Net::Cmd)
1064 ##
1065
1066
1067 sub debug_text { $_[2] =~ /^(pass|resp|acct)/i ? "$1 ....\n" : $_[2]; }
1068
1069
1070 sub command {
1071   my $ftp = shift;
1072
1073   delete ${*$ftp}{'net_ftp_port'};
1074   $ftp->SUPER::command(@_);
1075 }
1076
1077
1078 sub response {
1079   my $ftp  = shift;
1080   my $code = $ftp->SUPER::response();
1081
1082   delete ${*$ftp}{'net_ftp_pasv'}
1083     if ($code != CMD_MORE && $code != CMD_INFO);
1084
1085   $code;
1086 }
1087
1088
1089 sub parse_response {
1090   return ($1, $2 eq "-")
1091     if $_[1] =~ s/^(\d\d\d)([- ]?)//o;
1092
1093   my $ftp = shift;
1094
1095   # Darn MS FTP server is a load of CRAP !!!!
1096   return ()
1097     unless ${*$ftp}{'net_cmd_code'} + 0;
1098
1099   (${*$ftp}{'net_cmd_code'}, 1);
1100 }
1101
1102 ##
1103 ## Allow 2 servers to talk directly
1104 ##
1105
1106
1107 sub pasv_xfer_unique {
1108   my ($sftp, $sfile, $dftp, $dfile) = @_;
1109   $sftp->pasv_xfer($sfile, $dftp, $dfile, 1);
1110 }
1111
1112
1113 sub pasv_xfer {
1114   my ($sftp, $sfile, $dftp, $dfile, $unique) = @_;
1115
1116   ($dfile = $sfile) =~ s#.*/##
1117     unless (defined $dfile);
1118
1119   my $port = $sftp->pasv
1120     or return undef;
1121
1122   $dftp->port($port)
1123     or return undef;
1124
1125   return undef
1126     unless ($unique ? $dftp->stou($dfile) : $dftp->stor($dfile));
1127
1128   unless ($sftp->retr($sfile) && $sftp->response == CMD_INFO) {
1129     $sftp->retr($sfile);
1130     $dftp->abort;
1131     $dftp->response();
1132     return undef;
1133   }
1134
1135   $dftp->pasv_wait($sftp);
1136 }
1137
1138
1139 sub pasv_wait {
1140   @_ == 2 or croak 'usage: $ftp->pasv_wait(NON_PASV_FTP)';
1141
1142   my ($ftp, $non_pasv) = @_;
1143   my ($file, $rin, $rout);
1144
1145   vec($rin = '', fileno($ftp), 1) = 1;
1146   select($rout = $rin, undef, undef, undef);
1147
1148   $ftp->response();
1149   $non_pasv->response();
1150
1151   return undef
1152     unless $ftp->ok() && $non_pasv->ok();
1153
1154   return $1
1155     if $ftp->message =~ /unique file name:\s*(\S*)\s*\)/;
1156
1157   return $1
1158     if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/;
1159
1160   return 1;
1161 }
1162
1163
1164 sub feature {
1165   @_ == 2 or croak 'usage: $ftp->feature( NAME )';
1166   my ($ftp, $feat) = @_;
1167
1168   my $feature = ${*$ftp}{net_ftp_feature} ||= do {
1169     my @feat;
1170
1171     # Example response
1172     # 211-Features:
1173     #  MDTM
1174     #  REST STREAM
1175     #  SIZE
1176     # 211 End
1177
1178     @feat = map { /^\s+(.*\S)/ } $ftp->message
1179       if $ftp->_FEAT;
1180
1181     \@feat;
1182   };
1183
1184   return grep { /^\Q$feat\E\b/i } @$feature;
1185 }
1186
1187
1188 sub cmd { shift->command(@_)->response() }
1189
1190 ########################################
1191 #
1192 # RFC959 commands
1193 #
1194
1195
1196 sub _ABOR { shift->command("ABOR")->response() == CMD_OK }
1197 sub _ALLO { shift->command("ALLO", @_)->response() == CMD_OK }
1198 sub _CDUP { shift->command("CDUP")->response() == CMD_OK }
1199 sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
1200 sub _PASV { shift->command("PASV")->response() == CMD_OK }
1201 sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
1202 sub _DELE { shift->command("DELE", @_)->response() == CMD_OK }
1203 sub _CWD  { shift->command("CWD", @_)->response() == CMD_OK }
1204 sub _PORT { shift->command("PORT", @_)->response() == CMD_OK }
1205 sub _RMD  { shift->command("RMD", @_)->response() == CMD_OK }
1206 sub _MKD  { shift->command("MKD", @_)->response() == CMD_OK }
1207 sub _PWD  { shift->command("PWD", @_)->response() == CMD_OK }
1208 sub _TYPE { shift->command("TYPE", @_)->response() == CMD_OK }
1209 sub _RNTO { shift->command("RNTO", @_)->response() == CMD_OK }
1210 sub _RESP { shift->command("RESP", @_)->response() == CMD_OK }
1211 sub _MDTM { shift->command("MDTM", @_)->response() == CMD_OK }
1212 sub _SIZE { shift->command("SIZE", @_)->response() == CMD_OK }
1213 sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
1214 sub _STAT { shift->command("STAT", @_)->response() == CMD_OK }
1215 sub _FEAT { shift->command("FEAT", @_)->response() == CMD_OK }
1216 sub _APPE { shift->command("APPE", @_)->response() == CMD_INFO }
1217 sub _LIST { shift->command("LIST", @_)->response() == CMD_INFO }
1218 sub _NLST { shift->command("NLST", @_)->response() == CMD_INFO }
1219 sub _RETR { shift->command("RETR", @_)->response() == CMD_INFO }
1220 sub _STOR { shift->command("STOR", @_)->response() == CMD_INFO }
1221 sub _STOU { shift->command("STOU", @_)->response() == CMD_INFO }
1222 sub _RNFR { shift->command("RNFR", @_)->response() == CMD_MORE }
1223 sub _REST { shift->command("REST", @_)->response() == CMD_MORE }
1224 sub _PASS { shift->command("PASS", @_)->response() }
1225 sub _ACCT { shift->command("ACCT", @_)->response() }
1226 sub _AUTH { shift->command("AUTH", @_)->response() }
1227
1228
1229 sub _USER {
1230   my $ftp = shift;
1231   my $ok  = $ftp->command("USER", @_)->response();
1232
1233   # A certain brain dead firewall :-)
1234   $ok = $ftp->command("user", @_)->response()
1235     unless $ok == CMD_MORE or $ok == CMD_OK;
1236
1237   $ok;
1238 }
1239
1240
1241 sub _SMNT { shift->unsupported(@_) }
1242 sub _MODE { shift->unsupported(@_) }
1243 sub _SYST { shift->unsupported(@_) }
1244 sub _STRU { shift->unsupported(@_) }
1245 sub _REIN { shift->unsupported(@_) }
1246
1247 1;
1248
1249 __END__
1250
1251 =head1 NAME
1252
1253 Net::FTP - FTP Client class
1254
1255 =head1 SYNOPSIS
1256
1257     use Net::FTP;
1258
1259     $ftp = Net::FTP->new("some.host.name", Debug => 0)
1260       or die "Cannot connect to some.host.name: $@";
1261
1262     $ftp->login("anonymous",'-anonymous@')
1263       or die "Cannot login ", $ftp->message;
1264
1265     $ftp->cwd("/pub")
1266       or die "Cannot change working directory ", $ftp->message;
1267
1268     $ftp->get("that.file")
1269       or die "get failed ", $ftp->message;
1270
1271     $ftp->quit;
1272
1273 =head1 DESCRIPTION
1274
1275 C<Net::FTP> is a class implementing a simple FTP client in Perl as
1276 described in RFC959.  It provides wrappers for a subset of the RFC959
1277 commands.
1278
1279 =head1 OVERVIEW
1280
1281 FTP stands for File Transfer Protocol.  It is a way of transferring
1282 files between networked machines.  The protocol defines a client
1283 (whose commands are provided by this module) and a server (not
1284 implemented in this module).  Communication is always initiated by the
1285 client, and the server responds with a message and a status code (and
1286 sometimes with data).
1287
1288 The FTP protocol allows files to be sent to or fetched from the
1289 server.  Each transfer involves a B<local file> (on the client) and a
1290 B<remote file> (on the server).  In this module, the same file name
1291 will be used for both local and remote if only one is specified.  This
1292 means that transferring remote file C</path/to/file> will try to put
1293 that file in C</path/to/file> locally, unless you specify a local file
1294 name.
1295
1296 The protocol also defines several standard B<translations> which the
1297 file can undergo during transfer.  These are ASCII, EBCDIC, binary,
1298 and byte.  ASCII is the default type, and indicates that the sender of
1299 files will translate the ends of lines to a standard representation
1300 which the receiver will then translate back into their local
1301 representation.  EBCDIC indicates the file being transferred is in
1302 EBCDIC format.  Binary (also known as image) format sends the data as
1303 a contiguous bit stream.  Byte format transfers the data as bytes, the
1304 values of which remain the same regardless of differences in byte size
1305 between the two machines (in theory - in practice you should only use
1306 this if you really know what you're doing).
1307
1308 =head1 CONSTRUCTOR
1309
1310 =over 4
1311
1312 =item new ([ HOST ] [, OPTIONS ])
1313
1314 This is the constructor for a new Net::FTP object. C<HOST> is the
1315 name of the remote host to which an FTP connection is required.
1316
1317 C<HOST> is optional. If C<HOST> is not given then it may instead be
1318 passed as the C<Host> option described below. 
1319
1320 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
1321 Possible options are:
1322
1323 B<Host> - FTP host to connect to. It may be a single scalar, as defined for
1324 the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
1325 an array with hosts to try in turn. The L</host> method will return the value
1326 which was used to connect to the host.
1327
1328
1329 B<Firewall> - The name of a machine which acts as an FTP firewall. This can be
1330 overridden by an environment variable C<FTP_FIREWALL>. If specified, and the
1331 given host cannot be directly connected to, then the
1332 connection is made to the firewall machine and the string C<@hostname> is
1333 appended to the login identifier. This kind of setup is also referred to
1334 as an ftp proxy.
1335
1336 B<FirewallType> - The type of firewall running on the machine indicated by
1337 B<Firewall>. This can be overridden by an environment variable
1338 C<FTP_FIREWALL_TYPE>. For a list of permissible types, see the description of
1339 ftp_firewall_type in L<Net::Config>.
1340
1341 B<BlockSize> - This is the block size that Net::FTP will use when doing
1342 transfers. (defaults to 10240)
1343
1344 B<Port> - The port number to connect to on the remote machine for the
1345 FTP connection
1346
1347 B<Timeout> - Set a timeout value (defaults to 120)
1348
1349 B<Debug> - debug level (see the debug method in L<Net::Cmd>)
1350
1351 B<Passive> - If set to a non-zero value then all data transfers will
1352 be done using passive mode. If set to zero then data transfers will be
1353 done using active mode.  If the machine is connected to the Internet
1354 directly, both passive and active mode should work equally well.
1355 Behind most firewall and NAT configurations passive mode has a better
1356 chance of working.  However, in some rare firewall configurations,
1357 active mode actually works when passive mode doesn't.  Some really old
1358 FTP servers might not implement passive transfers.  If not specified,
1359 then the transfer mode is set by the environment variable
1360 C<FTP_PASSIVE> or if that one is not set by the settings done by the
1361 F<libnetcfg> utility.  If none of these apply then passive mode is
1362 used.
1363
1364 B<Hash> - If given a reference to a file handle (e.g., C<\*STDERR>),
1365 print hash marks (#) on that filehandle every 1024 bytes.  This
1366 simply invokes the C<hash()> method for you, so that hash marks
1367 are displayed for all transfers.  You can, of course, call C<hash()>
1368 explicitly whenever you'd like.
1369
1370 B<LocalAddr> - Local address to use for all socket connections, this
1371 argument will be passed to L<IO::Socket::INET>
1372
1373 If the constructor fails undef will be returned and an error message will
1374 be in $@
1375
1376 =back
1377
1378 =head1 METHODS
1379
1380 Unless otherwise stated all methods return either a I<true> or I<false>
1381 value, with I<true> meaning that the operation was a success. When a method
1382 states that it returns a value, failure will be returned as I<undef> or an
1383 empty list.
1384
1385 =over 4
1386
1387 =item login ([LOGIN [,PASSWORD [, ACCOUNT] ] ])
1388
1389 Log into the remote FTP server with the given login information. If
1390 no arguments are given then the C<Net::FTP> uses the C<Net::Netrc>
1391 package to lookup the login information for the connected host.
1392 If no information is found then a login of I<anonymous> is used.
1393 If no password is given and the login is I<anonymous> then I<anonymous@>
1394 will be used for password.
1395
1396 If the connection is via a firewall then the C<authorize> method will
1397 be called with no arguments.
1398
1399 =item authorize ( [AUTH [, RESP]])
1400
1401 This is a protocol used by some firewall ftp proxies. It is used
1402 to authorise the user to send data out.  If both arguments are not specified
1403 then C<authorize> uses C<Net::Netrc> to do a lookup.
1404
1405 =item site (ARGS)
1406
1407 Send a SITE command to the remote server and wait for a response.
1408
1409 Returns most significant digit of the response code.
1410
1411 =item ascii
1412
1413 Transfer file in ASCII. CRLF translation will be done if required
1414
1415 =item binary
1416
1417 Transfer file in binary mode. No transformation will be done.
1418
1419 B<Hint>: If both server and client machines use the same line ending for
1420 text files, then it will be faster to transfer all files in binary mode.
1421
1422 =item rename ( OLDNAME, NEWNAME )
1423
1424 Rename a file on the remote FTP server from C<OLDNAME> to C<NEWNAME>. This
1425 is done by sending the RNFR and RNTO commands.
1426
1427 =item delete ( FILENAME )
1428
1429 Send a request to the server to delete C<FILENAME>.
1430
1431 =item cwd ( [ DIR ] )
1432
1433 Attempt to change directory to the directory given in C<$dir>.  If
1434 C<$dir> is C<"..">, the FTP C<CDUP> command is used to attempt to
1435 move up one directory. If no directory is given then an attempt is made
1436 to change the directory to the root directory.
1437
1438 =item cdup ()
1439
1440 Change directory to the parent of the current directory.
1441
1442 =item pwd ()
1443
1444 Returns the full pathname of the current directory.
1445
1446 =item restart ( WHERE )
1447
1448 Set the byte offset at which to begin the next data transfer. Net::FTP simply
1449 records this value and uses it when during the next data transfer. For this
1450 reason this method will not return an error, but setting it may cause
1451 a subsequent data transfer to fail.
1452
1453 =item rmdir ( DIR [, RECURSE ])
1454
1455 Remove the directory with the name C<DIR>. If C<RECURSE> is I<true> then
1456 C<rmdir> will attempt to delete everything inside the directory.
1457
1458 =item mkdir ( DIR [, RECURSE ])
1459
1460 Create a new directory with the name C<DIR>. If C<RECURSE> is I<true> then
1461 C<mkdir> will attempt to create all the directories in the given path.
1462
1463 Returns the full pathname to the new directory.
1464
1465 =item alloc ( SIZE [, RECORD_SIZE] )
1466
1467 The alloc command allows you to give the ftp server a hint about the size
1468 of the file about to be transferred using the ALLO ftp command. Some storage
1469 systems use this to make intelligent decisions about how to store the file.
1470 The C<SIZE> argument represents the size of the file in bytes. The
1471 C<RECORD_SIZE> argument indicates a maximum record or page size for files
1472 sent with a record or page structure.
1473
1474 The size of the file will be determined, and sent to the server
1475 automatically for normal files so that this method need only be called if
1476 you are transferring data from a socket, named pipe, or other stream not
1477 associated with a normal file.
1478
1479 =item ls ( [ DIR ] )
1480
1481 Get a directory listing of C<DIR>, or the current directory.
1482
1483 In an array context, returns a list of lines returned from the server. In
1484 a scalar context, returns a reference to a list.
1485
1486 =item dir ( [ DIR ] )
1487
1488 Get a directory listing of C<DIR>, or the current directory in long format.
1489
1490 In an array context, returns a list of lines returned from the server. In
1491 a scalar context, returns a reference to a list.
1492
1493 =item get ( REMOTE_FILE [, LOCAL_FILE [, WHERE]] )
1494
1495 Get C<REMOTE_FILE> from the server and store locally. C<LOCAL_FILE> may be
1496 a filename or a filehandle. If not specified, the file will be stored in
1497 the current directory with the same leafname as the remote file.
1498
1499 If C<WHERE> is given then the first C<WHERE> bytes of the file will
1500 not be transferred, and the remaining bytes will be appended to
1501 the local file if it already exists.
1502
1503 Returns C<LOCAL_FILE>, or the generated local file name if C<LOCAL_FILE>
1504 is not given. If an error was encountered undef is returned.
1505
1506 =item put ( LOCAL_FILE [, REMOTE_FILE ] )
1507
1508 Put a file on the remote server. C<LOCAL_FILE> may be a name or a filehandle.
1509 If C<LOCAL_FILE> is a filehandle then C<REMOTE_FILE> must be specified. If
1510 C<REMOTE_FILE> is not specified then the file will be stored in the current
1511 directory with the same leafname as C<LOCAL_FILE>.
1512
1513 Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
1514 is not given.
1515
1516 B<NOTE>: If for some reason the transfer does not complete and an error is
1517 returned then the contents that had been transferred will not be remove
1518 automatically.
1519
1520 =item put_unique ( LOCAL_FILE [, REMOTE_FILE ] )
1521
1522 Same as put but uses the C<STOU> command.
1523
1524 Returns the name of the file on the server.
1525
1526 =item append ( LOCAL_FILE [, REMOTE_FILE ] )
1527
1528 Same as put but appends to the file on the remote server.
1529
1530 Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
1531 is not given.
1532
1533 =item unique_name ()
1534
1535 Returns the name of the last file stored on the server using the
1536 C<STOU> command.
1537
1538 =item mdtm ( FILE )
1539
1540 Returns the I<modification time> of the given file
1541
1542 =item size ( FILE )
1543
1544 Returns the size in bytes for the given file as stored on the remote server.
1545
1546 B<NOTE>: The size reported is the size of the stored file on the remote server.
1547 If the file is subsequently transferred from the server in ASCII mode
1548 and the remote server and local machine have different ideas about
1549 "End Of Line" then the size of file on the local machine after transfer
1550 may be different.
1551
1552 =item supported ( CMD )
1553
1554 Returns TRUE if the remote server supports the given command.
1555
1556 =item hash ( [FILEHANDLE_GLOB_REF],[ BYTES_PER_HASH_MARK] )
1557
1558 Called without parameters, or with the first argument false, hash marks
1559 are suppressed.  If the first argument is true but not a reference to a 
1560 file handle glob, then \*STDERR is used.  The second argument is the number
1561 of bytes per hash mark printed, and defaults to 1024.  In all cases the
1562 return value is a reference to an array of two:  the filehandle glob reference
1563 and the bytes per hash mark.
1564
1565 =item feature ( NAME )
1566
1567 Determine if the server supports the specified feature. The return
1568 value is a list of lines the server responded with to describe the
1569 options that it supports for the given feature. If the feature is
1570 unsupported then the empty list is returned.
1571
1572   if ($ftp->feature( 'MDTM' )) {
1573     # Do something
1574   }
1575
1576   if (grep { /\bTLS\b/ } $ftp->feature('AUTH')) {
1577     # Server supports TLS
1578   }
1579
1580 =back
1581
1582 The following methods can return different results depending on
1583 how they are called. If the user explicitly calls either
1584 of the C<pasv> or C<port> methods then these methods will
1585 return a I<true> or I<false> value. If the user does not
1586 call either of these methods then the result will be a
1587 reference to a C<Net::FTP::dataconn> based object.
1588
1589 =over 4
1590
1591 =item nlst ( [ DIR ] )
1592
1593 Send an C<NLST> command to the server, with an optional parameter.
1594
1595 =item list ( [ DIR ] )
1596
1597 Same as C<nlst> but using the C<LIST> command
1598
1599 =item retr ( FILE )
1600
1601 Begin the retrieval of a file called C<FILE> from the remote server.
1602
1603 =item stor ( FILE )
1604
1605 Tell the server that you wish to store a file. C<FILE> is the
1606 name of the new file that should be created.
1607
1608 =item stou ( FILE )
1609
1610 Same as C<stor> but using the C<STOU> command. The name of the unique
1611 file which was created on the server will be available via the C<unique_name>
1612 method after the data connection has been closed.
1613
1614 =item appe ( FILE )
1615
1616 Tell the server that we want to append some data to the end of a file
1617 called C<FILE>. If this file does not exist then create it.
1618
1619 =back
1620
1621 If for some reason you want to have complete control over the data connection,
1622 this includes generating it and calling the C<response> method when required,
1623 then the user can use these methods to do so.
1624
1625 However calling these methods only affects the use of the methods above that
1626 can return a data connection. They have no effect on methods C<get>, C<put>,
1627 C<put_unique> and those that do not require data connections.
1628
1629 =over 4
1630
1631 =item port ( [ PORT ] )
1632
1633 Send a C<PORT> command to the server. If C<PORT> is specified then it is sent
1634 to the server. If not, then a listen socket is created and the correct information
1635 sent to the server.
1636
1637 =item pasv ()
1638
1639 Tell the server to go into passive mode. Returns the text that represents the
1640 port on which the server is listening, this text is in a suitable form to
1641 sent to another ftp server using the C<port> method.
1642
1643 =back
1644
1645 The following methods can be used to transfer files between two remote
1646 servers, providing that these two servers can connect directly to each other.
1647
1648 =over 4
1649
1650 =item pasv_xfer ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
1651
1652 This method will do a file transfer between two remote ftp servers. If
1653 C<DEST_FILE> is omitted then the leaf name of C<SRC_FILE> will be used.
1654
1655 =item pasv_xfer_unique ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
1656
1657 Like C<pasv_xfer> but the file is stored on the remote server using
1658 the STOU command.
1659
1660 =item pasv_wait ( NON_PASV_SERVER )
1661
1662 This method can be used to wait for a transfer to complete between a passive
1663 server and a non-passive server. The method should be called on the passive
1664 server with the C<Net::FTP> object for the non-passive server passed as an
1665 argument.
1666
1667 =item abort ()
1668
1669 Abort the current data transfer.
1670
1671 =item quit ()
1672
1673 Send the QUIT command to the remote FTP server and close the socket connection.
1674
1675 =back
1676
1677 =head2 Methods for the adventurous
1678
1679 C<Net::FTP> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
1680 be used to send commands to the remote FTP server.
1681
1682 =over 4
1683
1684 =item quot (CMD [,ARGS])
1685
1686 Send a command, that Net::FTP does not directly support, to the remote
1687 server and wait for a response.
1688
1689 Returns most significant digit of the response code.
1690
1691 B<WARNING> This call should only be used on commands that do not require
1692 data connections. Misuse of this method can hang the connection.
1693
1694 =back
1695
1696 =head1 THE dataconn CLASS
1697
1698 Some of the methods defined in C<Net::FTP> return an object which will
1699 be derived from this class.The dataconn class itself is derived from
1700 the C<IO::Socket::INET> class, so any normal IO operations can be performed.
1701 However the following methods are defined in the dataconn class and IO should
1702 be performed using these.
1703
1704 =over 4
1705
1706 =item read ( BUFFER, SIZE [, TIMEOUT ] )
1707
1708 Read C<SIZE> bytes of data from the server and place it into C<BUFFER>, also
1709 performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
1710 given, the timeout value from the command connection will be used.
1711
1712 Returns the number of bytes read before any <CRLF> translation.
1713
1714 =item write ( BUFFER, SIZE [, TIMEOUT ] )
1715
1716 Write C<SIZE> bytes of data from C<BUFFER> to the server, also
1717 performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
1718 given, the timeout value from the command connection will be used.
1719
1720 Returns the number of bytes written before any <CRLF> translation.
1721
1722 =item bytes_read ()
1723
1724 Returns the number of bytes read so far.
1725
1726 =item abort ()
1727
1728 Abort the current data transfer.
1729
1730 =item close ()
1731
1732 Close the data connection and get a response from the FTP server. Returns
1733 I<true> if the connection was closed successfully and the first digit of
1734 the response from the server was a '2'.
1735
1736 =back
1737
1738 =head1 UNIMPLEMENTED
1739
1740 The following RFC959 commands have not been implemented:
1741
1742 =over 4
1743
1744 =item B<SMNT>
1745
1746 Mount a different file system structure without changing login or
1747 accounting information.
1748
1749 =item B<HELP>
1750
1751 Ask the server for "helpful information" (that's what the RFC says) on
1752 the commands it accepts.
1753
1754 =item B<MODE>
1755
1756 Specifies transfer mode (stream, block or compressed) for file to be
1757 transferred.
1758
1759 =item B<SYST>
1760
1761 Request remote server system identification.
1762
1763 =item B<STAT>
1764
1765 Request remote server status.
1766
1767 =item B<STRU>
1768
1769 Specifies file structure for file to be transferred.
1770
1771 =item B<REIN>
1772
1773 Reinitialize the connection, flushing all I/O and account information.
1774
1775 =back
1776
1777 =head1 REPORTING BUGS
1778
1779 When reporting bugs/problems please include as much information as possible.
1780 It may be difficult for me to reproduce the problem as almost every setup
1781 is different.
1782
1783 A small script which yields the problem will probably be of help. It would
1784 also be useful if this script was run with the extra options C<Debug => 1>
1785 passed to the constructor, and the output sent with the bug report. If you
1786 cannot include a small script then please include a Debug trace from a
1787 run of your program which does yield the problem.
1788
1789 =head1 AUTHOR
1790
1791 Graham Barr <gbarr@pobox.com>
1792
1793 =head1 SEE ALSO
1794
1795 L<Net::Netrc>
1796 L<Net::Cmd>
1797
1798 ftp(1), ftpd(8), RFC 959
1799 http://www.cis.ohio-state.edu/htbin/rfc/rfc959.html
1800
1801 =head1 USE EXAMPLES
1802
1803 For an example of the use of Net::FTP see
1804
1805 =over 4
1806
1807 =item http://www.csh.rit.edu/~adam/Progs/
1808
1809 C<autoftp> is a program that can retrieve, send, or list files via
1810 the FTP protocol in a non-interactive manner.
1811
1812 =back
1813
1814 =head1 CREDITS
1815
1816 Henry Gabryjelski <henryg@WPI.EDU> - for the suggestion of creating directories
1817 recursively.
1818
1819 Nathan Torkington <gnat@frii.com> - for some input on the documentation.
1820
1821 Roderick Schertler <roderick@gate.net> - for various inputs
1822
1823 =head1 COPYRIGHT
1824
1825 Copyright (c) 1995-2004 Graham Barr. All rights reserved.
1826 This program is free software; you can redistribute it and/or modify it
1827 under the same terms as Perl itself.
1828
1829 =cut