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

@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 {
    my ($self, $username, $password) = @_;

    require MIME::Base64;
    require Authen::SASL;

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

    my $sasl;

    if (ref($username) and UNIVERSAL::isa($username,'Authen::SASL')) {
      $sasl = $username;
      $sasl->mechanism($mechanisms);
    }
    else {
      die "auth(username, password)" if not length $username;
      $sasl = Authen::SASL->new(mechanism=> $mechanisms,
				callback => { user => $username,
                                              pass => $password,
					      authname => $username,
                                            });
    }

    # We should probably allow the user to pass the host, but I don't
    # currently know and SASL mechanisms that are used by smtp that need it
    my $client = $sasl->client_new('smtp',${*$self}{'net_smtp_host'},0);
    my $str    = $client->client_start;
    # We dont support sasl mechanisms that encrypt the socket traffic.
    # todo that we would really need to change the ISA hierarchy
    # so we dont inherit from IO::Socket, but instead hold it in an attribute

    my @cmd = ("AUTH", $client->mechanism, MIME::Base64::encode_base64($str,''));
    my $code;

    while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
      @cmd = (MIME::Base64::encode_base64(
	$client->client_step(
	  MIME::Base64::decode_base64(
	    ($self->message)[0]
	  )
	), ''
      ));
    }

    $code == CMD_OK;
}

sub hello
{
 my $me = shift;
 my $domain = shift || "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;
  $addr = "" unless defined $addr;
  $addr =~ s/^\s*<?\s*|\s*>?\s*$//sg;
  "<$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.

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

All methods that accept addresses expect the address to be a valid rfc2821-quoted address, although
Net::SMTP will accept accept the address surrounded by angle brackets.

 funny user@domain      WRONG
 "funny user"@domain    RIGHT, recommended
 <"funny user"@domain>  OK

=head1 SEE ALSO

L<Net::Cmd>

=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#25 $>

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