differs from the CPAN version (Net::FTP and Net::NNTP).
p4raw-id: //depot/perl@30144
+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
# 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.
}
}
-$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);
{
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))
{
}
else
{
- carp("$cmd: Timeout") if($cmd->debug);
+ my $msg = $select_ret ? "Error or Interrupted: $!" : "Timeout";
+ carp("$cmd: $msg") if($cmd->debug);
return undef;
}
}
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'};
=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
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
sub parse_response
{
return ($1, $2 eq "-")
- if $_[1] =~ s/^(\d\d\d)(.?)//o;
+ if $_[1] =~ s/^(\d\d\d)([- ]?)//o;
my $ftp = shift;
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(@_) }
require Net::FTP::dataconn;
@ISA = qw(Net::FTP::dataconn);
-$VERSION = "1.16";
+$VERSION = "1.17";
sub read {
my $data = shift;
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
use Time::Local;
use Net::Config;
-$VERSION = "2.23";
+$VERSION = "2.23_01";
@ISA = qw(Net::Cmd IO::Socket::INET);
sub new
use Carp;
use Net::Config;
-$VERSION = "2.28";
+$VERSION = "2.28_2";
@ISA = qw(Net::Cmd IO::Socket::INET);
# 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;
}
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;
# 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
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;
use Net::Cmd;
use Net::Config;
-$VERSION = "2.29";
+$VERSION = "2.30";
@ISA = qw(Net::Cmd IO::Socket::INET);
}
}
+ 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'
$smtp = Net::SMTP->new('mailhost',
- Hello => 'my.mail.domain'
+ Hello => 'my.mail.domain',
Timeout => 30,
Debug => 1,
);
# 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,
);
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
$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 [...]] )
projects / p5sagit/p5-mst-13.2.git / commitdiff