Upgrade libnet from version 3.07 to 3.08

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 16b7770..44319ba 100755 (executable)
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -675,7 +675,7 @@ use File::Glob qw(:case);
     },
 
     'libnet' => {
     },
 
     'libnet' => {

-        'DISTRIBUTION' => 'SHAY/libnet-3.07.tar.gz',
+        'DISTRIBUTION' => 'SHAY/libnet-3.08.tar.gz',

         'FILES'        => q[cpan/libnet],
         'EXCLUDED'     => [
             qw( Configure
         'FILES'        => q[cpan/libnet],
         'EXCLUDED'     => [
             qw( Configure

diff --git a/cpan/libnet/Makefile.PL b/cpan/libnet/Makefile.PL
index 872eac8..64d6959 100644 (file)
--- a/cpan/libnet/Makefile.PL
+++ b/cpan/libnet/Makefile.PL
@@ -66,7 +66,7 @@ MAIN: {
         ABSTRACT => 'Collection of network protocol modules',
         AUTHOR   => 'Graham Barr <gbarr@pobox.com>, Steve Hay <shay@cpan.org>',
         LICENSE  => 'perl_5',
         ABSTRACT => 'Collection of network protocol modules',
         AUTHOR   => 'Graham Barr <gbarr@pobox.com>, Steve Hay <shay@cpan.org>',
         LICENSE  => 'perl_5',

-        VERSION  => '3.07',
+        VERSION  => '3.08',

 
         META_MERGE => {
             'meta-spec' => {
 
         META_MERGE => {
             'meta-spec' => {


@@ -210,7 +210,7 @@ MAIN: {
             'vars'           => '0'
         },
 
             'vars'           => '0'
         },
 

-        INSTALLDIRS => ($] >= 5.008 && $] < 5.011) ? 'perl' : 'site',
+        INSTALLDIRS => ($] < 5.011 ? 'perl' : 'site'),

 
         realclean => {
             FILES => $CfgFile
 
         realclean => {
             FILES => $CfgFile

diff --git a/cpan/libnet/lib/Net/Cmd.pm b/cpan/libnet/lib/Net/Cmd.pm
index 3bf5ec6..2242600 100644 (file)
--- a/cpan/libnet/lib/Net/Cmd.pm
+++ b/cpan/libnet/lib/Net/Cmd.pm
@@ -18,6 +18,7 @@ use warnings;
 use Carp;
 use Exporter;
 use Symbol 'gensym';
 use Carp;
 use Exporter;
 use Symbol 'gensym';

+use Errno 'EINTR';

 
 BEGIN {
   if ($^O eq 'os390') {
 
 BEGIN {
   if ($^O eq 'os390') {


@@ -27,7 +28,7 @@ BEGIN {
   }
 }
 
   }
 }
 

-our $VERSION = "3.07";
+our $VERSION = "3.08";

 our @ISA     = qw(Exporter);
 our @EXPORT  = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
 
 our @ISA     = qw(Exporter);
 our @EXPORT  = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
 


@@ -189,7 +190,57 @@ sub set_status {
   1;
 }
 
   1;
 }
 

+sub _syswrite_with_timeout {
+  my $cmd = shift;
+  my $line = shift;

 
 

+  my $len    = length($line);
+  my $offset = 0;
+  my $win    = "";
+  vec($win, fileno($cmd), 1) = 1;
+  my $timeout = $cmd->timeout || undef;
+  my $initial = time;
+  my $pending = $timeout;
+
+  local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
+
+  while ($len) {
+    my $wout;
+    my $nfound = select(undef, $wout = $win, undef, $pending);
+    if ((defined $nfound and $nfound > 0) or -f $cmd)    # -f for testing on win32
+    {
+      my $w = syswrite($cmd, $line, $len, $offset);
+      if (! defined($w) ) {
+        my $err = $!;
+        $cmd->close;
+        $cmd->_set_status_closed($err);
+        return;
+      }
+      $len -= $w;
+      $offset += $w;
+    }
+    elsif ($nfound == -1) {
+      if ( $! == EINTR ) {
+        if ( defined($timeout) ) {
+          redo if ($pending = $timeout - ( time - $initial ) ) > 0;
+          $cmd->_set_status_timeout;
+          return;
+        }
+        redo;
+      }
+      my $err = $!;
+      $cmd->close;
+      $cmd->_set_status_closed($err);
+      return;
+    }
+    else {
+      $cmd->_set_status_timeout;
+      return;
+    }
+  }
+
+  return 1;
+}

 
 sub _set_status_timeout {
   my $cmd = shift;
 
 sub _set_status_timeout {
   my $cmd = shift;


@@ -201,17 +252,18 @@ sub _set_status_timeout {
 
 sub _set_status_closed {
   my $cmd = shift;
 
 sub _set_status_closed {
   my $cmd = shift;

+  my $err = shift;

   my $pkg = ref($cmd) || $cmd;
 
   $cmd->set_status($cmd->DEF_REPLY_CODE, "[$pkg] Connection closed");
   carp(ref($cmd) . ": " . (caller(1))[3]
   my $pkg = ref($cmd) || $cmd;
 
   $cmd->set_status($cmd->DEF_REPLY_CODE, "[$pkg] Connection closed");
   carp(ref($cmd) . ": " . (caller(1))[3]

-    . "(): unexpected EOF on command channel: $!") if $cmd->debug;
+    . "(): unexpected EOF on command channel: $err") if $cmd->debug;

 }
 
 sub _is_closed {
   my $cmd = shift;
   if (!defined fileno($cmd)) {
 }
 
 sub _is_closed {
   my $cmd = shift;
   if (!defined fileno($cmd)) {

-     $cmd->_set_status_closed;
+     $cmd->_set_status_closed($!);

      return 1;
   }
   return 0;
      return 1;
   }
   return 0;


@@ -227,8 +279,6 @@ sub command {
     if (exists ${*$cmd}{'net_cmd_last_ch'});
 
   if (scalar(@_)) {
     if (exists ${*$cmd}{'net_cmd_last_ch'});
 
   if (scalar(@_)) {

-    local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
-

     my $str = join(
       " ",
       map {
     my $str = join(
       " ",
       map {


@@ -240,17 +290,13 @@ sub command {
     $str = $cmd->toascii($str) if $tr;
     $str .= "\015\012";
 
     $str = $cmd->toascii($str) if $tr;
     $str .= "\015\012";
 

-    my $len = length $str;
-    my $swlen;
-

     $cmd->debug_print(1, $str)
       if ($cmd->debug);
 
     $cmd->debug_print(1, $str)
       if ($cmd->debug);
 

-    unless (defined($swlen = syswrite($cmd,$str,$len)) && $swlen == $len) {
-      $cmd->close;
-      $cmd->_set_status_closed;
-      return $cmd;
-    }
+    # though documented to return undef on failure, the legacy behavior
+    # was to return $cmd even on failure, so this odd construct does that
+    $cmd->_syswrite_with_timeout($str)
+      or return $cmd;

   }
 
   $cmd;
   }
 
   $cmd;


@@ -300,8 +346,9 @@ sub getline {
     my $select_ret = select($rout = $rin, undef, undef, $timeout);
     if ($select_ret > 0) {
       unless (sysread($cmd, $buf = "", 1024)) {
     my $select_ret = select($rout = $rin, undef, undef, $timeout);
     if ($select_ret > 0) {
       unless (sysread($cmd, $buf = "", 1024)) {

+        my $err = $!;

         $cmd->close;
         $cmd->close;

-        $cmd->_set_status_closed;
+        $cmd->_set_status_closed($err);

         return;
       }
 
         return;
       }
 


@@ -463,33 +510,8 @@ sub datasend {
 
   ${*$cmd}{'net_cmd_last_ch'} = substr($line, -1, 1);
 
 
   ${*$cmd}{'net_cmd_last_ch'} = substr($line, -1, 1);
 

-  my $len    = length($line);
-  my $offset = 0;
-  my $win    = "";
-  vec($win, fileno($cmd), 1) = 1;
-  my $timeout = $cmd->timeout || undef;
-
-  local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
-
-  while ($len) {
-    my $wout;
-    my $s = select(undef, $wout = $win, undef, $timeout);
-    if ((defined $s and $s > 0) or -f $cmd)    # -f for testing on win32
-    {
-      my $w = syswrite($cmd, $line, $len, $offset);
-      unless (defined($w) && $w == $len) {
-        $cmd->close;
-        $cmd->_set_status_closed;
-        return;
-      }
-      $len -= $w;
-      $offset += $w;
-    }
-    else {
-      $cmd->_set_status_timeout;
-      return;
-    }
-  }
+  $cmd->_syswrite_with_timeout($line)
+    or return;

 
   1;
 }
 
   1;
 }


@@ -511,30 +533,8 @@ sub rawdatasend {
     print STDERR $b, join("\n$b", split(/\n/, $line)), "\n";
   }
 
     print STDERR $b, join("\n$b", split(/\n/, $line)), "\n";
   }
 

-  my $len    = length($line);
-  my $offset = 0;
-  my $win    = "";
-  vec($win, fileno($cmd), 1) = 1;
-  my $timeout = $cmd->timeout || undef;
-
-  local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
-  while ($len) {
-    my $wout;
-    if (select(undef, $wout = $win, undef, $timeout) > 0) {
-      my $w = syswrite($cmd, $line, $len, $offset);
-      unless (defined($w) && $w == $len) {
-        $cmd->close;
-        $cmd->_set_status_closed;
-        return;
-      }
-      $len -= $w;
-      $offset += $w;
-    }
-    else {
-      $cmd->_set_status_timeout;
-      return;
-    }
-  }
+  $cmd->_syswrite_with_timeout($line)
+    or return;

 
   1;
 }
 
   1;
 }


@@ -558,19 +558,11 @@ sub dataend {
 
   $tosend .= ".\015\012";
 
 
   $tosend .= ".\015\012";
 

-  local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
-

   $cmd->debug_print(1, ".\n")
     if ($cmd->debug);
 
   $cmd->debug_print(1, ".\n")
     if ($cmd->debug);
 

-  my $len = length $tosend;
-  my $w = syswrite($cmd, $tosend, $len);
-  unless (defined($w) && $w == $len)
-  {
-    $cmd->close;
-    $cmd->_set_status_closed;
-    return 0;
-  }
+  $cmd->_syswrite_with_timeout($tosend)
+    or return 0;

 
   delete ${*$cmd}{'net_cmd_last_ch'};
 
 
   delete ${*$cmd}{'net_cmd_last_ch'};
 

diff --git a/cpan/libnet/lib/Net/Config.pm b/cpan/libnet/lib/Net/Config.pm
index fe8ce8a..3aa547e 100644 (file)
--- a/cpan/libnet/lib/Net/Config.pm
+++ b/cpan/libnet/lib/Net/Config.pm
@@ -20,7 +20,7 @@ use Socket qw(inet_aton inet_ntoa);
 
 our @EXPORT  = qw(%NetConfig);
 our @ISA     = qw(Net::LocalCfg Exporter);
 
 our @EXPORT  = qw(%NetConfig);
 our @ISA     = qw(Net::LocalCfg Exporter);

-our $VERSION = "3.07";
+our $VERSION = "3.08";

 
 our($CONFIGURE, $LIBNET_CFG);
 
 
 our($CONFIGURE, $LIBNET_CFG);
 

diff --git a/cpan/libnet/lib/Net/Domain.pm b/cpan/libnet/lib/Net/Domain.pm
index 3109f43..e2be3b1 100644 (file)
--- a/cpan/libnet/lib/Net/Domain.pm
+++ b/cpan/libnet/lib/Net/Domain.pm
@@ -21,7 +21,7 @@ use Net::Config;
 
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);
 
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);

-our $VERSION = "3.07";
+our $VERSION = "3.08";

 
 my ($host, $domain, $fqdn) = (undef, undef, undef);
 
 
 my ($host, $domain, $fqdn) = (undef, undef, undef);
 

diff --git a/cpan/libnet/lib/Net/FTP.pm b/cpan/libnet/lib/Net/FTP.pm
index 7700bb3..c0904c6 100644 (file)
--- a/cpan/libnet/lib/Net/FTP.pm
+++ b/cpan/libnet/lib/Net/FTP.pm
@@ -25,7 +25,7 @@ use Net::Config;
 use Socket;
 use Time::Local;
 
 use Socket;
 use Time::Local;
 

-our $VERSION = '3.07';
+our $VERSION = '3.08';

 
 our $IOCLASS;
 my $family_key;
 
 our $IOCLASS;
 my $family_key;


@@ -1991,7 +1991,7 @@ It may be difficult for me to reproduce the problem as almost every setup
 is different.
 
 A small script which yields the problem will probably be of help. It would
 is different.
 
 A small script which yields the problem will probably be of help. It would

-also be useful if this script was run with the extra options C<Debug => 1>
+also be useful if this script was run with the extra options C<< Debug => 1 >>

 passed to the constructor, and the output sent with the bug report. If you
 cannot include a small script then please include a Debug trace from a
 run of your program which does yield the problem.
 passed to the constructor, and the output sent with the bug report. If you
 cannot include a small script then please include a Debug trace from a
 run of your program which does yield the problem.

diff --git a/cpan/libnet/lib/Net/FTP/A.pm b/cpan/libnet/lib/Net/FTP/A.pm
index f3375c6..a1ae30b 100644 (file)
--- a/cpan/libnet/lib/Net/FTP/A.pm
+++ b/cpan/libnet/lib/Net/FTP/A.pm
@@ -13,7 +13,7 @@ use Carp;
 use Net::FTP::dataconn;
 
 our @ISA     = qw(Net::FTP::dataconn);
 use Net::FTP::dataconn;
 
 our @ISA     = qw(Net::FTP::dataconn);

-our $VERSION = "3.07";
+our $VERSION = "3.08";

 
 our $buf;
 
 
 our $buf;
 

diff --git a/cpan/libnet/lib/Net/FTP/E.pm b/cpan/libnet/lib/Net/FTP/E.pm
index 56075f6..cf09d90 100644 (file)
--- a/cpan/libnet/lib/Net/FTP/E.pm
+++ b/cpan/libnet/lib/Net/FTP/E.pm
@@ -8,6 +8,6 @@ use warnings;
 use Net::FTP::I;
 
 our @ISA = qw(Net::FTP::I);
 use Net::FTP::I;
 
 our @ISA = qw(Net::FTP::I);

-our $VERSION = "3.07";
+our $VERSION = "3.08";

 
 1;
 
 1;

diff --git a/cpan/libnet/lib/Net/FTP/I.pm b/cpan/libnet/lib/Net/FTP/I.pm
index bb18ff8..b014f08 100644 (file)
--- a/cpan/libnet/lib/Net/FTP/I.pm
+++ b/cpan/libnet/lib/Net/FTP/I.pm
@@ -13,7 +13,7 @@ use Carp;
 use Net::FTP::dataconn;
 
 our @ISA     = qw(Net::FTP::dataconn);
 use Net::FTP::dataconn;
 
 our @ISA     = qw(Net::FTP::dataconn);

-our $VERSION = "3.07";
+our $VERSION = "3.08";

 
 our $buf;
 
 
 our $buf;
 

diff --git a/cpan/libnet/lib/Net/FTP/L.pm b/cpan/libnet/lib/Net/FTP/L.pm
index d96a39b..d13efe7 100644 (file)
--- a/cpan/libnet/lib/Net/FTP/L.pm
+++ b/cpan/libnet/lib/Net/FTP/L.pm
@@ -8,6 +8,6 @@ use warnings;
 use Net::FTP::I;
 
 our @ISA = qw(Net::FTP::I);
 use Net::FTP::I;
 
 our @ISA = qw(Net::FTP::I);

-our $VERSION = "3.07";
+our $VERSION = "3.08";

 
 1;
 
 1;

diff --git a/cpan/libnet/lib/Net/FTP/dataconn.pm b/cpan/libnet/lib/Net/FTP/dataconn.pm
index 81e3a61..8d82030 100644 (file)
--- a/cpan/libnet/lib/Net/FTP/dataconn.pm
+++ b/cpan/libnet/lib/Net/FTP/dataconn.pm
@@ -13,7 +13,7 @@ use Carp;
 use Errno;
 use Net::Cmd;
 
 use Errno;
 use Net::Cmd;
 

-our $VERSION = '3.07';
+our $VERSION = '3.08';

 
 $Net::FTP::IOCLASS or die "please load Net::FTP before Net::FTP::dataconn";
 our @ISA = $Net::FTP::IOCLASS;
 
 $Net::FTP::IOCLASS or die "please load Net::FTP before Net::FTP::dataconn";
 our @ISA = $Net::FTP::IOCLASS;

diff --git a/cpan/libnet/lib/Net/NNTP.pm b/cpan/libnet/lib/Net/NNTP.pm
index 7499204..0d690de 100644 (file)
--- a/cpan/libnet/lib/Net/NNTP.pm
+++ b/cpan/libnet/lib/Net/NNTP.pm
@@ -21,7 +21,7 @@ use Net::Cmd;
 use Net::Config;
 use Time::Local;
 
 use Net::Config;
 use Time::Local;
 

-our $VERSION = "3.07";
+our $VERSION = "3.08";

 
 # Code for detecting if we can use SSL
 my $ssl_class = eval {
 
 # Code for detecting if we can use SSL
 my $ssl_class = eval {

diff --git a/cpan/libnet/lib/Net/Netrc.pm b/cpan/libnet/lib/Net/Netrc.pm
index 4b721be..4945604 100644 (file)
--- a/cpan/libnet/lib/Net/Netrc.pm
+++ b/cpan/libnet/lib/Net/Netrc.pm
@@ -18,7 +18,7 @@ use warnings;
 use Carp;
 use FileHandle;
 
 use Carp;
 use FileHandle;
 

-our $VERSION = "3.07";
+our $VERSION = "3.08";

 
 our $TESTING;
 
 
 our $TESTING;
 

diff --git a/cpan/libnet/lib/Net/POP3.pm b/cpan/libnet/lib/Net/POP3.pm
index 791b1d2..bccdfb0 100644 (file)
--- a/cpan/libnet/lib/Net/POP3.pm
+++ b/cpan/libnet/lib/Net/POP3.pm
@@ -20,7 +20,7 @@ use IO::Socket;
 use Net::Cmd;
 use Net::Config;
 
 use Net::Cmd;
 use Net::Config;
 

-our $VERSION = "3.07";
+our $VERSION = "3.08";

 
 # Code for detecting if we can use SSL
 my $ssl_class = eval {
 
 # Code for detecting if we can use SSL
 my $ssl_class = eval {

diff --git a/cpan/libnet/lib/Net/SMTP.pm b/cpan/libnet/lib/Net/SMTP.pm
index 7a703d9..6d3e4c2 100644 (file)
--- a/cpan/libnet/lib/Net/SMTP.pm
+++ b/cpan/libnet/lib/Net/SMTP.pm
@@ -21,7 +21,7 @@ use Net::Cmd;
 use Net::Config;
 use Socket;
 
 use Net::Config;
 use Socket;
 

-our $VERSION = "3.07";
+our $VERSION = "3.08";

 
 # Code for detecting if we can use SSL
 my $ssl_class = eval {
 
 # Code for detecting if we can use SSL
 my $ssl_class = eval {


@@ -833,7 +833,11 @@ usually use the right arguments already.
 
 =item auth ( USERNAME, PASSWORD )
 
 
 =item auth ( USERNAME, PASSWORD )
 

-Attempt SASL authentication. Requires Authen::SASL module.
+=item auth ( SASL )
+
+Attempt SASL authentication. Requires Authen::SASL module. The first form
+constructs a new Authen::SASL object using the given username and password;
+the second form uses the given Authen::SASL object.

 
 =item mail ( ADDRESS [, OPTIONS] )
 
 
 =item mail ( ADDRESS [, OPTIONS] )
 

diff --git a/cpan/libnet/lib/Net/Time.pm b/cpan/libnet/lib/Net/Time.pm
index aaddfac..fae93f8 100644 (file)
--- a/cpan/libnet/lib/Net/Time.pm
+++ b/cpan/libnet/lib/Net/Time.pm
@@ -24,7 +24,7 @@ use Net::Config;
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw(inet_time inet_daytime);
 
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw(inet_time inet_daytime);
 

-our $VERSION = "3.07";
+our $VERSION = "3.08";

 
 our $TIMEOUT = 120;
 
 
 our $TIMEOUT = 120;