| Subject: | Net::Lite FTP hangs when trying to retrieve a file which isn't there |
Thank you very much for this module!
There is a bug I am finding when using Net-Lite-FTP-0.33 on Fedora Core
2 2.6.10-1.771_FC2 and perl, v5.8.3 built for i386-linux-thread-multi.
I have created a patch to fix the bug and also to provide more
information in the return values of the get and put subs.
I want to use Net::Lite::FTP in an automated script for transfering
files to and from a remote server. When I call the 'get' function for a
file that does not exist on the server, instead of returning an error
message the script just hangs indefinitely. This is even though the FTPS
server does send back a response saying the file can't be retrieved.
This is an issue because sometimes an error (at the FTPS server end) can
occur between reading a directory and attempting to retrieve the file.
For example, sometimes the file is no longer there when the retrieve
command is sent. In those cases, I need to get an error message and for
my script to complete, rather than to just hang. I think the problem
occurs at line 321 which is part of getslurp and the return value of
'$self->command("RETR $remote");'is not checked.
Here is a script that encounters the error:
#!/usr/bin/perl -w
use strict;
use Net::Lite::FTP;
$"="\n";
my $tlsftp=Net::Lite::FTP->new();
print "Created Net::Lite:FTP object\n" if $tlsftp;
my $open = $tlsftp->open("172.21.0.21","21");
print "Result returned from open call is $open\n";
my $login = $tlsftp->login("maria","changed");
print "Result returned from login call is $login\n";
my $cwd=$tlsftp->cwd('outgoing');
print "Result returned from cwd call is $cwd\n";
my $files=$tlsftp->list;
print "Here is the directory listing:\n@$files\n";
my $result = $tlsftp->get('filenotthere');
print "Result returned from result call is $result\n";
my $quit = $tlsftp->quit();
print "Result returned from quit call is $quit\n";
and here is what I see when I run it:
Created Net::Lite:FTP object
OPEN.Received: 220 FTP service. Unauthorized access prohibited.
Activities will be monitored.
SRV Response: 220 FTP service. Unauthorized access prohibited.
Activities will be monitored.
RECV: 220 FTP service. Unauthorized access prohibited. Activities will
be monitored.
OPEN..Received: 220 FTP service. Unauthorized access prohibited.
Activities will be monitored.
Received: 234 Proceed with negotiation.
Sending: PBSZ 0
SRV Response: 200 PBSZ set to 0.
RECV: 200 PBSZ set to 0.
Sending: PROT P
SRV Response: 200 PROT now Private.
RECV: 200 PROT now Private.
Result returned from open call is 1
Sending: USER maria
SRV Response: 331 Please specify the password.
RECV: 331 Please specify the password.
Sending: PASS changed
SRV Response: 230 Login successful.
RECV: 230 Login successful.
Result returned from login call is 230 Login successful.
Sending: CWD outgoing
SRV Response: 250 Directory successfully changed.
RECV: 250 Directory successfully changed.
Result returned from cwd call is 250 Directory successfully changed.
Sending: PASV
SRV Response: 227 Entering Passive Mode (172,21,0,21,226,69)
RECV: 227 Entering Passive Mode (172,21,0,21,226,69)
Data link connected.. to 172.21.0.21 at 57925
Sending: NLST
SRV Response: 150 Here comes the directory listing.
RECV: 150 Here comes the directory listing.
SSL for data connection enabled...
SRV Response: 226 Directory send OK.
RECV: 226 Directory send OK.
resp(end LIST) 226 Directory send OK.
Here is the directory listing:
bigfile.txt
percentage.rrd
testfile
Sending: TYPE I
SRV Response: 200 Switching to Binary mode.
RECV: 200 Switching to Binary mode.
Sending: PASV
SRV Response: 227 Entering Passive Mode (172,21,0,21,220,236)
RECV: 227 Entering Passive Mode (172,21,0,21,220,236)
Data link connected.. to 172.21.0.21 at 56556
Sending: PROT P
SRV Response: 550 Permission denied.
Sending: RETR filenotthere
SRV Response: 550 Failed to open file.
and at this point it just hangs indefinitely...
I also find it very useful to get a return value from get or put which
tells me whether or not it was successful. The patch I have submitted
fixes the issue where the client used to hang indefinitely on a get
error, and also provides a return value which is true for success and
undef on fail.
| Subject: | Net_Lite_FTP_get_put_fix.diff |
--- FTP.orig.pm 2006-02-23 14:06:34.327586112 -0500
+++ FTP.new.pm 2006-02-24 10:56:45.389171432 -0500
@@ -260,41 +260,49 @@
sub putblat {
my ($putorblat,$self,$remote,$local)=@_;
+ $local=$remote unless defined($local);
+ unless (CORE::open(L,"$local")) {
+ print STDERR "couldn't open local file $local: $!\n";
+ return undef;
+ }
+ binmode L;
+ my $outcome;
my $socket;
my $sock=$self->{'Sock'};
- $local=$remote unless defined($local);
$self->command("TYPE I");
$socket=$self->datasocket();
die "SOCKET NOT CONNECTED! $!\n" unless defined($socket);
if ($self->{"EncryptData"}!=0) {$self->command("PROT P"); };
- $self->command("STOR $remote");
-
- if ($self->{"EncryptData"}==1) {
- {my $io=new IO::Handle; tie(*$io, "Net::SSLeay::Handle", $socket);$socket = \*$io;};
- print STDERR "SSL for data connection enabled...\n" if $self->{Debug};
- };
-
- print STDERR "STORE connection opened.\n" if $self->{Debug};
- select($socket);
-#print "selected.\n";
- if ($putorblat=~/put/) {
- CORE::open(L,"$local");binmode L;
- my $tmp;
- while ($tmp=<L>) {
- print $tmp;
- if (defined ($self->{'PutUpdateCallback'})) {$self->{'PutUpdateCallback'}->(); };#TODO send sth..
- };#Probably syswrite/sysread would be smarter..
- close L;
- } else {
- print $local;
+ if ($self->command("STOR $remote")) {
+ if ($self->{"EncryptData"}==1) {
+ {my $io=new IO::Handle; tie(*$io, "Net::SSLeay::Handle", $socket);$socket = \*$io;};
+ print STDERR "SSL for data connection enabled...\n" if $self->{Debug};
+ };
+
+ print STDERR "STORE connection opened.\n" if $self->{Debug};
+ select($socket);
+ #print "selected.\n";
+ if ($putorblat=~/put/) {
+ my $tmp;
+ while ($tmp=<L>) {
+ print $tmp;
+ if (defined ($self->{'PutUpdateCallback'})) {$self->{'PutUpdateCallback'}->(); };#TODO send sth..
+ };#Probably syswrite/sysread would be smarter..
+ close L;
+ } else {
+ print $local;
+
+ }
+ #print "after write...\n";
+ select(STDOUT);
+ close $socket;
+ my $response=$self->response();
+ $outcome = $response;
+ print STDERR "resp(afterSTOR) ",$response if $self->{Debug};
+ if (defined $self->{'PutDoneCallBack'}) {$self->{'PutDoneCallBack'}->($response);};
}
-#print "after write...\n";
- select(STDOUT);
- close $socket;
- my $response=$self->response();
- print STDERR "resp(afterSTOR) ",$response if $self->{Debug};
- if (defined $self->{'PutDoneCallBack'}) {$self->{'PutDoneCallBack'}->($response);};
+ return $outcome;
};
sub put {
putblat('put',@_);
@@ -311,42 +319,45 @@
sub getslurp {
my ($getorslurp,$self,$remote,$local)=@_;
+ my $outcome;
my $socket;
my $sock=$self->{'Sock'};
$local=$remote unless defined($local);
$self->command("TYPE I");
$socket=$self->datasocket();
if ($self->{"EncryptData"}!=0) {$self->command("PROT P"); };
- $self->command("RETR $remote");
- if ($self->{"EncryptData"}==1) {
- {my $io=new IO::Handle; tie(*$io, "Net::SSLeay::Handle", $socket);$socket = \*$io;};
- print STDERR "SSL for data connection(RETR) enabled...\n" if $self->{Debug};
- };
- my $slurped="";
- if ($getorslurp=~/get/) {
- print STDERR "getorslurp: get\n" if $self->{Debug};
- CORE::open(L,">$local");binmode L;
- # TODO replace while <$socket> with
- # TODO while sysread($sock,$tmp,BUFSIZE);
- my $tmp;
- while ($tmp=<$socket>) {
- print L $tmp; print STDERR ":;" if $self->{Debug};
- if (defined ($self->{'GetUpdateCallback'})) {$self->{'GetUpdateCallback'}->(); };#TODO send sth..
- };
- close L;
- } else {
- print STDERR "getorslurp: slurp($getorslurp)\n" if $self->{Debug};
- my $tmp;
- while ($tmp=<$socket>) {
- $slurped.=$tmp;print STDERR ":." if $self->{Debug};
- if (defined ($self->{'GetUpdateCallback'})) {$self->{'GetUpdateCallback'}->(); };#TODO send sth..
- };
- };
- close $socket;
- my $response=$self->response();
- print STDERR "resp(afterRETR) ",$response if $self->{Debug};
- if (defined $self->{'GetDoneCallBack'}) {$self->{'GetDoneCallBack'}->($response);};
- return $slurped;
+ if ($self->command("RETR $remote")) {
+ if ($self->{"EncryptData"}==1) {
+ {my $io=new IO::Handle; tie(*$io, "Net::SSLeay::Handle", $socket);$socket = \*$io;};
+ print STDERR "SSL for data connection(RETR) enabled...\n" if $self->{Debug};
+ };
+ my $slurped="";
+ if ($getorslurp=~/get/) {
+ print STDERR "getorslurp: get\n" if $self->{Debug};
+ CORE::open(L,">$local");binmode L;
+ # TODO replace while <$socket> with
+ # TODO while sysread($sock,$tmp,BUFSIZE);
+ my $tmp;
+ while ($tmp=<$socket>) {
+ print L $tmp; print STDERR ":;" if $self->{Debug};
+ if (defined ($self->{'GetUpdateCallback'})) {$self->{'GetUpdateCallback'}->(); };#TODO send sth..
+ };
+ close L;
+ } else {
+ print STDERR "getorslurp: slurp($getorslurp)\n" if $self->{Debug};
+ my $tmp;
+ while ($tmp=<$socket>) {
+ $slurped.=$tmp;print STDERR ":." if $self->{Debug};
+ if (defined ($self->{'GetUpdateCallback'})) {$self->{'GetUpdateCallback'}->(); };#TODO send sth..
+ };
+ };
+ close $socket;
+ my $response=$self->response();
+ print STDERR "resp(afterRETR) ",$response if $self->{Debug};
+ $outcome = $response;
+ if (defined $self->{'GetDoneCallBack'}) {$self->{'GetDoneCallBack'}->($response);};
+ }
+ return $outcome;
};
sub datasocket {