This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade libnet from version 1.24 to 1.25
[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.79';
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       Timeout   => $ftp->timeout
948     );
949   }
950   elsif (defined ${*$ftp}{'net_ftp_listen'}) {
951     $data = ${*$ftp}{'net_ftp_listen'}->accept($pkg);
952     close(delete ${*$ftp}{'net_ftp_listen'});
953   }
954
955   if ($data) {
956     ${*$data} = "";
957     $data->timeout($ftp->timeout);
958     ${*$ftp}{'net_ftp_dataconn'} = $data;
959     ${*$data}{'net_ftp_cmd'}     = $ftp;
960     ${*$data}{'net_ftp_blksize'} = ${*$ftp}{'net_ftp_blksize'};
961   }
962
963   $data;
964 }
965
966
967 sub _list_cmd {
968   my $ftp = shift;
969   my $cmd = uc shift;
970
971   delete ${*$ftp}{'net_ftp_port'};
972   delete ${*$ftp}{'net_ftp_pasv'};
973
974   my $data = $ftp->_data_cmd($cmd, @_);
975
976   return
977     unless (defined $data);
978
979   require Net::FTP::A;
980   bless $data, "Net::FTP::A";    # Force ASCII mode
981
982   my $databuf = '';
983   my $buf     = '';
984   my $blksize = ${*$ftp}{'net_ftp_blksize'};
985
986   while ($data->read($databuf, $blksize)) {
987     $buf .= $databuf;
988   }
989
990   my $list = [split(/\n/, $buf)];
991
992   $data->close();
993
994   if (trEBCDIC) {
995     for (@$list) { $_ = $ftp->toebcdic($_) }
996   }
997
998   wantarray
999     ? @{$list}
1000     : $list;
1001 }
1002
1003
1004 sub _data_cmd {
1005   my $ftp   = shift;
1006   my $cmd   = uc shift;
1007   my $ok    = 1;
1008   my $where = delete ${*$ftp}{'net_ftp_rest'} || 0;
1009   my $arg;
1010
1011   for $arg (@_) {
1012     croak("Bad argument '$arg'\n")
1013       if $arg =~ /[\r\n]/s;
1014   }
1015
1016   if ( ${*$ftp}{'net_ftp_passive'}
1017     && !defined ${*$ftp}{'net_ftp_pasv'}
1018     && !defined ${*$ftp}{'net_ftp_port'})
1019   {
1020     my $data = undef;
1021
1022     return undef unless defined $ftp->pasv;
1023     $data = $ftp->_dataconn() or return undef;
1024
1025     if ($where and !$ftp->_REST($where)) {
1026       my ($status, $message) = ($ftp->status, $ftp->message);
1027       $ftp->abort;
1028       $ftp->set_status($status, $message);
1029       return undef;
1030     }
1031
1032     $ftp->command($cmd, @_);
1033     if (CMD_INFO == $ftp->response()) {
1034       $data->reading
1035         if $cmd =~ /RETR|LIST|NLST/;
1036       return $data;
1037     }
1038     $data->_close;
1039
1040     return undef;
1041   }
1042
1043   $ok = $ftp->port
1044     unless (defined ${*$ftp}{'net_ftp_port'}
1045     || defined ${*$ftp}{'net_ftp_pasv'});
1046
1047   $ok = $ftp->_REST($where)
1048     if $ok && $where;
1049
1050   return undef
1051     unless $ok;
1052
1053   if ($cmd =~ /(STOR|APPE|STOU)/ and exists ${*$ftp}{net_ftp_allo}) {
1054     $ftp->_ALLO(delete ${*$ftp}{net_ftp_allo})
1055       or return undef;
1056   }
1057
1058   $ftp->command($cmd, @_);
1059
1060   return 1
1061     if (defined ${*$ftp}{'net_ftp_pasv'});
1062
1063   $ok = CMD_INFO == $ftp->response();
1064
1065   return $ok
1066     unless exists ${*$ftp}{'net_ftp_intern_port'};
1067
1068   if ($ok) {
1069     my $data = $ftp->_dataconn();
1070
1071     $data->reading
1072       if $data && $cmd =~ /RETR|LIST|NLST/;
1073
1074     return $data;
1075   }
1076
1077
1078   close(delete ${*$ftp}{'net_ftp_listen'});
1079
1080   return undef;
1081 }
1082
1083 ##
1084 ## Over-ride methods (Net::Cmd)
1085 ##
1086
1087
1088 sub debug_text { $_[2] =~ /^(pass|resp|acct)/i ? "$1 ....\n" : $_[2]; }
1089
1090
1091 sub command {
1092   my $ftp = shift;
1093
1094   delete ${*$ftp}{'net_ftp_port'};
1095   $ftp->SUPER::command(@_);
1096 }
1097
1098
1099 sub response {
1100   my $ftp  = shift;
1101   my $code = $ftp->SUPER::response() || 5;    # assume 500 if undef
1102
1103   delete ${*$ftp}{'net_ftp_pasv'}
1104     if ($code != CMD_MORE && $code != CMD_INFO);
1105
1106   $code;
1107 }
1108
1109
1110 sub parse_response {
1111   return ($1, $2 eq "-")
1112     if $_[1] =~ s/^(\d\d\d)([- ]?)//o;
1113
1114   my $ftp = shift;
1115
1116   # Darn MS FTP server is a load of CRAP !!!!
1117   # Expect to see undef here.
1118   return ()
1119     unless 0 + (${*$ftp}{'net_cmd_code'} || 0);
1120
1121   (${*$ftp}{'net_cmd_code'}, 1);
1122 }
1123
1124 ##
1125 ## Allow 2 servers to talk directly
1126 ##
1127
1128
1129 sub pasv_xfer_unique {
1130   my ($sftp, $sfile, $dftp, $dfile) = @_;
1131   $sftp->pasv_xfer($sfile, $dftp, $dfile, 1);
1132 }
1133
1134
1135 sub pasv_xfer {
1136   my ($sftp, $sfile, $dftp, $dfile, $unique) = @_;
1137
1138   ($dfile = $sfile) =~ s#.*/##
1139     unless (defined $dfile);
1140
1141   my $port = $sftp->pasv
1142     or return undef;
1143
1144   $dftp->port($port)
1145     or return undef;
1146
1147   return undef
1148     unless ($unique ? $dftp->stou($dfile) : $dftp->stor($dfile));
1149
1150   unless ($sftp->retr($sfile) && $sftp->response == CMD_INFO) {
1151     $sftp->retr($sfile);
1152     $dftp->abort;
1153     $dftp->response();
1154     return undef;
1155   }
1156
1157   $dftp->pasv_wait($sftp);
1158 }
1159
1160
1161 sub pasv_wait {
1162   @_ == 2 or croak 'usage: $ftp->pasv_wait(NON_PASV_FTP)';
1163
1164   my ($ftp, $non_pasv) = @_;
1165   my ($file, $rin, $rout);
1166
1167   vec($rin = '', fileno($ftp), 1) = 1;
1168   select($rout = $rin, undef, undef, undef);
1169
1170   my $dres = $ftp->response();
1171   my $sres = $non_pasv->response();
1172
1173   return undef
1174     unless $dres == CMD_OK && $sres == CMD_OK;
1175
1176   return undef
1177     unless $ftp->ok() && $non_pasv->ok();
1178
1179   return $1
1180     if $ftp->message =~ /unique file name:\s*(\S*)\s*\)/;
1181
1182   return $1
1183     if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/;
1184
1185   return 1;
1186 }
1187
1188
1189 sub feature {
1190   @_ == 2 or croak 'usage: $ftp->feature( NAME )';
1191   my ($ftp, $feat) = @_;
1192
1193   my $feature = ${*$ftp}{net_ftp_feature} ||= do {
1194     my @feat;
1195
1196     # Example response
1197     # 211-Features:
1198     #  MDTM
1199     #  REST STREAM
1200     #  SIZE
1201     # 211 End
1202
1203     @feat = map { /^\s+(.*\S)/ } $ftp->message
1204       if $ftp->_FEAT;
1205
1206     \@feat;
1207   };
1208
1209   return grep { /^\Q$feat\E\b/i } @$feature;
1210 }
1211
1212
1213 sub cmd { shift->command(@_)->response() }
1214
1215 ########################################
1216 #
1217 # RFC959 commands
1218 #
1219
1220
1221 sub _ABOR { shift->command("ABOR")->response() == CMD_OK }
1222 sub _ALLO { shift->command("ALLO", @_)->response() == CMD_OK }
1223 sub _CDUP { shift->command("CDUP")->response() == CMD_OK }
1224 sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
1225 sub _PASV { shift->command("PASV")->response() == CMD_OK }
1226 sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
1227 sub _DELE { shift->command("DELE", @_)->response() == CMD_OK }
1228 sub _CWD  { shift->command("CWD", @_)->response() == CMD_OK }
1229 sub _PORT { shift->command("PORT", @_)->response() == CMD_OK }
1230 sub _RMD  { shift->command("RMD", @_)->response() == CMD_OK }
1231 sub _MKD  { shift->command("MKD", @_)->response() == CMD_OK }
1232 sub _PWD  { shift->command("PWD", @_)->response() == CMD_OK }
1233 sub _TYPE { shift->command("TYPE", @_)->response() == CMD_OK }
1234 sub _RNTO { shift->command("RNTO", @_)->response() == CMD_OK }
1235 sub _RESP { shift->command("RESP", @_)->response() == CMD_OK }
1236 sub _MDTM { shift->command("MDTM", @_)->response() == CMD_OK }
1237 sub _SIZE { shift->command("SIZE", @_)->response() == CMD_OK }
1238 sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
1239 sub _STAT { shift->command("STAT", @_)->response() == CMD_OK }
1240 sub _FEAT { shift->command("FEAT", @_)->response() == CMD_OK }
1241 sub _APPE { shift->command("APPE", @_)->response() == CMD_INFO }
1242 sub _LIST { shift->command("LIST", @_)->response() == CMD_INFO }
1243 sub _NLST { shift->command("NLST", @_)->response() == CMD_INFO }
1244 sub _RETR { shift->command("RETR", @_)->response() == CMD_INFO }
1245 sub _STOR { shift->command("STOR", @_)->response() == CMD_INFO }
1246 sub _STOU { shift->command("STOU", @_)->response() == CMD_INFO }
1247 sub _RNFR { shift->command("RNFR", @_)->response() == CMD_MORE }
1248 sub _REST { shift->command("REST", @_)->response() == CMD_MORE }
1249 sub _PASS { shift->command("PASS", @_)->response() }
1250 sub _ACCT { shift->command("ACCT", @_)->response() }
1251 sub _AUTH { shift->command("AUTH", @_)->response() }
1252
1253
1254 sub _USER {
1255   my $ftp = shift;
1256   my $ok  = $ftp->command("USER", @_)->response();
1257
1258   # A certain brain dead firewall :-)
1259   $ok = $ftp->command("user", @_)->response()
1260     unless $ok == CMD_MORE or $ok == CMD_OK;
1261
1262   $ok;
1263 }
1264
1265
1266 sub _SMNT { shift->unsupported(@_) }
1267 sub _MODE { shift->unsupported(@_) }
1268 sub _SYST { shift->unsupported(@_) }
1269 sub _STRU { shift->unsupported(@_) }
1270 sub _REIN { shift->unsupported(@_) }
1271
1272 1;
1273
1274 __END__
1275
1276 =head1 NAME
1277
1278 Net::FTP - FTP Client class
1279
1280 =head1 SYNOPSIS
1281
1282     use Net::FTP;
1283
1284     $ftp = Net::FTP->new("some.host.name", Debug => 0)
1285       or die "Cannot connect to some.host.name: $@";
1286
1287     $ftp->login("anonymous",'-anonymous@')
1288       or die "Cannot login ", $ftp->message;
1289
1290     $ftp->cwd("/pub")
1291       or die "Cannot change working directory ", $ftp->message;
1292
1293     $ftp->get("that.file")
1294       or die "get failed ", $ftp->message;
1295
1296     $ftp->quit;
1297
1298 =head1 DESCRIPTION
1299
1300 C<Net::FTP> is a class implementing a simple FTP client in Perl as
1301 described in RFC959.  It provides wrappers for a subset of the RFC959
1302 commands.
1303
1304 The Net::FTP class is a subclass of Net::Cmd and IO::Socket::INET.
1305
1306 =head1 OVERVIEW
1307
1308 FTP stands for File Transfer Protocol.  It is a way of transferring
1309 files between networked machines.  The protocol defines a client
1310 (whose commands are provided by this module) and a server (not
1311 implemented in this module).  Communication is always initiated by the
1312 client, and the server responds with a message and a status code (and
1313 sometimes with data).
1314
1315 The FTP protocol allows files to be sent to or fetched from the
1316 server.  Each transfer involves a B<local file> (on the client) and a
1317 B<remote file> (on the server).  In this module, the same file name
1318 will be used for both local and remote if only one is specified.  This
1319 means that transferring remote file C</path/to/file> will try to put
1320 that file in C</path/to/file> locally, unless you specify a local file
1321 name.
1322
1323 The protocol also defines several standard B<translations> which the
1324 file can undergo during transfer.  These are ASCII, EBCDIC, binary,
1325 and byte.  ASCII is the default type, and indicates that the sender of
1326 files will translate the ends of lines to a standard representation
1327 which the receiver will then translate back into their local
1328 representation.  EBCDIC indicates the file being transferred is in
1329 EBCDIC format.  Binary (also known as image) format sends the data as
1330 a contiguous bit stream.  Byte format transfers the data as bytes, the
1331 values of which remain the same regardless of differences in byte size
1332 between the two machines (in theory - in practice you should only use
1333 this if you really know what you're doing).
1334
1335 =head1 CONSTRUCTOR
1336
1337 =over 4
1338
1339 =item new ([ HOST ] [, OPTIONS ])
1340
1341 This is the constructor for a new Net::FTP object. C<HOST> is the
1342 name of the remote host to which an FTP connection is required.
1343
1344 C<HOST> is optional. If C<HOST> is not given then it may instead be
1345 passed as the C<Host> option described below. 
1346
1347 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
1348 Possible options are:
1349
1350 B<Host> - FTP host to connect to. It may be a single scalar, as defined for
1351 the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
1352 an array with hosts to try in turn. The L</host> method will return the value
1353 which was used to connect to the host.
1354
1355
1356 B<Firewall> - The name of a machine which acts as an FTP firewall. This can be
1357 overridden by an environment variable C<FTP_FIREWALL>. If specified, and the
1358 given host cannot be directly connected to, then the
1359 connection is made to the firewall machine and the string C<@hostname> is
1360 appended to the login identifier. This kind of setup is also referred to
1361 as an ftp proxy.
1362
1363 B<FirewallType> - The type of firewall running on the machine indicated by
1364 B<Firewall>. This can be overridden by an environment variable
1365 C<FTP_FIREWALL_TYPE>. For a list of permissible types, see the description of
1366 ftp_firewall_type in L<Net::Config>.
1367
1368 B<BlockSize> - This is the block size that Net::FTP will use when doing
1369 transfers. (defaults to 10240)
1370
1371 B<Port> - The port number to connect to on the remote machine for the
1372 FTP connection
1373
1374 B<Timeout> - Set a timeout value in seconds (defaults to 120)
1375
1376 B<Debug> - debug level (see the debug method in L<Net::Cmd>)
1377
1378 B<Passive> - If set to a non-zero value then all data transfers will
1379 be done using passive mode. If set to zero then data transfers will be
1380 done using active mode.  If the machine is connected to the Internet
1381 directly, both passive and active mode should work equally well.
1382 Behind most firewall and NAT configurations passive mode has a better
1383 chance of working.  However, in some rare firewall configurations,
1384 active mode actually works when passive mode doesn't.  Some really old
1385 FTP servers might not implement passive transfers.  If not specified,
1386 then the transfer mode is set by the environment variable
1387 C<FTP_PASSIVE> or if that one is not set by the settings done by the
1388 F<libnetcfg> utility.  If none of these apply then passive mode is
1389 used.
1390
1391 B<Hash> - If given a reference to a file handle (e.g., C<\*STDERR>),
1392 print hash marks (#) on that filehandle every 1024 bytes.  This
1393 simply invokes the C<hash()> method for you, so that hash marks
1394 are displayed for all transfers.  You can, of course, call C<hash()>
1395 explicitly whenever you'd like.
1396
1397 B<LocalAddr> - Local address to use for all socket connections, this
1398 argument will be passed to L<IO::Socket::INET>
1399
1400 If the constructor fails undef will be returned and an error message will
1401 be in $@
1402
1403 =back
1404
1405 =head1 METHODS
1406
1407 Unless otherwise stated all methods return either a I<true> or I<false>
1408 value, with I<true> meaning that the operation was a success. When a method
1409 states that it returns a value, failure will be returned as I<undef> or an
1410 empty list.
1411
1412 C<Net::FTP> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
1413 be used to send commands to the remote FTP server in addition to the methods
1414 documented here.
1415
1416 =over 4
1417
1418 =item login ([LOGIN [,PASSWORD [, ACCOUNT] ] ])
1419
1420 Log into the remote FTP server with the given login information. If
1421 no arguments are given then the C<Net::FTP> uses the C<Net::Netrc>
1422 package to lookup the login information for the connected host.
1423 If no information is found then a login of I<anonymous> is used.
1424 If no password is given and the login is I<anonymous> then I<anonymous@>
1425 will be used for password.
1426
1427 If the connection is via a firewall then the C<authorize> method will
1428 be called with no arguments.
1429
1430 =item authorize ( [AUTH [, RESP]])
1431
1432 This is a protocol used by some firewall ftp proxies. It is used
1433 to authorise the user to send data out.  If both arguments are not specified
1434 then C<authorize> uses C<Net::Netrc> to do a lookup.
1435
1436 =item site (ARGS)
1437
1438 Send a SITE command to the remote server and wait for a response.
1439
1440 Returns most significant digit of the response code.
1441
1442 =item ascii
1443
1444 Transfer file in ASCII. CRLF translation will be done if required
1445
1446 =item binary
1447
1448 Transfer file in binary mode. No transformation will be done.
1449
1450 B<Hint>: If both server and client machines use the same line ending for
1451 text files, then it will be faster to transfer all files in binary mode.
1452
1453 =item rename ( OLDNAME, NEWNAME )
1454
1455 Rename a file on the remote FTP server from C<OLDNAME> to C<NEWNAME>. This
1456 is done by sending the RNFR and RNTO commands.
1457
1458 =item delete ( FILENAME )
1459
1460 Send a request to the server to delete C<FILENAME>.
1461
1462 =item cwd ( [ DIR ] )
1463
1464 Attempt to change directory to the directory given in C<$dir>.  If
1465 C<$dir> is C<"..">, the FTP C<CDUP> command is used to attempt to
1466 move up one directory. If no directory is given then an attempt is made
1467 to change the directory to the root directory.
1468
1469 =item cdup ()
1470
1471 Change directory to the parent of the current directory.
1472
1473 =item passive ( [ PASSIVE ] )
1474
1475 Set or get if data connections will be initiated in passive mode.
1476
1477 =item pwd ()
1478
1479 Returns the full pathname of the current directory.
1480
1481 =item restart ( WHERE )
1482
1483 Set the byte offset at which to begin the next data transfer. Net::FTP simply
1484 records this value and uses it when during the next data transfer. For this
1485 reason this method will not return an error, but setting it may cause
1486 a subsequent data transfer to fail.
1487
1488 =item rmdir ( DIR [, RECURSE ])
1489
1490 Remove the directory with the name C<DIR>. If C<RECURSE> is I<true> then
1491 C<rmdir> will attempt to delete everything inside the directory.
1492
1493 =item mkdir ( DIR [, RECURSE ])
1494
1495 Create a new directory with the name C<DIR>. If C<RECURSE> is I<true> then
1496 C<mkdir> will attempt to create all the directories in the given path.
1497
1498 Returns the full pathname to the new directory.
1499
1500 =item alloc ( SIZE [, RECORD_SIZE] )
1501
1502 The alloc command allows you to give the ftp server a hint about the size
1503 of the file about to be transferred using the ALLO ftp command. Some storage
1504 systems use this to make intelligent decisions about how to store the file.
1505 The C<SIZE> argument represents the size of the file in bytes. The
1506 C<RECORD_SIZE> argument indicates a maximum record or page size for files
1507 sent with a record or page structure.
1508
1509 The size of the file will be determined, and sent to the server
1510 automatically for normal files so that this method need only be called if
1511 you are transferring data from a socket, named pipe, or other stream not
1512 associated with a normal file.
1513
1514 =item ls ( [ DIR ] )
1515
1516 Get a directory listing of C<DIR>, or the current directory.
1517
1518 In an array context, returns a list of lines returned from the server. In
1519 a scalar context, returns a reference to a list.
1520
1521 =item dir ( [ DIR ] )
1522
1523 Get a directory listing of C<DIR>, or the current directory in long format.
1524
1525 In an array context, returns a list of lines returned from the server. In
1526 a scalar context, returns a reference to a list.
1527
1528 =item get ( REMOTE_FILE [, LOCAL_FILE [, WHERE]] )
1529
1530 Get C<REMOTE_FILE> from the server and store locally. C<LOCAL_FILE> may be
1531 a filename or a filehandle. If not specified, the file will be stored in
1532 the current directory with the same leafname as the remote file.
1533
1534 If C<WHERE> is given then the first C<WHERE> bytes of the file will
1535 not be transferred, and the remaining bytes will be appended to
1536 the local file if it already exists.
1537
1538 Returns C<LOCAL_FILE>, or the generated local file name if C<LOCAL_FILE>
1539 is not given. If an error was encountered undef is returned.
1540
1541 =item put ( LOCAL_FILE [, REMOTE_FILE ] )
1542
1543 Put a file on the remote server. C<LOCAL_FILE> may be a name or a filehandle.
1544 If C<LOCAL_FILE> is a filehandle then C<REMOTE_FILE> must be specified. If
1545 C<REMOTE_FILE> is not specified then the file will be stored in the current
1546 directory with the same leafname as C<LOCAL_FILE>.
1547
1548 Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
1549 is not given.
1550
1551 B<NOTE>: If for some reason the transfer does not complete and an error is
1552 returned then the contents that had been transferred will not be remove
1553 automatically.
1554
1555 =item put_unique ( LOCAL_FILE [, REMOTE_FILE ] )
1556
1557 Same as put but uses the C<STOU> command.
1558
1559 Returns the name of the file on the server.
1560
1561 =item append ( LOCAL_FILE [, REMOTE_FILE ] )
1562
1563 Same as put but appends to the file on the remote server.
1564
1565 Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
1566 is not given.
1567
1568 =item unique_name ()
1569
1570 Returns the name of the last file stored on the server using the
1571 C<STOU> command.
1572
1573 =item mdtm ( FILE )
1574
1575 Returns the I<modification time> of the given file
1576
1577 =item size ( FILE )
1578
1579 Returns the size in bytes for the given file as stored on the remote server.
1580
1581 B<NOTE>: The size reported is the size of the stored file on the remote server.
1582 If the file is subsequently transferred from the server in ASCII mode
1583 and the remote server and local machine have different ideas about
1584 "End Of Line" then the size of file on the local machine after transfer
1585 may be different.
1586
1587 =item supported ( CMD )
1588
1589 Returns TRUE if the remote server supports the given command.
1590
1591 =item hash ( [FILEHANDLE_GLOB_REF],[ BYTES_PER_HASH_MARK] )
1592
1593 Called without parameters, or with the first argument false, hash marks
1594 are suppressed.  If the first argument is true but not a reference to a 
1595 file handle glob, then \*STDERR is used.  The second argument is the number
1596 of bytes per hash mark printed, and defaults to 1024.  In all cases the
1597 return value is a reference to an array of two:  the filehandle glob reference
1598 and the bytes per hash mark.
1599
1600 =item feature ( NAME )
1601
1602 Determine if the server supports the specified feature. The return
1603 value is a list of lines the server responded with to describe the
1604 options that it supports for the given feature. If the feature is
1605 unsupported then the empty list is returned.
1606
1607   if ($ftp->feature( 'MDTM' )) {
1608     # Do something
1609   }
1610
1611   if (grep { /\bTLS\b/ } $ftp->feature('AUTH')) {
1612     # Server supports TLS
1613   }
1614
1615 =back
1616
1617 The following methods can return different results depending on
1618 how they are called. If the user explicitly calls either
1619 of the C<pasv> or C<port> methods then these methods will
1620 return a I<true> or I<false> value. If the user does not
1621 call either of these methods then the result will be a
1622 reference to a C<Net::FTP::dataconn> based object.
1623
1624 =over 4
1625
1626 =item nlst ( [ DIR ] )
1627
1628 Send an C<NLST> command to the server, with an optional parameter.
1629
1630 =item list ( [ DIR ] )
1631
1632 Same as C<nlst> but using the C<LIST> command
1633
1634 =item retr ( FILE )
1635
1636 Begin the retrieval of a file called C<FILE> from the remote server.
1637
1638 =item stor ( FILE )
1639
1640 Tell the server that you wish to store a file. C<FILE> is the
1641 name of the new file that should be created.
1642
1643 =item stou ( FILE )
1644
1645 Same as C<stor> but using the C<STOU> command. The name of the unique
1646 file which was created on the server will be available via the C<unique_name>
1647 method after the data connection has been closed.
1648
1649 =item appe ( FILE )
1650
1651 Tell the server that we want to append some data to the end of a file
1652 called C<FILE>. If this file does not exist then create it.
1653
1654 =back
1655
1656 If for some reason you want to have complete control over the data connection,
1657 this includes generating it and calling the C<response> method when required,
1658 then the user can use these methods to do so.
1659
1660 However calling these methods only affects the use of the methods above that
1661 can return a data connection. They have no effect on methods C<get>, C<put>,
1662 C<put_unique> and those that do not require data connections.
1663
1664 =over 4
1665
1666 =item port ( [ PORT ] )
1667
1668 Send a C<PORT> command to the server. If C<PORT> is specified then it is sent
1669 to the server. If not, then a listen socket is created and the correct information
1670 sent to the server.
1671
1672 =item pasv ()
1673
1674 Tell the server to go into passive mode. Returns the text that represents the
1675 port on which the server is listening, this text is in a suitable form to
1676 sent to another ftp server using the C<port> method.
1677
1678 =back
1679
1680 The following methods can be used to transfer files between two remote
1681 servers, providing that these two servers can connect directly to each other.
1682
1683 =over 4
1684
1685 =item pasv_xfer ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
1686
1687 This method will do a file transfer between two remote ftp servers. If
1688 C<DEST_FILE> is omitted then the leaf name of C<SRC_FILE> will be used.
1689
1690 =item pasv_xfer_unique ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
1691
1692 Like C<pasv_xfer> but the file is stored on the remote server using
1693 the STOU command.
1694
1695 =item pasv_wait ( NON_PASV_SERVER )
1696
1697 This method can be used to wait for a transfer to complete between a passive
1698 server and a non-passive server. The method should be called on the passive
1699 server with the C<Net::FTP> object for the non-passive server passed as an
1700 argument.
1701
1702 =item abort ()
1703
1704 Abort the current data transfer.
1705
1706 =item quit ()
1707
1708 Send the QUIT command to the remote FTP server and close the socket connection.
1709
1710 =back
1711
1712 =head2 Methods for the adventurous
1713
1714 =over 4
1715
1716 =item quot (CMD [,ARGS])
1717
1718 Send a command, that Net::FTP does not directly support, to the remote
1719 server and wait for a response.
1720
1721 Returns most significant digit of the response code.
1722
1723 B<WARNING> This call should only be used on commands that do not require
1724 data connections. Misuse of this method can hang the connection.
1725
1726 =back
1727
1728 =head1 THE dataconn CLASS
1729
1730 Some of the methods defined in C<Net::FTP> return an object which will
1731 be derived from this class.The dataconn class itself is derived from
1732 the C<IO::Socket::INET> class, so any normal IO operations can be performed.
1733 However the following methods are defined in the dataconn class and IO should
1734 be performed using these.
1735
1736 =over 4
1737
1738 =item read ( BUFFER, SIZE [, TIMEOUT ] )
1739
1740 Read C<SIZE> bytes of data from the server and place it into C<BUFFER>, also
1741 performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
1742 given, the timeout value from the command connection will be used.
1743
1744 Returns the number of bytes read before any <CRLF> translation.
1745
1746 =item write ( BUFFER, SIZE [, TIMEOUT ] )
1747
1748 Write C<SIZE> bytes of data from C<BUFFER> to the server, also
1749 performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
1750 given, the timeout value from the command connection will be used.
1751
1752 Returns the number of bytes written before any <CRLF> translation.
1753
1754 =item bytes_read ()
1755
1756 Returns the number of bytes read so far.
1757
1758 =item abort ()
1759
1760 Abort the current data transfer.
1761
1762 =item close ()
1763
1764 Close the data connection and get a response from the FTP server. Returns
1765 I<true> if the connection was closed successfully and the first digit of
1766 the response from the server was a '2'.
1767
1768 =back
1769
1770 =head1 UNIMPLEMENTED
1771
1772 The following RFC959 commands have not been implemented:
1773
1774 =over 4
1775
1776 =item B<SMNT>
1777
1778 Mount a different file system structure without changing login or
1779 accounting information.
1780
1781 =item B<HELP>
1782
1783 Ask the server for "helpful information" (that's what the RFC says) on
1784 the commands it accepts.
1785
1786 =item B<MODE>
1787
1788 Specifies transfer mode (stream, block or compressed) for file to be
1789 transferred.
1790
1791 =item B<SYST>
1792
1793 Request remote server system identification.
1794
1795 =item B<STAT>
1796
1797 Request remote server status.
1798
1799 =item B<STRU>
1800
1801 Specifies file structure for file to be transferred.
1802
1803 =item B<REIN>
1804
1805 Reinitialize the connection, flushing all I/O and account information.
1806
1807 =back
1808
1809 =head1 REPORTING BUGS
1810
1811 When reporting bugs/problems please include as much information as possible.
1812 It may be difficult for me to reproduce the problem as almost every setup
1813 is different.
1814
1815 A small script which yields the problem will probably be of help. It would
1816 also be useful if this script was run with the extra options C<Debug => 1>
1817 passed to the constructor, and the output sent with the bug report. If you
1818 cannot include a small script then please include a Debug trace from a
1819 run of your program which does yield the problem.
1820
1821 =head1 AUTHOR
1822
1823 Graham Barr <gbarr@pobox.com>
1824
1825 =head1 SEE ALSO
1826
1827 L<Net::Netrc>
1828 L<Net::Cmd>
1829
1830 ftp(1), ftpd(8), RFC 959
1831 http://www.ietf.org/rfc/rfc959.txt
1832
1833 =head1 USE EXAMPLES
1834
1835 For an example of the use of Net::FTP see
1836
1837 =over 4
1838
1839 =item http://www.csh.rit.edu/~adam/Progs/
1840
1841 C<autoftp> is a program that can retrieve, send, or list files via
1842 the FTP protocol in a non-interactive manner.
1843
1844 =back
1845
1846 =head1 CREDITS
1847
1848 Henry Gabryjelski <henryg@WPI.EDU> - for the suggestion of creating directories
1849 recursively.
1850
1851 Nathan Torkington <gnat@frii.com> - for some input on the documentation.
1852
1853 Roderick Schertler <roderick@gate.net> - for various inputs
1854
1855 =head1 COPYRIGHT
1856
1857 Copyright (c) 1995-2004 Graham Barr. All rights reserved.
1858 This program is free software; you can redistribute it and/or modify it
1859 under the same terms as Perl itself.
1860
1861 =cut