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