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