lib/Net/SMTP.pm

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