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

@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)',
			    LocalAddr => $arg{LocalAddr},
			    LocalPort => $arg{LocalPort},
			    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 =~ /(\w+)\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 datafh {
  my $me = shift;
  return unless $me->_DATA();
  return $me->tied_fh;
}

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<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)

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#23 $>

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