summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Net/FTP.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Net/FTP.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Net/FTP.pm98
1 files changed, 65 insertions, 33 deletions
diff --git a/Master/tlpkg/tlperl/lib/Net/FTP.pm b/Master/tlpkg/tlperl/lib/Net/FTP.pm
index 9ed6d385d9c..8107ef77e65 100644
--- a/Master/tlpkg/tlperl/lib/Net/FTP.pm
+++ b/Master/tlpkg/tlperl/lib/Net/FTP.pm
@@ -21,11 +21,11 @@ use Net::Cmd;
use Net::Config;
use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC);
-$VERSION = '2.77';
+$VERSION = '2.79';
@ISA = qw(Exporter Net::Cmd IO::Socket::INET);
# Someday I will "use constant", when I am not bothered to much about
-# compatability with older releases of perl
+# compatibility with older releases of perl
use vars qw($TELNET_IAC $TELNET_IP $TELNET_DM);
($TELNET_IAC, $TELNET_IP, $TELNET_DM) = (255, 244, 242);
@@ -107,7 +107,8 @@ sub new {
unless ($ftp->response() == CMD_OK) {
$ftp->close();
- $@ = $ftp->message;
+ # keep @$ if no message. Happens, when response did not start with a code.
+ $@ = $ftp->message || $@;
undef $ftp;
}
@@ -124,6 +125,12 @@ sub host {
${*$me}{'net_ftp_host'};
}
+sub passive {
+ my $ftp = shift;
+ return ${*$ftp}{'net_ftp_passive'} unless @_;
+ ${*$ftp}{'net_ftp_passive'} = shift;
+}
+
sub hash {
my $ftp = shift; # self
@@ -583,6 +590,9 @@ sub rmdir {
return undef
unless @filelist; # failed, it is probably not a directory
+ return $ftp->delete($dir)
+ if @filelist == 1 and $dir eq $filelist[0];
+
# Go thru and delete each file or the directory
my $file;
foreach $file (map { m,/, ? $_ : "$dir/$_" } @filelist) {
@@ -688,7 +698,7 @@ sub _store_cmd {
my $localfd = ref($local) || ref(\$local) eq "GLOB";
- unless (defined $remote) {
+ if (!defined($remote) and 'STOU' ne uc($cmd)) {
croak 'Must specify remote filename with stream input'
if $localfd;
@@ -705,10 +715,10 @@ sub _store_cmd {
# 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;
+ ${*$ftp}{'net_ftp_allo'} = $size if $size;
}
croak("Bad remote filename '$remote'\n")
- if $remote =~ /[\r\n]/s;
+ if defined($remote) and $remote =~ /[\r\n]/s;
if ($localfd) {
$loc = $local;
@@ -730,10 +740,10 @@ sub _store_cmd {
delete ${*$ftp}{'net_ftp_port'};
delete ${*$ftp}{'net_ftp_pasv'};
- $sock = $ftp->_data_cmd($cmd, $remote)
+ $sock = $ftp->_data_cmd($cmd, grep { defined } $remote)
or return undef;
- $remote = ($ftp->message =~ /FILE:\s*(.*)/)[0]
+ $remote = ($ftp->message =~ /\w+\s*:\s*(.*)/)[0]
if 'STOU' eq uc $cmd;
my $blksize = ${*$ftp}{'net_ftp_blksize'};
@@ -852,6 +862,9 @@ sub supported {
return $hash->{$cmd}
if exists $hash->{$cmd};
+ return $hash->{$cmd} = 1
+ if $ftp->feature($cmd);
+
return $hash->{$cmd} = 0
unless $ftp->_HELP($cmd);
@@ -930,7 +943,8 @@ sub _dataconn {
PeerAddr => join(".", @port[0 .. 3]),
PeerPort => $port[4] * 256 + $port[5],
LocalAddr => ${*$ftp}{'net_ftp_localaddr'},
- Proto => 'tcp'
+ Proto => 'tcp',
+ Timeout => $ftp->timeout
);
}
elsif (defined ${*$ftp}{'net_ftp_listen'}) {
@@ -1005,22 +1019,24 @@ sub _data_cmd {
{
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 unless defined $ftp->pasv;
+ $data = $ftp->_dataconn() or return undef;
+
+ if ($where and !$ftp->_REST($where)) {
+ my ($status, $message) = ($ftp->status, $ftp->message);
+ $ftp->abort;
+ $ftp->set_status($status, $message);
+ return undef;
+ }
+
+ $ftp->command($cmd, @_);
+ if (CMD_INFO == $ftp->response()) {
+ $data->reading
+ if $cmd =~ /RETR|LIST|NLST/;
+ return $data;
}
+ $data->_close;
+
return undef;
}
@@ -1034,6 +1050,11 @@ sub _data_cmd {
return undef
unless $ok;
+ if ($cmd =~ /(STOR|APPE|STOU)/ and exists ${*$ftp}{net_ftp_allo}) {
+ $ftp->_ALLO(delete ${*$ftp}{net_ftp_allo})
+ or return undef;
+ }
+
$ftp->command($cmd, @_);
return 1
@@ -1077,7 +1098,7 @@ sub command {
sub response {
my $ftp = shift;
- my $code = $ftp->SUPER::response();
+ my $code = $ftp->SUPER::response() || 5; # assume 500 if undef
delete ${*$ftp}{'net_ftp_pasv'}
if ($code != CMD_MORE && $code != CMD_INFO);
@@ -1093,8 +1114,9 @@ sub parse_response {
my $ftp = shift;
# Darn MS FTP server is a load of CRAP !!!!
+ # Expect to see undef here.
return ()
- unless ${*$ftp}{'net_cmd_code'} + 0;
+ unless 0 + (${*$ftp}{'net_cmd_code'} || 0);
(${*$ftp}{'net_cmd_code'}, 1);
}
@@ -1145,8 +1167,11 @@ sub pasv_wait {
vec($rin = '', fileno($ftp), 1) = 1;
select($rout = $rin, undef, undef, undef);
- $ftp->response();
- $non_pasv->response();
+ my $dres = $ftp->response();
+ my $sres = $non_pasv->response();
+
+ return undef
+ unless $dres == CMD_OK && $sres == CMD_OK;
return undef
unless $ftp->ok() && $non_pasv->ok();
@@ -1276,6 +1301,8 @@ C<Net::FTP> is a class implementing a simple FTP client in Perl as
described in RFC959. It provides wrappers for a subset of the RFC959
commands.
+The Net::FTP class is a subclass of Net::Cmd and IO::Socket::INET.
+
=head1 OVERVIEW
FTP stands for File Transfer Protocol. It is a way of transferring
@@ -1344,7 +1371,7 @@ transfers. (defaults to 10240)
B<Port> - The port number to connect to on the remote machine for the
FTP connection
-B<Timeout> - Set a timeout value (defaults to 120)
+B<Timeout> - Set a timeout value in seconds (defaults to 120)
B<Debug> - debug level (see the debug method in L<Net::Cmd>)
@@ -1382,6 +1409,10 @@ value, with I<true> meaning that the operation was a success. When a method
states that it returns a value, failure will be returned as I<undef> or an
empty list.
+C<Net::FTP> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
+be used to send commands to the remote FTP server in addition to the methods
+documented here.
+
=over 4
=item login ([LOGIN [,PASSWORD [, ACCOUNT] ] ])
@@ -1439,6 +1470,10 @@ to change the directory to the root directory.
Change directory to the parent of the current directory.
+=item passive ( [ PASSIVE ] )
+
+Set or get if data connections will be initiated in passive mode.
+
=item pwd ()
Returns the full pathname of the current directory.
@@ -1676,9 +1711,6 @@ Send the QUIT command to the remote FTP server and close the socket connection.
=head2 Methods for the adventurous
-C<Net::FTP> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
-be used to send commands to the remote FTP server.
-
=over 4
=item quot (CMD [,ARGS])
@@ -1796,7 +1828,7 @@ L<Net::Netrc>
L<Net::Cmd>
ftp(1), ftpd(8), RFC 959
-http://www.cis.ohio-state.edu/htbin/rfc/rfc959.html
+http://www.ietf.org/rfc/rfc959.txt
=head1 USE EXAMPLES