Upgrade to libnet-1.20. Includes some additional version bumps where bleadperl

differs from the CPAN version (Net::FTP and Net::NNTP).

p4raw-id: //depot/perl@30144

7 files changed, 142 insertions, 37 deletions

diff --git a/lib/Net/Changes.libnet b/lib/Net/Changes.libnet
index 724135cda6..2d74af57d0 100644
--- a/lib/Net/Changes.libnet
+++ b/lib/Net/Changes.libnet
@@ -1,3 +1,16 @@
+libnet 1.20  -- Fri Feb  2 19:42:51 CST 2007
+
+Bug Fixes
+  * Fixed incorrect handling of CRLF that straddled two blocks
+  * Fix bug in response() which was too liberal in what it thought was a response line
+  * Silence uninitialized value warnings in Net::Cmd during testing on Win32
+  * Documentations typos and updates
+
+Enhancements
+  * Added support for ORCPT into Net::SMTP
+  * Support for servers that expect the USER command in upper or lower case. Try USER
+    first then try user if that fails
+
 libnet 1.19  -- Wed Jun 30 14:53:48 BST 2004
 
 Bug Fixes
diff --git a/lib/Net/Cmd.pm b/lib/Net/Cmd.pm
index f7c74846c6..201349f98f 100644
--- a/lib/Net/Cmd.pm
+++ b/lib/Net/Cmd.pm
@@ -1,6 +1,6 @@
 # Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#34 $
 #
-# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# Copyright (c) 1995-2006 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 
@@ -21,7 +21,9 @@ BEGIN {
   }
 }
 
-$VERSION = "2.26_01";
+my $doUTF8 = eval { require utf8 };
+
+$VERSION = "2.27";
 @ISA     = qw(Exporter);
 @EXPORT  = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
 
@@ -266,7 +268,9 @@ sub getline
   {
    my $timeout = $cmd->timeout || undef;
    my $rout;
-   if (select($rout=$rin, undef, undef, $timeout))
+
+   my $select_ret = select($rout=$rin, undef, undef, $timeout);
+   if ($select_ret > 0)
     {
      unless (sysread($cmd, $buf="", 1024))
       {
@@ -287,7 +291,8 @@ sub getline
     }
    else
     {
-     carp("$cmd: Timeout") if($cmd->debug);
+     my $msg = $select_ret ? "Error or Interrupted: $!" : "Timeout";
+     carp("$cmd: $msg") if($cmd->debug);
      return undef;
     }
   }
@@ -390,6 +395,8 @@ sub datasend
  my $arr = @_ == 1 && ref($_[0]) ? $_[0] : \@_;
  my $line = join("" ,@$arr);
 
+ utf8::encode($line) if $doUTF8;
+
  return 0 unless defined(fileno($cmd));
 
  my $last_ch = ${*$cmd}{'net_cmd_last_ch'};
@@ -767,12 +774,8 @@ Graham Barr <gbarr@pobox.com>
 
 =head1 COPYRIGHT
 
-Copyright (c) 1995-1997 Graham Barr. All rights reserved.
+Copyright (c) 1995-2006 Graham Barr. All rights reserved.
 This program is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
 
-=for html <hr>
-
-I<$Id: //depot/libnet/Net/Cmd.pm#34 $>
-
 =cut
diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm
index 6b15b9c755..99057afccf 100644
--- a/lib/Net/FTP.pm
+++ b/lib/Net/FTP.pm
@@ -22,7 +22,7 @@ use Net::Config;
 use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC);
 # use AutoLoader qw(AUTOLOAD);
 
-$VERSION = "2.75";
+$VERSION = "2.77_01";
 @ISA     = qw(Exporter Net::Cmd IO::Socket::INET);
 
 # Someday I will "use constant", when I am not bothered to much about
