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.17"; # $Id: //depot/libnet/Net/SMTP.pm#17 $
  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->{uc $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*(\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 BEGIN {
 312   *to  = \&recipient;
 313   *cc  = \&recipient;
 314   *bcc = \&recipient;
 315 }
 316
 317 sub data
 318 {
 319  my $me = shift;
 320
 321  my $ok = $me->_DATA() && $me->datasend(@_);
 322
 323  $ok && @_ ? $me->dataend
 324            : $ok;
 325 }
 326
 327 sub expand
 328 {
 329  my $me = shift;
 330
 331  $me->_EXPN(@_) ? ($me->message)
 332                 : ();
 333 }
 334
 335
 336 sub verify { shift->_VRFY(@_) }
 337
 338 sub help
 339 {
 340  my $me = shift;
 341
 342  $me->_HELP(@_) ? scalar $me->message
 343                 : undef;
 344 }
 345
 346 sub quit
 347 {
 348  my $me = shift;
 349
 350  $me->_QUIT;
 351  $me->close;
 352 }
 353
 354 sub DESTROY
 355 {
 356 # ignore
 357 }
 358
 359 ##
 360 ## RFC821 commands
 361 ##
 362
 363 sub _EHLO { shift->command("EHLO", @_)->response()  == CMD_OK }
 364 sub _HELO { shift->command("HELO", @_)->response()  == CMD_OK }
 365 sub _MAIL { shift->command("MAIL", @_)->response()  == CMD_OK }
 366 sub _RCPT { shift->command("RCPT", @_)->response()  == CMD_OK }
 367 sub _SEND { shift->command("SEND", @_)->response()  == CMD_OK }
 368 sub _SAML { shift->command("SAML", @_)->response()  == CMD_OK }
 369 sub _SOML { shift->command("SOML", @_)->response()  == CMD_OK }
 370 sub _VRFY { shift->command("VRFY", @_)->response()  == CMD_OK }
 371 sub _EXPN { shift->command("EXPN", @_)->response()  == CMD_OK }
 372 sub _HELP { shift->command("HELP", @_)->response()  == CMD_OK }
 373 sub _RSET { shift->command("RSET")->response()      == CMD_OK }
 374 sub _NOOP { shift->command("NOOP")->response()      == CMD_OK }
 375 sub _QUIT { shift->command("QUIT")->response()      == CMD_OK }
 376 sub _DATA { shift->command("DATA")->response()      == CMD_MORE }
 377 sub _TURN { shift->unsupported(@_); }
 378 sub _ETRN { shift->command("ETRN", @_)->response()  == CMD_OK }
 379
 380 1;
 381
 382 __END__
 383
 384 =head1 NAME
 385
 386 Net::SMTP - Simple Mail Transfer Protocol Client
 387
 388 =head1 SYNOPSIS
 389
 390     use Net::SMTP;
 391
 392     # Constructors
 393     $smtp = Net::SMTP->new('mailhost');
 394     $smtp = Net::SMTP->new('mailhost', Timeout => 60);
 395
 396 =head1 DESCRIPTION
 397
 398 This module implements a client interface to the SMTP and ESMTP
 399 protocol, enabling a perl5 application to talk to SMTP servers. This
 400 documentation assumes that you are familiar with the concepts of the
 401 SMTP protocol described in RFC821.
 402
 403 A new Net::SMTP object must be created with the I<new> method. Once
 404 this has been done, all SMTP commands are accessed through this object.
 405
 406 The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
 407
 408 =head1 EXAMPLES
 409
 410 This example prints the mail domain name of the SMTP server known as mailhost:
 411
 412     #!/usr/local/bin/perl -w
 413
 414     use Net::SMTP;
 415
 416     $smtp = Net::SMTP->new('mailhost');
 417     print $smtp->domain,"\n";
 418     $smtp->quit;
 419
 420 This example sends a small message to the postmaster at the SMTP server
 421 known as mailhost:
 422
 423     #!/usr/local/bin/perl -w
 424
 425     use Net::SMTP;
 426
 427     $smtp = Net::SMTP->new('mailhost');
 428
 429     $smtp->mail($ENV{USER});
 430     $smtp->to('postmaster');
 431
 432     $smtp->data();
 433     $smtp->datasend("To: postmaster\n");
 434     $smtp->datasend("\n");
 435     $smtp->datasend("A simple test message\n");
 436     $smtp->dataend();
 437
 438     $smtp->quit;
 439
 440 =head1 CONSTRUCTOR
 441
 442 =over 4
 443
 444 =item new Net::SMTP [ HOST, ] [ OPTIONS ]
 445
 446 This is the constructor for a new Net::SMTP object. C<HOST> is the
 447 name of the remote host to which a SMTP connection is required.
 448
 449 If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
 450 will be used.
 451
 452 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
 453 Possible options are:
 454
 455 B<Hello> - SMTP requires that you identify yourself. This option
 456 specifies a string to pass as your mail domain. If not
 457 given a guess will be taken.
 458
 459 B<Timeout> - Maximum time, in seconds, to wait for a response from the
 460 SMTP server (default: 120)
 461
 462 B<Debug> - Enable debugging information
 463
 464
 465 Example:
 466
 467
 468     $smtp = Net::SMTP->new('mailhost',
 469                            Hello => 'my.mail.domain'
 470                            Timeout => 30,
 471                            Debug   => 1,
 472                           );
 473
 474 =back
 475
 476 =head1 METHODS
 477
 478 Unless otherwise stated all methods return either a I<true> or I<false>
 479 value, with I<true> meaning that the operation was a success. When a method
 480 states that it returns a value, failure will be returned as I<undef> or an
 481 empty list.
 482
 483 =over 4
 484
 485 =item banner ()
 486
 487 Returns the banner message which the server replied with when the
 488 initial connection was made.
 489
 490 =item domain ()
 491
 492 Returns the domain that the remote SMTP server identified itself as during
 493 connection.
 494
 495 =item hello ( DOMAIN )
 496
 497 Tell the remote server the mail domain which you are in using the EHLO
 498 command (or HELO if EHLO fails).  Since this method is invoked
 499 automatically when the Net::SMTP object is constructed the user should
 500 normally not have to call it manually.
 501
 502 =item etrn ( DOMAIN )
 503
 504 Request a queue run for the DOMAIN given.
 505
 506 =item mail ( ADDRESS [, OPTIONS] )
 507
 508 =item send ( ADDRESS )
 509
 510 =item send_or_mail ( ADDRESS )
 511
 512 =item send_and_mail ( ADDRESS )
 513
 514 Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
 515 is the address of the sender. This initiates the sending of a message. The
 516 method C<recipient> should be called for each address that the message is to
 517 be sent to.
 518
 519 The C<mail> method can some additional ESMTP OPTIONS which is passed
 520 in hash like fashion, using key and value pairs.  Possible options are:
 521
 522  Size        => <bytes>
 523  Return      => <???>
 524  Bits        => "7" | "8"
 525  Transaction => <ADDRESS>
 526  Envelope    => <ENVID>
 527
 528
 529 =item reset ()
 530
 531 Reset the status of the server. This may be called after a message has been
 532 initiated, but before any data has been sent, to cancel the sending of the
 533 message.
 534
 535 =item recipient ( ADDRESS [, ADDRESS [ ...]] [, OPTIONS ] )
 536
 537 Notify the server that the current message should be sent to all of the
 538 addresses given. Each address is sent as a separate command to the server.
 539 Should the sending of any address result in a failure then the
 540 process is aborted and a I<false> value is returned. It is up to the
 541 user to call C<reset> if they so desire.
 542
 543 The C<recipient> method can some additional OPTIONS which is passed
 544 in hash like fashion, using key and value pairs.  Possible options are:
 545
 546  Notify    =>
 547  SkipBad   => ignore bad addresses
 548
 549 If C<SkipBad> is true the C<recipient> will not return an error when a
 550 bad address is encountered and it will return an array of addresses
 551 that did succeed.
 552
 553   $smtp->recipient($recipient1,$recipient2);  # Good
 554   $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 });  # Good
 555   $smtp->recipient("$recipient,$recipient2"); # BAD
 556
 557 =item to ( ADDRESS [, ADDRESS [...]] )
 558
 559 =item cc ( ADDRESS [, ADDRESS [...]] )
 560
 561 =item bcc ( ADDRESS [, ADDRESS [...]] )
 562
 563 Synonyms for C<recipient>.
 564
 565 =item data ( [ DATA ] )
 566
 567 Initiate the sending of the data from the current message.
 568
 569 C<DATA> may be a reference to a list or a list. If specified the contents
 570 of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
 571 result will be true if the data was accepted.
 572
 573 If C<DATA> is not specified then the result will indicate that the server
 574 wishes the data to be sent. The data must then be sent using the C<datasend>
 575 and C<dataend> methods described in L<Net::Cmd>.
 576
 577 =item expand ( ADDRESS )
 578
 579 Request the server to expand the given address Returns an array
 580 which contains the text read from the server.
 581
 582 =item verify ( ADDRESS )
 583
 584 Verify that C<ADDRESS> is a legitimate mailing address.
 585
 586 =item help ( [ $subject ] )
 587
 588 Request help text from the server. Returns the text or undef upon failure
 589
 590 =item quit ()
 591
 592 Send the QUIT command to the remote SMTP server and close the socket connection.
 593
 594 =back
 595
 596 =head1 SEE ALSO
 597
 598 L<Net::Cmd>
 599
 600 =head1 AUTHOR
 601
 602 Graham Barr <gbarr@pobox.com>
 603
 604 =head1 COPYRIGHT
 605
 606 Copyright (c) 1995-1997 Graham Barr. All rights reserved.
 607 This program is free software; you can redistribute it and/or modify
 608 it under the same terms as Perl itself.
 609
 610 =for html <hr>
 611
 612 I<$Id: //depot/libnet/Net/SMTP.pm#17 $>
 613
 614 =cut