view release on metacpan or  search on metacpan

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 || "");

 $ok = $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 undef
	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);