cpan/libnet/lib/Net/FTP.pm

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