use Net::Cmd;
use Net::Config;
-$VERSION = "2.15"; # $Id$
+$VERSION = "2.24"; # $Id: //depot/libnet/Net/SMTP.pm#25 $
@ISA = qw(Net::Cmd IO::Socket::INET);
{
$obj = $type->SUPER::new(PeerAddr => ($host = $h),
PeerPort => $arg{Port} || 'smtp(25)',
+ LocalAddr => $arg{LocalAddr},
+ LocalPort => $arg{LocalPort},
Proto => 'tcp',
Timeout => defined $arg{Timeout}
? $arg{Timeout}
$self->_ETRN(@_);
}
+sub auth {
+ my ($self, $username, $password) = @_;
+
+ require MIME::Base64;
+ require Authen::SASL;
+
+ my $mechanisms = $self->supports('AUTH',500,["Command unknown: 'AUTH'"]);
+ return unless defined $mechanisms;
+
+ my $sasl;
+
+ if (ref($username) and UNIVERSAL::isa($username,'Authen::SASL')) {
+ $sasl = $username;
+ $sasl->mechanism($mechanisms);
+ }
+ else {
+ die "auth(username, password)" if not length $username;
+ $sasl = Authen::SASL->new(mechanism=> $mechanisms,
+ callback => { user => $username,
+ pass => $password,
+ authname => $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('smtp',${*$self}{'net_smtp_host'},0);
+ my $str = $client->client_start;
+ # We dont support sasl mechanisms that encrypt the socket traffic.
+ # todo that we would really need to change the ISA hierarchy
+ # so we dont inherit from IO::Socket, but instead hold it in an attribute
+
+ my @cmd = ("AUTH", $client->mechanism, MIME::Base64::encode_base64($str,''));
+ my $code;
+
+ while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
+ @cmd = (MIME::Base64::encode_base64(
+ $client->client_step(
+ MIME::Base64::decode_base64(
+ ($self->message)[0]
+ )
+ ), ''
+ ));
+ }
+
+ $code == CMD_OK;
+}
+
sub hello
{
my $me = shift;
- my $domain = shift ||
- eval {
- require Net::Domain;
- Net::Domain::hostfqdn();
- } ||
- "";
+ my $domain = shift || "localhost.localdomain";
my $ok = $me->_EHLO($domain);
my @msg = $me->message;
my $h = ${*$me}{'net_smtp_esmtp'} = {};
my $ln;
foreach $ln (@msg) {
- $h->{$1} = $2
- if $ln =~ /(\S+)\b[ \t]*([^\n]*)/;
+ $h->{uc $1} = $2
+ if $ln =~ /(\w+)\b[= \t]*([^\n]*)/;
}
}
elsif($me->status == CMD_ERROR)
if $ok = $me->_HELO($domain);
}
- $ok && $msg[0] =~ /\A(\S+)/
+ $ok && $msg[0] =~ /\A\s*(\S+)/
? $1
: undef;
}
return;
}
-sub _addr
-{
- my $addr = shift || "";
-
- return $1
- if $addr =~ /(<[^>]+>)/so;
-
- $addr =~ s/\n/ /sog;
- $addr =~ s/(\A\s+|\s+\Z)//sog;
-
- return "<" . $addr . ">";
+sub _addr {
+ my $addr = shift;
+ $addr = "" unless defined $addr;
+ $addr =~ s/^\s*<?\s*|\s*>?\s*$//sg;
+ "<$addr>";
}
-
sub mail
{
my $me = shift;
return $skip_bad ? @ok : 1;
}
-sub to { shift->recipient(@_) }
+BEGIN {
+ *to = \&recipient;
+ *cc = \&recipient;
+ *bcc = \&recipient;
+}
sub data
{
: $ok;
}
+sub datafh {
+ my $me = shift;
+ return unless $me->_DATA();
+ return $me->tied_fh;
+}
+
sub expand
{
my $me = shift;
sub _DATA { shift->command("DATA")->response() == CMD_MORE }
sub _TURN { shift->unsupported(@_); }
sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
+sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
1;
=head1 SYNOPSIS
use Net::SMTP;
-
+
# Constructors
$smtp = Net::SMTP->new('mailhost');
$smtp = Net::SMTP->new('mailhost', Timeout => 60);
This example prints the mail domain name of the SMTP server known as mailhost:
#!/usr/local/bin/perl -w
-
+
use Net::SMTP;
-
+
$smtp = Net::SMTP->new('mailhost');
print $smtp->domain,"\n";
$smtp->quit;
known as mailhost:
#!/usr/local/bin/perl -w
-
+
use Net::SMTP;
-
+
$smtp = Net::SMTP->new('mailhost');
-
+
$smtp->mail($ENV{USER});
$smtp->to('postmaster');
-
+
$smtp->data();
$smtp->datasend("To: postmaster\n");
$smtp->datasend("\n");
$smtp->datasend("A simple test message\n");
$smtp->dataend();
-
+
$smtp->quit;
=head1 CONSTRUCTOR
=item new Net::SMTP [ HOST, ] [ OPTIONS ]
This is the constructor for a new Net::SMTP object. C<HOST> is the
-name of the remote host to which a SMTP connection is required.
+name of the remote host to which an SMTP connection is required.
If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
will be used.
specifies a string to pass as your mail domain. If not
given a guess will be taken.
+B<LocalAddr> and B<LocalPort> - These parameters are passed directly
+to IO::Socket to allow binding the socket to a local port.
+
B<Timeout> - Maximum time, in seconds, to wait for a response from the
SMTP server (default: 120)
Debug => 1,
);
+=back
+
=head1 METHODS
Unless otherwise stated all methods return either a I<true> or I<false>
Request a queue run for the DOMAIN given.
+=item auth ( USERNAME, PASSWORD )
+
+Attempt SASL authentication.
+
=item mail ( ADDRESS [, OPTIONS] )
=item send ( ADDRESS )
bad address is encountered and it will return an array of addresses
that did succeed.
+ $smtp->recipient($recipient1,$recipient2); # Good
+ $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
+ $smtp->recipient("$recipient,$recipient2"); # BAD
+
=item to ( ADDRESS [, ADDRESS [...]] )
-A synonym for C<recipient>.
+=item cc ( ADDRESS [, ADDRESS [...]] )
+
+=item bcc ( ADDRESS [, ADDRESS [...]] )
+
+Synonyms for C<recipient>.
=item data ( [ DATA ] )
=back
+=head1 ADDRESSES
+
+All methods that accept addresses expect the address to be a valid rfc2821-quoted address, although
+Net::SMTP will accept accept the address surrounded by angle brackets.
+
+ funny user@domain WRONG
+ "funny user"@domain RIGHT, recommended
+ <"funny user"@domain> OK
+
=head1 SEE ALSO
L<Net::Cmd>
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/SMTP.pm#25 $>
+
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff