lib/Net/SMTP.pm

   1 # Net::SMTP.pm
   2 #
   3 # Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
   4 # reserved. 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 =head1 NAME
  10
  11 Net::SMTP - Simple Mail transfer Protocol Client
  12
  13 =head1 SYNOPSIS
  14
  15     use Net::SMTP;
  16
  17     # Constructors
  18     $smtp = Net::SMTP->new('mailhost');
  19     $smtp = Net::SMTP->new('mailhost', Timeout => 60);
  20
  21 =head1 DESCRIPTION
  22
  23 This module implements a client interface to the SMTP protocol, enabling
  24 a perl5 application to talk to SMTP servers. This documentation assumes
  25 that you are familiar with the SMTP protocol described in RFC821.
  26
  27 A new Net::SMTP object must be created with the I<new> method. Once
  28 this has been done, all SMTP commands are accessed through this object.
  29
  30 =head1 EXAMPLES
  31
  32 This example prints the mail domain name of the SMTP server known as mailhost:
  33
  34     #!/usr/local/bin/perl -w
  35
  36     use Net::SMTP;
  37
  38     $smtp = Net::SMTP->new('mailhost');
  39
  40     print $smtp->domain,"\n";
  41
  42     $smtp->quit;
  43
  44 This example sends a small message to the postmaster at the SMTP server
  45 known as mailhost:
  46
  47     #!/usr/local/bin/perl -w
  48
  49     use Net::SMTP;
  50
  51     $smtp = Net::SMTP->new('mailhost');
  52
  53     $smtp->mail($ENV{USER});
  54
  55     $smtp->to('postmaster');
  56
  57     $smtp->data();
  58
  59     $smtp->datasend("To: postmaster\n");
  60     $smtp->datasend("\n");
  61     $smtp->datasend("A simple test message\n");
  62
  63     $smtp->dataend();
  64
  65     $smtp->quit;
  66
  67 =head1 CONSTRUCTOR
  68
  69 =over 4
  70
  71 =item new ( HOST, [ OPTIONS ] )
  72
  73 This is the constructor for a new Net::SMTP object. C<HOST> is the
  74 name of the remote host to which a SMTP connection is required.
  75
  76 C<OPTIONS> are passed in a hash like fasion, using key and value pairs.
  77 Possible options are:
  78
  79 B<Hello> - SMTP requires that you identify yourself. This option
  80 specifies a string to pass as your mail domain. If not
  81 given a guess will be taken.
  82
  83 B<Timeout> - Maximum time, in seconds, to wait for a response from the
  84 SMTP server (default: 120)
  85
  86 B<Debug> - Enable debugging information
  87
  88
  89 Example:
  90
  91
  92     $smtp = Net::SMTP->new('mailhost',
  93                            Hello => 'my.mail.domain'
  94                           );
  95
  96 =head1 METHODS
  97
  98 Unless otherwise stated all methods return either a I<true> or I<false>
  99 value, with I<true> meaning that the operation was a success. When a method
 100 states that it returns a value, falure will be returned as I<undef> or an
 101 empty list.
 102
 103 =over 4
 104
 105 =item domain ()
 106
 107 Returns the domain that the remote SMTP server identified itself as during
 108 connection.
 109
 110 =item hello ( DOMAIN )
 111
 112 Tell the remote server the mail domain which you are in using the HELO
 113 command.
 114
 115 =item mail ( ADDRESS )
 116
 117 =item send ( ADDRESS )
 118
 119 =item send_or_mail ( ADDRESS )
 120
 121 =item send_and_mail ( ADDRESS )
 122
 123 Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
 124 is the address of the sender. This initiates the sending of a message. The
 125 method C<recipient> should be called for each address that the message is to
 126 be sent to.
 127
 128 =item reset ()
 129
 130 Reset the status of the server. This may be called after a message has been
 131 initiated, but before any data has been sent, to cancel the sending of the
 132 message.
 133
 134 =item recipient ( ADDRESS [, ADDRESS [ ...]] )
 135
 136 Notify the server that the current message should be sent to all of the
 137 addresses given. Each address is sent as a separate command to the server.
 138 Should the sending of any address result in a failure then the
 139 process is aborted and a I<false> value is returned. It is up to the
 140 user to call C<reset> if they so desire.
 141
 142 =item to ()
 143
 144 A synonym for recipient
 145
 146 =item data ( [ DATA ] )
 147
 148 Initiate the sending of the data fro the current message.
 149
 150 C<DATA> may be a reference to a list or a list. If specified the contents
 151 of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
 152 result will be true if the data was accepted.
 153
 154 If C<DATA> is not specified then the result will indicate that the server
 155 wishes the data to be sent. The data must then be sent using the C<datasend>
 156 and C<dataend> methods defined in C<Net::Cmd>.
 157
 158 =item expand ( ADDRESS )
 159
 160 Request the server to expand the given address Returns a reference to an array
 161 which contains the text read from the server.
 162
 163 =item verify ( ADDRESS )
 164
 165 Verify that C<ADDRESS> is a legitimate mailing address.
 166
 167 =item help ( [ $subject ] )
 168
 169 Request help text from the server. Returns the text or undef upon failure
 170
 171 =item quit ()
 172
 173 Send the QUIT command to the remote SMTP server and close the socket connection.
 174
 175 =back
 176
 177 =head1 SEE ALSO
 178
 179 L<Net::Cmd>
 180
 181 =head1 AUTHOR
 182
 183 Graham Barr <Graham.Barr@tiuk.ti.com>
 184
 185 =head1 REVISION
 186
 187 $Revision: 2.1 $
 188 $Date: 1996/08/20 20:23:56 $
 189
 190 The VERSION is derived from the revision by changing each number after the
 191 first dot into a 2 digit number so
 192
 193         Revision 1.8   => VERSION 1.08
 194         Revision 1.2.3 => VERSION 1.0203
 195
 196 =head1 COPYRIGHT
 197
 198 Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
 199 software; you can redistribute it and/or modify it under the same terms
 200 as Perl itself.
 201
 202 =cut
 203
 204 require 5.001;
 205
 206 use strict;
 207 use vars qw($VERSION @ISA);
 208 use Socket 1.3;
 209 use Carp;
 210 use IO::Socket;
 211 use Net::Cmd;
 212
 213 $VERSION = do{my @r=(q$Revision: 2.1 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
 214
 215 @ISA = qw(Net::Cmd IO::Socket::INET);
 216
 217 sub new
 218 {
 219  my $self = shift;
 220  my $type = ref($self) || $self;
 221  my $host = shift;
 222  my %arg  = @_;
 223  my $obj = $type->SUPER::new(PeerAddr => $host,
 224                              PeerPort => $arg{Port} || 'smtp(25)',
 225                              Proto    => 'tcp',
 226                              Timeout  => defined $arg{Timeout}
 227                                                 ? $arg{Timeout}
 228                                                 : 120
 229                             ) or return undef;
 230
 231  $obj->autoflush(1);
 232
 233  $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
 234
 235  unless ($obj->response() == CMD_OK)
 236   {
 237    $obj->SUPER::close();
 238    return undef;
 239   }
 240
 241  ${*$obj}{'net_smtp_host'} = $host;
 242
 243  (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
 244
 245  $obj->hello($arg{Hello} || "");
 246
 247  $obj;
 248 }
 249
 250 ##
 251 ## User interface methods
 252 ##
 253
 254 sub domain
 255 {
 256  my $me = shift;
 257
 258  return ${*$me}{'net_smtp_domain'} || undef;
 259 }
 260
 261 sub hello
 262 {
 263  my $me = shift;
 264  my $domain = shift ||
 265               eval {
 266                     require Net::Domain;
 267                     Net::Domain::hostdomain();
 268                    } ||
 269                 "";
 270  my $ok = $me->_EHLO($domain);
 271  my $msg;
 272
 273  if($ok)
 274   {
 275    $msg = $me->message;
 276
 277    my $h = ${*$me}{'net_smtp_esmtp'} = {};
 278    my $ext;
 279    foreach $ext (qw(8BITMIME CHECKPOINT DSN SIZE))
 280     {
 281      $h->{$ext} = 1
 282         if $msg =~ /\b${ext}\b/;
 283     }
 284   }
 285  else
 286   {
 287    $msg = $me->message
 288         if $me->_HELO($domain);
 289   }
 290
 291  $ok && $msg =~ /\A(\S+)/
 292         ? $1
 293         : undef;
 294 }
 295
 296 sub _addr
 297 {
 298  my $addr = shift || "";
 299
 300  return $1
 301     if $addr =~ /(<[^>]+>)/so;
 302
 303  $addr =~ s/\n/ /sog;
 304  $addr =~ s/(\A\s+|\s+\Z)//sog;
 305
 306  return "<" . $addr . ">";
 307 }
 308
 309
 310 sub mail
 311 {
 312  my $me = shift;
 313  my $addr = _addr(shift);
 314  my $opts = "";
 315
 316  if(@_)
 317   {
 318    my %opt = @_;
 319    my($k,$v);
 320
 321    if(exists ${*$me}{'net_smtp_esmtp'})
 322     {
 323      my $esmtp = ${*$me}{'net_smtp_esmtp'};
 324
 325      if(defined($v = delete $opt{Size}))
 326       {
 327        if(exists $esmtp->{SIZE})
 328         {
 329          $opts .= sprintf " SIZE=%d", $v + 0
 330         }
 331        else
 332         {
 333          carp 'Net::SMTP::mail: SIZE option not supported by host';
 334         }
 335       }
 336
 337      if(defined($v = delete $opt{Return}))
 338       {
 339        if(exists $esmtp->{DSN})
 340         {
 341          $opts .= " RET=" . uc $v
 342         }
 343        else
 344         {
 345          carp 'Net::SMTP::mail: DSN option not supported by host';
 346         }
 347       }
 348
 349      if(defined($v = delete $opt{Bits}))
 350       {
 351        if(exists $esmtp->{'8BITMIME'})
 352         {
 353          $opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT"
 354         }
 355        else
 356         {
 357          carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
 358         }
 359       }
 360
 361      if(defined($v = delete $opt{Transaction}))
 362       {
 363        if(exists $esmtp->{CHECKPOINT})
 364         {
 365          $opts .= " TRANSID=" . _addr($v);
 366         }
 367        else
 368         {
 369          carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
 370         }
 371       }
 372
 373      if(defined($v = delete $opt{Envelope}))
 374       {
 375        if(exists $esmtp->{DSN})
 376         {
 377          $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
 378          $opts .= " ENVID=$v"
 379         }
 380        else
 381         {
 382          carp 'Net::SMTP::mail: DSN option not supported by host';
 383         }
 384       }
 385
 386      carp 'Net::SMTP::recipient: unknown option(s) '
 387                 . join(" ", keys %opt)
 388                 . ' - ignored'
 389         if scalar keys %opt;
 390     }
 391    else
 392     {
 393      carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
 394     }
 395   }
 396
 397  $me->_MAIL("FROM:".$addr.$opts);
 398 }
 399
 400 sub send          { shift->_SEND("FROM:" . _addr($_[0])) }
 401 sub send_or_mail  { shift->_SOML("FROM:" . _addr($_[0])) }
 402 sub send_and_mail { shift->_SAML("FROM:" . _addr($_[0])) }
 403
 404 sub reset
 405 {
 406  my $me = shift;
 407
 408  $me->dataend()
 409         if(exists ${*$me}{'net_smtp_lastch'});
 410
 411  $me->_RSET();
 412 }
 413
 414
 415 sub recipient
 416 {
 417  my $smtp = shift;
 418  my $ok = 1;
 419  my $opts = "";
 420
 421  if(@_ && ref($_[-1]))
 422   {
 423    my %opt = %{pop(@_)};
 424    my $v;
 425
 426    if(exists ${*$smtp}{'net_smtp_esmtp'})
 427     {
 428      my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
 429
 430      if(defined($v = delete $opt{Notify}))
 431       {
 432        if(exists $esmtp->{DSN})
 433         {
 434          $opts .= " NOTIFY=" . join(",",map { uc $_ } @$v)
 435         }
 436        else
 437         {
 438          carp 'Net::SMTP::recipient: DSN option not supported by host';
 439         }
 440       }
 441
 442      carp 'Net::SMTP::recipient: unknown option(s) '
 443                 . join(" ", keys %opt)
 444                 . ' - ignored'
 445         if scalar keys %opt;
 446     }
 447    else
 448     {
 449      carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
 450     }
 451   }
 452
 453  while($ok && scalar(@_))
 454   {
 455    $ok = $smtp->_RCPT("TO:" . _addr(shift) . $opts);
 456   }
 457
 458  return $ok;
 459 }
 460
 461 *to = \&recipient;
 462
 463 sub data
 464 {
 465  my $me = shift;
 466
 467  my $ok = $me->_DATA() && $me->datasend(@_);
 468
 469  $ok && @_ ? $me->dataend
 470            : $ok;
 471 }
 472
 473 sub expand
 474 {
 475  my $me = shift;
 476
 477  $me->_EXPN(@_) ? ($me->message)
 478                 : ();
 479 }
 480
 481
 482 sub verify { shift->_VRFY(@_) }
 483
 484 sub help
 485 {
 486  my $me = shift;
 487
 488  $me->_HELP(@_) ? scalar $me->message
 489                 : undef;
 490 }
 491
 492 sub close
 493 {
 494  my $me = shift;
 495
 496  return 1
 497    unless (ref($me) && defined fileno($me));
 498
 499  $me->_QUIT && $me->SUPER::close;
 500 }
 501
 502 sub DESTROY { shift->close }
 503 sub quit    { shift->close }
 504
 505 ##
 506 ## RFC821 commands
 507 ##
 508
 509 sub _EHLO { shift->command("EHLO", @_)->response()  == CMD_OK }
 510 sub _HELO { shift->command("HELO", @_)->response()  == CMD_OK }
 511 sub _MAIL { shift->command("MAIL", @_)->response()  == CMD_OK }
 512 sub _RCPT { shift->command("RCPT", @_)->response()  == CMD_OK }
 513 sub _SEND { shift->command("SEND", @_)->response()  == CMD_OK }
 514 sub _SAML { shift->command("SAML", @_)->response()  == CMD_OK }
 515 sub _SOML { shift->command("SOML", @_)->response()  == CMD_OK }
 516 sub _VRFY { shift->command("VRFY", @_)->response()  == CMD_OK }
 517 sub _EXPN { shift->command("EXPN", @_)->response()  == CMD_OK }
 518 sub _HELP { shift->command("HELP", @_)->response()  == CMD_OK }
 519 sub _RSET { shift->command("RSET")->response()      == CMD_OK }
 520 sub _NOOP { shift->command("NOOP")->response()      == CMD_OK }
 521 sub _QUIT { shift->command("QUIT")->response()      == CMD_OK }
 522 sub _DATA { shift->command("DATA")->response()      == CMD_MORE }
 523 sub _TURN { shift->unsupported(@_); }
 524
 525 1;
 526