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