@@ -1118,7 +1118,7 @@ sub response
 sub parse_response
 {
  return ($1, $2 eq "-")
-    if $_[1] =~ s/^(\d\d\d)(.?)//o;
+    if $_[1] =~ s/^(\d\d\d)([- ]?)//o;
 
  my $ftp = shift;
 
@@ -1217,11 +1217,21 @@ sub _STOR { shift->command("STOR",@_)->response() == CMD_INFO }
 sub _STOU { shift->command("STOU",@_)->response() == CMD_INFO }
 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 _USER {
+  my $ftp = shift;
+  my $ok = $ftp->command("USER",@_)->response();
+
+  # A certain brain dead firewall :-)
+  $ok = $ftp->command("user",@_)->response()
+    unless $ok == CMD_MORE or $ok == CMD_OK;
+
+  $ok;
+}
+
 sub _SMNT { shift->unsupported(@_) }
 sub _MODE { shift->unsupported(@_) }
 sub _SYST { shift->unsupported(@_) }
diff --git a/lib/Net/FTP/A.pm b/lib/Net/FTP/A.pm
index d0688280fc..44b9cdb0fa 100644
--- a/lib/Net/FTP/A.pm
+++ b/lib/Net/FTP/A.pm
@@ -10,7 +10,7 @@ use Carp;
 require Net::FTP::dataconn;
 
 @ISA = qw(Net::FTP::dataconn);
-$VERSION = "1.16";
+$VERSION = "1.17";
 
 sub read {
   my    $data 	 = shift;
@@ -71,7 +71,10 @@ sub write {
   my    $size 	= shift || croak 'write($buf,$size,[$timeout])';
   my    $timeout = @_ ? shift : $data->timeout;
 
-  (my $tmp = substr($buf,0,$size)) =~ s/\r?\n/\015\012/sg;
+  my $nr = (my $tmp = substr($buf,0,$size)) =~ tr/\r\n/\015\012/;
+  $tmp =~ s/[^\015]\012/\015\012/sg if $nr;
+  $tmp =~ s/^\012/\015\012/ unless ${*$data}{'net_ftp_outcr'};
+  ${*$data}{'net_ftp_outcr'} = substr($tmp,-1) eq "\015";
 
   # If the remote server has closed the connection we will be signal'd
   # when we write. This can happen if the disk on the remote server fills up
diff --git a/lib/Net/NNTP.pm b/lib/Net/NNTP.pm
index fb4819ae54..d4ea3a9761 100644
--- a/lib/Net/NNTP.pm
+++ b/lib/Net/NNTP.pm
@@ -14,7 +14,7 @@ use Carp;
 use Time::Local;
 use Net::Config;
 
-$VERSION = "2.23";
+$VERSION = "2.23_01";
 @ISA     = qw(Net::Cmd IO::Socket::INET);
 
 sub new
diff --git a/lib/Net/POP3.pm b/lib/Net/POP3.pm
index 510d1864cf..02c8bc63de 100644
--- a/lib/Net/POP3.pm
+++ b/lib/Net/POP3.pm
@@ -13,7 +13,7 @@ use Net::Cmd;
 use Carp;
 use Net::Config;
 
-$VERSION = "2.28";
+$VERSION = "2.28_2";
 
 @ISA = qw(Net::Cmd IO::Socket::INET);
 
@@ -380,12 +380,19 @@ sub capa {
     # Fake a capability here
     $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/);
 
-    return \%capabilities unless $this->_CAPA();
-
-    $capa = $this->read_until_dot();
-    %capabilities = map { /^\s*(\S+)\s*(.*)/ } @$capa;
-    $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/);
-
+    if ($this->_CAPA()) {
+      $capabilities{CAPA} = 1;
+      $capa = $this->read_until_dot();
+      %capabilities = (%capabilities, map { /^\s*(\S+)\s*(.*)/ } @$capa);
+    }
+    else {
+      # Check AUTH for SASL capabilities
+      if ( $this->command('AUTH')->response() == CMD_OK ) {
+          my $mechanism = $this->read_until_dot();
+          $capabilities{SASL} = join " ", map { m/([A-Z0-9_-]+)/ } @{ $mechanism };
+      }
+    }
+    
     return ${*$this}{'net_pop3e_capabilities'} = \%capabilities;
 }
 
@@ -410,7 +417,25 @@ sub auth {
 
     if (ref($username) and UNIVERSAL::isa($username,'Authen::SASL')) {
       $sasl = $username;
-      $sasl->mechanism($mechanisms);
+      my $user_mech = $sasl->mechanism || '';
+      my @user_mech = split(/\s+/, $user_mech);
+      my %user_mech; @user_mech{@user_mech} = ();
+
+      my @server_mech = split(/\s+/,$mechanisms);
+      my @mech = @user_mech
+      				? grep { exists $user_mech{$_} } @server_mech
+      				: @server_mech;
+      unless (@mech) {
+        $self->set_status(500,
+                             [ 'Client SASL mechanisms (',
+                               join(', ', @user_mech),
+                               ') do not match the SASL mechnism the server announces (',
+                               join(', ', @server_mech), ')',
+                             ]);
+        return 0;
+      }
+
+      $sasl->mechanism(join(" ",@mech));
     }
     else {
       die "auth(username, password)" if not length $username;
@@ -423,8 +448,29 @@ sub auth {
 
     # We should probably allow the user to pass the host, but I don't
     # currently know and SASL mechanisms that are used by smtp that need it
-    my $client = $sasl->client_new('pop3',${*$self}{'net_pop3_host'},0);
-    my $str    = $client->client_start;
+    my ( $hostname ) = split /:/ , ${*$self}{'net_pop3_host'};
+    my $client = eval { $sasl->client_new('pop',$hostname,0) };
+    
+    unless ($client) {
+      my $mech = $sasl->mechanism;
+      $self->set_status(500, [
+         " Authen::SASL failure: $@",
+         '(please check if your local Authen::SASL installation',
+         "supports mechanism '$mech'"
+       ]);
+      return 0;
+    }
+    
+    my ($token) = $client->client_start
+      or do {
+        my $mech = $client->mechanism;
+        $self->set_status(500, [
+          ' Authen::SASL failure:  $client->client_start ',
+          "mechanism '$mech' hostname #$hostname#",
+          $client->error
+        ]);
+        return 0;
+      };
 
     # We dont support sasl mechanisms that encrypt the socket traffic.
     # todo that we would really need to change the ISA hierarchy
@@ -433,17 +479,29 @@ sub auth {
     my @cmd = ("AUTH", $client->mechanism);
     my $code;
 
-    push @cmd, MIME::Base64::encode_base64($str,'')
-      if defined $str and length $str;
+    push @cmd, MIME::Base64::encode_base64($token,'')
+      if defined $token and length $token;
 
     while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
+
+      my ( $token ) = $client->client_step(
+	MIME::Base64::decode_base64(
+	  ($self->message)[0]
+	)
+      ) or do {
+        $self->set_status(500, [
+          ' Authen::SASL failure:  $client->client_step ',
+          "mechanism '", $client->mechanism ," hostname #$hostname#, ",
+          $client->error
+        ]);
+        return 0;
+      };
+
       @cmd = (MIME::Base64::encode_base64(
-	$client->client_step(
-	  MIME::Base64::decode_base64(
-	    ($self->message)[0]
-	  )
-	), ''
-      ));
+                  defined $token ?  $token : '',
+                  ''
+             )
+      );
     }
 
     $code == CMD_OK;
diff --git a/lib/Net/SMTP.pm b/lib/Net/SMTP.pm
index 2e410dddce..8069f88884 100644
--- a/lib/Net/SMTP.pm
+++ b/lib/Net/SMTP.pm
@@ -16,7 +16,7 @@ use IO::Socket;
 use Net::Cmd;
 use Net::Config;
 
-$VERSION = "2.29";
+$VERSION = "2.30";
 
 @ISA = qw(Net::Cmd IO::Socket::INET);
 
@@ -382,6 +382,18 @@ sub recipient
         }
       }
 
