cvs commit: qpsmtpd/t addresses.t qpsmtpd-address.t

[email protected]
Newsgroups perl.cvs.qpsmtpd
Message-ID <[email protected]>
cvsuser     05/01/27 19:30:50

  Modified:    .        Changes
               lib/Qpsmtpd Auth.pm SMTP.pm
               plugins  check_badmailfrom check_earlytalker
                        count_unrecognized_commands dnsbl
                        require_resolvable_fromhost
               plugins/auth auth_vpopmail_sql
               plugins/queue qmail-queue
               t        addresses.t qpsmtpd-address.t
  Added:       plugins  check_badmailfromto dns_whitelist_soft
  Log:
  Changes by [email protected] (John Peacock)
  
  o plugins/check_badmailfromto
      - New plugin in the style of check_badmailfrom, which matches a pair
        of FROM/TO and makes it seem like the recipient's address no longer
        exists (but only from the matching sender's point of view).  Useful
        for stalkers and other harassment cases.
  
  o plugins/dns_whitelist_soft
      - New plugin to provide a DNS-based whitelist (good for distributed
        sites).
  
  o various files
      - Replaced tab character with 8 spaces and adjusted line breaks for
        better readability.
  
  Changes by [email protected] (Michael C. Toren)
  
  o lib/Qpsmtpd/SMTP.pm
  
      - Assumes a MAIL FROM value of "<#@[]>" (utilized by qmail to
        indicate a null sender when generating a doublebounce message)
        is equivalent to "<>".  Previously qpsmtpd complained that the
        value could not be parsed.
  
      - Adds LOGIN to the default list of supported auth mechanisms.
        The documentation in Auth.pm indicated that auth-login was not
        currently supported due to lack of functionality, however I can
        confirm that LOGIN appears to work fine as tested by using msmtp
        (http://msmtp.sourceforge.net/).  Are there any indications that
        LOGIN support is actually broken in the current implementation?
  
      - Removes the "X-Qpsmtpd-Auth: True" header appended when a message
        has been sent by an authenticated user.  One problem with such a
        header is that it's impossible to say which SMTP hop added it,
        and it provides no information which could be used to backtrack
        the transaction.  I grepped through my mail archives a bit
        looking for how other MTAs handled the problem, and decided it
        would be best to place this information in the Received: header:
  
          Received: from remotehost (HELO remotehost) (192.168.42.42)
            (smtp-auth username foo, mechanism cram-md5)
            by mail.netisland.net (qpsmtpd/0.28) with ESMTP; <date>
  
  o lib/Qpsmtpd/Auth.pm:
  
      - Documentation update for the arguments passed to an auth
        handler; previously the $mechanism argument was not mentioned,
        which threw off the argument offsets.
  
      - Documentation update for auth-login removing the warning
        that auth-login is not currently supported due to lack of
        functionality.
  
      - Fix to execute a generic auth hook when a more specific
        auth-$mechanism hook does not exist.  (Previously posted
        to the list last week.)
  
      - Upon authentication, sets $session->{_auth_user} and
        $session->{_auth_mechanism} so that SMTP.pm can include them
        in the Received: header.
  
  o plugins/queue/qmail-queue
  
      - Added a timestamp and the qmail-queue qp identifier to the
        "Queued!" 250 message, for compatibility with qmail-smtpd, which
        can be very useful for tracking message delivery from machine to
        machine.  For example, the new 250 message might be:
  
          250 Queued! 1105927468 qp 3210 <[email protected]>
  
        qmail-smtpd returns:
  
          250 ok 1106546213 qp 7129
  
        Additionally, for consistency angle brackets are placed around
        the Message-ID displayed in the 250 if they were missing in the
        message header.
  
  o plugins/check_badmailfrom:
  
      - Changed the error message from "Mail from $bad not accepted
        here" to "sorry, your envelope sender is in my badmailfrom
        list", for compatibility with qmail-smtpd.  I didn't see any
        reason to share with the sender the value of $bad, especially
        for situations where the sender was rejected resulting from a
        wildcard.
  
  o plugins/check_earlytalker:
  o plugins/require_resolvable_fromhost:
  
      - No longer checks for earlytalkers or resolvable senders if the
        connection note "whitelistclient" is set, which is nice for
        helping backup MX hosts empty their queue faster.
  
  o plugins/count_unrecognized_commands:
  
      - Return code changed from DENY_DISCONNECT, which isn't valid in
        an unrecognized_command hook, to DENY, which in this context
        drops the connection anyway.  (Previously posted to the list
        last week.)
  
  Revision  Changes    Path
  1.80      +32 -0     qpsmtpd/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/Changes,v
  retrieving revision 1.79
  retrieving revision 1.80
  diff -u -r1.79 -r1.80
  --- Changes	25 Nov 2004 19:52:34 -0000	1.79
  +++ Changes	28 Jan 2005 03:30:50 -0000	1.80
  @@ -1,6 +1,38 @@
   
   0.29 - 
   
  +  Qpsmtpd::Auth - document $mechanism option, improve fallback to generic
  +  hooks, document that auth-login works now, stash auth user and method for
  +  later use by Qpsmtpd::SMTP to generate authentication header.
  +  (Michael Toren)
  +
  +  Qpsmtpd::SMTP - "MAIL FROM: <#@[]>" now works like qmail (null sender), 
  +  add LOGIN to default auth mechanisms, display auth user and method in
  +  Received: line instead of X-Qpsmtpd-Auth header.
  +  (Michael Toren)
  +
  +  check_badmailfromto - NEW PLUGIN - like check_badmailfrom except matches
  +  both FROM: and TO:, and effectively makes it seem like the recipient 
  +  no longer exists for that sender (great for harassment cases).
  +  (John Peacock)
  +
  +  check_earlytalker and require_resolvable_fromhost - short circuit test if
  +  whitelistclient is set. (Michael Toren)
  +
  +  check_badmailfrom - Do not say why a given message is denied.
  +  (Michael Toren)
  +
  +  dns_whitelist_soft - NEW PLUGIN - dns-based whitelist override for
  +  other qpsmtpd plugins.  Add suuport for whitelisthost to dnsbl.
  +  (John Peacock)
  +
  +  auth/auth_vpopmail_sql - Support CRAM-MD5 (requires clear_passwd)
  +  (John Peacock)
  +
  +  plugins/queue/qmail-queue - Added a timestamp and the qmail-queue qp
  +  identifier to the "Queued!" message, for compatibility with qmail-smtpd
  +  (Michael Toren)
  +
     Support qmail-smtpd's timeoutsmtpd config file
   
     Many improvements to the forking server (qpsmtpd-forkserver)
  
  
  
  1.6       +15 -6     qpsmtpd/lib/Qpsmtpd/Auth.pm
  
  Index: Auth.pm
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/lib/Qpsmtpd/Auth.pm,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- Auth.pm	23 Sep 2004 16:14:56 -0000	1.5
  +++ Auth.pm	28 Jan 2005 03:30:50 -0000	1.6
  @@ -64,6 +64,11 @@
   A Qpsmtpd::Transaction object which can be used to examine information
   about the current SMTP session like the remote IP address.
   
  +=item $mechanism
  +
  +The lower-case name of the authentication mechanism requested by the
  +client; either "plain", "login", or "cram-md5".
  +
   =item $user
   
   Whatever the remote SMTP client sent to identify the user (may be bare
  @@ -157,7 +162,6 @@
   encoded before sending.  This is still an insecure method, since it is
   trivial to decode the Base-64 data.  Again, it will not normally be chosen
   by SMTP clients unless a more secure method is not available (or if it fails).
  -CURRENTLY NOT SUPPORTED DUE TO LACK OF DOCUMENTATION ON FUNCTIONALITY
   
   =item * auth-cram-md5
   
  @@ -309,23 +313,28 @@
           $passHash, $ticket );
   
       # try running the polymorphous hooks next
  -    if ( $rc == DECLINED ) {    
  +    if ( !$rc || $rc == DECLINED ) {    
           ( $rc, $msg ) =
  -          $session->run_hooks( "auth", $mechanism, $user, $passClear, $passHash,
  -            $ticket );
  +          $session->run_hooks( "auth", $mechanism, $user, $passClear,
  +            $passHash, $ticket );
       }
   
       if ( $rc == OK ) {
           $msg = "Authentication successful for $user" .
  -	    ( defined $msg ? " - " . $msg : "" );
  +            ( defined $msg ? " - " . $msg : "" );
           $session->respond( 235, $msg );
           $session->connection->relay_client(1);
           $session->log( LOGINFO, $msg );
  +
  +        $session->{_auth_user} = $user;
  +        $session->{_auth_mechanism} = $mechanism;
  +        s/[\r\n].*//s for ($session->{_auth_user}, $session->{_auth_mechanism}); 
  +
           return OK;
       }
       else {
           $msg = "Authentication failed for $user" .
  -	    ( defined $msg ? " - " . $msg : "" );
  +            ( defined $msg ? " - " . $msg : "" );
           $session->respond( 535, $msg );
           $session->log( LOGERROR, $msg );
           return DENY;
  
  
  
  1.48      +34 -36    qpsmtpd/lib/Qpsmtpd/SMTP.pm
  
  Index: SMTP.pm
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/lib/Qpsmtpd/SMTP.pm,v
  retrieving revision 1.47
  retrieving revision 1.48
  diff -u -r1.47 -r1.48
  --- SMTP.pm	27 Nov 2004 06:38:32 -0000	1.47
  +++ SMTP.pm	28 Jan 2005 03:30:50 -0000	1.48
  @@ -35,6 +35,7 @@
     my (%commands); @commands{@commands} = ('') x @commands;
     # this list of valid commands should probably be a method or a set of methods
     $self->{_commands} = \%commands;
  +
     $self;
   }
   
  @@ -104,7 +105,7 @@
       }
       elsif ($rc != DONE) {
         $self->respond(220, $self->config('me') ." ESMTP qpsmtpd "
  -		     . $self->version ." ready; send us your mail, but not your spam.");
  +          . $self->version ." ready; send us your mail, but not your spam.");
         return DONE;
       }
   }
  @@ -166,7 +167,7 @@
   
       my @capabilities = $self->transaction->notes('capabilities')
                           ? @{ $self->transaction->notes('capabilities') }
  -			: ();  
  +                        : ();  
   
       # Check for possible AUTH mechanisms
       my %auth_mechanisms;
  @@ -176,7 +177,7 @@
                   $auth_mechanisms{uc($1)} = 1;
               }
               else { # at least one polymorphous auth provider
  -                %auth_mechanisms = map {$_,1} qw(PLAIN CRAM-MD5);
  +                %auth_mechanisms = map {$_,1} qw(PLAIN CRAM-MD5 LOGIN);
                   last HOOK;
               }
           }
  @@ -188,12 +189,12 @@
       }
   
       $self->respond(250,
  -		 $self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]",
  -		 "PIPELINING",
  -		 "8BITMIME",
  -		 ($self->config('databytes') ? "SIZE ". ($self->config('databytes'))[0] : ()),
  -		 @capabilities,  
  -		);
  +                 $self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]",
  +                 "PIPELINING",
  +                 "8BITMIME",
  +                 ($self->config('databytes') ? "SIZE ". ($self->config('databytes'))[0] : ()),
  +                 @capabilities,  
  +                );
     }
   }
   
  @@ -236,7 +237,7 @@
   
       $self->log(LOGWARN, "from email address : [$from]");
   
  -    if ($from eq "<>" or $from =~ m/\[undefined\]/) {
  +    if ($from eq "<>" or $from =~ m/\[undefined\]/ or $from eq "<#@[]>") {
         $from = Qpsmtpd::Address->new("<>");
       } 
       else {
  @@ -329,9 +330,9 @@
   sub help {
     my $self = shift;
     $self->respond(214, 
  -	  "This is qpsmtpd " . $self->version,
  -	  "See http://smtpd.develooper.com/",
  -	  'To report bugs or send comments, mail to <[email protected]>.');
  +          "This is qpsmtpd " . $self->version,
  +          "See http://smtpd.develooper.com/",
  +          'To report bugs or send comments, mail to <[email protected]>.');
   }
   
   sub noop {
  @@ -443,39 +444,39 @@
       # lot of spam that is malformed in the header.
   
       ($_ eq ".\n" or $_ eq ".\r")
  -	and $self->respond(421, "See http://smtpd.develooper.com/barelf.html")
  -	and return $self->disconnect;
  +        and $self->respond(421, "See http://smtpd.develooper.com/barelf.html")
  +        and return $self->disconnect;
   
       # add a transaction->blocked check back here when we have line by line plugin access...
       unless (($max_size and $size > $max_size)) {
         s/\r\n$/\n/;
         s/^\.\./\./;
         if ($in_header and m/^\s*$/) {
  -	$in_header = 0;
  -	my @headers = split /^/m, $buffer;
  +        $in_header = 0;
  +        my @headers = split /^/m, $buffer;
   
  -	# ... need to check that we don't reformat any of the received lines.
  -	#
  -	# 3.8.2 Received Lines in Gatewaying
  -	#   When forwarding a message into or out of the Internet environment, a
  -	#   gateway MUST prepend a Received: line, but it MUST NOT alter in any
  -	#   way a Received: line that is already in the header.
  +        # ... need to check that we don't reformat any of the received lines.
  +        #
  +        # 3.8.2 Received Lines in Gatewaying
  +        #   When forwarding a message into or out of the Internet environment, a
  +        #   gateway MUST prepend a Received: line, but it MUST NOT alter in any
  +        #   way a Received: line that is already in the header.
   
  -	$header->extract(\@headers);
  -	#$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/");
  +        $header->extract(\@headers);
  +        #$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/");
   
  -	$buffer = "";
  +        $buffer = "";
   
  -	# FIXME - call plugins to work on just the header here; can
  -	# save us buffering the mail content.
  +        # FIXME - call plugins to work on just the header here; can
  +        # save us buffering the mail content.
   
         }
   
         if ($in_header) {
  -	$buffer .= $_;  
  +        $buffer .= $_;  
         }
         else {
  -	$self->transaction->body_write($_);
  +        $self->transaction->body_write($_);
         }
   
         $size += length $_;
  @@ -488,15 +489,12 @@
     $self->transaction->header($header);
   
     my $smtp = $self->connection->hello eq "ehlo" ? "ESMTP" : "SMTP";
  -
  -  # only true if client authenticated
  -  if ( defined $self->{_auth} and $self->{_auth} == OK ) { 
  -    $header->add("X-Qpsmtpd-Auth","True");
  -  }
  +  my $authheader = (defined $self->{_auth} and $self->{_auth} == OK) ?
  +    "(smtp-auth username $self->{_auth_user}, mechanism $self->{_auth_mechanism})\n" : "";
   
     $header->add("Received", "from ".$self->connection->remote_info
                  ." (HELO ".$self->connection->hello_host . ") (".$self->connection->remote_ip
  -               . ")\n  by ".$self->config('me')." (qpsmtpd/".$self->version
  +               . ")\n  $authheader  by ".$self->config('me')." (qpsmtpd/".$self->version
                  .") with $smtp; ". (strftime('%a, %d %b %Y %H:%M:%S %z', localtime)),
                  0);
   
  
  
  
  1.7       +2 -2      qpsmtpd/plugins/check_badmailfrom
  
  Index: check_badmailfrom
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/plugins/check_badmailfrom,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -r1.6 -r1.7
  --- check_badmailfrom	27 Nov 2004 18:40:54 -0000	1.6
  +++ check_badmailfrom	28 Jan 2005 03:30:50 -0000	1.7
  @@ -33,7 +33,7 @@
       or return (DECLINED);
   
     return (DECLINED) unless ($sender->format ne "<>"
  -			    and $sender->host && $sender->user);
  +                            and $sender->host && $sender->user);
   
     my $host = lc $sender->host;
     my $from = lc($sender->user) . '@' . $host;
  @@ -43,7 +43,7 @@
       next unless $bad;
       $bad = lc $bad;
       warn "Bad badmailfrom config: No \@ sign in $bad\n" and next unless $bad =~ m/\@/;
  -    $transaction->notes('badmailfrom', "Mail from $bad not accepted here")
  +    $transaction->notes('badmailfrom', "sorry, your envelope sender is in my badmailfrom list")
         if ($bad eq $from) || (substr($bad,0,1) eq '@' && $bad eq "\@$host");
     }
     return (DECLINED);
  
  
  
  1.4       +13 -9     qpsmtpd/plugins/check_earlytalker
  
  Index: check_earlytalker
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/plugins/check_earlytalker,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- check_earlytalker	1 Aug 2004 07:08:07 -0000	1.3
  +++ check_earlytalker	28 Jan 2005 03:30:50 -0000	1.4
  @@ -53,14 +53,14 @@
     my ($self, $qp, @args) = @_;
   
     if (@args % 2) {
  -	$self->log(LOGERROR, "Unrecognized/mismatched arguments");
  -	return undef;
  +        $self->log(LOGERROR, "Unrecognized/mismatched arguments");
  +        return undef;
     }
     $self->{_args} = {
  -  	'wait' => 1,
  -	'action' => 'denysoft',
  -	'defer-reject' => 0,
  -	@args,
  +        'wait' => 1,
  +        'action' => 'denysoft',
  +        'defer-reject' => 0,
  +        @args,
     };
     $self->register_hook('connect', 'connect_handler');
     $self->register_hook('mail', 'mail_handler')
  @@ -71,12 +71,16 @@
   sub connect_handler {
     my ($self, $transaction) = @_;
     my $in = new IO::Select;
  -  
  +  my $ip = $self->qp->connection->remote_ip;
  +
  +  return DECLINED
  +      if ($self->qp->connection->notes('whitelistclient'));
  +
     $in->add(\*STDIN) || return DECLINED;
     if ($in->can_read($self->{_args}->{'wait'})) {
  -    $self->log(LOGNOTICE, 'remote host started talking before we said hello');
  +    $self->log(LOGNOTICE, "remote host started talking before we said hello [$ip]");
       if ($self->{_args}->{'defer-reject'}) {
  -	$self->qp->connection->notes('earlytalker', 1);
  +        $self->qp->connection->notes('earlytalker', 1);
       } else {
         my $msg = 'Connecting host started transmitting before SMTP greeting';
         return (DENY,$msg) if $self->{_args}->{'action'} eq 'deny';
  
  
  
  1.7       +4 -4      qpsmtpd/plugins/count_unrecognized_commands
  
  Index: count_unrecognized_commands
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/plugins/count_unrecognized_commands,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -r1.6 -r1.7
  --- count_unrecognized_commands	28 Nov 2004 05:58:58 -0000	1.6
  +++ count_unrecognized_commands	28 Jan 2005 03:30:50 -0000	1.7
  @@ -36,13 +36,13 @@
     $self->log(LOGINFO, "Unrecognized command '$cmd'");
   
     my $badcmdcount = 
  -    $self->qp->connection->notes('unrec_cmd_count',
  -				 ($self->qp->connection->notes('unrec_cmd_count') || 0) + 1
  -				);
  +    $self->qp->connection->notes( 'unrec_cmd_count',
  +        ($self->qp->connection->notes('unrec_cmd_count') || 0) + 1
  +    );
   
     if ($badcmdcount >= $self->{_unrec_cmd_max}) {
       $self->log(LOGINFO, "Closing connection. Too many unrecognized commands.");
  -    return (DENY_DISCONNECT, "Closing connection. $badcmdcount unrecognized commands.  Perhaps you should read RFC 2821?");
  +    return (DENY, "Closing connection. $badcmdcount unrecognized commands.  Perhaps you should read RFC 2821?");
     }
   
     return DECLINED;
  
  
  
  1.15      +13 -1     qpsmtpd/plugins/dnsbl
  
  Index: dnsbl
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/plugins/dnsbl,v
  retrieving revision 1.14
  retrieving revision 1.15
  diff -u -r1.14 -r1.15
  --- dnsbl	27 Nov 2004 07:08:45 -0000	1.14
  +++ dnsbl	28 Jan 2005 03:30:50 -0000	1.15
  @@ -154,8 +154,20 @@
     }
   
     my $note = $self->process_sockets;
  -  return (DENY, $note) if $note;
  +  my $whitelist = $self->qp->connection->notes('whitelisthost');
  +  if ( $note ) {
  +    if ( $rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i ) {
  +      $self->log(2, "Don't blacklist special account: ".$rcpt->user);
  +    }
  +    elsif ( $whitelist ) {
  +      $self->log(2, "Whitelist overrode blacklist: $whitelist");
  +    }
  +    else {
  +      return (DENY, $note);
  +    }
  +  }
     return DECLINED;
  +
   }
   
   sub disconnect_handler {
  
  
  
  1.4       +6 -3      qpsmtpd/plugins/require_resolvable_fromhost
  
  Index: require_resolvable_fromhost
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/plugins/require_resolvable_fromhost,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- require_resolvable_fromhost	27 Nov 2004 07:08:45 -0000	1.3
  +++ require_resolvable_fromhost	28 Jan 2005 03:30:50 -0000	1.4
  @@ -8,13 +8,16 @@
   sub mail_handler {
     my ($self, $transaction, $sender) = @_;
   
  +  return DECLINED
  +        if ($self->qp->connection->notes('whitelistclient'));
  +
     $sender->format ne "<>"
       and $self->qp->config("require_resolvable_fromhost")
       and !check_dns($sender->host)
       and return (DENYSOFT, 
  -		($sender->host
  -		   ? "Could not resolve ". $sender->host
  -		   : "FQDN required in the envelope sender"));
  +                ($sender->host
  +                   ? "Could not resolve ". $sender->host
  +                   : "FQDN required in the envelope sender"));
     
      return DECLINED;
   
  
  
  
  1.1                  qpsmtpd/plugins/check_badmailfromto
  
  Index: check_badmailfromto
  ===================================================================
  #! perl
  =head1 NAME
  
  check_badmailfromto - checks the badmailfromto config
  
  =head1 DESCRIPTION
  
  Much like the similar check_badmailfrom, this plugin references both the
  FROM: and TO: lines, and if they both are present in the badmailfromto
  config file (a tab delimited list of FROM/TO pairs), then the message is
  blocked as if the recipient (TO) didn't exist.  This is specifically designed
  to not give the impression that the sender is blocked (good for cases of
  harassment).
  
  Based heavily on check_badmailfrom.
  
  =cut
  
  sub register {
    my ($self, $qp) = @_;
    $self->register_hook("mail", "mail_handler");
    $self->register_hook("rcpt", "rcpt_handler");
  }
  
  sub mail_handler {
    my ($self, $transaction, $sender) = @_;
  
    my @badmailfromto = $self->qp->config("badmailfromto")
      or return (DECLINED);
  
    return (DECLINED) unless ($sender->format ne "<>"
  			    and $sender->host && $sender->user);
  
    my $host = lc $sender->host;
    my $from = lc($sender->user) . '@' . $host;
  
    for my $bad (@badmailfromto) {
      $bad =~ s/^\s*(\S+).*/$1/;
      next unless $bad;
      $bad = lc $bad;
      warn "Bad badmailfromto config: No \@ sign in $bad\n" and next unless $bad =~ m/\@/;
      $transaction->notes('badmailfromto', "$bad")
        if ($bad eq $from)
        || (substr($bad,0,1) eq '@' && $bad eq "\@$host");
    }
    return (DECLINED);
  }
  
  sub rcpt_handler {
    my ($self, $transaction, $rcpt) = @_;
    my $recipient = lc($rcpt->user) . '@' . lc($rcpt->host);
    my $sender = $transaction->notes('badmailfromto');
    if ($sender) {
      my @badmailfromto = $self->qp->config("badmailfromto")
        or return (DECLINED);
  
      foreach (@badmailfromto) {
        my ($from, $to) = m/^\s*(\S+)\t(\S+).*/;
        return (DENY, "mail to $recipient not accepted here")
          if lc($from) eq $sender and lc($to) eq $recipient;
      }
    }
    return (DECLINED);
  }
  
  
  
  1.1                  qpsmtpd/plugins/dns_whitelist_soft
  
  Index: dns_whitelist_soft
  ===================================================================
  =head1 NAME
  
  dns_whitelist_soft - dns-based whitelist override for other qpsmtpd plugins
  
  =head1 DESCRIPTION
  
  The dns_whitelist_soft plugin allows selected host to be whitelisted as
  exceptions to later plugin processing.  It is strongly based on the original
  dnsbl plugin as well as Gavin Carr's original whitelist_soft plugin.  It is
  most suitable for multisite installations, so that the whitelist is stored
  in one location and available from all.
  
  =head1 CONFIGURATION
  
  To enable the plugin, add it to the ~qpsmtpd/config/plugins file as usual.
  It should precede any plugins whose rejections you wish to override.  You may
  have to alter those plugins to check the appropriate notes field.
  
  Several configuration files are supported, corresponding to different
  parts of the SMTP conversation:
  
  =over 4
  
  =item whitelist_zones
  
  Any IP address listed in the whitelist_zones file is queried using
  the connecting MTA's IP address.  Any A or TXT answer is means that the
  remote HOST address can be selectively exempted at other stages by plugins
  testing for a 'whitelisthost' connection note.
  
  NOTE: other 'connect' hooks will continue to fire (e.g. dnsbl), since the DNS
  queries happen in the background.  This plugin's 'rcpt_handler' retrieves
  the results of the query and sets the connection note if found.
  
  =head1 AUTHOR
  
  John Peacock <[email protected]>
  
  Based on the 'whitelist_soft' plugin by Gavin Carr <[email protected]>,
  based on the 'whitelist' plugin by Devin Carraway <[email protected]>.
  
  =cut
  
  sub register {
    my ($self, $qp) = @_;
  
    $self->register_hook("connect", "connect_handler");
    $self->register_hook("rcpt", "rcpt_handler");
  }
  
  sub connect_handler {
    my ($self, $transaction) = @_;
  
    my $remote_ip = $self->qp->connection->remote_ip;
  
    my %whitelist_zones = map { (split /\s+/, $_, 2)[0,1] }
  				$self->qp->config('whitelist_zones');
  
    return DECLINED unless %whitelist_zones;
  
    my $reversed_ip = join(".", reverse(split(/\./, $remote_ip)));
  
    # we queue these lookups in the background and just fetch the
    # results in the first rcpt handler
  
    my $res = new Net::DNS::Resolver;
    my $sel = IO::Select->new();
  
    for my $dnsbl (keys %whitelist_zones) {
      $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl in the background");
      $sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT"));
    }
  
    $self->qp->connection->notes('whitelist_sockets', $sel);
  
    return DECLINED;
  }
  
  sub process_sockets {
    my ($self) = @_;
  
    my $conn = $self->qp->connection;
  
    return $conn->notes('whitelisthost') 
      if $conn->notes('whitelisthost');
  
    my $res = new Net::DNS::Resolver;
    my $sel = $conn->notes('whitelist_sockets') or return "";
  
    my $result; 
  
    $self->log(LOGDEBUG, "waiting for whitelist dns");
  
    # don't wait more than 4 seconds here
    my @ready = $sel->can_read(4);
  
    $self->log(LOGDEBUG, "DONE waiting for whitelist dns, got ",
    	scalar @ready, " answers ...") ;
    return '' unless @ready;
  
    for my $socket (@ready) {
      my $query = $res->bgread($socket);
      $sel->remove($socket);
      undef $socket;
  
      my $whitelist;
  
      if ($query) {
        my $a_record = 0;
        foreach my $rr ($query->answer) {
  	$a_record = 1 if $rr->type eq "A";
  	my $name = $rr->name;
  	($whitelist) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $whitelist;
  	$whitelist = $name unless $whitelist;
  	$self->log(LOGDEBUG, "name ", $rr->name);
  	next unless $rr->type eq "TXT";
  	$self->log(LOGDEBUG, "got txt record");
  	$result = $rr->txtdata and last;
        }
        $a_record and $result = "Blocked by $whitelist";
      }
      else {
        $self->log(LOGERROR, "$whitelist query failed: ", $res->errorstring)
  	unless $res->errorstring eq "NXDOMAIN";
      }
  
      if ($result) {
        #kill any other pending I/O
        $conn->notes('whitelist_sockets', undef);
        return $conn->notes('whitelisthost', $result);
      }
    }
  
    if ($sel->count) {
      # loop around if we have dns blacklists left to see results from
      return $self->process_sockets();
    }
  
    # er, the following code doesn't make much sense anymore...
  
    # if there was more to read; then forget it
    $conn->notes('whitelist_sockets', undef);
  
    return $conn->notes('whitelisthost', $result);
  
  }
  
  sub rcpt_handler {
    my ($self, $transaction, $rcpt) = @_;
    my $ip = $self->qp->connection->remote_ip || return (DECLINED);
    my $note = $self->process_sockets;
    if ( $note ) {
      $self->log(LOGNOTICE,"Host $ip is whitelisted: $note");
    }
    return DECLINED;
  }
  
  sub disconnect_handler {
    my ($self, $transaction) = @_;
  
    $self->qp->connection->notes('whitelist_sockets', undef);
  
    return DECLINED;
  }
  
  
  1;
  
  
  
  1.3       +22 -16    qpsmtpd/plugins/auth/auth_vpopmail_sql
  
  Index: auth_vpopmail_sql
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/plugins/auth/auth_vpopmail_sql,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- auth_vpopmail_sql	23 Sep 2004 18:54:58 -0000	1.2
  +++ auth_vpopmail_sql	28 Jan 2005 03:30:50 -0000	1.3
  @@ -9,9 +9,9 @@
   This plugin authenticates vpopmail users directly against a standard
   vpopmail MySQL database.  It makes the not-unreasonable assumption that
   both pw_name and pw_domain are lowercase only (qmail doesn't actually care).
  -It also requires that vpopmail be built with the recommended 
  -'--enable-clear-passwd=y' option, because there is no other way to compare
  -the password with CRAM-MD5.
  +If you are using CRAM-MD5, it also requires that vpopmail be built with the
  +recommended '--enable-clear-passwd=y' option, because there is no way
  +to compare the crypted password.
   
   =head1 CONFIGURATION
   
  @@ -50,9 +50,9 @@
   sub register {
       my ( $self, $qp ) = @_;
   
  -    $self->register_hook( "auth-plain", "authsql" );
  -
  -    #  $self->register_hook("auth-cram-md5", "authsql");
  +    $self->register_hook("auth-plain", "authsql" );
  +    $self->register_hook("auth-login", "authsql" );
  +    $self->register_hook("auth-cram-md5", "authsql");
   
   }
   
  @@ -82,31 +82,37 @@
   	"Authentication to vpopmail via mysql: $pw_name\@$pw_domain");
   
       my $sth = $dbh->prepare(<<SQL);
  -select pw_clear_passwd
  +select pw_passwd, pw_clear_passwd
   from vpopmail
   where pw_name = ? and pw_domain = ?
   SQL
   
       $sth->execute( $pw_name, $pw_domain );
   
  -    my ($pw_clear_passwd) = $sth->fetchrow_array;
  +    my ($pw_passwd, $pw_clear_passwd) = $sth->fetchrow_array;
   
       $sth->finish;
       $dbh->disconnect;
   
  -    unless ( defined $pw_clear_passwd ) {
  -
  -        # if this isn't defined then the user doesn't exist here
  -        # or the administrator forgot to build with --enable-clear-passwd=y
  +    if ( # clear_passwd isn't defined so we cannot support CRAM-MD5
  +         ( $method =~ /CRAM-MD5/i and not defined $pw_clear_passwd )
  +	 or
  +         # user doesn't exist in this domain
  +	 ( not defined $pw_passwd )
  +       ) {
           return ( DECLINED, "authsql/$method" );
       }
   
       # at this point we can assume the user name matched
       if (
  -        ( defined $passClear
  -            and $pw_clear_passwd eq $passClear ) or
  -        ( defined $passHash
  -            and $passHash eq hmac_md5_hex( $ticket, $pw_clear_passwd ) )
  +        ( defined $passClear and 
  +	  (
  +	     ($pw_clear_passwd eq $passClear)
  +	  or ($pw_passwd eq crypt( $passClear, $pw_passwd ) )
  +	  )
  +	) 
  +        or ( defined $passHash
  +             and $passHash eq hmac_md5_hex( $ticket, $pw_clear_passwd ) )
         )
       {
   
  
  
  
  1.9       +3 -2      qpsmtpd/plugins/queue/qmail-queue
  
  Index: qmail-queue
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/plugins/queue/qmail-queue,v
  retrieving revision 1.8
  retrieving revision 1.9
  diff -u -r1.8 -r1.9
  --- qmail-queue	27 Nov 2004 17:54:46 -0000	1.8
  +++ qmail-queue	28 Jan 2005 03:30:50 -0000	1.9
  @@ -75,7 +75,8 @@
   
       my $msg_id = $transaction->header->get('Message-Id') || '';
       $msg_id =~ s/[\r\n].*//s;  # don't allow newlines in the Message-Id here
  -    return (OK, "Queued! $msg_id");
  +    $msg_id = "<$msg_id>" unless $msg_id =~ /^<.*>$/;  # surround in <>'s
  +    return (OK, "Queued! " . time . " qp $child $msg_id");
     }
     elsif (defined $child) {
       # Child
  @@ -100,7 +101,7 @@
       POSIX::dup2(fileno(ENVELOPE_READER), 1) or die "Unable to dup ENVELOPE_READER: $!";
   
       my $ppid = getppid();
  -    $self->log(LOGNOTICE, "(for $ppid ) Queuing to $queue_exec");
  +    $self->log(LOGNOTICE, "(for $ppid ) Queuing qp $$ to $queue_exec");
   
       my $rc = exec $queue_exec;
   
  
  
  
  1.4       +2 -2      qpsmtpd/t/addresses.t
  
  Index: addresses.t
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/t/addresses.t,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- addresses.t	9 Nov 2004 15:25:51 -0000	1.3
  +++ addresses.t	28 Jan 2005 03:30:50 -0000	1.4
  @@ -19,11 +19,11 @@
   is(($smtpd->command($command))[0], 250, $command);
   is($smtpd->transaction->sender->format, '<[email protected]>', 'got the right sender');
   
  -$command = 'MAIL FROM:<>';
  +my $command = 'MAIL FROM:<>';
   is(($smtpd->command($command))[0], 250, $command);
   is($smtpd->transaction->sender->format, '<>', 'got the right sender');
   
  -$command = 'MAIL FROM:<[email protected]> SIZE=1230';
  +my $command = 'MAIL FROM:<[email protected]> SIZE=1230';
   is(($smtpd->command($command))[0], 250, $command);
   is($smtpd->transaction->sender->format, '<[email protected]>', 'got the right sender');
   
  
  
  
  1.9       +9 -0      qpsmtpd/t/qpsmtpd-address.t
  
  Index: qpsmtpd-address.t
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/t/qpsmtpd-address.t,v
  retrieving revision 1.8
  retrieving revision 1.9
  diff -u -r1.8 -r1.9
  --- qpsmtpd-address.t	16 Nov 2004 02:15:22 -0000	1.8
  +++ qpsmtpd-address.t	28 Jan 2005 03:30:50 -0000	1.9
  @@ -63,6 +63,15 @@
   ok ($ao, "new $as");
   is ($ao->address, '[email protected]', "address $as");
   
  +$as = '<[email protected]>';
  +$ao = Qpsmtpd::Address->new($as);
  +ok ($ao, "new $as");
  +is ($ao->format, $as, "format $as");
  +
  +$as = '[email protected]';
  +ok ($ao = Qpsmtpd::Address->parse('<'.$as.'>'), "parse $as");
  +is ($ao && $ao->address, $as, "address $as");
  +
   # Not sure why we can change the address like this, but we can so test it ...
   is ($ao && $ao->address('[email protected]'), '[email protected]', 'address([email protected])');
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.