[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/5.10.0/Net/ -> FTP.pm (source)

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


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1