lib/Net/FTP.pm

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