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