home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / Net / SMTP.pm < prev    next >
Text File  |  1997-11-17  |  12KB  |  544 lines

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