<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># Net::SMTP.pm
#
# Copyright (c) 1995-1997 Graham Barr &lt;gbarr@pobox.com&gt;. 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-&gt;SUPER::new(PeerAddr =&gt; ($host = $h), 
			    PeerPort =&gt; $arg{Port} || 'smtp(25)',
			    LocalAddr =&gt; $arg{LocalAddr},
			    LocalPort =&gt; $arg{LocalPort},
			    Proto    =&gt; 'tcp',
			    Timeout  =&gt; defined $arg{Timeout}
						? $arg{Timeout}
						: 120
			   ) and last;
  }

 return undef
	unless defined $obj;

 $obj-&gt;autoflush(1);

 $obj-&gt;debug(exists $arg{Debug} ? $arg{Debug} : undef);

 unless ($obj-&gt;response() == CMD_OK)
  {
   $obj-&gt;close();
   return undef;
  }

 ${*$obj}{'net_smtp_host'} = $host;

 (${*$obj}{'net_smtp_banner'}) = $obj-&gt;message;
 (${*$obj}{'net_smtp_domain'}) = $obj-&gt;message =~ /\A\s*(\S+)/;

 unless($obj-&gt;hello($arg{Hello} || ""))
  {
   $obj-&gt;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-&gt;supports('ETRN',500,["Command unknown: 'ETRN'"])) &amp;&amp;
	$self-&gt;_ETRN(@_);
}

