my ($ftp, $where) = @_;  ${*$ftp}{'net_ftp_rest'} = $where;  return undef;}sub mkdir {  @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )';  my ($ftp, $dir, $recurse) = @_;  $ftp->_MKD($dir) || $recurse    or return undef;  my $path = $dir;  unless ($ftp->ok) {    my @path = split(m#(?=/+)#, $dir);    $path = "";    while (@path) {      $path .= shift @path;      $ftp->_MKD($path);      $path = $ftp->_extract_path($path);    }    # If the creation of the last element was not successful, see if we    # can cd to it, if so then return path    unless ($ftp->ok) {      my ($status, $message) = ($ftp->status, $ftp->message);      my $pwd = $ftp->pwd;      if ($pwd && $ftp->cwd($dir)) {        $path = $dir;        $ftp->cwd($pwd);      }      else {        undef $path;      }      $ftp->set_status($status, $message);    }  }  $path;}sub delete {  @_ == 2 || croak 'usage: $ftp->delete( FILENAME )';  $_[0]->_DELE($_[1]);}sub put        { shift->_store_cmd("stor", @_) }sub put_unique { shift->_store_cmd("stou", @_) }sub append     { shift->_store_cmd("appe", @_) }sub nlst { shift->_data_cmd("NLST", @_) }sub list { shift->_data_cmd("LIST", @_) }sub retr { shift->_data_cmd("RETR", @_) }sub stor { shift->_data_cmd("STOR", @_) }sub stou { shift->_data_cmd("STOU", @_) }sub appe { shift->_data_cmd("APPE", @_) }sub _store_cmd {  my ($ftp, $cmd, $local, $remote) = @_;  my ($loc, $sock, $len, $buf);  local *FD;  my $localfd = ref($local) || ref(\$local) eq "GLOB";  unless (defined $remote) {    croak 'Must specify remote filename with stream input'      if $localfd;    require File::Basename;    $remote = File::Basename::basename($local);  }  if (defined ${*$ftp}{'net_ftp_allo'}) {    delete ${*$ftp}{'net_ftp_allo'};  }  else {    # if the user hasn't already invoked the alloc method since the last    # _store_cmd call, figure out if the local file is a regular file(not    # a pipe, or device) and if so get the file size from stat, and send    # an ALLO command before sending the STOR, STOU, or APPE command.    my $size = do { local $^W; -f $local && -s _ };    # no ALLO if sending data from a pipe    $ftp->_ALLO($size) if $size;  }  croak("Bad remote filename '$remote'\n")    if $remote =~ /[\r\n]/s;  if ($localfd) {    $loc = $local;  }  else {    $loc = \*FD;    unless (sysopen($loc, $local, O_RDONLY)) {      carp "Cannot open Local file $local: $!\n";      return undef;    }  }  if ($ftp->type eq 'I' && !binmode($loc)) {    carp "Cannot binmode Local file $local: $!\n";    return undef;  }  delete ${*$ftp}{'net_ftp_port'};  delete ${*$ftp}{'net_ftp_pasv'};  $sock = $ftp->_data_cmd($cmd, $remote)    or return undef;  $remote = ($ftp->message =~ /FILE:\s*(.*)/)[0]    if 'STOU' eq uc $cmd;  my $blksize = ${*$ftp}{'net_ftp_blksize'};  my ($count, $hashh, $hashb, $ref) = (0);  ($hashh, $hashb) = @$ref    if ($ref = ${*$ftp}{'net_ftp_hash'});  while (1) {    last unless $len = read($loc, $buf = "", $blksize);    if (trEBCDIC && $ftp->type ne 'I') {      $buf = $ftp->toascii($buf);      $len = length($buf);    }    if ($hashh) {      $count += $len;      print $hashh "#" x (int($count / $hashb));      $count %= $hashb;    }    my $wlen;    unless (defined($wlen = $sock->write($buf, $len)) && $wlen == $len) {      $sock->abort;      close($loc)        unless $localfd;      print $hashh "\n" if $hashh;      return undef;    }  }  print $hashh "\n" if $hashh;  close($loc)    unless $localfd;  $sock->close()    or return undef;  if ('STOU' eq uc $cmd and $ftp->message =~ m/unique\s+file\s*name\s*:\s*(.*)\)|"(.*)"/) {    require File::Basename;    $remote = File::Basename::basename($+);  }  return $remote;}sub port {  @_ == 1 || @_ == 2 or croak 'usage: $ftp->port([PORT])';  my ($ftp, $port) = @_;  my $ok;  delete ${*$ftp}{'net_ftp_intern_port'};  unless (defined $port) {    # create a Listen socket at same address as the command socket    ${*$ftp}{'net_ftp_listen'} ||= IO::Socket::INET->new(      Listen    => 5,      Proto     => 'tcp',      Timeout   => $ftp->timeout,      LocalAddr => $ftp->sockhost,    );    my $listen = ${*$ftp}{'net_ftp_listen'};    my ($myport, @myaddr) = ($listen->sockport, split(/\./, $listen->sockhost));    $port = join(',', @myaddr, $myport >> 8, $myport & 0xff);    ${*$ftp}{'net_ftp_intern_port'} = 1;  }  $ok = $ftp->_PORT($port);  ${*$ftp}{'net_ftp_port'} = $port;  $ok;}sub ls  { shift->_list_cmd("NLST", @_); }sub dir { shift->_list_cmd("LIST", @_); }sub pasv {  @_ == 1 or croak 'usage: $ftp->pasv()';  my $ftp = shift;  delete ${*$ftp}{'net_ftp_intern_port'};  $ftp->_PASV && $ftp->message =~ /(\d+(,\d+)+)/    ? ${*$ftp}{'net_ftp_pasv'} = $1    : undef;}sub unique_name {  my $ftp = shift;  ${*$ftp}{'net_ftp_unique'} || undef;}sub supported {  @_ == 2 or croak 'usage: $ftp->supported( CMD )';  my $ftp  = shift;  my $cmd  = uc shift;  my $hash = ${*$ftp}{'net_ftp_supported'} ||= {};  return $hash->{$cmd}    if exists $hash->{$cmd};  return $hash->{$cmd} = 0    unless $ftp->_HELP($cmd);  my $text = $ftp->message;  if ($text =~ /following\s+commands/i) {    $text =~ s/^.*\n//;    while ($text =~ /(\*?)(\w+)(\*?)/sg) {      $hash->{"\U$2"} = !length("$1$3");    }  }  else {    $hash->{$cmd} = $text !~ /unimplemented/i;  }  $hash->{$cmd} ||= 0;}#### Deprecated methods##sub lsl {  carp "Use of Net::FTP::lsl deprecated, use 'dir'"    if $^W;  goto &dir;}sub authorise {  carp "Use of Net::FTP::authorise deprecated, use 'authorize'"    if $^W;  goto &authorize;}#### Private methods##sub _extract_path {  my ($ftp, $path) = @_;  # This tries to work both with and without the quote doubling  # convention (RFC 959 requires it, but the first 3 servers I checked  # didn't implement it).  It will fail on a server which uses a quote in  # the message which isn't a part of or surrounding the path.  $ftp->ok    && $ftp->message =~ /(?:^|\s)\"(.*)\"(?:$|\s)/    && ($path = $1) =~ s/\"\"/\"/g;  $path;}#### Communication methods##sub _dataconn {  my $ftp  = shift;  my $data = undef;  my $pkg  = "Net::FTP::" . $ftp->type;  eval "require " . $pkg;  $pkg =~ s/ /_/g;  delete ${*$ftp}{'net_ftp_dataconn'};  if (defined ${*$ftp}{'net_ftp_pasv'}) {    my @port = map { 0 + $_ } split(/,/, ${*$ftp}{'net_ftp_pasv'});    $data = $pkg->new(      PeerAddr  => join(".", @port[0 .. 3]),      PeerPort  => $port[4] * 256 + $port[5],      LocalAddr => ${*$ftp}{'net_ftp_localaddr'},      Proto     => 'tcp'    );  }  elsif (defined ${*$ftp}{'net_ftp_listen'}) {    $data = ${*$ftp}{'net_ftp_listen'}->accept($pkg);    close(delete ${*$ftp}{'net_ftp_listen'});  }  if ($data) {    ${*$data} = "";    $data->timeout($ftp->timeout);    ${*$ftp}{'net_ftp_dataconn'} = $data;    ${*$data}{'net_ftp_cmd'}     = $ftp;    ${*$data}{'net_ftp_blksize'} = ${*$ftp}{'net_ftp_blksize'};  }  $data;}sub _list_cmd {  my $ftp = shift;  my $cmd = uc shift;  delete ${*$ftp}{'net_ftp_port'};  delete ${*$ftp}{'net_ftp_pasv'};  my $data = $ftp->_data_cmd($cmd, @_);  return    unless (defined $data);  require Net::FTP::A;  bless $data, "Net::FTP::A";    # Force ASCII mode  my $databuf = '';  my $buf     = '';  my $blksize = ${*$ftp}{'net_ftp_blksize'};  while ($data->read($databuf, $blksize)) {    $buf .= $databuf;  }  my $list = [split(/\n/, $buf)];  $data->close();  if (trEBCDIC) {    for (@$list) { $_ = $ftp->toebcdic($_) }  }  wantarray    ? @{$list}    : $list;}sub _data_cmd {  my $ftp   = shift;  my $cmd   = uc shift;  my $ok    = 1;  my $where = delete ${*$ftp}{'net_ftp_rest'} || 0;  my $arg;  for $arg (@_) {    croak("Bad argument '$arg'\n")      if $arg =~ /[\r\n]/s;  }  if ( ${*$ftp}{'net_ftp_passive'}    && !defined ${*$ftp}{'net_ftp_pasv'}    && !defined ${*$ftp}{'net_ftp_port'})  {    my $data = undef;    $ok = defined $ftp->pasv;    $ok = $ftp->_REST($where)      if $ok && $where;    if ($ok) {      $ftp->command($cmd, @_);      $data = $ftp->_dataconn();      $ok   = CMD_INFO == $ftp->response();      if ($ok) {        $data->reading          if $data && $cmd =~ /RETR|LIST|NLST/;        return $data;      }      $data->_close        if $data;    }    return undef;  }  $ok = $ftp->port    unless (defined ${*$ftp}{'net_ftp_port'}    || defined ${*$ftp}{'net_ftp_pasv'});  $ok = $ftp->_REST($where)    if $ok && $where;  return undef    unless $ok;  $ftp->command($cmd, @_);  return 1    if (defined ${*$ftp}{'net_ftp_pasv'});  $ok = CMD_INFO == $ftp->response();  return $ok    unless exists ${*$ftp}{'net_ftp_intern_port'};  if ($ok) {    my $data = $ftp->_dataconn();    $data->reading      if $data && $cmd =~ /RETR|LIST|NLST/;    return $data;  }  close(delete ${*$ftp}{'net_ftp_listen'});  return undef;}#### Over-ride methods (Net::Cmd)##sub debug_text { $_[2] =~ /^(pass|resp|acct)/i ? "$1 ....\n" : $_[2]; }sub command {  my $ftp = shift;  delete ${*$ftp}{'net_ftp_port'};  $ftp->SUPER::command(@_);}sub response {  my $ftp  = shift;  my $code = $ftp->SUPER::response();  delete ${*$ftp}{'net_ftp_pasv'}    if ($code != CMD_MORE && $code != CMD_INFO);  $code;}sub parse_response {  return ($1, $2 eq "-")    if $_[1] =~ s/^(\d\d\d)([- ]?)//o;  my $ftp = shift;  # Darn MS FTP server is a load of CRAP !!!!  return ()    unless ${*$ftp}{'net_cmd_code'} + 0;  (${*$ftp}{'net_cmd_code'}, 1);}#### Allow 2 servers to talk directly##sub pasv_xfer_unique {  my ($sftp, $sfile, $dftp, $dfile) = @_;  $sftp->pasv_xfer($sfile, $dftp, $dfile, 1);}sub pasv_xfer {  my ($sftp, $sfile, $dftp, $dfile, $unique) = @_;  ($dfile = $sfile) =~ s#.*/##    unless (defined $dfile);  my $port = $sftp->pasv    or return undef;  $dftp->port($port)    or return undef;  return undef    unless ($unique ? $dftp->stou($dfile) : $dftp->stor($dfile));  unless ($sftp->retr($sfile) && $sftp->response == CMD_INFO) {    $sftp->retr($sfile);    $dftp->abort;    $dftp->response();    return undef;  }  $dftp->pasv_wait($sftp);}sub pasv_wait {  @_ == 2 or croak 'usage: $ftp->pasv_wait(NON_PASV_FTP)';  my ($ftp, $non_pasv) = @_;  my ($file, $rin, $rout);  vec($rin = '', fileno($ftp), 1) = 1;  select($rout = $rin, undef, undef, undef);  $ftp->response();  $non_pasv->response();  return undef    unless $ftp->ok() && $non_pasv->ok();  return $1    if $ftp->message =~ /unique file name:\s*(\S*)\s*\)/;  return $1    if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/;  return 1;}sub feature {  @_ == 2 or croak 'usage: $ftp->feature( NAME )';  my ($ftp, $feat) = @_;  my $feature = ${*$ftp}{net_ftp_feature} ||= do {    my @feat;    # Example response    # 211-Features:    #  MDTM    #  REST STREAM    #  SIZE    # 211 End    @feat = map { /^\s+(.*\S)/ } $ftp->message      if $ftp->_FEAT;    \@feat;  };  return grep { /^\Q$feat\E\b/i } @$feature;}sub cmd { shift->command(@_)->response() }########################################## RFC959 commands#sub _ABOR { shift->command("ABOR")->response() == CMD_OK }sub _ALLO { shift->command("ALLO", @_)->response() == CMD_OK }sub _CDUP { shift->command("CDUP")->response() == CMD_OK }sub _NOOP { shift->command("NOOP")->response() == CMD_OK }sub _PASV { shift->command("PASV")->response() == CMD_OK }sub _QUIT { shift->command("QUIT")->response() == CMD_OK }sub _DELE { shift->command("DELE", @_)->response() == CMD_OK }sub _CWD  { shift->command("CWD", @_)->response() == CMD_OK }sub _PORT { shift->command("PORT", @_)->response() == CMD_OK }sub _RMD  { shift->command("RMD", @_)->response() == CMD_OK }sub _MKD  { shift->command("MKD", @_)->response() == CMD_OK }sub _PWD  { shift->command("PWD", @_)->response() == CMD_OK }sub _TYPE { shift->command("TYPE", @_)->response() == CMD_OK }sub _RNTO { shift->command("RNTO", @_)->response() == CMD_OK }sub _RESP { shift->command("RESP", @_)->response() == CMD_OK }sub _MDTM { shift->command("MDTM", @_)->response() == CMD_OK }sub _SIZE { shift->command("SIZE", @_)->response() == CMD_OK }sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }sub _STAT { shift->command("STAT", @_)->response() == CMD_OK }sub _FEAT { shift->command("FEAT", @_)->response() == CMD_OK }sub _APPE { shift->command("APPE", @_)->response() == CMD_INFO }sub _LIST { shift->command("LIST", @_)->response() == CMD_INFO }sub _NLST { shift->command("NLST", @_)->response() == CMD_INFO }sub _RETR { shift->command("RETR", @_)->response() == CMD_INFO }sub _STOR { shift->command("STOR", @_)->response() == CMD_INFO }