[perl5.git] / lib / Net / SMTP.pm

# Net::SMTP.pm
#
# Copyright (c) 1995-1997 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.

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.19"; # $Id: //depot/libnet/Net/SMTP.pm#20 $

@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 auth { # auth(username, password) by mengwong 20011106.  the only supported mechanism at this time is PLAIN.
    # 
    # my $auth = $smtp->supports("AUTH");
    # $smtp->auth("username", "password") or die $smtp->message;
    # 

    require MIME::Base64;

    my $self = shift;
    my ($username, $password) = @_;
    die "auth(username, password)" if not length $username;

    my $mechanisms = $self->supports('AUTH',500,["Command unknown: 'AUTH'"]);
    return unless defined $mechanisms;

    if (not grep { uc $_ eq "PLAIN" } split ' ', $mechanisms) {
	$self->set_status(500, ["PLAIN mechanism not supported; server supports $mechanisms"]);
	return;
    }
    my $authstring = MIME::Base64::encode_base64(join "\0", ($username)x2, $password);
    $authstring =~ s/\n//g; # wrap long lines

    $self->_AUTH("PLAIN $authstring");
}

sub hello
{
 my $me = shift;
 my $domain = shift || "localhost.localdomain";
 my $ok = $me->_EHLO($domain);
 my @msg = $me->message;

 if($ok)
  {
   my $h = ${*$me}{'net_smtp_esmtp'} = {};
   my $ln;
   foreach $ln (@msg) {
     $h->{uc $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*(\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;
}

BEGIN {
  *to  = \&recipient;
  *cc  = \&recipient;
  *bcc = \&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 }
sub _AUTH { shift->command("AUTH", @_)->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 an 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,
			  );

=back

=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 auth ( USERNAME, PASSWORD )

Attempt SASL authentication.  At this time only the PLAIN mechanism is supported.

At some point in the future support for using Authen::SASL will be added

=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.

  $smtp->recipient($recipient1,$recipient2);  # Good
  $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 });  # Good
  $smtp->recipient("$recipient,$recipient2"); # BAD   

=item to ( ADDRESS [, ADDRESS [...]] )

=item cc ( ADDRESS [, ADDRESS [...]] )

=item bcc ( ADDRESS [, ADDRESS [...]] )

Synonyms 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 <gbarr@pobox.com>

=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.

=for html <hr>

I<$Id: //depot/libnet/Net/SMTP.pm#20 $>

=cut
Commit	Line	Data
406c51ee JH	1	# Net::SMTP.pm
	2	#
	3	# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
	4	# This program is free software; you can redistribute it and/or
	5	# modify it under the same terms as Perl itself.
	6
	7	package Net::SMTP;
	8
	9	require 5.001;
	10
	11	use strict;
	12	use vars qw($VERSION @ISA);
	13	use Socket 1.3;
	14	use Carp;
	15	use IO::Socket;
	16	use Net::Cmd;
	17	use Net::Config;
	18
046d9f47	19	$VERSION = "2.19"; # $Id: //depot/libnet/Net/SMTP.pm#20 $
406c51ee JH	20
	21	@ISA = qw(Net::Cmd IO::Socket::INET);
	22
	23	sub new
	24	{
	25	my $self = shift;
	26	my $type = ref($self) \|\| $self;
	27	my $host = shift if @_ % 2;
	28	my %arg = @_;
	29	my $hosts = defined $host ? [ $host ] : $NetConfig{smtp_hosts};
	30	my $obj;
	31
	32	my $h;
	33	foreach $h (@{$hosts})
	34	{
	35	$obj = $type->SUPER::new(PeerAddr => ($host = $h),
	36	PeerPort => $arg{Port} \|\| 'smtp(25)',
	37	Proto => 'tcp',
	38	Timeout => defined $arg{Timeout}
	39	? $arg{Timeout}
	40	: 120
	41	) and last;
	42	}
	43
	44	return undef
	45	unless defined $obj;
	46
	47	$obj->autoflush(1);
	48
	49	$obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
	50
	51	unless ($obj->response() == CMD_OK)
	52	{
	53	$obj->close();
	54	return undef;
	55	}
	56
	57	${*$obj}{'net_smtp_host'} = $host;
	58
	59	(${*$obj}{'net_smtp_banner'}) = $obj->message;
	60	(${$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s(\S+)/;
	61
	62	unless($obj->hello($arg{Hello} \|\| ""))
	63	{
	64	$obj->close();
	65	return undef;
	66	}
	67
	68	$obj;
	69	}
	70
	71	##
	72	## User interface methods
	73	##
	74
	75	sub banner
	76	{
	77	my $me = shift;
	78
	79	return ${*$me}{'net_smtp_banner'} \|\| undef;
	80	}
	81
	82	sub domain
	83	{
84	my $me = shift;
85
86	return ${*$me}{'net_smtp_domain'} \|\| undef;
87	}
88
89	sub etrn {
90	my $self = shift;
91	defined($self->supports('ETRN',500,["Command unknown: 'ETRN'"])) &&
92	$self->_ETRN(@_);
93	}
94
c8570720 GB	95	sub auth { # auth(username, password) by mengwong 20011106. the only supported mechanism at this time is PLAIN.
	96	#
	97	# my $auth = $smtp->supports("AUTH");
	98	# $smtp->auth("username", "password") or die $smtp->message;
	99	#
	100
	101	require MIME::Base64;
	102
	103	my $self = shift;
	104	my ($username, $password) = @_;
	105	die "auth(username, password)" if not length $username;
	106
	107	my $mechanisms = $self->supports('AUTH',500,["Command unknown: 'AUTH'"]);
	108	return unless defined $mechanisms;
	109
	110	if (not grep { uc $_ eq "PLAIN" } split ' ', $mechanisms) {
	111	$self->set_status(500, ["PLAIN mechanism not supported; server supports $mechanisms"]);
	112	return;
	113	}
	114	my $authstring = MIME::Base64::encode_base64(join "\0", ($username)x2, $password);
	115	$authstring =~ s/\n//g; # wrap long lines
	116
	117	$self->_AUTH("PLAIN $authstring");
	118	}
	119
406c51ee JH	120	sub hello
	121	{
	122	my $me = shift;
046d9f47	123	my $domain = shift \|\| "localhost.localdomain";
406c51ee JH	124	my $ok = $me->_EHLO($domain);
	125	my @msg = $me->message;
	126
	127	if($ok)
	128	{
	129	my $h = ${*$me}{'net_smtp_esmtp'} = {};
	130	my $ln;
	131	foreach $ln (@msg) {
686337f3	132	$h->{uc $1} = $2
406c51ee JH	133	if $ln =~ /(\S+)\b[ \t]([^\n])/;
	134	}
	135	}
	136	elsif($me->status == CMD_ERROR)
	137	{
	138	@msg = $me->message
	139	if $ok = $me->_HELO($domain);
	140	}
	141
302c2e6b	142	$ok && $msg[0] =~ /\A\s*(\S+)/
406c51ee JH	143	? $1
	144	: undef;
	145	}
	146
	147	sub supports {
	148	my $self = shift;
	149	my $cmd = uc shift;
	150	return ${*$self}{'net_smtp_esmtp'}->{$cmd}
	151	if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
	152	$self->set_status(@_)
	153	if @_;
	154	return;
	155	}
	156
	157	sub _addr
	158	{
	159	my $addr = shift \|\| "";
	160
	161	return $1
	162	if $addr =~ /(<[^>]+>)/so;
	163
	164	$addr =~ s/\n/ /sog;
	165	$addr =~ s/(\A\s+\|\s+\Z)//sog;
	166
	167	return "<" . $addr . ">";
	168	}
	169
	170
	171	sub mail
	172	{
	173	my $me = shift;
	174	my $addr = _addr(shift);
	175	my $opts = "";
	176
	177	if(@_)
	178	{
	179	my %opt = @_;
	180	my($k,$v);
	181
	182	if(exists ${*$me}{'net_smtp_esmtp'})
	183	{
	184	my $esmtp = ${*$me}{'net_smtp_esmtp'};
	185
	186	if(defined($v = delete $opt{Size}))
	187	{
	188	if(exists $esmtp->{SIZE})
	189	{
	190	$opts .= sprintf " SIZE=%d", $v + 0
	191	}
	192	else
	193	{
	194	carp 'Net::SMTP::mail: SIZE option not supported by host';
	195	}
	196	}
	197
	198	if(defined($v = delete $opt{Return}))
	199	{
	200	if(exists $esmtp->{DSN})
	201	{
	202	$opts .= " RET=" . uc $v
	203	}
	204	else
	205	{
	206	carp 'Net::SMTP::mail: DSN option not supported by host';
207	}
208	}
209
210	if(defined($v = delete $opt{Bits}))
211	{
212	if(exists $esmtp->{'8BITMIME'})
213	{
214	$opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT"
215	}
216	else
217	{
218	carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
219	}
220	}
221
222	if(defined($v = delete $opt{Transaction}))
223	{
224	if(exists $esmtp->{CHECKPOINT})
225	{
226	$opts .= " TRANSID=" . _addr($v);
227	}
228	else
229	{
230	carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
231	}
232	}
233
234	if(defined($v = delete $opt{Envelope}))
235	{
236	if(exists $esmtp->{DSN})
237	{
238	$v =~ s/([^\041-\176]\|=\|\+)/sprintf "+%02x", ord($1)/sge;
239	$opts .= " ENVID=$v"
240	}
241	else
242	{
243	carp 'Net::SMTP::mail: DSN option not supported by host';
244	}
245	}
246
247	carp 'Net::SMTP::recipient: unknown option(s) '
248	. join(" ", keys %opt)
249	. ' - ignored'
250	if scalar keys %opt;
251	}
252	else
253	{
254	carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
255	}
256	}
257
258	$me->_MAIL("FROM:".$addr.$opts);
259	}
260
261	sub send { shift->_SEND("FROM:" . _addr($_[0])) }
262	sub send_or_mail { shift->_SOML("FROM:" . _addr($_[0])) }
263	sub send_and_mail { shift->_SAML("FROM:" . _addr($_[0])) }
264
265	sub reset
266	{
267	my $me = shift;
268
269	$me->dataend()
270	if(exists ${*$me}{'net_smtp_lastch'});
271
272	$me->_RSET();
273	}
274
275
276	sub recipient
277	{
278	my $smtp = shift;
279	my $opts = "";
280	my $skip_bad = 0;
281
282	if(@_ && ref($_[-1]))
283	{
284	my %opt = %{pop(@_)};
285	my $v;
286
287	$skip_bad = delete $opt{'SkipBad'};
288
289	if(exists ${*$smtp}{'net_smtp_esmtp'})
290	{
291	my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
292
293	if(defined($v = delete $opt{Notify}))
294	{
295	if(exists $esmtp->{DSN})
296	{
297	$opts .= " NOTIFY=" . join(",",map { uc $_ } @$v)
298	}
299	else
300	{
301	carp 'Net::SMTP::recipient: DSN option not supported by host';
302	}
303	}
304
305	carp 'Net::SMTP::recipient: unknown option(s) '
306	. join(" ", keys %opt)
307	. ' - ignored'
308	if scalar keys %opt;
309	}
310	elsif(%opt)
311	{
312	carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
313	}
314	}
315
316	my @ok;
317	my $addr;
318	foreach $addr (@_)
319	{
320	if($smtp->_RCPT("TO:" . _addr($addr) . $opts)) {
321	push(@ok,$addr) if $skip_bad;
322	}
323	elsif(!$skip_bad) {
324	return 0;
325	}
326	}
327
328	return $skip_bad ? @ok : 1;
329	}
330
686337f3 JH	331	BEGIN {
	332	*to = \&recipient;
	333	*cc = \&recipient;
	334	*bcc = \&recipient;
	335	}
406c51ee JH	336
	337	sub data
	338	{
	339	my $me = shift;
	340
	341	my $ok = $me->_DATA() && $me->datasend(@_);
	342
	343	$ok && @_ ? $me->dataend
	344	: $ok;
	345	}
	346
	347	sub expand
	348	{
	349	my $me = shift;
	350
	351	$me->_EXPN(@_) ? ($me->message)
	352	: ();
	353	}
	354
	355
	356	sub verify { shift->_VRFY(@_) }
	357
	358	sub help
	359	{
	360	my $me = shift;
	361
	362	$me->_HELP(@_) ? scalar $me->message
	363	: undef;
	364	}
	365
	366	sub quit
	367	{
	368	my $me = shift;
	369
	370	$me->_QUIT;
	371	$me->close;
	372	}
	373
	374	sub DESTROY
	375	{
	376	# ignore
	377	}
	378
	379	##
	380	## RFC821 commands
	381	##
	382
	383	sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
	384	sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
	385	sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
	386	sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
	387	sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
	388	sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
	389	sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
	390	sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
	391	sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
	392	sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
	393	sub _RSET { shift->command("RSET")->response() == CMD_OK }
	394	sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
	395	sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
	396	sub _DATA { shift->command("DATA")->response() == CMD_MORE }
	397	sub _TURN { shift->unsupported(@_); }
	398	sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
c8570720	399	sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
406c51ee JH	400
	401	1;
	402
	403	__END__
	404
	405	=head1 NAME
	406
	407	Net::SMTP - Simple Mail Transfer Protocol Client
	408
	409	=head1 SYNOPSIS
	410
	411	use Net::SMTP;
686337f3	412
406c51ee JH	413	# Constructors
	414	$smtp = Net::SMTP->new('mailhost');
	415	$smtp = Net::SMTP->new('mailhost', Timeout => 60);
	416
	417	=head1 DESCRIPTION
	418
	419	This module implements a client interface to the SMTP and ESMTP
	420	protocol, enabling a perl5 application to talk to SMTP servers. This
	421	documentation assumes that you are familiar with the concepts of the
	422	SMTP protocol described in RFC821.
	423
	424	A new Net::SMTP object must be created with the I<new> method. Once
	425	this has been done, all SMTP commands are accessed through this object.
	426
	427	The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
	428
	429	=head1 EXAMPLES
	430
	431	This example prints the mail domain name of the SMTP server known as mailhost:
	432
	433	#!/usr/local/bin/perl -w
686337f3	434
406c51ee	435	use Net::SMTP;
686337f3	436
406c51ee JH	437	$smtp = Net::SMTP->new('mailhost');
	438	print $smtp->domain,"\n";
	439	$smtp->quit;
	440
	441	This example sends a small message to the postmaster at the SMTP server
	442	known as mailhost:
	443
	444	#!/usr/local/bin/perl -w
686337f3	445
406c51ee	446	use Net::SMTP;
686337f3	447
406c51ee	448	$smtp = Net::SMTP->new('mailhost');
686337f3	449
406c51ee JH	450	$smtp->mail($ENV{USER});
406c51ee JH	451	$smtp->to('postmaster');
686337f3	452
406c51ee JH	453	$smtp->data();
	454	$smtp->datasend("To: postmaster\n");
	455	$smtp->datasend("\n");
	456	$smtp->datasend("A simple test message\n");
	457	$smtp->dataend();
686337f3	458
406c51ee JH	459	$smtp->quit;
	460
	461	=head1 CONSTRUCTOR
	462
	463	=over 4
	464
	465	=item new Net::SMTP [ HOST, ] [ OPTIONS ]
	466
	467	This is the constructor for a new Net::SMTP object. C<HOST> is the
d1be9408	468	name of the remote host to which an SMTP connection is required.
406c51ee JH	469
	470	If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
	471	will be used.
	472
	473	C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
	474	Possible options are:
	475
	476	B<Hello> - SMTP requires that you identify yourself. This option
	477	specifies a string to pass as your mail domain. If not
	478	given a guess will be taken.
	479
	480	B<Timeout> - Maximum time, in seconds, to wait for a response from the
	481	SMTP server (default: 120)
	482
	483	B<Debug> - Enable debugging information
	484
	485
	486	Example:
	487
	488
	489	$smtp = Net::SMTP->new('mailhost',
	490	Hello => 'my.mail.domain'
	491	Timeout => 30,
	492	Debug => 1,
	493	);
	494
686337f3 JH	495	=back
686337f3 JH	496
406c51ee JH	497	=head1 METHODS
	498
	499	Unless otherwise stated all methods return either a I<true> or I<false>
	500	value, with I<true> meaning that the operation was a success. When a method
	501	states that it returns a value, failure will be returned as I<undef> or an
	502	empty list.
	503
	504	=over 4
	505
	506	=item banner ()
	507
	508	Returns the banner message which the server replied with when the
	509	initial connection was made.
	510
	511	=item domain ()
	512
	513	Returns the domain that the remote SMTP server identified itself as during
	514	connection.
	515
	516	=item hello ( DOMAIN )
	517
	518	Tell the remote server the mail domain which you are in using the EHLO
	519	command (or HELO if EHLO fails). Since this method is invoked
	520	automatically when the Net::SMTP object is constructed the user should
	521	normally not have to call it manually.
	522
	523	=item etrn ( DOMAIN )
	524
	525	Request a queue run for the DOMAIN given.
	526
c8570720 GB	527	=item auth ( USERNAME, PASSWORD )
	528
	529	Attempt SASL authentication. At this time only the PLAIN mechanism is supported.
	530
	531	At some point in the future support for using Authen::SASL will be added
	532
406c51ee JH	533	=item mail ( ADDRESS [, OPTIONS] )
	534
	535	=item send ( ADDRESS )
	536
	537	=item send_or_mail ( ADDRESS )
	538
	539	=item send_and_mail ( ADDRESS )
	540
	541	Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
	542	is the address of the sender. This initiates the sending of a message. The
	543	method C<recipient> should be called for each address that the message is to
	544	be sent to.
	545
	546	The C<mail> method can some additional ESMTP OPTIONS which is passed
	547	in hash like fashion, using key and value pairs. Possible options are:
	548
	549	Size => <bytes>
	550	Return => <???>
	551	Bits => "7" \| "8"
	552	Transaction => <ADDRESS>
	553	Envelope => <ENVID>
	554
	555
	556	=item reset ()
	557
	558	Reset the status of the server. This may be called after a message has been
	559	initiated, but before any data has been sent, to cancel the sending of the
	560	message.
	561
	562	=item recipient ( ADDRESS [, ADDRESS [ ...]] [, OPTIONS ] )
	563
	564	Notify the server that the current message should be sent to all of the
	565	addresses given. Each address is sent as a separate command to the server.
	566	Should the sending of any address result in a failure then the
	567	process is aborted and a I<false> value is returned. It is up to the
	568	user to call C<reset> if they so desire.
	569
	570	The C<recipient> method can some additional OPTIONS which is passed
	571	in hash like fashion, using key and value pairs. Possible options are:
	572
	573	Notify =>
	574	SkipBad => ignore bad addresses
	575
	576	If C<SkipBad> is true the C<recipient> will not return an error when a
	577	bad address is encountered and it will return an array of addresses
	578	that did succeed.
	579
686337f3 JH	580	$smtp->recipient($recipient1,$recipient2); # Good
	581	$smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
	582	$smtp->recipient("$recipient,$recipient2"); # BAD
	583
406c51ee JH	584	=item to ( ADDRESS [, ADDRESS [...]] )
406c51ee JH	585
686337f3 JH	586	=item cc ( ADDRESS [, ADDRESS [...]] )
	587
	588	=item bcc ( ADDRESS [, ADDRESS [...]] )
	589
	590	Synonyms for C<recipient>.
406c51ee JH	591
	592	=item data ( [ DATA ] )
	593
	594	Initiate the sending of the data from the current message.
	595
	596	C<DATA> may be a reference to a list or a list. If specified the contents
	597	of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
	598	result will be true if the data was accepted.
	599
	600	If C<DATA> is not specified then the result will indicate that the server
	601	wishes the data to be sent. The data must then be sent using the C<datasend>
	602	and C<dataend> methods described in L<Net::Cmd>.
	603
	604	=item expand ( ADDRESS )
	605
	606	Request the server to expand the given address Returns an array
	607	which contains the text read from the server.
	608
	609	=item verify ( ADDRESS )
	610
	611	Verify that C<ADDRESS> is a legitimate mailing address.
	612
	613	=item help ( [ $subject ] )
	614
	615	Request help text from the server. Returns the text or undef upon failure
	616
	617	=item quit ()
	618
	619	Send the QUIT command to the remote SMTP server and close the socket connection.
	620
	621	=back
	622
	623	=head1 SEE ALSO
	624
	625	L<Net::Cmd>
	626
	627	=head1 AUTHOR
	628
	629	Graham Barr <gbarr@pobox.com>
	630
	631	=head1 COPYRIGHT
	632
	633	Copyright (c) 1995-1997 Graham Barr. All rights reserved.
	634	This program is free software; you can redistribute it and/or modify
	635	it under the same terms as Perl itself.
	636
686337f3 JH	637	=for html <hr>
686337f3 JH	638
046d9f47	639	I<$Id: //depot/libnet/Net/SMTP.pm#20 $>
686337f3	640
406c51ee	641	=cut