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