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