+     if(defined($v = delete $opt{ORcpt}))
+      {
+       if(exists $esmtp->{DSN})
+        {
+	 $opts .= " ORCPT=" . $v;
+        }
+       else
+        {
+	 carp 'Net::SMTP::recipient: DSN option not supported by host';
+        }
+      }
+
      carp 'Net::SMTP::recipient: unknown option(s) '
 		. join(" ", keys %opt)
 		. ' - ignored'
@@ -628,7 +640,7 @@ Example:
 
 
     $smtp = Net::SMTP->new('mailhost',
-			   Hello => 'my.mail.domain'
+			   Hello => 'my.mail.domain',
 			   Timeout => 30,
                            Debug   => 1,
 			  );
@@ -636,14 +648,14 @@ Example:
     # the same
     $smtp = Net::SMTP->new(
 			   Host => 'mailhost',
-			   Hello => 'my.mail.domain'
+			   Hello => 'my.mail.domain',
 			   Timeout => 30,
                            Debug   => 1,
 			  );
 
     # Connect to the default server from Net::config
     $smtp = Net::SMTP->new(
-			   Hello => 'my.mail.domain'
+			   Hello => 'my.mail.domain',
 			   Timeout => 30,
 			  );
 
@@ -732,6 +744,7 @@ The C<recipient> method can also pass additional case-sensitive OPTIONS as an
 anonymous hash using key and value pairs.  Possible options are:
 
   Notify  => ['NEVER'] or ['SUCCESS','FAILURE','DELAY']  (see below)
+  ORcpt   => <ORCPT>
   SkipBad => 1        (to ignore bad addresses)
 
 If C<SkipBad> is true the C<recipient> will not return an error when a bad
@@ -778,6 +791,11 @@ any conditions."
 
   $smtp->recipient(@recipients, { Notify => ['FAILURE','DELAY'], SkipBad => 1 });  # Good
 
+ORcpt is also part of the SMTP DSN extension according to RFC3461.
+It is used to pass along the original recipient that the mail was first
+sent to.  The machine that generates a DSN will use this address to inform
+the sender, because he can't know if recipients get rewritten by mail servers.
+
 =item to ( ADDRESS [, ADDRESS [...]] )
 
 =item cc ( ADDRESS [, ADDRESS [...]] )