[p5sagit/p5-mst-13.2.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.18"; # $Id: //depot/libnet/Net/SMTP.pm#19 $

@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 ||
	      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->{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#19 $>

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