Change 30144 by [EMAIL PROTECTED] on 2007/02/06 17:29:09
Upgrade to libnet-1.20. Includes some additional version bumps where
bleadperl
differs from the CPAN version (Net::FTP and Net::NNTP).
Affected files ...
... //depot/perl/lib/Net/Changes.libnet#3 edit
... //depot/perl/lib/Net/Cmd.pm#12 edit
... //depot/perl/lib/Net/FTP.pm#19 edit
... //depot/perl/lib/Net/FTP/A.pm#4 edit
... //depot/perl/lib/Net/NNTP.pm#12 edit
... //depot/perl/lib/Net/POP3.pm#12 edit
... //depot/perl/lib/Net/SMTP.pm#16 edit
Differences ...
==== //depot/perl/lib/Net/Changes.libnet#3 (text) ====
Index: perl/lib/Net/Changes.libnet
--- perl/lib/Net/Changes.libnet#2~23016~ 2004-06-30 06:47:36.000000000
-0700
+++ perl/lib/Net/Changes.libnet 2007-02-06 09:29:09.000000000 -0800
@@ -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
==== //depot/perl/lib/Net/Cmd.pm#12 (text) ====
Index: perl/lib/Net/Cmd.pm
--- perl/lib/Net/Cmd.pm#11~25261~ 2005-08-02 03:39:51.000000000 -0700
+++ perl/lib/Net/Cmd.pm 2007-02-06 09:29:09.000000000 -0800
@@ -1,6 +1,6 @@
# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#34 $
#
-# Copyright (c) 1995-1997 Graham Barr <[EMAIL PROTECTED]>. All rights reserved.
+# Copyright (c) 1995-2006 Graham Barr <[EMAIL PROTECTED]>. 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 @@
}
}
-$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 @@
{
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 @@
}
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 @@
my $arr = @_ == 1 && ref($_[0]) ? $_[0] : [EMAIL PROTECTED];
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 @@
=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
==== //depot/perl/lib/Net/FTP.pm#19 (text) ====
Index: perl/lib/Net/FTP.pm
--- perl/lib/Net/FTP.pm#18~26970~ 2006-01-27 11:48:28.000000000 -0800
+++ perl/lib/Net/FTP.pm 2007-02-06 09:29:09.000000000 -0800
@@ -22,7 +22,7 @@
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 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 _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(@_) }
==== //depot/perl/lib/Net/FTP/A.pm#4 (text) ====
Index: perl/lib/Net/FTP/A.pm
--- perl/lib/Net/FTP/A.pm#3~19661~ 2003-06-02 05:13:35.000000000 -0700
+++ perl/lib/Net/FTP/A.pm 2007-02-06 09:29:09.000000000 -0800
@@ -10,7 +10,7 @@
require Net::FTP::dataconn;
@ISA = qw(Net::FTP::dataconn);
-$VERSION = "1.16";
+$VERSION = "1.17";
sub read {
my $data = shift;
@@ -71,7 +71,10 @@
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
==== //depot/perl/lib/Net/NNTP.pm#12 (text) ====
Index: perl/lib/Net/NNTP.pm
--- perl/lib/Net/NNTP.pm#11~27211~ 2006-02-17 13:19:03.000000000 -0800
+++ perl/lib/Net/NNTP.pm 2007-02-06 09:29:09.000000000 -0800
@@ -14,7 +14,7 @@
use Time::Local;
use Net::Config;
-$VERSION = "2.23";
+$VERSION = "2.23_01";
@ISA = qw(Net::Cmd IO::Socket::INET);
sub new
==== //depot/perl/lib/Net/POP3.pm#12 (text) ====
Index: perl/lib/Net/POP3.pm
--- perl/lib/Net/POP3.pm#11~25261~ 2005-08-02 03:39:51.000000000 -0700
+++ perl/lib/Net/POP3.pm 2007-02-06 09:29:09.000000000 -0800
@@ -13,7 +13,7 @@
use Carp;
use Net::Config;
-$VERSION = "2.28";
+$VERSION = "2.28_2";
@ISA = qw(Net::Cmd IO::Socket::INET);
@@ -380,12 +380,19 @@
# 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 @@
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; @[EMAIL PROTECTED] = ();
+
+ 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 @@
# 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 @@
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;
==== //depot/perl/lib/Net/SMTP.pm#16 (text) ====
Index: perl/lib/Net/SMTP.pm
--- perl/lib/Net/SMTP.pm#15~25261~ 2005-08-02 03:39:51.000000000 -0700
+++ perl/lib/Net/SMTP.pm 2007-02-06 09:29:09.000000000 -0800
@@ -16,7 +16,7 @@
use Net::Cmd;
use Net::Config;
-$VERSION = "2.29";
+$VERSION = "2.30";
@ISA = qw(Net::Cmd IO::Socket::INET);
@@ -382,6 +382,18 @@
}
}
+ 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 @@
$smtp = Net::SMTP->new('mailhost',
- Hello => 'my.mail.domain'
+ Hello => 'my.mail.domain',
Timeout => 30,
Debug => 1,
);
@@ -636,14 +648,14 @@
# 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 @@
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 @@
$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 [...]] )
End of Patch.
