X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FNet%2FSMTP.pm;h=a28496d68867903deee5b51ca360d6cad75088ee;hb=23f6cb285656c85849665669b0a13828f0d8b395;hp=be64037403a2685a41281733162ae28e5d6832ef;hpb=dea4d7dfbb03f4a0014d53b245f3d8b5b801961c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/Net/SMTP.pm b/lib/Net/SMTP.pm
index be64037..a28496d 100644
--- a/lib/Net/SMTP.pm
+++ b/lib/Net/SMTP.pm
@@ -1,6 +1,6 @@
 # Net::SMTP.pm
 #
-# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 
@@ -16,174 +16,192 @@ use IO::Socket;
 use Net::Cmd;
 use Net::Config;
 
-$VERSION = "2.26"; # $Id: //depot/libnet/Net/SMTP.pm#31 $
+$VERSION = "2.31";
 
 @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 (@{ref($hosts) ? $hosts : [ $hosts ]})
-  {
-   $obj = $type->SUPER::new(PeerAddr => ($host = $h), 
-			    PeerPort => $arg{Port} || 'smtp(25)',
-			    LocalAddr => $arg{LocalAddr},
-			    LocalPort => $arg{LocalPort},
-			    Proto    => 'tcp',
-			    Timeout  => defined $arg{Timeout}
-						? $arg{Timeout}
-						: 120
-			   ) and last;
+
+sub new {
+  my $self = shift;
+  my $type = ref($self) || $self;
+  my ($host, %arg);
+  if (@_ % 2) {
+    $host = shift;
+    %arg  = @_;
+  }
+  else {
+    %arg  = @_;
+    $host = delete $arg{Host};
+  }
+  my $hosts = defined $host ? $host : $NetConfig{smtp_hosts};
+  my $obj;
+
+  my $h;
+  foreach $h (@{ref($hosts) ? $hosts : [$hosts]}) {
+    $obj = $type->SUPER::new(
+      PeerAddr => ($host = $h),
+      PeerPort => $arg{Port} || 'smtp(25)',
+      LocalAddr => $arg{LocalAddr},
+      LocalPort => $arg{LocalPort},
+      Proto     => 'tcp',
+      Timeout   => defined $arg{Timeout}
+      ? $arg{Timeout}
+      : 120
+      )
+      and last;
   }
 
- return undef
-	unless defined $obj;
+  return undef
+    unless defined $obj;
 
- $obj->autoflush(1);
+  $obj->autoflush(1);
 
- $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
+  $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
 
- unless ($obj->response() == CMD_OK)
-  {
-   $obj->close();
-   return undef;
+  unless ($obj->response() == CMD_OK) {
+    $obj->close();
+    return undef;
   }
 
- ${*$obj}{'net_smtp_exact_addr'} = $arg{ExactAddresses};
- ${*$obj}{'net_smtp_host'} = $host;
+  ${*$obj}{'net_smtp_exact_addr'} = $arg{ExactAddresses};
+  ${*$obj}{'net_smtp_host'}       = $host;
 
- (${*$obj}{'net_smtp_banner'}) = $obj->message;
- (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
+  (${*$obj}{'net_smtp_banner'}) = $obj->message;
+  (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
 
- unless($obj->hello($arg{Hello} || ""))
-  {
-   $obj->close();
-   return undef;
+  unless ($obj->hello($arg{Hello} || "")) {
+    $obj->close();
+    return undef;
   }
 
- $obj;
+  $obj;
+}
+
+
+sub host {
+  my $me = shift;
+  ${*$me}{'net_smtp_host'};
 }
 
 ##
 ## User interface methods
 ##
 
-sub banner
-{
- my $me = shift;
 
- return ${*$me}{'net_smtp_banner'} || undef;
+sub banner {
+  my $me = shift;
+
+  return ${*$me}{'net_smtp_banner'} || undef;
 }
 
-sub domain
-{
- my $me = shift;
 
- return ${*$me}{'net_smtp_domain'} || undef;
+sub domain {
+  my $me = shift;
+
+  return ${*$me}{'net_smtp_domain'} || undef;
 }
 
+
 sub etrn {
-    my $self = shift;
-    defined($self->supports('ETRN',500,["Command unknown: 'ETRN'"])) &&
-	$self->_ETRN(@_);
+  my $self = shift;
+  defined($self->supports('ETRN', 500, ["Command unknown: 'ETRN'"]))
+    && $self->_ETRN(@_);
 }
 
+
 sub auth {
-    my ($self, $username, $password) = @_;
+  my ($self, $username, $password) = @_;
 
+  eval {
     require MIME::Base64;
     require Authen::SASL;
+  } or $self->set_status(500, ["Need MIME::Base64 and Authen::SASL todo auth"]), return 0;
 
-    my $mechanisms = $self->supports('AUTH',500,["Command unknown: 'AUTH'"]);
-    return unless defined $mechanisms;
+  my $mechanisms = $self->supports('AUTH', 500, ["Command unknown: 'AUTH'"]);
+  return unless defined $mechanisms;
 
-    my $sasl;
+  my $sasl;
 
-    if (ref($username) and UNIVERSAL::isa($username,'Authen::SASL')) {
-      $sasl = $username;
-      $sasl->mechanism($mechanisms);
-    }
-    else {
-      die "auth(username, password)" if not length $username;
-      $sasl = Authen::SASL->new(mechanism=> $mechanisms,
-				callback => { user => $username,
-                                              pass => $password,
-					      authname => $username,
-                                            });
-    }
+  if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) {
+    $sasl = $username;
+    $sasl->mechanism($mechanisms);
+  }
+  else {
+    die "auth(username, password)" if not length $username;
+    $sasl = Authen::SASL->new(
+      mechanism => $mechanisms,
+      callback  => {
+        user     => $username,
+        pass     => $password,
+        authname => $username,
+      }
+    );
+  }
 
-    # We should probably allow the user to pass the host, but I don't
-    # currently know and SASL mechanisms that are used by smtp that need it
-    my $client = $sasl->client_new('smtp',${*$self}{'net_smtp_host'},0);
-    my $str    = $client->client_start;
-    # We dont support sasl mechanisms that encrypt the socket traffic.
-    # todo that we would really need to change the ISA hierarchy
-    # so we dont inherit from IO::Socket, but instead hold it in an attribute
-
-    my @cmd = ("AUTH", $client->mechanism);
-    my $code;
-
-    push @cmd, MIME::Base64::encode_base64($str,'')
-      if defined $str and length $str;
-
-    while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
-      @cmd = (MIME::Base64::encode_base64(
-	$client->client_step(
-	  MIME::Base64::decode_base64(
-	    ($self->message)[0]
-	  )
-	), ''
-      ));
-    }
+  # We should probably allow the user to pass the host, but I don't
+  # currently know and SASL mechanisms that are used by smtp that need it
+  my $client = $sasl->client_new('smtp', ${*$self}{'net_smtp_host'}, 0);
+  my $str    = $client->client_start;
+
+  # We dont support sasl mechanisms that encrypt the socket traffic.
+  # todo that we would really need to change the ISA hierarchy
+  # so we dont inherit from IO::Socket, but instead hold it in an attribute
+
+  my @cmd = ("AUTH", $client->mechanism);
+  my $code;
+
+  push @cmd, MIME::Base64::encode_base64($str, '')
+    if defined $str and length $str;
 
-    $code == CMD_OK;
+  while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
+    @cmd = (
+      MIME::Base64::encode_base64(
+        $client->client_step(MIME::Base64::decode_base64(($self->message)[0])), ''
+      )
+    );
+  }
+
+  $code == CMD_OK;
 }
 
-sub hello
-{
- my $me = shift;
- my $domain = shift || "localhost.localdomain";
- my $ok = $me->_EHLO($domain);
- my @msg = $me->message;
-
- if($ok)
-  {
-   my $h = ${*$me}{'net_smtp_esmtp'} = {};
-   my $ln;
-   foreach $ln (@msg) {
-     $h->{uc $1} = $2
-	if $ln =~ /(\w+)\b[= \t]*([^\n]*)/;
+
+sub hello {
+  my $me     = shift;
+  my $domain = shift || "localhost.localdomain";
+  my $ok     = $me->_EHLO($domain);
+  my @msg    = $me->message;
+
+  if ($ok) {
+    my $h = ${*$me}{'net_smtp_esmtp'} = {};
+    my $ln;
+    foreach $ln (@msg) {
+      $h->{uc $1} = $2
+        if $ln =~ /(\w+)\b[= \t]*([^\n]*)/;
     }
   }
- elsif($me->status == CMD_ERROR) 
-  {
-   @msg = $me->message
-	if $ok = $me->_HELO($domain);
+  elsif ($me->status == CMD_ERROR) {
+    @msg = $me->message
+      if $ok = $me->_HELO($domain);
   }
 
- return undef unless $ok;
+  return undef unless $ok;
 
- $msg[0] =~ /\A\s*(\S+)/;
- return ($1 || " ");
+  $msg[0] =~ /\A\s*(\S+)/;
+  return ($1 || " ");
 }
 
+
 sub supports {
-    my $self = shift;
-    my $cmd = uc shift;
-    return ${*$self}{'net_smtp_esmtp'}->{$cmd}
-	if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
-    $self->set_status(@_)
-	if @_;
-    return;
+  my $self = shift;
+  my $cmd  = uc shift;
+  return ${*$self}{'net_smtp_esmtp'}->{$cmd}
+    if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
+  $self->set_status(@_)
+    if @_;
+  return;
 }
 
+
 sub _addr {
   my $self = shift;
   my $addr = shift;
@@ -200,187 +218,194 @@ sub _addr {
   "<$addr>";
 }
 
-sub mail
-{
- my $me = shift;
- my $addr = _addr($me, 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
+
+sub mail {
+  my $me   = shift;
+  my $addr = _addr($me, 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';
+        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) eq "FULL") ? "FULL" : "HDRS");
+      if (defined($v = delete $opt{Return})) {
+        if (exists $esmtp->{DSN}) {
+          $opts .= " RET=" . ((uc($v) eq "FULL") ? "FULL" : "HDRS");
         }
-       else
-        {
-	 carp 'Net::SMTP::mail: DSN option not supported by host';
+        else {
+          carp 'Net::SMTP::mail: DSN option not supported by host';
         }
       }
 
-     if(defined($v = delete $opt{Bits}))
-      {
-       if($v eq "8")
-        {
-         if(exists $esmtp->{'8BITMIME'})
-          {
-	 $opts .= " BODY=8BITMIME";
+      if (defined($v = delete $opt{Bits})) {
+        if ($v eq "8") {
+          if (exists $esmtp->{'8BITMIME'}) {
+            $opts .= " BODY=8BITMIME";
           }
-         else
-          {
-	 carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
+          else {
+            carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
           }
         }
-       elsif($v eq "binary")
-        {
-         if(exists $esmtp->{'BINARYMIME'} && exists $esmtp->{'CHUNKING'})
-          {
-   $opts .= " BODY=BINARYMIME";
-   ${*$me}{'net_smtp_chunking'} = 1;
+        elsif ($v eq "binary") {
+          if (exists $esmtp->{'BINARYMIME'} && exists $esmtp->{'CHUNKING'}) {
+            $opts .= " BODY=BINARYMIME";
+            ${*$me}{'net_smtp_chunking'} = 1;
           }
-         else
-          {
-   carp 'Net::SMTP::mail: BINARYMIME option not supported by host';
+          else {
+            carp 'Net::SMTP::mail: BINARYMIME option not supported by host';
           }
         }
-       elsif(exists $esmtp->{'8BITMIME'} or exists $esmtp->{'BINARYMIME'})
-        {
-   $opts .= " BODY=7BIT";
+        elsif (exists $esmtp->{'8BITMIME'} or exists $esmtp->{'BINARYMIME'}) {
+          $opts .= " BODY=7BIT";
         }
-       else
-        {
-   carp 'Net::SMTP::mail: 8BITMIME and BINARYMIME options not supported by host';
+        else {
+          carp 'Net::SMTP::mail: 8BITMIME and BINARYMIME options not supported by host';
         }
       }
 
-     if(defined($v = delete $opt{Transaction}))
-      {
-       if(exists $esmtp->{CHECKPOINT})
-        {
-	 $opts .= " TRANSID=" . _addr($me, $v);
+      if (defined($v = delete $opt{Transaction})) {
+        if (exists $esmtp->{CHECKPOINT}) {
+          $opts .= " TRANSID=" . _addr($me, $v);
         }
-       else
-        {
-	 carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
+        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"
+      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';
+        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;
+      if (defined($v = delete $opt{ENVID})) {
+
+        # expected to be in a format as required by RFC 3461, xtext-encoded
+        if (exists $esmtp->{DSN}) {
+          $opts .= " ENVID=$v";
+        }
+        else {
+          carp 'Net::SMTP::mail: DSN option not supported by host';
+        }
+      }
+
+      if (defined($v = delete $opt{AUTH})) {
+
+        # expected to be in a format as required by RFC 2554,
+        # rfc2821-quoted and xtext-encoded, or <>
+        if (exists $esmtp->{AUTH}) {
+          $v = '<>' if !defined($v) || $v eq '';
+          $opts .= " AUTH=$v";
+        }
+        else {
+          carp 'Net::SMTP::mail: AUTH option not supported by host';
+        }
+      }
+
+      if (defined($v = delete $opt{XVERP})) {
+        if (exists $esmtp->{'XVERP'}) {
+          $opts .= " XVERP";
+        }
+        else {
+          carp 'Net::SMTP::mail: XVERP 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 :-(';
+    else {
+      carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
     }
   }
 
- $me->_MAIL("FROM:".$addr.$opts);
+  $me->_MAIL("FROM:" . $addr . $opts);
 }
 
-sub send	  { my $me = shift; $me->_SEND("FROM:" . _addr($me, $_[0])) }
+
+sub send          { my $me = shift; $me->_SEND("FROM:" . _addr($me, $_[0])) }
 sub send_or_mail  { my $me = shift; $me->_SOML("FROM:" . _addr($me, $_[0])) }
 sub send_and_mail { my $me = shift; $me->_SAML("FROM:" . _addr($me, $_[0])) }
 
-sub reset
-{
- my $me = shift;
 
- $me->dataend()
-	if(exists ${*$me}{'net_smtp_lastch'});
+sub reset {
+  my $me = shift;
+
+  $me->dataend()
+    if (exists ${*$me}{'net_smtp_lastch'});
 
- $me->_RSET();
+  $me->_RSET();
 }
 
 
-sub recipient
-{
- my $smtp = shift;
- my $opts = "";
- my $skip_bad = 0;
+sub recipient {
+  my $smtp     = shift;
+  my $opts     = "";
+  my $skip_bad = 0;
 
- if(@_ && ref($_[-1]))
-  {
-   my %opt = %{pop(@_)};
-   my $v;
+  if (@_ && ref($_[-1])) {
+    my %opt = %{pop(@_)};
+    my $v;
 
-   $skip_bad = delete $opt{'SkipBad'};
+    $skip_bad = delete $opt{'SkipBad'};
 
-   if(exists ${*$smtp}{'net_smtp_esmtp'})
-    {
-     my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
+    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)
+      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';
+        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;
+      if (defined($v = delete $opt{ORcpt})) {
+        if (exists $esmtp->{DSN}) {
+          $opts .= " ORCPT=" . $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;
     }
-   elsif(%opt)
-    {
-     carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
+    elsif (%opt) {
+      carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
     }
   }
 
- my @ok;
- my $addr;
- foreach $addr (@_) 
-  {
-    if($smtp->_RCPT("TO:" . _addr($smtp, $addr) . $opts)) {
-      push(@ok,$addr) if $skip_bad;
+  my @ok;
+  my $addr;
+  foreach $addr (@_) {
+    if ($smtp->_RCPT("TO:" . _addr($smtp, $addr) . $opts)) {
+      push(@ok, $addr) if $skip_bad;
     }
-    elsif(!$skip_bad) {
+    elsif (!$skip_bad) {
       return 0;
     }
   }
 
- return $skip_bad ? @ok : 1;
+  return $skip_bad ? @ok : 1;
 }
 
 BEGIN {
@@ -389,117 +414,119 @@ BEGIN {
   *bcc = \&recipient;
 }
 
-sub data
-{
- my $me = shift;
 
- if(exists ${*$me}{'net_smtp_chunking'})
-  {
-   carp 'Net::SMTP::data: CHUNKING extension in use, must call bdat instead';
+sub data {
+  my $me = shift;
+
+  if (exists ${*$me}{'net_smtp_chunking'}) {
+    carp 'Net::SMTP::data: CHUNKING extension in use, must call bdat instead';
   }
- else
-  {
-   my $ok = $me->_DATA() && $me->datasend(@_);
+  else {
+    my $ok = $me->_DATA() && $me->datasend(@_);
 
-   $ok && @_ ? $me->dataend
-	     : $ok;
+    $ok && @_
+      ? $me->dataend
+      : $ok;
   }
 }
 
-sub bdat
-{
- my $me = shift;
 
- if(exists ${*$me}{'net_smtp_chunking'})
-  {
-   my $data = shift;
+sub bdat {
+  my $me = shift;
+
+  if (exists ${*$me}{'net_smtp_chunking'}) {
+    my $data = shift;
 
-   $me->_BDAT(length $data) && $me->rawdatasend($data) &&
-     $me->response() == CMD_OK;
+    $me->_BDAT(length $data)
+      && $me->rawdatasend($data)
+      && $me->response() == CMD_OK;
   }
- else
-  {
-   carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
+  else {
+    carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
   }
 }
 
-sub bdatlast
-{
- my $me = shift;
 
- if(exists ${*$me}{'net_smtp_chunking'})
-  {
-   my $data = shift;
+sub bdatlast {
+  my $me = shift;
+
+  if (exists ${*$me}{'net_smtp_chunking'}) {
+    my $data = shift;
 
-   $me->_BDAT(length $data, "LAST") && $me->rawdatasend($data) &&
-     $me->response() == CMD_OK;
+    $me->_BDAT(length $data, "LAST")
+      && $me->rawdatasend($data)
+      && $me->response() == CMD_OK;
   }
- else
-  {
-   carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
+  else {
+    carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
   }
 }
 
+
 sub datafh {
   my $me = shift;
   return unless $me->_DATA();
   return $me->tied_fh;
 }
 
-sub expand
-{
- my $me = shift;
 
- $me->_EXPN(@_) ? ($me->message)
-		: ();
+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 help {
+  my $me = shift;
+
+  $me->_HELP(@_)
+    ? scalar $me->message
+    : undef;
 }
 
-sub quit
-{
- my $me = shift;
 
- $me->_QUIT;
- $me->close;
+sub quit {
+  my $me = shift;
+
+  $me->_QUIT;
+  $me->close;
 }
 
-sub DESTROY
-{
-# ignore
+
+sub DESTROY {
+
+  # ignore
 }
 
 ##
 ## 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 _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 _BDAT { shift->command("BDAT", @_) }
-sub _TURN { shift->unsupported(@_); } 			   	  
-sub _ETRN { shift->command("ETRN", @_)->response()  == CMD_OK }
-sub _AUTH { shift->command("AUTH", @_)->response()  == CMD_OK }   
+sub _TURN { shift->unsupported(@_); }
+sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
+sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
 
 1;
 
@@ -565,23 +592,26 @@ known as mailhost:
 
 =over 4
 
-=item new Net::SMTP [ HOST, ] [ OPTIONS ]
+=item new ( [ HOST ] [, OPTIONS ] )
 
 This is the constructor for a new Net::SMTP object. C<HOST> is the
 name of the remote host to which an SMTP connection is required.
 
-If C<HOST> is an array reference then each value will be attempted
-in turn until a connection is made.
-
-If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
-will be used.
+C<HOST> is optional. If C<HOST> is not given then it may instead be
+passed as the C<Host> option described below. If neither is given then
+the C<SMTP_Hosts> 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.
+specifies a string to pass as your mail domain. If not given localhost.localdomain
+will be used.
+
+B<Host> - SMTP host to connect to. It may be a single scalar, as defined for
+the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
+an array with hosts to try in turn. The L</host> method will return the value
+which was used to connect to the host.
 
 B<LocalAddr> and B<LocalPort> - These parameters are passed directly
 to IO::Socket to allow binding the socket to a local port.
@@ -600,11 +630,25 @@ Example:
 
 
     $smtp = Net::SMTP->new('mailhost',
-			   Hello => 'my.mail.domain'
+			   Hello => 'my.mail.domain',
 			   Timeout => 30,
                            Debug   => 1,
 			  );
 
+    # the same
+    $smtp = Net::SMTP->new(
+			   Host => 'mailhost',
+			   Hello => 'my.mail.domain',
+			   Timeout => 30,
+                           Debug   => 1,
+			  );
+
+    # Connect to the default server from Net::config
+    $smtp = Net::SMTP->new(
+			   Hello => 'my.mail.domain',
+			   Timeout => 30,
+			  );
+
 =back
 
 =head1 METHODS
@@ -633,6 +677,11 @@ 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 host ()
+
+Returns the value used by the constructor, and passed to IO::Socket::INET,
+to connect to the host.
+
 =item etrn ( DOMAIN )
 
 Request a queue run for the DOMAIN given.
@@ -661,38 +710,87 @@ in hash like fashion, using key and value pairs.  Possible options are:
  Return      => "FULL" | "HDRS"
  Bits        => "7" | "8" | "binary"
  Transaction => <ADDRESS>
- Envelope    => <ENVID>
+ Envelope    => <ENVID>     # xtext-encodes its argument
+ ENVID       => <ENVID>     # similar to Envelope, but expects argument encoded
+ XVERP       => 1
+ AUTH        => <submitter> # encoded address according to RFC 2554
 
 The C<Return> and C<Envelope> parameters are used for DSN (Delivery
 Status Notification).
 
+The submitter address in C<AUTH> option is expected to be in a format as
+required by RFC 2554, in an RFC2821-quoted form and xtext-encoded, or <> .
+
 =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 [ ...]] [, OPTIONS ] )
+=item recipient ( ADDRESS [, ADDRESS, [...]] [, OPTIONS ] )
 
 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.
+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.
 
-The C<recipient> method can some additional OPTIONS which is passed
-in hash like fashion, using key and value pairs.  Possible options are:
+The C<recipient> method can also pass additional case-sensitive OPTIONS as an
+anonymous hash using key and value pairs.  Possible options are:
 
- Notify    =>
- SkipBad   => ignore bad addresses
+  Notify  => ['NEVER'] or ['SUCCESS','FAILURE','DELAY']  (see below)
+  ORcpt   => <ORCPT>
+  SkipBad => 1        (to ignore bad addresses)
 
-If C<SkipBad> is true the C<recipient> will not return an error when a
-bad address is encountered and it will return an array of addresses
-that did succeed.
+If C<SkipBad> is true the C<recipient> will not return an error when a bad
+address is encountered and it will return an array of addresses that did
+succeed.
 
   $smtp->recipient($recipient1,$recipient2);  # Good
   $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 });  # Good
-  $smtp->recipient("$recipient,$recipient2"); # BAD   
+  $smtp->recipient($recipient1,$recipient2, { Notify => ['FAILURE','DELAY'], SkipBad => 1 });  # Good
+  @goodrecips=$smtp->recipient(@recipients, { Notify => ['FAILURE'], SkipBad => 1 });  # Good
+  $smtp->recipient("$recipient,$recipient2"); # BAD
+
+Notify is used to request Delivery Status Notifications (DSNs), but your
+SMTP/ESMTP service may not respect this request depending upon its version and
+your site's SMTP configuration.
+
+Leaving out the Notify option usually defaults an SMTP service to its default
+behavior equivalent to ['FAILURE'] notifications only, but again this may be
+dependent upon your site's SMTP configuration.
+
+The NEVER keyword must appear by itself if used within the Notify option and "requests
+that a DSN not be returned to the sender under any conditions."
+
+  {Notify => ['NEVER']}
+
+  $smtp->recipient(@recipients, { Notify => ['NEVER'], SkipBad => 1 });  # Good
+
+You may use any combination of these three values 'SUCCESS','FAILURE','DELAY' in
+the anonymous array reference as defined by RFC3461 (see http://rfc.net/rfc3461.html
+for more information.  Note: quotations in this topic from same.).
+
+A Notify parameter of 'SUCCESS' or 'FAILURE' "requests that a DSN be issued on
+successful delivery or delivery failure, respectively."
+
+A Notify parameter of 'DELAY' "indicates the sender's willingness to receive
+delayed DSNs.  Delayed DSNs may be issued if delivery of a message has been
+delayed for an unusual amount of time (as determined by the Message Transfer
+Agent (MTA) at which the message is delayed), but the final delivery status
+(whether successful or failure) cannot be determined.  The absence of the DELAY
+keyword in a NOTIFY parameter requests that a "delayed" DSN NOT be issued under
+any conditions."
+
+  {Notify => ['SUCCESS','FAILURE','DELAY']}
+
+  $smtp->recipient(@recipients, { Notify => ['FAILURE','DELAY'], SkipBad => 1 });  # Good
+
+ORcpt is also part of the SMTP DSN extension according to RFC3461.
+It is used to pass along the original recipient that the mail was first
+sent to.  The machine that generates a DSN will use this address to inform
+the sender, because he can't know if recipients get rewritten by mail servers.
+It is expected to be in a format as required by RFC3461, xtext-encoded.
 
 =item to ( ADDRESS [, ADDRESS [...]] )
 
@@ -723,6 +821,9 @@ which contains the text read from the server.
 
 Verify that C<ADDRESS> is a legitimate mailing address.
 
+Most sites usually disable this feature in their SMTP service configuration.
+Use "Debug => 1" option under new() to see if disabled.
+
 =item help ( [ $subject ] )
 
 Request help text from the server. Returns the text or undef upon failure
@@ -737,11 +838,11 @@ Send the QUIT command to the remote SMTP server and close the socket connection.
 
 Net::SMTP attempts to DWIM with addresses that are passed. For
 example an application might extract The From: line from an email
-and pass that to mail(). While this may work, it is not reccomended.
+and pass that to mail(). While this may work, it is not recommended.
 The application should really use a module like L<Mail::Address>
 to extract the mail address and pass that.
 
-If C<ExactAddresses> is passed to the contructor, then addresses
+If C<ExactAddresses> is passed to the constructor, then addresses
 should be a valid rfc2821-quoted address, although Net::SMTP will
 accept accept the address surrounded by angle brackets.
 
@@ -759,12 +860,8 @@ Graham Barr <gbarr@pobox.com>
 
 =head1 COPYRIGHT
 
-Copyright (c) 1995-1997 Graham Barr. All rights reserved.
+Copyright (c) 1995-2004 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.
 
-=for html <hr>
-
-I<$Id: //depot/libnet/Net/SMTP.pm#31 $>
-
 =cut