CLIX - Fazer Clix Custa Nix/CLIX-CD.cdr/mac/lib/Net/SMTP.pm

Text File | 1997-11-18 | 12KB | 543 lines

# Net::SMTP.pm
#
# Copyright (c) 1995-1997 Graham Barr <[e-mail]>. 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 = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};

@ISA = qw(Net::Cmd IO::Socket::INET);

sub new
{
 my $self = shift;
 my $type = ref($self) || $self;
 my $host = shift if @_ % 2;
 my %arg  = @_;
 my $hosts = defined $host ? [ $host ] : $NetConfig{smtp_hosts};
 my $obj;

 my $h;
 foreach $h (@{$hosts})
  {
   $obj = $type->SUPER::new(PeerAddr => ($host = $h),
                PeerPort => $arg{Port} || 'smtp(25)',
                Proto    => 'tcp',
                Timeout  => defined $arg{Timeout}
                        ? $arg{Timeout}
                        : 120
               ) and last;
  }

 return undef
    unless defined $obj;

 $obj->autoflush(1);

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

 unless ($obj->response() == CMD_OK)
  {
   $obj->SUPER::close();
   return undef;
  }

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

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

 $obj->hello($arg{Hello} || "");

 $obj;
}

##
## User interface methods
##

sub domain
{
 my $me = shift;

 return ${*$me}{'net_smtp_domain'} || undef;
}

sub hello
{
 my $me = shift;
 my $domain = shift ||
          eval {
            require Net::Domain;
            Net::Domain::hostfqdn();
           } ||
        "";
 my $ok = $me->_EHLO($domain);
 my $msg;

 if($ok)
  {
   $msg = $me->message;

   my $h = ${*$me}{'net_smtp_esmtp'} = {};
   my $ext;
   foreach $ext (qw(8BITMIME CHECKPOINT DSN SIZE))
    {
     $h->{$ext} = 1
    if $msg =~ /\b${ext}\b/;
    }
  }
 else
  {
   $msg = $me->message
    if $me->_HELO($domain);
  }

 $ok && $msg =~ /\A(\S+)/
    ? $1
    : undef;
}

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 $ok = 1;
 my $opts = "";

 if(@_ && ref($_[-1]))
  {
   my %opt = %{pop(@_)};
   my $v;

   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;
    }
   else
    {
     carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
    }
  }

 while($ok && scalar(@_))
  {
   $ok = $smtp->_RCPT("TO:" . _addr(shift) . $opts);
  }

 return $ok;
}

sub to { shift->recipient(@_) }

sub data
{
 my $me = shift;

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

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

sub expand
{
 my $me = shift;

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


sub verify { shift->_VRFY(@_) }

sub help
{
 my $me = shift;

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

sub close
{
 my $me = shift;

 return 1
   unless (ref($me) && defined fileno($me));

 $me->_QUIT && $me->SUPER::close;
}

sub DESTROY { shift->close }
sub quit    { shift->close }

##
## 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(@_); }

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 a SMTP connection is required.

If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
will be used.

C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
Possible options are:

B<Hello> - SMTP requires that you identify yourself. This option
specifies a string to pass as your mail domain. If not
given a guess will be taken.

B<Timeout> - Maximum time, in seconds, to wait for a response from the
SMTP server (default: 120)

B<Debug> - Enable debugging information


Example:


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

=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 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 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 [ ...]] )

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.

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

A synonym 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 a reference to 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 <[e-mail]>

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

=cut