Net::FTP

- Fixed return vlue of _ACCT

Net::Cmd
- Fixed datasend to ensure all data is sent
- Fixed a || bug in getline

Some FAQ updates

3 files changed, 49 insertions, 7 deletions

diff --git a/FAQ b/FAQ
index 1ddd59b..bc40634 100644
--- a/FAQ
+++ b/FAQ
@@ -182,6 +182,23 @@ must be taken, eg
     $ftp->login($firewall_user, $firewall_passwd) or die $ftp->message;
     $ftp->login($ext_user . '@' . $ext_host, $ext_passwd) or die $ftp->message.
 
+=head2 My fto proxy firewall does not listen on port 21
+
+FTP servers usually listen on the same port number, port 21, as any other
+FTP server. But there is no reason why thi has to be the case.
+
+If you pass a port number to Net::FTP then it assumes this is the port
+number of the final destination. By default Net::FTP will always try
+to connect to the firewall on port 21.
+
+Net::FTP uses IO::Socket to open the connection and IO::Socket allows
+the port number to be specified as part of the hostname. So this problem
+can be resolved by either passing a Firewall option like C<"hostname:1234">
+or by setting the C<ftp_firewall> option in Net::Config to be a string
+in in the same form.
+
+
+
 =head2 I have seen scripts call a method message, but cannot find it documented ?
 
 Net::FTP, like several other packages in libnet, inherits from Net::Cmd, so
diff --git a/Net/Cmd.pm b/Net/Cmd.pm
index ab10482..8e414ef 100644
--- a/Net/Cmd.pm
+++ b/Net/Cmd.pm
@@ -209,7 +209,8 @@ sub getline
  return shift @{${*$cmd}{'net_cmd_lines'}}
     if scalar(@{${*$cmd}{'net_cmd_lines'}});
 
- my $partial = ${*$cmd}{'net_cmd_partial'} || "";
+ my $partial = defined(${*$cmd}{'net_cmd_partial'})
+                ? ${*$cmd}{'net_cmd_partial'} : || "";
  my $fd = fileno($cmd);
  
  return undef
@@ -228,7 +229,7 @@ sub getline
     {
      unless (sysread($cmd, $buf="", 1024))
       {
-       carp ref($cmd) . ": Unexpected EOF on command channel"
+       carp(ref($cmd) . ": Unexpected EOF on command channel")
                 if $cmd->debug;
        $cmd->close;
        return undef;
@@ -249,7 +250,7 @@ sub getline
     }
    else
     {
-     carp "$cmd: Timeout" if($cmd->debug);
+     carp("$cmd: Timeout") if($cmd->debug);
      return undef;
     }
   }
@@ -355,9 +356,33 @@ sub datasend
  ${*$cmd}{'net_cmd_lastch'} = substr($line,-1,1);
 
  my $len = length($line) - 1;
+ my $offset = 1;
+ my $win = "";
+ vec($win,$fd,1) = 1;
+ my $timeout = $cmd->timeout || undef;
 
- return $len == 0 ||
-        syswrite($cmd, $line, $len, 1) == $len;
+ while($len)
+  {
+   my $wout;
+   if (select(undef,$wout=$win, undef, $timeout) > 0)
+    {
+     my $w = syswrite($cmd, $line, $len, $offset);
+     unless (defined($w))
+      {
+       carp("$cmd: $!") if $cmd->debug;
+       return undef;
+      }
+     $len -= $w;
+     $offset += $w;
+    }
+   else
+    {
+     carp("$cmd: Timeout") if($cmd->debug);
+     return undef;
+    }
+  }
+
+ 1;
 }
 
 sub dataend
diff --git a/Net/FTP.pm b/Net/FTP.pm
index 13216ec..64d79be 100644
--- a/Net/FTP.pm
+++ b/Net/FTP.pm
@@ -21,7 +21,7 @@ use Net::Cmd;
 use Net::Config;
 # use AutoLoader qw(AUTOLOAD);
 
-$VERSION = "2.48"; # $Id: //depot/libnet/Net/FTP.pm#33 $
+$VERSION = "2.49"; # $Id: //depot/libnet/Net/FTP.pm#34 $
 @ISA     = qw(Exporter Net::Cmd IO::Socket::INET);
 
 # Someday I will "use constant", when I am not bothered to much about
@@ -995,7 +995,6 @@ 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 _ACCT { shift->command("ACCT",@_)->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 }
@@ -1011,6 +1010,7 @@ sub _RNFR { shift->command("RNFR",@_)->response() == CMD_MORE }
 sub _REST { shift->command("REST",@_)->response() == CMD_MORE }
 sub _USER { shift->command("user",@_)->response() } # A certain brain dead firewall :-)
 sub _PASS { shift->command("PASS",@_)->response() }
+sub _ACCT { shift->command("ACCT",@_)->response() }
 sub _AUTH { shift->command("AUTH",@_)->response() }
 
 sub _ALLO { shift->unsupported(@_) }