Add Qpsmtpd::Command to gather all parsing logic in one place (Hanno

Hecker)


git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.3x@631 958fd67b-6ff1-0310-b445-bb7760255be9

Changes

@@ -1,5 +1,8 @@
 0.33
 
+  Add Qpsmtpd::Command to gather all parsing logic in one place (Hanno
+  Hecker)
+
   Fix a spurious newline at the start of messages queued via exim (Devin
   Carraway)
 

MANIFEST

@@ -16,6 +16,7 @@ lib/Apache/Qpsmtpd.pm
 lib/Qpsmtpd.pm
 lib/Qpsmtpd/Address.pm
 lib/Qpsmtpd/Auth.pm
+lib/Qpsmtpd/Command.pm
 lib/Qpsmtpd/Connection.pm
 lib/Qpsmtpd/Constants.pm
 lib/Qpsmtpd/Plugin.pm

config.sample/plugins

@@ -12,6 +12,13 @@
 # from one IP!
 hosts_allow
 
+# enable to accept MAIL FROM:/RCPT TO: addresses without surrounding <>
+dont_require_anglebrackets
+
+# enable to reject MAIL FROM:/RCPT TO: parameters if client helo was HELO
+# (strict RFC 821)... this is not used in EHLO ...
+# parse_addr_withhelo
+
 quit_fortune
 
 check_earlytalker

lib/Apache/Qpsmtpd.pm