sub auth {
    my ($self, $username, $password) = @_;

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

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

    my $sasl;

    if (ref($username) and UNIVERSAL::isa($username,'Authen::SASL')) {
      $sasl = $username;
      $sasl-&gt;mechanism($mechanisms);
    }
    else {
      die "auth(username, password)" if not length $username;
      $sasl = Authen::SASL-&gt;new(mechanism=&gt; $mechanisms,
				callback =&gt; { user =&gt; $username,
                                              pass =&gt; $password,
					      authname =&gt; $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-&gt;client_new('smtp',${*$self}{'net_smtp_host'},0);
    my $str    = $client-&gt;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-&gt;mechanism, MIME::Base64::encode_base64($str,''));
    my $code;

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

    $code == CMD_OK;
}

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

 if($ok)
  {
   my $h = ${*$me}{'net_smtp_esmtp'} = {};
   my $ln;
   foreach $ln (@msg) {
     $h-&gt;{uc $1} = $2
	if $ln =~ /(\w+)\b[= \t]*([^\n]*)/;
    }
  }
 elsif($me-&gt;status == CMD_ERROR) 
  {
   @msg = $me-&gt;message
	if $ok = $me-&gt;_HELO($domain);
  }

 $ok &amp;&amp; $msg[0] =~ /\A\s*(\S+)/
	? $1
	: undef;
}

sub supports {
    my $self = shift;
    my $cmd = uc shift;
    return ${*$self}{'net_smtp_esmtp'}-&gt;{$cmd}
	if exists ${*$self}{'net_smtp_esmtp'}-&gt;{$cmd};
    $self-&gt;set_status(@_)
	if @_;
    return;
}

sub _addr {
  my $addr = shift;
  $addr = "" unless defined $addr;
  $addr =~ s/^\s*&lt;?\s*|\s*&gt;?\s*$//sg;
  "&lt;$addr&gt;";
}

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-&gt;{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-&gt;{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-&gt;{'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-&gt;{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-&gt;{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-&gt;_MAIL("FROM:".$addr.$opts);
}

sub send	  { shift-&gt;_SEND("FROM:" . _addr($_[0])) }
sub send_or_mail  { shift-&gt;_SOML("FROM:" . _addr($_[0])) }
sub send_and_mail { shift-&gt;_SAML("FROM:" . _addr($_[0])) }

sub reset
{
 my $me = shift;

 $me-&gt;dataend()
	if(exists ${*$me}{'net_smtp_lastch'});

 $me-&gt;_RSET();
}


sub recipient
{
 my $smtp = shift;
 my $opts = "";
 my $skip_bad = 0;

 if(@_ &amp;&amp; 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-&gt;{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-&gt;_RCPT("TO:" . _addr($addr) . $opts)) {
      push(@ok,$addr) if $skip_bad;
    }
    elsif(!$skip_bad) {
      return 0;
    }
  }

 return $skip_bad ? @ok : 1;
}

BEGIN {
  *to  = \&amp;recipient;
  *cc  = \&amp;recipient;
  *bcc = \&amp;recipient;
}

sub data
{
 my $me = shift;

 my $ok = $me-&gt;_DATA() &amp;&amp; $me-&gt;datasend(@_);

 $ok &amp;&amp; @_ ? $me-&gt;dataend
	   : $ok;
}

sub datafh {
  my $me = shift;
  return unless $me-&gt;_DATA();
  return $me-&gt;tied_fh;
}

sub expand
{
 my $me = shift;

 $me-&gt;_EXPN(@_) ? ($me-&gt;message)
		: ();
}


sub verify { shift-&gt;_VRFY(@_) }

sub help
{
 my $me = shift;

 $me-&gt;_HELP(@_) ? scalar $me-&gt;message
	        : undef;
}

sub quit
{
 my $me = shift;

 $me-&gt;_QUIT;
 $me-&gt;close;
}

sub DESTROY
{
# ignore
}

##
## RFC821 commands
##

sub _EHLO { shift-&gt;command("EHLO", @_)-&gt;response()  == CMD_OK }   
sub _HELO { shift-&gt;command("HELO", @_)-&gt;response()  == CMD_OK }   
sub _MAIL { shift-&gt;command("MAIL", @_)-&gt;response()  == CMD_OK }   
sub _RCPT { shift-&gt;command("RCPT", @_)-&gt;response()  == CMD_OK }   
sub _SEND { shift-&gt;command("SEND", @_)-&gt;response()  == CMD_OK }   
sub _SAML { shift-&gt;command("SAML", @_)-&gt;response()  == CMD_OK }   
sub _SOML { shift-&gt;command("SOML", @_)-&gt;response()  == CMD_OK }   
sub _VRFY { shift-&gt;command("VRFY", @_)-&gt;response()  == CMD_OK }   
sub _EXPN { shift-&gt;command("EXPN", @_)-&gt;response()  == CMD_OK }   
sub _HELP { shift-&gt;command("HELP", @_)-&gt;response()  == CMD_OK }   
sub _RSET { shift-&gt;command("RSET")-&gt;response()	    == CMD_OK }   
sub _NOOP { shift-&gt;command("NOOP")-&gt;response()	    == CMD_OK }   
sub _QUIT { shift-&gt;command("QUIT")-&gt;response()	    == CMD_OK }   
sub _DATA { shift-&gt;command("DATA")-&gt;response()	    == CMD_MORE } 
sub _TURN { shift-&gt;unsupported(@_); } 			   	  
sub _ETRN { shift-&gt;command("ETRN", @_)-&gt;response()  == CMD_OK }
sub _AUTH { shift-&gt;command("AUTH", @_)-&gt;response()  == CMD_OK }   

1;

__END__

=head1 NAME

Net::SMTP - Simple Mail Transfer Protocol Client

=head1 SYNOPSIS

    use Net::SMTP;

    # Constructors
    $smtp = Net::SMTP-&gt;new('mailhost');
    $smtp = Net::SMTP-&gt;new('mailhost', Timeout =&gt; 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&lt;new&gt; 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-&gt;new('mailhost');
    print $smtp-&gt;domain,"\n";
    $smtp-&gt;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-&gt;new('mailhost');

    $smtp-&gt;mail($ENV{USER});
    $smtp-&gt;to('postmaster');

    $smtp-&gt;data();
    $smtp-&gt;datasend("To: postmaster\n");
    $smtp-&gt;datasend("\n");
    $smtp-&gt;datasend("A simple test message\n");
    $smtp-&gt;dataend();

    $smtp-&gt;quit;

=head1 CONSTRUCTOR

=over 4

=item new Net::SMTP [ HOST, ] [ OPTIONS ]

This is the constructor for a new Net::SMTP object. C&lt;HOST&gt; is the
name of the remote host to which an SMTP connection is required.

If C&lt;HOST&gt; is not given, then the C&lt;SMTP_Host&gt; specified in C&lt;Net::Config&gt;
will be used.

C&lt;OPTIONS&gt; are passed in a hash like fashion, using key and value pairs.
Possible options are:

B&lt;Hello&gt; - 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&lt;LocalAddr&gt; and B&lt;LocalPort&gt; - These parameters are passed directly
to IO::Socket to allow binding the socket to a local port.

B&lt;Timeout&gt; - Maximum time, in seconds, to wait for a response from the
SMTP server (default: 120)

B&lt;Debug&gt; - Enable debugging information


Example:


    $smtp = Net::SMTP-&gt;new('mailhost',
			   Hello =&gt; 'my.mail.domain'
			   Timeout =&gt; 30,
                           Debug   =&gt; 1,
			  );

=back

=head1 METHODS

Unless otherwise stated all methods return either a I&lt;true&gt; or I&lt;false&gt;
value, with I&lt;true&gt; meaning that the operation was a success. When a method
states that it returns a value, failure will be returned as I&lt;undef&gt; 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&lt;ADDRESS&gt;
is the address of the sender. This initiates the sending of a message. The
method C&lt;recipient&gt; should be called for each address that the message is to
be sent to.

The C&lt;mail&gt; method can some additional ESMTP OPTIONS which is passed
in hash like fashion, using key and value pairs.  Possible options are:

 Size        =&gt; &lt;bytes&gt;
 Return      =&gt; &lt;???&gt;
 Bits        =&gt; "7" | "8"
 Transaction =&gt; &lt;ADDRESS&gt;
 Envelope    =&gt; &lt;ENVID&gt;


=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&lt;false&gt; value is returned. It is up to the
user to call C&lt;reset&gt; if they so desire.

The C&lt;recipient&gt; method can some additional OPTIONS which is passed
in hash like fashion, using key and value pairs.  Possible options are:

 Notify    =&gt;
 SkipBad   =&gt; ignore bad addresses

If C&lt;SkipBad&gt; is true the C&lt;recipient&gt; will not return an error when a
bad address is encountered and it will return an array of addresses
that did succeed.

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

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

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

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

Synonyms for C&lt;recipient&gt;.

=item data ( [ DATA ] )

Initiate the sending of the data from the current message. 

C&lt;DATA&gt; may be a reference to a list or a list. If specified the contents
of C&lt;DATA&gt; and a termination string C&lt;".\r\n"&gt; is sent to the server. And the
result will be true if the data was accepted.

If C&lt;DATA&gt; 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&lt;datasend&gt;
and C&lt;dataend&gt; methods described in L&lt;Net::Cmd&gt;.

=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&lt;ADDRESS&gt; 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
 &lt;"funny user"@domain&gt;  OK

=head1 SEE ALSO

L&lt;Net::Cmd&gt;

=head1 AUTHOR

Graham Barr &lt;gbarr@pobox.com&gt;

=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 &lt;hr&gt;

I&lt;$Id: //depot/libnet/Net/SMTP.pm#25 $&gt;

=cut
</pre></body></html>