view release on metacpan or  search on metacpan

inc/Net/FTP.pm  view on Meta::CPAN

        if ($fwtype == 3) {
          $ok = $ftp->command("SITE", ${*$ftp}{'net_ftp_host'})->response;
        }
        elsif ($fwtype == 4) {
          $ok = $ftp->command("OPEN", ${*$ftp}{'net_ftp_host'})->response;
        }

        return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
      }
    }
  }

  $ok = $ftp->_USER($user);

  # Some dumb firewalls don't prefix the connection messages
  $ok = $ftp->response()
    if ($ok == CMD_OK && $ftp->code == 220 && $user =~ /\@/);

  if ($ok == CMD_MORE) {
    unless (defined $pass) {
      require Net::Netrc;

      my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}, $ruser);

      ($ruser, $pass, $acct) = $rc->lpa()
        if ($rc);

      $pass = '-anonymous@'
        if (!defined $pass && (!defined($ruser) || $ruser =~ /^anonymous/o));
    }

    $ok = $ftp->_PASS($pass || "");
  }

  $ok = $ftp->_ACCT($acct)
    if (defined($acct) && ($ok == CMD_MORE || $ok == CMD_OK));

  if ($fwtype == 7 && $ok == CMD_OK && defined ${*$ftp}{'net_ftp_firewall'}) {
    my ($f, $auth, $resp) = _auth_id($ftp);
    $ftp->authorize($auth, $resp) if defined($resp);
  }

  $ok == CMD_OK;
}


sub account {
  @_ == 2 or croak 'usage: $ftp->account( ACCT )';
  my $ftp  = shift;
  my $acct = shift;
  $ftp->_ACCT($acct) == CMD_OK;
}


sub _auth_id {
  my ($ftp, $auth, $resp) = @_;

  unless (defined $resp) {
    require Net::Netrc;

    $auth ||= eval { (getpwuid($>))[0] } || $ENV{NAME};

    my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}, $auth)
      || Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});

    ($auth, $resp) = $rc->lpa()
      if ($rc);
  }
  ($ftp, $auth, $resp);
}


sub authorize {
  @_ >= 1 || @_ <= 3 or croak 'usage: $ftp->authorize( [AUTH [, RESP]])';

  my ($ftp, $auth, $resp) = &_auth_id;

  my $ok = $ftp->_AUTH($auth || "");

  return $ftp->_RESP($resp || "")
    if ($ok == CMD_MORE);

  $ok == CMD_OK;
}


sub rename {
  @_ == 3 or croak 'usage: $ftp->rename(FROM, TO)';

  my ($ftp, $from, $to) = @_;

  $ftp->_RNFR($from)
    && $ftp->_RNTO($to);
}


sub type {
  my $ftp    = shift;
  my $type   = shift;
  my $oldval = ${*$ftp}{'net_ftp_type'};

  return $oldval
    unless (defined $type);

  return
    unless ($ftp->_TYPE($type, @_));

  ${*$ftp}{'net_ftp_type'} = join(" ", $type, @_);

  $oldval;
}


sub alloc {
  my $ftp    = shift;
  my $size   = shift;
  my $oldval = ${*$ftp}{'net_ftp_allo'};

  return $oldval
    unless (defined $size);