@@ -131,7 +131,7 @@ sub read_input {
     while (defined(my $data = $self->getline)) {
         $data =~ s/\r?\n$//s; # advanced chomp
         $self->log(LOGDEBUG, "dispatching $data");
-        defined $self->dispatch(split / +/, $data)
+        defined $self->dispatch(split / +/, $data, 2)
             or $self->respond(502, "command unrecognized: '$data'");
         last if $self->{_quitting};
     }

lib/Qpsmtpd/Command.pm

@@ -0,0 +1,170 @@
+package Qpsmtpd::Command;
+
+=head1 NAME
+
+Qpsmtpd::Command - parse arguments to SMTP commands
+
+=head1 DESCRIPTION
+
+B<Qpsmtpd::Command> provides just one public sub routine: B<parse()>.
+
+This sub expects two or three arguments. The first is the name of the 
+SMTP command (such as I<HELO>, I<MAIL>, ...). The second must be the remaining
+of the line the client sent.
+
+If no third argument is given (or it's not a reference to a CODE) it parses 
+the line according to RFC 1869 (SMTP Service Extensions) for the I<MAIL> and 
+I<RCPT> commands and splitting by spaces (" ") for all other.
+
+Any module can supply it's own parsing routine by returning a sub routine 
+reference from a hook_*_parse. This sub will be called with I<$self>, I<$cmd>
+and I<$line>. 
+
+On successfull parsing it MUST return B<OK> (the constant from 
+I<Qpsmtpd::Constants>) success as first argument and a list of 
+values, which will be the arguments to the hook for this command.
+
+If parsing failed, the second returned value (if any) will be returned to the
+client as error message.
+
+=head1 EXAMPLE
+
+Inside a plugin 
+
+ sub hook_unrecognized_command_parse {
+    my ($self, $transaction, $cmd) = @_;
+    return (OK, \&bdat_parser) if ($cmd eq 'bdat');
+ }
+ 
+ sub bdat_parser {
+    my ($self,$cmd,$line) = @_;
+    # .. do something with $line...
+    return (DENY, "Invalid arguments") 
+      if $some_reason_why_there_is_a_syntax_error;
+    return (OK, @args);
+ }
+ 
+ sub hook_unrecognized_command {
+    my ($self, $transaction, $cmd, @args) = @_;
+    return (DECLINED) if ($self->qp->connection->hello eq 'helo');
+    return (DECLINED) unless ($cmd eq 'bdat');
+    ....
+ }
+
+=cut
+
+use Qpsmtpd::Constants;
+use vars qw(@ISA);
+@ISA = qw(Qpsmtpd::SMTP);
+use strict;
+
+sub parse {
+    my ($me,$cmd,$line,$sub) = @_;
+    return (OK) unless defined $line; # trivial case
+    my $self = {};
+    bless $self, $me;
+    $cmd = lc $1;
+    if ($sub and (ref($sub) eq 'CODE')) {
+        my @ret = eval { $sub->($self, $cmd, $line); };
+        if ($@) {
+            $self->log(LOGERROR, "Failed to parse command [$cmd]: $@");
+            return (DENY, $line, ());
+        }
+        ## my @log = @ret;
+        ## for (@log) {
+        ##     $_ ||= "";
+        ## }
+        ## $self->log(LOGDEBUG, "parse($cmd) => [".join("], [", @log)."]");
+        return @ret;
+    } 
+    my $parse = "parse_$cmd";
+    if ($self->can($parse)) {
+        # print "CMD=$cmd,line=$line\n";
+        my @out = eval { $self->$parse($cmd, $line); };
+        if ($@) {
+            $self->log(LOGERROR, "$parse($cmd,$line) failed: $@");
+            return(DENY, "Failed to parse line");
+        }
+        return @out;
+    }
+    return(OK, split(/ +/, $line)); # default :)
+}
+
+sub parse_rcpt {
+    my ($self,$cmd,$line) = @_;
+    return (DENY, "Syntax error in command") unless $line =~ s/^to:\s*//i;
+    return &_get_mail_params($cmd, $line);
+}
+
+sub parse_mail {
+    my ($self,$cmd,$line) = @_;
+    return (DENY, "Syntax error in command") unless $line =~ s/^from:\s*//i;
+    return &_get_mail_params($cmd, $line);
+}
+### RFC 1869:
+## 6.  MAIL FROM and RCPT TO Parameters
+## [...]
+##
+##   esmtp-cmd        ::= inner-esmtp-cmd [SP esmtp-parameters] CR LF
+##   esmtp-parameters ::= esmtp-parameter *(SP esmtp-parameter)
+##   esmtp-parameter  ::= esmtp-keyword ["=" esmtp-value]
+##   esmtp-keyword    ::= (ALPHA / DIGIT) *(ALPHA / DIGIT / "-")
+##
+##                        ; syntax and values depend on esmtp-keyword
+##   esmtp-value      ::= 1*<any CHAR excluding "=", SP, and all
+##                           control characters (US ASCII 0-31
+##                           inclusive)>
+##
+##                        ; The following commands are extended to
+##                        ; accept extended parameters.
+##   inner-esmtp-cmd  ::= ("MAIL FROM:" reverse-path)   /
+##                        ("RCPT TO:" forward-path)
+sub _get_mail_params {
+    my ($cmd,$line) = @_;
+    my @params = ();
+    $line =~ s/\s*$//;
+
+    while ($line =~ s/\s+([A-Za-z0-9][A-Za-z0-9\-]*(=[^= \x00-\x1f]+)?)$//) {
+        push @params, $1;
+    }
+    @params = reverse @params;
+
+    # the above will "fail" (i.e. all of the line in @params) on 
+    # some addresses without <> like
+    #    MAIL FROM: user=name@example.net
+    # or RCPT TO: postmaster
+
+    # let's see if $line contains nothing and use the first value as address:
+    if ($line) {
+        # parameter syntax error, i.e. not all of the arguments were 
+        # stripped by the while() loop:
+        return (DENY, "Syntax error in parameters")
+          if ($line =~ /\@.*\s/); 
+        return (OK, $line, @params);
+    }
+
+    $line = shift @params; 
+    if ($cmd eq "mail") {
+        return (OK, "<>") unless $line; # 'MAIL FROM:' --> 'MAIL FROM:<>'
+        return (DENY, "Syntax error in parameters") 
+          if ($line =~ /\@.*\s/); # parameter syntax error
+    }
+    else {
+        if ($line =~ /\@/) {
+            return (DENY, "Syntax error in parameters") 
+              if ($line =~ /\@.*\s/);
+        } 
+        else {
+            # XXX: what about 'abuse' in Qpsmtpd::Address?
+            return (DENY, "Syntax error in parameters") if $line =~ /\s/;
+            return (DENY, "Syntax error in address") 
+              unless ($line =~ /^(postmaster|abuse)$/i); 
+        }
+    }
+    ## XXX:  No: let this do a plugin, so it's not up to us to decide
+    ##       if we require <> around an address :-)
+    ## unless ($line =~ /^<.*>$/) { $line = "<".$line.">"; }
+    return (OK, $line, @params);
+}
+
+1;

lib/Qpsmtpd/Plugin.pm

@@ -4,9 +4,10 @@ use strict;
 
 # more or less in the order they will fire
 our @hooks = qw(
-    logging config pre-connection connect ehlo helo
-    auth auth-plain auth-login auth-cram-md5
-    rcpt mail data data_post queue_pre queue queue_post
+    logging config pre-connection connect ehlo_parse ehlo
+    helo_parse helo auth_parse auth auth-plain auth-login auth-cram-md5
+    rcpt_parse rcpt_pre rcpt mail_parse mail mail_pre 
+    data data_post queue_pre queue queue_post
     quit reset_transaction disconnect post-connection
     unrecognized_command deny ok
 );

lib/Qpsmtpd/SMTP.pm

@@ -12,6 +12,7 @@ use Qpsmtpd::Plugin;
 use Qpsmtpd::Constants;
 use Qpsmtpd::Auth;
 use Qpsmtpd::Address ();
+use Qpsmtpd::Command;
 
 use Mail::Header ();
 #use Data::Dumper;
@@ -143,13 +144,16 @@ sub connection {
 
 
 sub helo {
-  my ($self, $hello_host, @stuff) = @_;
+  my ($self, $line) = @_;
+  my ($rc, @msg) = $self->run_hooks('helo_parse');
+  my ($ok, $hello_host, @stuff) = Qpsmtpd::Command->parse('helo', $line, $msg[0]);
+
   return $self->respond (501,
     "helo requires domain/address - see RFC-2821 4.1.1.1") unless $hello_host;
   my $conn = $self->connection;
   return $self->respond (503, "but you already said HELO ...") if $conn->hello;
 
-  my ($rc, @msg) = $self->run_hooks("helo", $hello_host, @stuff);
+  ($rc, @msg) = $self->run_hooks("helo", $hello_host, @stuff);
   if ($rc == DONE) {
     # do nothing
   } elsif ($rc == DENY) {
@@ -171,13 +175,15 @@ sub helo {
 }
 
 sub ehlo {
-  my ($self, $hello_host, @stuff) = @_;
+  my ($self, $line) = @_;
+  my ($rc, @msg) = $self->run_hooks('ehlo_parse');
+  my ($ok, $hello_host, @stuff) = Qpsmtpd::Command->parse('ehlo', $line, $msg[0]);
   return $self->respond (501,
     "ehlo requires domain/address - see RFC-2821 4.1.1.1") unless $hello_host;
   my $conn = $self->connection;
   return $self->respond (503, "but you already said HELO ...") if $conn->hello;
 
-  my ($rc, @msg) = $self->run_hooks("ehlo", $hello_host, @stuff);
+  ($rc, @msg) = $self->run_hooks("ehlo", $hello_host, @stuff);
   if ($rc == DONE) {
     # do nothing
   } elsif ($rc == DENY) {
@@ -229,7 +235,12 @@ HOOK: foreach my $hook ( keys %{$self->{hooks}} ) {
 }
 
 sub auth {
-    my ( $self, $arg, @stuff ) = @_;
+    my ($self, $line) = @_;
+    my ($rc, $sub)    = $self->run_hooks('auth_parse');
+    my ($ok, $arg, @stuff) = Qpsmtpd::Command->parse('auth', $line, $sub);
+    return $self->respond(501, $arg || "Syntax error in command") 
+      unless ($ok == OK);
+    
 
     #they AUTH'd once already
     return $self->respond( 503, "but you already said AUTH ..." )
@@ -242,9 +253,7 @@ sub auth {
 }
 
 sub mail {
-  my $self = shift;
-  return $self->respond(501, "syntax error in parameters") if !$_[0] or $_[0] !~ m/^from:/i;
-
+  my ($self, $line) = @_;
   # -> from RFC2821
   # The MAIL command (or the obsolete SEND, SOML, or SAML commands)
   # begins a mail transaction.  Once started, a mail transaction
@@ -269,16 +278,29 @@ sub mail {
     return $self->respond(503, "please say hello first ...");
   }
   else {
-    my $from_parameter = join " ", @_;
-    $self->log(LOGINFO, "full from_parameter: $from_parameter");
-
-    my ($from) = ($from_parameter =~ m/^from:\s*(<[^>]*>)/i)[0];
-
-    # support addresses without <> ... maybe we shouldn't?
-    ($from) = "<" . ($from_parameter =~ m/^from:\s*(\S+)/i)[0] . ">"
-      unless $from;
+    $self->log(LOGINFO, "full from_parameter: $line");
+    my ($rc, @msg) = $self->run_hooks("mail_parse");
+    my ($ok, $from, @params) = Qpsmtpd::Command->parse('mail', $line, $msg[0]);
+    return $self->respond(501, $from || "Syntax error in command") 
+      unless ($ok == OK); 
+    my %param;
+    foreach (@params) {
+        my ($k,$v) = split /=/, $_, 2;
+        $param{lc $k} = $v;
+    }
+    # to support addresses without <> we now require a plugin
+    # hooking "mail_pre" to 
+    #   return (OK, "<$from>"); 
+    # (...or anything else parseable by Qpsmtpd::Address ;-))
+    # see also comment in sub rcpt()
+    ($rc, @msg) = $self->run_hooks("mail_pre", $from);
+    if ($rc == OK) {
+      $from = shift @msg;
+    }
 
     $self->log(LOGALERT, "from email address : [$from]");
+    return $self->respond(501, "could not parse your mail from command") 
+      unless $from =~ /^<.*>$/;
 
     if ($from eq "<>" or $from =~ m/\[undefined\]/ or $from eq "<#@[]>") {
       $from = Qpsmtpd::Address->new("<>");
@@ -288,7 +310,7 @@ sub mail {
     }
     return $self->respond(501, "could not parse your mail from command") unless $from;
 
-    my ($rc, @msg) = $self->run_hooks("mail", $from);
+    ($rc, @msg) = $self->run_hooks("mail", $from, %param);
     if ($rc == DONE) {
       return 1;
     }
@@ -323,18 +345,39 @@ sub mail {
 }
 
 sub rcpt {
-  my $self = shift;
-  return $self->respond(501, "syntax error in parameters") unless $_[0] and $_[0] =~ m/^to:/i;
+  my ($self, $line) = @_;
+  my ($rc, @msg)    = $self->run_hooks("rcpt_parse");
+  my ($ok, $rcpt, @param) = Qpsmtpd::Command->parse("rcpt", $line, $msg[0]);
+  return $self->respond(501, $rcpt || "Syntax error in command")
+    unless ($ok == OK);
   return $self->respond(503, "Use MAIL before RCPT") unless $self->transaction->sender;
 
-  my ($rcpt) = ($_[0] =~ m/to:(.*)/i)[0];
-  $rcpt = $_[1] unless $rcpt;
+  my %param;
+  foreach (@param) {
+    my ($k,$v) = split /=/, $_, 2;
+    $param{lc $k} = $v;
+  }
+  # to support addresses without <> we now require a plugin
+  # hooking "rcpt_pre" to 
+  #   return (OK, "<$rcpt>"); 
+  # (... or anything else parseable by Qpsmtpd::Address ;-))
+  # this means, a plugin can decide to (pre-)accept
+  # addresses like <user@example.com.> or <user@example.com >
+  # by removing the trailing "."/" " from this example...
+  ($rc, @msg) = $self->run_hooks("rcpt_pre", $rcpt);
+  if ($rc == OK) {
+    $rcpt = shift @msg;
+  }
   $self->log(LOGALERT, "to email address : [$rcpt]");
+  return $self->respond(501, "could not parse recipient") 
+    unless $rcpt =~ /^<.*>$/;
+
   $rcpt = (Qpsmtpd::Address->parse($rcpt))[0];
 
-  return $self->respond(501, "could not parse recipient") unless $rcpt;
+  return $self->respond(501, "could not parse recipient") 
+    if (!$rcpt or ($rcpt->format eq '<>'));
 
-  my ($rc, @msg) = $self->run_hooks("rcpt", $rcpt);
+  ($rc, @msg) = $self->run_hooks("rcpt", $rcpt, %param);
   if ($rc == DONE) {
     return 1;
   }

lib/Qpsmtpd/SelectServer.pm

@@ -121,7 +121,7 @@ sub main {
                 }
                 else {
                     $qp->log(LOGINFO, "dispatching $req");
-                    defined $qp->dispatch(split / +/, $req)
+                    defined $qp->dispatch(split / +/, $req, 2)
                         or $qp->respond(502, "command unrecognized: '$req'");
                 }
             }

lib/Qpsmtpd/TcpServer.pm

@@ -63,7 +63,7 @@ sub read_input {
     $_ =~ s/\r?\n$//s; # advanced chomp
     $self->log(LOGDEBUG, "dispatching $_");
     $self->connection->notes('original_string', $_);
-    defined $self->dispatch(split / +/, $_)
+    defined $self->dispatch(split / +/, $_, 2)
       or $self->respond(502, "command unrecognized: '$_'");
     alarm $timeout;
   }

plugins/check_badmailfrom

@@ -21,7 +21,7 @@ stage, so store it until later.
 =cut
 
 sub hook_mail {
-  my ($self, $transaction, $sender) = @_;
+  my ($self, $transaction, $sender, %param) = @_;
 
   my @badmailfrom = $self->qp->config("badmailfrom")
     or return (DECLINED);
@@ -44,7 +44,7 @@ sub hook_mail {
 }
 
 sub hook_rcpt {
-  my ($self, $transaction, $rcpt) = @_;
+  my ($self, $transaction, $rcpt, %param) = @_;
   my $note = $transaction->notes('badmailfrom');
   if ($note) {
     $self->log(LOGINFO, $note);

plugins/check_badmailfromto

@@ -17,7 +17,7 @@ Based heavily on check_badmailfrom.
 =cut
 
 sub hook_mail {
-  my ($self, $transaction, $sender) = @_;
+  my ($self, $transaction, $sender, %param) = @_;
 
   my @badmailfromto = $self->qp->config("badmailfromto")
     or return (DECLINED);
@@ -41,7 +41,7 @@ sub hook_mail {
 }
 
 sub hook_rcpt {
-  my ($self, $transaction, $rcpt) = @_;
+  my ($self, $transaction, $rcpt, %param) = @_;
   my $recipient = lc($rcpt->user) . '@' . lc($rcpt->host);
   my $sender = $transaction->notes('badmailfromto');
   if ($sender) {

plugins/check_badrcptto

@@ -2,7 +2,7 @@
 use Qpsmtpd::DSN;
 
 sub hook_rcpt {
-  my ($self, $transaction, $recipient) = @_;
+  my ($self, $transaction, $recipient, %param) = @_;
   my @badrcptto = $self->qp->config("badrcptto") or return (DECLINED);
   return (DECLINED) unless $recipient->host && $recipient->user;
   my $host = lc $recipient->host;

plugins/dns_whitelist_soft

@@ -139,7 +139,7 @@ sub process_sockets {
 }
 
 sub hook_rcpt {
-  my ($self, $transaction, $rcpt) = @_;
+  my ($self, $transaction, $rcpt, %param) = @_;
   my $ip = $self->qp->connection->remote_ip || return (DECLINED);
   my $note = $self->process_sockets;
   if ( $note ) {

plugins/dnsbl

@@ -167,7 +167,7 @@ sub process_sockets {
 }
 
 sub hook_rcpt {
-  my ($self, $transaction, $rcpt) = @_;
+  my ($self, $transaction, $rcpt, %param) = @_;
   my $connection = $self->qp->connection;
 
   # RBLSMTPD being non-empty means it contains the failure message to return

plugins/dont_require_anglebrackets

@@ -0,0 +1,19 @@
+# 
+# dont_require_anglebrackets - accept addresses in MAIL FROM:/RCPT TO: 
+#        commands without surrounding <>
+#
+sub hook_mail_pre {
+    my ($self,$transaction, $addr) = @_;
+    unless ($addr =~ /^<.*>$/) {
+        $addr = "<".$addr.">";
+    }
+    return (OK, $addr);
+}
+
+sub hook_rcpt_pre {
+    my ($self,$transaction, $addr) = @_;
+    unless ($addr =~ /^<.*>$/) {
+        $addr = "<".$addr.">";
+    }
+    return (OK, $addr);
+}

plugins/milter

@@ -135,7 +135,7 @@ sub hook_helo {
 }
 
 sub hook_mail {
-    my ($self, $transaction, $address) = @_;
+    my ($self, $transaction, $address, %param) = @_;
     
     my $milter = $self->qp->connection->notes('milter');
 
@@ -148,7 +148,7 @@ sub hook_mail {
 }
 
 sub hook_rcpt {
-    my ($self, $transaction, $address) = @_;
+    my ($self, $transaction, $address, %param) = @_;
     
     my $milter = $self->qp->connection->notes('milter');
 

plugins/parse_addr_withhelo

@@ -0,0 +1,60 @@
+# parse_addr_withhelo
+# 
+# strict RFC 821 forbids parameters after the 
+#   MAIL FROM:<user@example.net> 
+# and
+#   RCPT TO:<someone@example.com>
+# 
+# load this plugin to enforce, else the default EHLO parsing with 
+# parameters is done.
+#
+
+sub hook_mail_parse {
+    my $self = shift;
+    return (OK, \&_parse) if ($self->qp->connection->hello eq 'helo');
+    return (DECLINED);
+}
+
+sub hook_rcpt_parse {
+    my $self = shift;
+    return (OK, \&_parse) if ($self->qp->connection->hello eq 'helo');
+    return (DECLINED);
+}
+
+sub _parse {
+    my ($self,$cmd,$line) = @_;
+    $self->log(LOGDEBUG, "_parse() cmd=[$cmd], line=[$line]");
+    if ($cmd eq 'mail') {
+        return(DENY, "Syntax error in command")
+          unless ($line =~ s/^from:\s*//i);
+    }
+    else { # cmd eq 'rcpt'
+        return(DENY, "Syntax error in command")
+          unless ($line =~ s/^to:\s*//i);
+    }
+
+    if ($line =~ s/^(<.*>)\s*//) {
+        my $addr = $1;
+        return (DENY, "No parameters allowed in ".uc($cmd))
+          if ($line =~ /^\S/);
+        return (OK, $addr, ());
+    }
+
+    ## now, no <> are given
+    $line =~ s/\s*$//;
+    if ($line =~ /\@/) {
+        return (DENY, "No parameters allowed in ".uc($cmd))
+          if ($line =~ /\@\S+\s+\S/);
+        return (OK, $line, ());
+    }
+
+    if ($cmd eq "mail") {
+        return (OK, "<>") unless $line; # 'MAIL FROM:' -> 'MAIL FROM:<>'
+        return (DENY, "Could not parse your MAIL FROM command");
+    }
+    else {
+        return (DENY, "Could not parse your RCPT TO command")
+          unless $line =~ /^(postmaster|abuse)$/i;
+    }
+}
+

plugins/rcpt_ok

@@ -5,7 +5,7 @@
 use Qpsmtpd::DSN;
 
 sub hook_rcpt {
-  my ($self, $transaction, $recipient) = @_;
+  my ($self, $transaction, $recipient, %param) = @_;
   my $host = lc $recipient->host;
 
   my @rcpt_hosts = ($self->qp->config("me"), $self->qp->config("rcpthosts"));

plugins/require_resolvable_fromhost

@@ -5,7 +5,7 @@ use Socket;
 my %invalid = ();
 
 sub hook_mail {
-  my ($self, $transaction, $sender) = @_;
+  my ($self, $transaction, $sender, %param) = @_;
 
   return DECLINED
         if ($self->qp->connection->notes('whitelistclient'));

plugins/rhsbl

@@ -1,14 +1,14 @@
 
 
 sub hook_mail {
-  my ($self, $transaction, $sender) = @_;
+  my ($self, $transaction, $sender, %param) = @_;
 
   my $res = new Net::DNS::Resolver;
   my $sel = IO::Select->new();
   my %rhsbl_zones_map = ();
 
-  # Perform any RHS lookups in the background. We just send the query packets here
-  # and pick up any results in the RCPT handler.
+  # Perform any RHS lookups in the background. We just send the query packets
+  # here and pick up any results in the RCPT handler.
   # MTAs gets confused when you reject mail during MAIL FROM:
 
     my %rhsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('rhsbl_zones');

plugins/sender_permitted_from

@@ -34,7 +34,7 @@ sub register {
 }
 
 sub hook_mail {
-  my ($self, $transaction, $sender) = @_;
+  my ($self, $transaction, $sender, %param) = @_;
 
   return (DECLINED) unless ($sender->format ne "<>"
                             and $sender->host && $sender->user);
@@ -71,7 +71,7 @@ sub hook_mail {
 }
 
 sub hook_rcpt {
-  my ($self, $transaction, $rcpt) = @_;
+  my ($self, $transaction, $rcpt, %param) = @_;
   
   # special addresses don't get SPF-tested.
   return DECLINED if $rcpt and $rcpt->user and $rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i;

t/addresses.t

@@ -27,4 +27,11 @@ $command = 'MAIL FROM:<ask@p.qpsmtpd-test.askask.com> SIZE=1230';
 is(($smtpd->command($command))[0], 250, $command);
 is($smtpd->transaction->sender->format, '<ask@p.qpsmtpd-test.askask.com>', 'got the right sender');
 
+$command = 'MAIL FROM:<ask@perl.org> SIZE=1230 CORRECT-WITHOUT-ARG';
+is(($smtpd->command($command))[0], 250, $command);
+
+$command = 'MAIL FROM:';
+is(($smtpd->command($command))[0], 250, $command);
+is($smtpd->transaction->sender->format, '<>', 'got the right sender');
+