lib/Net/FTP.pm

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