lib/Net/FTP.pm

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