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

@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);
    my $code;

    push @cmd, MIME::Base64::encode_base64($str,'')
      if defined $str and length $str;

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

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