You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
596 lines
13 KiB
596 lines
13 KiB
# Net::SMTP.pm
|
|
#
|
|
# Copyright (c) 1995-1997 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.
|
|
|
|
package Net::SMTP;
|
|
|
|
require 5.001;
|
|
|
|
use strict;
|
|
use vars qw($VERSION @ISA);
|
|
use Socket 1.3;
|
|
use Carp;
|
|
use IO::Socket;
|
|
use Net::Cmd;
|
|
use Net::Config;
|
|
|
|
$VERSION = "2.15"; # $Id$
|
|
|
|
@ISA = qw(Net::Cmd IO::Socket::INET);
|
|
|
|
sub new
|
|
{
|
|
my $self = shift;
|
|
my $type = ref($self) || $self;
|
|
my $host = shift if @_ % 2;
|
|
my %arg = @_;
|
|
my $hosts = defined $host ? [ $host ] : $NetConfig{smtp_hosts};
|
|
my $obj;
|
|
|
|
my $h;
|
|
foreach $h (@{$hosts})
|
|
{
|
|
$obj = $type->SUPER::new(PeerAddr => ($host = $h),
|
|
PeerPort => $arg{Port} || 'smtp(25)',
|
|
Proto => 'tcp',
|
|
Timeout => defined $arg{Timeout}
|
|
? $arg{Timeout}
|
|
: 120
|
|
) and last;
|
|
}
|
|
|
|
return undef
|
|
unless defined $obj;
|
|
|
|
$obj->autoflush(1);
|
|
|
|
$obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
|
|
|
|
unless ($obj->response() == CMD_OK)
|
|
{
|
|
$obj->close();
|
|
return undef;
|
|
}
|
|
|
|
${*$obj}{'net_smtp_host'} = $host;
|
|
|
|
(${*$obj}{'net_smtp_banner'}) = $obj->message;
|
|
(${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
|
|
|
|
unless($obj->hello($arg{Hello} || ""))
|
|
{
|
|
$obj->close();
|
|
return undef;
|
|
}
|
|
|
|
$obj;
|
|
}
|
|
|
|
##
|
|
## User interface methods
|
|
##
|
|
|
|
sub banner
|
|
{
|
|
my $me = shift;
|
|
|
|
return ${*$me}{'net_smtp_banner'} || undef;
|
|
}
|
|
|
|
sub domain
|
|
{
|
|
my $me = shift;
|
|
|
|
return ${*$me}{'net_smtp_domain'} || undef;
|
|
}
|
|
|
|
sub etrn {
|
|
my $self = shift;
|
|
defined($self->supports('ETRN',500,["Command unknown: 'ETRN'"])) &&
|
|
$self->_ETRN(@_);
|
|
}
|
|
|
|
sub hello
|
|
{
|
|
my $me = shift;
|
|
my $domain = shift ||
|
|
eval {
|
|
require Net::Domain;
|
|
Net::Domain::hostfqdn();
|
|
} ||
|
|
"";
|
|
my $ok = $me->_EHLO($domain);
|
|
my @msg = $me->message;
|
|
|
|
if($ok)
|
|
{
|
|
my $h = ${*$me}{'net_smtp_esmtp'} = {};
|
|
my $ln;
|
|
foreach $ln (@msg) {
|
|
$h->{$1} = $2
|
|
if $ln =~ /(\S+)\b[ \t]*([^\n]*)/;
|
|
}
|
|
}
|
|
elsif($me->status == CMD_ERROR)
|
|
{
|
|
@msg = $me->message
|
|
if $ok = $me->_HELO($domain);
|
|
}
|
|
|
|
$ok && $msg[0] =~ /\A(\S+)/
|
|
? $1
|
|
: undef;
|
|
}
|
|
|
|
sub supports {
|
|
my $self = shift;
|
|
my $cmd = uc shift;
|
|
return ${*$self}{'net_smtp_esmtp'}->{$cmd}
|
|
if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
|
|
$self->set_status(@_)
|
|
if @_;
|
|
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 mail
|
|
{
|
|
my $me = shift;
|
|
my $addr = _addr(shift);
|
|
my $opts = "";
|
|
|
|
if(@_)
|
|
{
|
|
my %opt = @_;
|
|
my($k,$v);
|
|
|
|
if(exists ${*$me}{'net_smtp_esmtp'})
|
|
{
|
|
my $esmtp = ${*$me}{'net_smtp_esmtp'};
|
|
|
|
if(defined($v = delete $opt{Size}))
|
|
{
|
|
if(exists $esmtp->{SIZE})
|
|
{
|
|
$opts .= sprintf " SIZE=%d", $v + 0
|
|
}
|
|
else
|
|
{
|
|
carp 'Net::SMTP::mail: SIZE option not supported by host';
|
|
}
|
|
}
|
|
|
|
if(defined($v = delete $opt{Return}))
|
|
{
|
|
if(exists $esmtp->{DSN})
|
|
{
|
|
$opts .= " RET=" . uc $v
|
|
}
|
|
else
|
|
{
|
|
carp 'Net::SMTP::mail: DSN option not supported by host';
|
|
}
|
|
}
|
|
|
|
if(defined($v = delete $opt{Bits}))
|
|
{
|
|
if(exists $esmtp->{'8BITMIME'})
|
|
{
|
|
$opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT"
|
|
}
|
|
else
|
|
{
|
|
carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
|
|
}
|
|
}
|
|
|
|
if(defined($v = delete $opt{Transaction}))
|
|
{
|
|
if(exists $esmtp->{CHECKPOINT})
|
|
{
|
|
$opts .= " TRANSID=" . _addr($v);
|
|
}
|
|
else
|
|
{
|
|
carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
|
|
}
|
|
}
|
|
|
|
if(defined($v = delete $opt{Envelope}))
|
|
{
|
|
if(exists $esmtp->{DSN})
|
|
{
|
|
$v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
|
|
$opts .= " ENVID=$v"
|
|
}
|
|
else
|
|
{
|
|
carp 'Net::SMTP::mail: DSN option not supported by host';
|
|
}
|
|
}
|
|
|
|
carp 'Net::SMTP::recipient: unknown option(s) '
|
|
. join(" ", keys %opt)
|
|
. ' - ignored'
|
|
if scalar keys %opt;
|
|
}
|
|
else
|
|
{
|
|
carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
|
|
}
|
|
}
|
|
|
|
$me->_MAIL("FROM:".$addr.$opts);
|
|
}
|
|
|
|
sub send { shift->_SEND("FROM:" . _addr($_[0])) }
|
|
sub send_or_mail { shift->_SOML("FROM:" . _addr($_[0])) }
|
|
sub send_and_mail { shift->_SAML("FROM:" . _addr($_[0])) }
|
|
|
|
sub reset
|
|
{
|
|
my $me = shift;
|
|
|
|
$me->dataend()
|
|
if(exists ${*$me}{'net_smtp_lastch'});
|
|
|
|
$me->_RSET();
|
|
}
|
|
|
|
|
|
sub recipient
|
|
{
|
|
my $smtp = shift;
|
|
my $opts = "";
|
|
my $skip_bad = 0;
|
|
|
|
if(@_ && ref($_[-1]))
|
|
{
|
|
my %opt = %{pop(@_)};
|
|
my $v;
|
|
|
|
$skip_bad = delete $opt{'SkipBad'};
|
|
|
|
if(exists ${*$smtp}{'net_smtp_esmtp'})
|
|
{
|
|
my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
|
|
|
|
if(defined($v = delete $opt{Notify}))
|
|
{
|
|
if(exists $esmtp->{DSN})
|
|
{
|
|
$opts .= " NOTIFY=" . join(",",map { uc $_ } @$v)
|
|
}
|
|
else
|
|
{
|
|
carp 'Net::SMTP::recipient: DSN option not supported by host';
|
|
}
|
|
}
|
|
|
|
carp 'Net::SMTP::recipient: unknown option(s) '
|
|
. join(" ", keys %opt)
|
|
. ' - ignored'
|
|
if scalar keys %opt;
|
|
}
|
|
elsif(%opt)
|
|
{
|
|
carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
|
|
}
|
|
}
|
|
|
|
my @ok;
|
|
my $addr;
|
|
foreach $addr (@_)
|
|
{
|
|
if($smtp->_RCPT("TO:" . _addr($addr) . $opts)) {
|
|
push(@ok,$addr) if $skip_bad;
|
|
}
|
|
elsif(!$skip_bad) {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
return $skip_bad ? @ok : 1;
|
|
}
|
|
|
|
sub to { shift->recipient(@_) }
|
|
|
|
sub data
|
|
{
|
|
my $me = shift;
|
|
|
|
my $ok = $me->_DATA() && $me->datasend(@_);
|
|
|
|
$ok && @_ ? $me->dataend
|
|
: $ok;
|
|
}
|
|
|
|
sub expand
|
|
{
|
|
my $me = shift;
|
|
|
|
$me->_EXPN(@_) ? ($me->message)
|
|
: ();
|
|
}
|
|
|
|
|
|
sub verify { shift->_VRFY(@_) }
|
|
|
|
sub help
|
|
{
|
|
my $me = shift;
|
|
|
|
$me->_HELP(@_) ? scalar $me->message
|
|
: undef;
|
|
}
|
|
|
|
sub quit
|
|
{
|
|
my $me = shift;
|
|
|
|
$me->_QUIT;
|
|
$me->close;
|
|
}
|
|
|
|
sub DESTROY
|
|
{
|
|
# ignore
|
|
}
|
|
|
|
##
|
|
## RFC821 commands
|
|
##
|
|
|
|
sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
|
|
sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
|
|
sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
|
|
sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
|
|
sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
|
|
sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
|
|
sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
|
|
sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
|
|
sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
|
|
sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
|
|
sub _RSET { shift->command("RSET")->response() == CMD_OK }
|
|
sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
|
|
sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
|
|
sub _DATA { shift->command("DATA")->response() == CMD_MORE }
|
|
sub _TURN { shift->unsupported(@_); }
|
|
sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Net::SMTP - Simple Mail Transfer Protocol Client
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Net::SMTP;
|
|
|
|
# Constructors
|
|
$smtp = Net::SMTP->new('mailhost');
|
|
$smtp = Net::SMTP->new('mailhost', Timeout => 60);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module implements a client interface to the SMTP and ESMTP
|
|
protocol, enabling a perl5 application to talk to SMTP servers. This
|
|
documentation assumes that you are familiar with the concepts of the
|
|
SMTP protocol described in RFC821.
|
|
|
|
A new Net::SMTP object must be created with the I<new> method. Once
|
|
this has been done, all SMTP commands are accessed through this object.
|
|
|
|
The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
|
|
|
|
=head1 EXAMPLES
|
|
|
|
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;
|
|
|
|
This example sends a small message to the postmaster at the SMTP server
|
|
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
|
|
|
|
=over 4
|
|
|
|
=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.
|
|
|
|
If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
|
|
will be used.
|
|
|
|
C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
|
|
Possible options are:
|
|
|
|
B<Hello> - SMTP requires that you identify yourself. This option
|
|
specifies a string to pass as your mail domain. If not
|
|
given a guess will be taken.
|
|
|
|
B<Timeout> - Maximum time, in seconds, to wait for a response from the
|
|
SMTP server (default: 120)
|
|
|
|
B<Debug> - Enable debugging information
|
|
|
|
|
|
Example:
|
|
|
|
|
|
$smtp = Net::SMTP->new('mailhost',
|
|
Hello => 'my.mail.domain'
|
|
Timeout => 30,
|
|
Debug => 1,
|
|
);
|
|
|
|
=head1 METHODS
|
|
|
|
Unless otherwise stated all methods return either a I<true> or I<false>
|
|
value, with I<true> meaning that the operation was a success. When a method
|
|
states that it returns a value, failure will be returned as I<undef> or an
|
|
empty list.
|
|
|
|
=over 4
|
|
|
|
=item banner ()
|
|
|
|
Returns the banner message which the server replied with when the
|
|
initial connection was made.
|
|
|
|
=item domain ()
|
|
|
|
Returns the domain that the remote SMTP server identified itself as during
|
|
connection.
|
|
|
|
=item hello ( DOMAIN )
|
|
|
|
Tell the remote server the mail domain which you are in using the EHLO
|
|
command (or HELO if EHLO fails). Since this method is invoked
|
|
automatically when the Net::SMTP object is constructed the user should
|
|
normally not have to call it manually.
|
|
|
|
=item etrn ( DOMAIN )
|
|
|
|
Request a queue run for the DOMAIN given.
|
|
|
|
=item mail ( ADDRESS [, OPTIONS] )
|
|
|
|
=item send ( ADDRESS )
|
|
|
|
=item send_or_mail ( ADDRESS )
|
|
|
|
=item send_and_mail ( ADDRESS )
|
|
|
|
Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
|
|
is the address of the sender. This initiates the sending of a message. The
|
|
method C<recipient> should be called for each address that the message is to
|
|
be sent to.
|
|
|
|
The C<mail> method can some additional ESMTP OPTIONS which is passed
|
|
in hash like fashion, using key and value pairs. Possible options are:
|
|
|
|
Size => <bytes>
|
|
Return => <???>
|
|
Bits => "7" | "8"
|
|
Transaction => <ADDRESS>
|
|
Envelope => <ENVID>
|
|
|
|
|
|
=item reset ()
|
|
|
|
Reset the status of the server. This may be called after a message has been
|
|
initiated, but before any data has been sent, to cancel the sending of the
|
|
message.
|
|
|
|
=item recipient ( ADDRESS [, ADDRESS [ ...]] [, OPTIONS ] )
|
|
|
|
Notify the server that the current message should be sent to all of the
|
|
addresses given. Each address is sent as a separate command to the server.
|
|
Should the sending of any address result in a failure then the
|
|
process is aborted and a I<false> value is returned. It is up to the
|
|
user to call C<reset> if they so desire.
|
|
|
|
The C<recipient> method can some additional OPTIONS which is passed
|
|
in hash like fashion, using key and value pairs. Possible options are:
|
|
|
|
Notify =>
|
|
SkipBad => ignore bad addresses
|
|
|
|
If C<SkipBad> is true the C<recipient> will not return an error when a
|
|
bad address is encountered and it will return an array of addresses
|
|
that did succeed.
|
|
|
|
=item to ( ADDRESS [, ADDRESS [...]] )
|
|
|
|
A synonym for C<recipient>.
|
|
|
|
=item data ( [ DATA ] )
|
|
|
|
Initiate the sending of the data from the current message.
|
|
|
|
C<DATA> may be a reference to a list or a list. If specified the contents
|
|
of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
|
|
result will be true if the data was accepted.
|
|
|
|
If C<DATA> is not specified then the result will indicate that the server
|
|
wishes the data to be sent. The data must then be sent using the C<datasend>
|
|
and C<dataend> methods described in L<Net::Cmd>.
|
|
|
|
=item expand ( ADDRESS )
|
|
|
|
Request the server to expand the given address Returns an array
|
|
which contains the text read from the server.
|
|
|
|
=item verify ( ADDRESS )
|
|
|
|
Verify that C<ADDRESS> is a legitimate mailing address.
|
|
|
|
=item help ( [ $subject ] )
|
|
|
|
Request help text from the server. Returns the text or undef upon failure
|
|
|
|
=item quit ()
|
|
|
|
Send the QUIT command to the remote SMTP server and close the socket connection.
|
|
|
|
=back
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Net::Cmd>
|
|
|
|
=head1 AUTHOR
|
|
|
|
Graham Barr <[email protected]>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 1995-1997 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.
|
|
|
|
=cut
|