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 TRUE, print hash marks (#) on STDERR every 1024 bytes.  This
1231 simply invokes the C<hash()> method for you, so that hash marks are displayed
1232 for all transfers.  You can, of course, call C<hash()> explicitly whenever
1233 you'd like.
1234
1235 If the constructor fails undef will be returned and an error message will
1236 be in $@
1237
1238 =back
1239
1240 =head1 METHODS
1241
1242 Unless otherwise stated all methods return either a I<true> or I<false>
1243 value, with I<true> meaning that the operation was a success. When a method
1244 states that it returns a value, failure will be returned as I<undef> or an
1245 empty list.
1246
1247 =over 4
1248
1249 =item login ([LOGIN [,PASSWORD [, ACCOUNT] ] ])
1250
1251 Log into the remote FTP server with the given login information. If
1252 no arguments are given then the C<Net::FTP> uses the C<Net::Netrc>
1253 package to lookup the login information for the connected host.
1254 If no information is found then a login of I<anonymous> is used.
1255 If no password is given and the login is I<anonymous> then the users
1256 Email address will be used for a password.
1257
1258 If the connection is via a firewall then the C<authorize> method will
1259 be called with no arguments.
1260
1261 =item authorize ( [AUTH [, RESP]])
1262
1263 This is a protocol used by some firewall ftp proxies. It is used
1264 to authorise the user to send data out.  If both arguments are not specified
1265 then C<authorize> uses C<Net::Netrc> to do a lookup.
1266
1267 =item site (ARGS)
1268
1269 Send a SITE command to the remote server and wait for a response.
1270
1271 Returns most significant digit of the response code.
1272
1273 =item type (TYPE [, ARGS])
1274
1275 This method will send the TYPE command to the remote FTP server
1276 to change the type of data transfer. The return value is the previous
1277 value.
1278
1279 =item ascii ([ARGS]) binary([ARGS]) ebcdic([ARGS]) byte([ARGS])
1280
1281 Synonyms for C<type> with the first arguments set correctly
1282
1283 B<NOTE> ebcdic and byte are not fully supported.
1284
1285 =item rename ( OLDNAME, NEWNAME )
1286
1287 Rename a file on the remote FTP server from C<OLDNAME> to C<NEWNAME>. This
1288 is done by sending the RNFR and RNTO commands.
1289
1290 =item delete ( FILENAME )
1291
1292 Send a request to the server to delete C<FILENAME>.
1293
1294 =item cwd ( [ DIR ] )
1295
1296 Attempt to change directory to the directory given in C<$dir>.  If
1297 C<$dir> is C<"..">, the FTP C<CDUP> command is used to attempt to
1298 move up one directory. If no directory is given then an attempt is made
1299 to change the directory to the root directory.
1300
1301 =item cdup ()
1302
1303 Change directory to the parent of the current directory.
1304
1305 =item pwd ()
1306
1307 Returns the full pathname of the current directory.
1308
1309 =item rmdir ( DIR )
1310
1311 Remove the directory with the name C<DIR>.
1312
1313 =item mkdir ( DIR [, RECURSE ])
1314
1315 Create a new directory with the name C<DIR>. If C<RECURSE> is I<true> then
1316 C<mkdir> will attempt to create all the directories in the given path.
1317
1318 Returns the full pathname to the new directory.
1319
1320 =item ls ( [ DIR ] )
1321
1322 Get a directory listing of C<DIR>, or the current directory.
1323
1324 In an array context, returns a list of lines returned from the server. In
1325 a scalar context, returns a reference to a list.
1326
1327 =item dir ( [ DIR ] )
1328
1329 Get a directory listing of C<DIR>, or the current directory in long format.
1330
1331 In an array context, returns a list of lines returned from the server. In
1332 a scalar context, returns a reference to a list.
1333
1334 =item get ( REMOTE_FILE [, LOCAL_FILE [, WHERE]] )
1335
1336 Get C<REMOTE_FILE> from the server and store locally. C<LOCAL_FILE> may be
1337 a filename or a filehandle. If not specified the the file will be stored in
1338 the current directory with the same leafname as the remote file.
1339
1340 If C<WHERE> is given then the first C<WHERE> bytes of the file will
1341 not be transfered, and the remaining bytes will be appended to
1342 the local file if it already exists.
1343
1344 Returns C<LOCAL_FILE>, or the generated local file name if C<LOCAL_FILE>
1345 is not given.
1346
1347 =item put ( LOCAL_FILE [, REMOTE_FILE ] )
1348
1349 Put a file on the remote server. C<LOCAL_FILE> may be a name or a filehandle.
1350 If C<LOCAL_FILE> is a filehandle then C<REMOTE_FILE> must be specified. If
1351 C<REMOTE_FILE> is not specified then the file will be stored in the current
1352 directory with the same leafname as C<LOCAL_FILE>.
1353
1354 Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
1355 is not given.
1356
1357 B<NOTE>: If for some reason the transfer does not complete and an error is
1358 returned then the contents that had been transfered will not be remove
1359 automatically.
1360
1361 =item put_unique ( LOCAL_FILE [, REMOTE_FILE ] )
1362
1363 Same as put but uses the C<STOU> command.
1364
1365 Returns the name of the file on the server.
1366
1367 =item append ( LOCAL_FILE [, REMOTE_FILE ] )
1368
1369 Same as put but appends to the file on the remote server.
1370
1371 Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
1372 is not given.
1373
1374 =item unique_name ()
1375
1376 Returns the name of the last file stored on the server using the
1377 C<STOU> command.
1378
1379 =item mdtm ( FILE )
1380
1381 Returns the I<modification time> of the given file
1382
1383 =item size ( FILE )
1384
1385 Returns the size in bytes for the given file as stored on the remote server.
1386
1387 B<NOTE>: The size reported is the size of the stored file on the remote server.
1388 If the file is subsequently transfered from the server in ASCII mode
1389 and the remote server and local machine have different ideas about
1390 "End Of Line" then the size of file on the local machine after transfer
1391 may be different.
1392
1393 =item supported ( CMD )
1394
1395 Returns TRUE if the remote server supports the given command.
1396
1397 =item hash ( [FILEHANDLE_GLOB_REF],[ BYTES_PER_HASH_MARK] )
1398
1399 Called without parameters, or with the first argument false, hash marks
1400 are suppressed.  If the first argument is true but not a reference to a
1401 file handle glob, then \*STDERR is used.  The second argument is the number
1402 of bytes per hash mark printed, and defaults to 1024.  In all cases the
1403 return value is a reference to an array of two:  the filehandle glob reference
1404 and the bytes per hash mark.
1405
1406 =back
1407
1408 The following methods can return different results depending on
1409 how they are called. If the user explicitly calls either
1410 of the C<pasv> or C<port> methods then these methods will
1411 return a I<true> or I<false> value. If the user does not
1412 call either of these methods then the result will be a
1413 reference to a C<Net::FTP::dataconn> based object.
1414
1415 =over 4
1416
1417 =item nlst ( [ DIR ] )
1418
1419 Send a C<NLST> command to the server, with an optional parameter.
1420
1421 =item list ( [ DIR ] )
1422
1423 Same as C<nlst> but using the C<LIST> command
1424
1425 =item retr ( FILE )
1426
1427 Begin the retrieval of a file called C<FILE> from the remote server.
1428
1429 =item stor ( FILE )
1430
1431 Tell the server that you wish to store a file. C<FILE> is the
1432 name of the new file that should be created.
1433
1434 =item stou ( FILE )
1435
1436 Same as C<stor> but using the C<STOU> command. The name of the unique
1437 file which was created on the server will be available via the C<unique_name>
1438 method after the data connection has been closed.
1439
1440 =item appe ( FILE )
1441
1442 Tell the server that we want to append some data to the end of a file
1443 called C<FILE>. If this file does not exist then create it.
1444
1445 =back
1446
1447 If for some reason you want to have complete control over the data connection,
1448 this includes generating it and calling the C<response> method when required,
1449 then the user can use these methods to do so.
1450
1451 However calling these methods only affects the use of the methods above that
1452 can return a data connection. They have no effect on methods C<get>, C<put>,
1453 C<put_unique> and those that do not require data connections.
1454
1455 =over 4
1456
1457 =item port ( [ PORT ] )
1458
1459 Send a C<PORT> command to the server. If C<PORT> is specified then it is sent
1460 to the server. If not the a listen socket is created and the correct information
1461 sent to the server.
1462
1463 =item pasv ()
1464
1465 Tell the server to go into passive mode. Returns the text that represents the
1466 port on which the server is listening, this text is in a suitable form to
1467 sent to another ftp server using the C<port> method.
1468
1469 =back
1470
1471 The following methods can be used to transfer files between two remote
1472 servers, providing that these two servers can connect directly to each other.
1473
1474 =over 4
1475
1476 =item pasv_xfer ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
1477
1478 This method will do a file transfer between two remote ftp servers. If
1479 C<DEST_FILE> is omitted then the leaf name of C<SRC_FILE> will be used.
1480
1481 =item pasv_xfer_unique ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
1482
1483 Like C<pasv_xfer> but the file is stored on the remote server using
1484 the STOU command.
1485
1486 =item pasv_wait ( NON_PASV_SERVER )
1487
1488 This method can be used to wait for a transfer to complete between a passive
1489 server and a non-passive server. The method should be called on the passive
1490 server with the C<Net::FTP> object for the non-passive server passed as an
1491 argument.
1492
1493 =item abort ()
1494
1495 Abort the current data transfer.
1496
1497 =item quit ()
1498
1499 Send the QUIT command to the remote FTP server and close the socket connection.
1500
1501 =back
1502
1503 =head2 Methods for the adventurous
1504
1505 C<Net::FTP> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
1506 be used to send commands to the remote FTP server.
1507
1508 =over 4
1509
1510 =item quot (CMD [,ARGS])
1511
1512 Send a command, that Net::FTP does not directly support, to the remote
1513 server and wait for a response.
1514
1515 Returns most significant digit of the response code.
1516
1517 B<WARNING> This call should only be used on commands that do not require
1518 data connections. Misuse of this method can hang the connection.
1519
1520 =back
1521
1522 =head1 THE dataconn CLASS
1523
1524 Some of the methods defined in C<Net::FTP> return an object which will
1525 be derived from this class.The dataconn class itself is derived from
1526 the C<IO::Socket::INET> class, so any normal IO operations can be performed.
1527 However the following methods are defined in the dataconn class and IO should
1528 be performed using these.
1529
1530 =over 4
1531
1532 =item read ( BUFFER, SIZE [, TIMEOUT ] )
1533
1534 Read C<SIZE> bytes of data from the server and place it into C<BUFFER>, also
1535 performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
1536 given the the timeout value from the command connection will be used.
1537
1538 Returns the number of bytes read before any <CRLF> translation.
1539
1540 =item write ( BUFFER, SIZE [, TIMEOUT ] )
1541
1542 Write C<SIZE> bytes of data from C<BUFFER> to the server, also
1543 performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
1544 given the the timeout value from the command connection will be used.
1545
1546 Returns the number of bytes written before any <CRLF> translation.
1547
1548 =item abort ()
1549
1550 Abort the current data transfer.
1551
1552 =item close ()
1553
1554 Close the data connection and get a response from the FTP server. Returns
1555 I<true> if the connection was closed successfully and the first digit of
1556 the response from the server was a '2'.
1557
1558 =back
1559
1560 =head1 UNIMPLEMENTED
1561
1562 The following RFC959 commands have not been implemented:
1563
1564 =over 4
1565
1566 =item B<ALLO>
1567
1568 Allocates storage for the file to be transferred.
1569
1570 =item B<SMNT>
1571
1572 Mount a different file system structure without changing login or
1573 accounting information.
1574
1575 =item B<HELP>
1576
1577 Ask the server for "helpful information" (that's what the RFC says) on
1578 the commands it accepts.
1579
1580 =item B<MODE>
1581
1582 Specifies transfer mode (stream, block or compressed) for file to be
1583 transferred.
1584
1585 =item B<SYST>
1586
1587 Request remote server system identification.
1588
1589 =item B<STAT>
1590
1591 Request remote server status.
1592
1593 =item B<STRU>
1594
1595 Specifies file structure for file to be transferred.
1596
1597 =item B<REIN>
1598
1599 Reinitialize the connection, flushing all I/O and account information.
1600
1601 =back
1602
1603 =head1 REPORTING BUGS
1604
1605 When reporting bugs/problems please include as much information as possible.
1606 It may be difficult for me to reproduce the problem as almost every setup
1607 is different.
1608
1609 A small script which yields the problem will probably be of help. It would
1610 also be useful if this script was run with the extra options C<Debug => 1>
1611 passed to the constructor, and the output sent with the bug report. If you
1612 cannot include a small script then please include a Debug trace from a
1613 run of your program which does yield the problem.
1614
1615 =head1 AUTHOR
1616
1617 Graham Barr <gbarr@pobox.com>
1618
1619 =head1 SEE ALSO
1620
1621 L<Net::Netrc>
1622 L<Net::Cmd>
1623
1624 ftp(1), ftpd(8), RFC 959
1625 http://www.cis.ohio-state.edu/htbin/rfc/rfc959.html
1626
1627 =head1 CREDITS
1628
1629 Henry Gabryjelski <henryg@WPI.EDU> - for the suggestion of creating directories
1630 recursively.
1631
1632 Nathan Torkington <gnat@frii.com> - for some input on the documentation.
1633
1634 Roderick Schertler <roderick@gate.net> - for various inputs
1635
1636 =head1 COPYRIGHT
1637
1638 Copyright (c) 1995-1998 Graham Barr. All rights reserved.
1639 This program is free software; you can redistribute it and/or modify it
1640 under the same terms as Perl itself.
1641
1642 =cut