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