use Net::Cmd;
use Net::Config;
-$VERSION = "2.16"; # $Id: //depot/libnet/Net/SMTP.pm#16 $
+$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 $ln;
foreach $ln (@msg) {
$h->{uc $1} = $2
- if $ln =~ /(\S+)\b[ \t]*([^\n]*)/;
+ 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;
: $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;
=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)
Request a queue run for the DOMAIN given.
+=item auth ( USERNAME, PASSWORD )
+
+Attempt SASL authentication.
+
=item mail ( ADDRESS [, OPTIONS] )
=item send ( ADDRESS )
=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>
=for html <hr>
-I<$Id: //depot/libnet/Net/SMTP.pm#16 $>
+I<$Id: //depot/libnet/Net/SMTP.pm#25 $>
=cut