Merge branches/0.3x back to trunk.

Too many individual changes to document.  Trust me... ;-)

Lightly tested (i.e. it accepts and delivers mail with minimal plugins).

NOTES/LIMITATIONS: 
logging/adaptive currently eats some log messages.
auth_vpopmail_sql is currently broken (needs continuations?).
'make test' fails in dnsbl (no Test::Qpsmtpd::input_sock() method).


git-svn-id: https://svn.perl.org/qpsmtpd/trunk@588 958fd67b-6ff1-0310-b445-bb7760255be9

.perltidyrc

@@ -0,0 +1,16 @@
+
+-i=4    # 4 space indentation (we used to use 2; in the future we'll use 4)
+-ci=2   # continuation indention
+
+-pt=2   # tight parens
+-sbt=2  # tight square parens
+-bt=2   # tight curly braces
+-bbt=0  # open code block curly braces
+
+-lp     # line up with parentheses
+-cti=1  # align closing parens with opening parens ("closing token placement")
+
+# -nolq # don't outdent long quotes (not sure if we should enable this)
+
+
+

Changes

@@ -1,10 +1,20 @@
 0.40
 
-  Make the clamdscan plugin temporarily deny mail if if can't talk to clamd
+0.31.1 - 2005/11/18
-  (Filippo Carletti)
+
+  Add missing files to the distribution, oops... (Thanks Budi Ang!)
+  (exim plugin, tls plugin, various sample configuration files)
 
 
-0.31 -
+0.31 - 2005/11/16
+
+  STARTTLS support (see plugins/tls)
+
+  Added queue/exim-bsmtp plugin to spool accepted mail into an Exim
+  backend via BSMTP. (Devin Carraway)
+
+  New plugin inheritance system, see the bottom of README.plugins for
+  more information
 
   qpsmtpd-forkserver: --listen-address may now be given more than once, to
   request listening on multiple local addresses (Devin Carraway)
@@ -17,14 +27,41 @@
   postfix backend, which expects to have write permission to a fifo
   which usually belongs to group postdrop). (pjh)
 
+  qpsmtpd-forkserver: if -d or --detach is given on the commandline,
+  forkserver will detach from the controlling terminal and daemonize
+  itself (Devin Carraway)
+
+  replace some fun smtp comments with boring ones.
+
+  example patterns for badrcptto plugin - Gordon Rowell
+
+  Extend require_resolvable_fromhost to include a configurable list of
+  "impossible" addresses to combat spammer forging.  (Hanno Hecker)
+
+  Use qmail/control/smtpdgreeting if it exists, otherwise
+  show the original qpsmtpd greeting (with version information).
+
+  Apply slight variation on patch from Peter Holzer to allow specification of
+  an explicit $QPSMTPD_CONFIG variable to specify where the config lives,
+  overriding $QMAIL/control and /var/qmail/control if set.  The usual
+  "last location with the file wins" rule still applies.
+
+  Refactor Qpsmtpd::Address
+
   when disconncting with a temporary failure, return 421 rather than
   450 or 451. (Peter J. Holzer)
 
   The unrecognized_command hook now uses DENY_DISCONNECT return
   for disconnecting the user.
 
+  If the environment variable $QPSMTPD_CONFIG is set, qpsmtpd will look
+  for its config files in the directory given therein, in addition to (and
+  in preference to) other locations. (Peter J. Holzer)
+
   Updated documentation
 
+  Various minor cleanups
+
 
 0.30 - 2005/07/05
 

MANIFEST

@@ -1,6 +1,8 @@
 Changes
 config.sample/badhelo
+config.sample/badrcptto_patterns
 config.sample/dnsbl_zones
+config.sample/invalid_resolvable_fromhost
 config.sample/IP
 config.sample/logging
 config.sample/loglevel
@@ -8,6 +10,7 @@ config.sample/plugins
 config.sample/relayclients
 config.sample/require_resolvable_fromhost
 config.sample/rhsbl_zones
+config.sample/size_threshold
 CREDITS
 lib/Apache/Qpsmtpd.pm
 lib/Qpsmtpd.pm
@@ -55,6 +58,7 @@ plugins/logging/adaptive
 plugins/logging/devnull
 plugins/logging/warn
 plugins/milter
+plugins/queue/exim-bsmtp
 plugins/queue/maildir
 plugins/queue/postfix-queue
 plugins/queue/qmail-queue
@@ -65,6 +69,7 @@ plugins/require_resolvable_fromhost
 plugins/rhsbl
 plugins/sender_permitted_from
 plugins/spamassassin
+plugins/tls
 plugins/virus/aveclient
 plugins/virus/bitdefender
 plugins/virus/check_for_hi_virus

README

@@ -57,13 +57,9 @@ run the following command in the /home/smtpd/ directory.
 
    svn co http://svn.perl.org/qpsmtpd/trunk .
 
-Or if you want a specific release, use for example
+Beware that the trunk might be unstable and unsuitable for anything but development, so you might want to get a specific release, for example:
 
-   svn co http://svn.perl.org/qpsmtpd/tags/0.30 .
+   svn co http://svn.perl.org/qpsmtpd/tags/0.31.1 .
-
-In the branch L<http://svn.perl.org/qpsmtpd/branches/high_perf/> we
-have an experimental event based version of qpsmtpd that can handle
-thousands of simultaneous connections with very little overhead.
 
 chmod o+t ~smtpd/qpsmtpd/ (or whatever directory you installed qpsmtpd
 in) to make supervise start the log process.

STATUS

@@ -10,13 +10,15 @@ pez (or pezmail)
 Near term roadmap
 =================
 
-0.31:
+0.32:
       - Bugfixes
       - add module requirements to the META.yml file
 
 0.40:
       - Add user configuration plugin
       - Add plugin API for checking if a local email address is valid
+      - use keyword "ESMTPA" in Received header in case of authentication to comply with RFC 3848.
+
 
 0.50:
       Include the popular check_delivery[1] functionality via the 0.30 API

config.sample/invalid_resolvable_fromhost

@@ -0,0 +1,6 @@
+# include full network block including mask
+127.0.0.0/8 
+0.0.0.0/8 
+224.0.0.0/4
+169.254.0.0/16 
+10.0.0.0/8 

config.sample/size_threshold

@@ -0,0 +1,3 @@
+# Messages below the size below will be stored in memory and not spooled.
+# Without this file, the default is 0 bytes, i.e. all messages will be spooled.
+10000

lib/Qpsmtpd.pm

@@ -1,13 +1,13 @@
 package Qpsmtpd;
 use strict;
-use vars qw($VERSION $Logger $TraceLevel $Spool_dir);
+use vars qw($VERSION $Logger $TraceLevel $Spool_dir $Size_threshold);
 
 use Sys::Hostname;
 use Qpsmtpd::Constants;
 use Qpsmtpd::Transaction;
 use Qpsmtpd::Connection;
 
-$VERSION = "0.31-dev";
+$VERSION = "0.40-dev";
 
 sub version { $VERSION };
 
@@ -242,8 +242,6 @@ sub expand_inclusion_ {
 }
 
 
-#our $HOOKS;
-
 sub load_plugins {
   my $self = shift;
 
@@ -480,6 +478,29 @@ sub temp_dir {
   return $dirname;
 }
 
+sub size_threshold {
+  my $self = shift;
+  unless ( defined $Size_threshold ) {
+    $Size_threshold = $self->config('size_threshold') || 0;
+    $self->log(LOGNOTICE, "size_threshold set to $Size_threshold");
+  }
+  return $Size_threshold;
+}
+
+sub auth_user {
+  my ($self, $user) = @_;
+  $user =~ s/[\r\n].*//s;
+  $self->{_auth_user} = $user if $user;    
+  return (defined $self->{_auth_user} ? $self->{_auth_user} : "" );
+}
+
+sub auth_mechanism {
+  my ($self, $mechanism) = @_;
+  $mechanism =~ s/[\r\n].*//s;
+  $self->{_auth_mechanism} = $mechanism if $mechanism;    
+  return (defined $self->{_auth_mechanism} ? $self->{_auth_mechanism} : "" );
+}
+  
 1;
 
 __END__

lib/Qpsmtpd/Address.pm

@@ -1,16 +1,74 @@
+#!/usr/bin/perl -w
 package Qpsmtpd::Address;
 use strict;
 
+=head1 NAME
+
+Qpsmtpd::Address - Lightweight E-Mail address objects
+
+=head1 DESCRIPTION
+
+Based originally on cut and paste from Mail::Address and including 
+every jot and tittle from RFC-2821/2822 on what is a legal e-mail 
+address for use during the SMTP transaction.
+
+=head1 USAGE
+
+  my $rcpt = Qpsmtpd::Address->new('<email.address@example.com>');
+
+The objects created can be used as is, since they automatically 
+stringify to a standard form, and they have an overloaded comparison 
+for easy testing of values.
+
+=head1 METHODS
+
+=cut
+
+use overload (
+    '""'   => \&format,
+    'cmp'  => \&_addr_cmp,
+);
+
+=head2 new()
+
+Can be called two ways:
+
+=over 4 
+
+=item * Qpsmtpd::Address->new('<full_address@example.com>')
+
+The normal mode of operation is to pass the entire contents of the 
+RCPT TO: command from the SMTP transaction.  The value will be fully 
+parsed via the L<canonify> method, using the full RFC 2821 rules.
+
+=item * Qpsmtpd::Address->new("user", "host")
+
+If the caller has already split the address from the domain/host,
+this mode will not L<canonify> the input values.  This is not 
+recommended in cases of user-generated input for that reason.  This 
+can be used to generate Qpsmtpd::Address objects for accounts like 
+"<postmaster>" or indeed for the bounce address "<>".
+
+=back
+
+The resulting objects can be stored in arrays or used in plugins to 
+test for equality (like in badmailfrom).
+
+=cut
+
 sub new {
-    my ($class, $address) = @_;
+    my ($class, $user, $host) = @_;
-    my $self = [ ];
+    my $self = {};
-    if ($address =~ /^<(.*)>$/) {
+    if ($user =~ /^<(.*)>$/ ) {
-        $self->[0] = $1;
+	($user, $host) = $class->canonify($user)
-      } else {
-        $self->[0] = $address;
     }
-    bless ($self, $class);
+    elsif ( not defined $host ) {
-    return $self;
+	my $address = $user;
+	($user, $host) = $address =~ m/(.*)(?:\@(.*))/;
+    }
+    $self->{_user} = $user;
+    $self->{_host} = $host;
+    return bless $self, $class;
 }
 
 # Definition of an address ("path") from RFC 2821:
@@ -110,6 +168,15 @@ sub new {
 #
 # (We ignore all obs forms)
 
+=head2 canonify()
+
+Primarily an internal method, it is used only on the path portion of
+an e-mail message, as defined in RFC-2821 (this is the part inside the
+angle brackets and does not include the "human readable" portion of an
+address).  It returns a list of (local-part, domain).
+
+=cut
+
 sub canonify {
     my ($dummy, $path) = @_;
     my $atom = '[a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~]+';
@@ -131,60 +198,131 @@ sub canonify {
     # empty path is ok
     return "" if $path eq "";
 
-    # 
+    # bare postmaster is permissible, perl RFC-2821 (4.5.1)
+    return ("postmaster", undef) if $path eq "postmaster";
+    
     my ($localpart, $domainpart) = ($path =~ /^(.*)\@($domain)$/);
-    return undef unless defined $localpart;
+    return (undef) unless defined $localpart;
 
     if ($localpart =~ /^$atom(\.$atom)*/) {
         # simple case, we are done
-        return $path;
+        return ($localpart, $domainpart);
       }
     if ($localpart =~ /^"(($qtext|\\$text)*)"$/) {
         $localpart = $1;
         $localpart =~ s/\\($text)/$1/g;
-        return "$localpart\@$domainpart";
+        return ($localpart, $domainpart);
       }
-    return undef;
+    return (undef);
 }
 
+=head2 parse()
 
+Retained as a compatibility method, it is completely equivalent
+to new() called with a single parameter.
 
-sub parse {
+=cut
-    my ($class, $line) = @_;
+
-    my $a = $class->canonify($line);
+sub parse { # retain for compatibility only
-    return ($class->new($a)) if (defined $a);
+    return shift->new(shift);
-    return undef;
 }
 
+=head2 address()
+
+Can be used to reset the value of an existing Q::A object, in which
+case it takes a parameter with or without the angle brackets.
+
+Returns the stringified representation of the address.  NOTE: does
+not escape any of the characters that need escaping, nor does it
+include the surrounding angle brackets.  For that purpose, see
+L<format>.
+
+=cut
+
 sub address {
     my ($self, $val) = @_;
-    my $oldval = $self->[0];
+    if ( defined($val) ) {
-    return $self->[0] = $val if (defined($val));
+	$val = "<$val>" unless $val =~ /^<.+>$/;
-    return $oldval;
+	my ($user, $host) = $self->canonify($val);
+	$self->{_user} = $user;
+	$self->{_host} = $host;
+    }
+    return ( defined $self->{_user} ?     $self->{_user} : '' )
+         . ( defined $self->{_host} ? '@'.$self->{_host} : '' );
 }
 
+=head2 format()
+
+Returns the canonical stringified representation of the address.  It
+does escape any characters requiring it (per RFC-2821/2822) and it
+does include the surrounding angle brackets.  It is also the default
+stringification operator, so the following are equivalent:
+
+  print $rcpt->format();
+  print $rcpt;
+
+=cut
+
 sub format {
     my ($self) = @_;
     my $qchar = '[^a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~.]';
-    my $s = $self->[0];
+    return '<>' unless defined $self->{_user};
-    return '<>' unless $s;
+    if ( ( my $user = $self->{_user}) =~ s/($qchar)/\\$1/g) {
-    my ($user, $host) = $s =~ m/(.*)\@(.*)/;
+        return qq(<"$user")
-    if ($user =~ s/($qchar)/\\$1/g) {
+	. ( defined $self->{_host} ? '@'.$self->{_host} : '' ). ">";
-        return qq{<"$user"\@$host>};
       }
-    return "<$s>";
+    return "<".$self->address().">";
 }
 
+=head2 user()
+
+Returns the "localpart" of the address, per RFC-2821, or the portion
+before the '@' sign.
+
+=cut
+
 sub user {
     my ($self) = @_;
-    my ($user, $host) = $self->[0] =~ m/(.*)\@(.*)/;
+    return $self->{_user};
-    return $user;
 }
 
+=head2 host()
+
+Returns the "domain" part of the address, per RFC-2821, or the portion
+after the '@' sign.
+
+=cut
+
 sub host {
     my ($self) = @_;
-    my ($user, $host) = $self->[0] =~ m/(.*)\@(.*)/;
+    return $self->{_host};
-    return $host;
 }
 
+sub _addr_cmp {
+    require UNIVERSAL;
+    my ($left, $right, $swap) = @_;
+    my $class = ref($left);
+
+    unless ( UNIVERSAL::isa($right, $class) ) {
+	$right = $class->new($right);
+    }
+
+    #invert the address so we can sort by domain then user    
+    $left = lc($left->host.'='.$left->user);
+    $right = lc($right->host.'='.$right->user);
+
+    if ( $swap ) {
+	($right, $left) = ($left, $right);
+    }
+
+    return ($left cmp $right);
+}
+
+=head1 COPYRIGHT
+
+Copyright 2004-2005 Peter J. Holzer.  See the LICENSE file for more 
+information.
+
+=cut
+
 1;

lib/Qpsmtpd/Auth.pm

@@ -226,19 +226,6 @@ sub e64
   return($res);
 }
 
-sub Qpsmtpd::SMTP::auth {
-    my ( $self, $arg, @stuff ) = @_;
-
-    #they AUTH'd once already
-    return $self->respond( 503, "but you already said AUTH ..." )
-      if ( defined $self->{_auth}
-        and $self->{_auth} == OK );
-    return $self->respond( 503, "AUTH not defined for HELO" )
-      if ( $self->connection->hello eq "helo" );
-
-    return $self->{_auth} = Qpsmtpd::Auth::SASL( $self, $arg, @stuff );
-}
-
 sub SASL {
 
     # $DB::single = 1;
@@ -326,9 +313,8 @@ sub SASL {
         $session->connection->relay_client(1);
         $session->log( LOGINFO, $msg );
 
-        $session->{_auth_user} = $user;
+        $session->auth_user($user);
-        $session->{_auth_mechanism} = $mechanism;
+        $session->auth_mechanism($mechanism);
-        s/[\r\n].*//s for ($session->{_auth_user}, $session->{_auth_mechanism}); 
 
         return OK;
     }

lib/Qpsmtpd/Plugin.pm

@@ -37,9 +37,9 @@ sub _register {
   my $self = shift;
   my $qp = shift;
   local $self->{_qp} = $qp;
-  $self->init($qp, @_);
+  $self->init($qp, @_)     if $self->can('init');
   $self->_register_standard_hooks($qp, @_);
-  $self->register($qp, @_);
+  $self->register($qp, @_) if $self->can('register');
 }
 
 # Designed to be overloaded
@@ -73,6 +73,14 @@ sub spool_dir {
   shift->qp->spool_dir;
 }
 
+sub auth_user {
+    shift->qp->auth_user(@_);
+}
+
+sub auth_mechanism {
+    shift->qp->auth_mechanism(@_);
+}
+
 sub temp_file {
   my $self = shift;
   my $tempfile = $self->qp->temp_file;

lib/Qpsmtpd/PollServer.pm

@@ -15,6 +15,8 @@ use fields qw(
     hooks
     start_time
     _auth
+    _auth_user
+    _auth_mechanism
     _commands
     _config_cache
     _connection

lib/Qpsmtpd/SMTP.pm

@@ -196,7 +196,9 @@ sub ehlo_respond {
     $conn->hello_host($hello_host);
     $self->transaction;
 
-    my @capabilities = @{ $self->transaction->notes('capabilities') };
+    my @capabilities = $self->transaction->notes('capabilities')
+    			? @{ $self->transaction->notes('capabilities') }
+			: ();
 
     # Check for possible AUTH mechanisms
     my %auth_mechanisms;
@@ -227,6 +229,19 @@ HOOK: foreach my $hook ( keys %{$self->{hooks}} ) {
   }
 }
 
+sub auth {
+    my ( $self, $arg, @stuff ) = @_;
+    
+    #they AUTH'd once already
+    return $self->respond( 503, "but you already said AUTH ..." )
+      if ( defined $self->{_auth}
+        and $self->{_auth} == OK );
+    return $self->respond( 503, "AUTH not defined for HELO" )
+      if ( $self->connection->hello eq "helo" );
+
+    return $self->{_auth} = Qpsmtpd::Auth::SASL( $self, $arg, @stuff );
+}
+
 sub mail {
   my $self = shift;
   return $self->respond(501, "syntax error in parameters") if !$_[0] or $_[0] !~ m/^from:/i;
@@ -365,7 +380,6 @@ sub rcpt_respond {
   return 0;
 }
 
-
 sub help {
   my $self = shift;
   $self->respond(214, 

lib/Qpsmtpd/TcpServer.pm

@@ -39,7 +39,7 @@ sub run {
     my $self = shift;
 
     # should be somewhere in Qpsmtpd.pm and not here...
-    $self->load_plugins;
+    $self->load_plugins unless $self->{hooks};
 
     my $rc = $self->start_conversation;
     return if $rc != DONE;

lib/Qpsmtpd/Transaction.pm

@@ -15,9 +15,6 @@ sub start {
   my %args = @_;
   my $self = { _notes => { capabilities => [] }, _rcpt => [], started => time };
   bless ($self, $class);
-  my $sz = $self->config('memory_threshold');
-  $sz = 10_000 unless defined($sz);
-  $self->{_size_threshold} = $sz;
   return $self;
 }
 
@@ -91,13 +88,28 @@ sub body_current_pos {
     return $self->{_body_current_pos} || 0;
 }
 
-# TODO - should we create the file here if we're storing as an array?
 sub body_filename {
   my $self = shift;
-  return unless $self->{_body_file};
+  $self->body_spool() unless $self->{_filename};
+  $self->{_body_file}->flush(); # so contents won't be cached
   return $self->{_filename};
 }
 
+sub body_spool {
+  my $self = shift;
+  $self->log(LOGINFO, "spooling message to disk");
+  $self->{_filename} = $self->temp_file();
+  $self->{_body_file} = IO::File->new($self->{_filename}, O_RDWR|O_CREAT, 0600)
+    or die "Could not open file $self->{_filename} - $! "; # . $self->{_body_file}->error;
+  if ($self->{_body_array}) {
+    foreach my $line (@{ $self->{_body_array} }) {
+      $self->{_body_file}->print($line) or die "Cannot print to temp file: $!";
+    }
+    $self->{_body_start} = $self->{_header_size};
+  }
+  $self->{_body_array} = undef;
+}
+
 sub body_write {
   my $self = shift;
   my $data = shift;
@@ -125,19 +137,7 @@ sub body_write {
       $self->{_body_size} += length($1);
       ++$self->{_body_current_pos};
     }
-    if ($self->{_body_size} >= $self->{_size_threshold}) {
+    $self->body_spool if ( $self->{_body_size} >= $self->size_threshold() );
-      #warn("spooling to disk\n");
-      $self->{_filename} = $self->temp_file();
-      $self->{_body_file} = IO::File->new($self->{_filename}, O_RDWR|O_CREAT, 0600)
-        or die "Could not open file $self->{_filename} - $! "; # . $self->{_body_file}->error;
-      if ($self->{_body_array}) {
-        foreach my $line (@{ $self->{_body_array} }) {
-          $self->{_body_file}->print($line) or die "Cannot print to temp file: $!";
-        }
-        $self->{_body_start} = $self->{_header_size};
-      }
-      $self->{_body_array} = undef;
-    }
   }
 }
 

plugins/dnsbl

@@ -2,13 +2,18 @@
 
 use Danga::DNS;
 
-sub register {
+sub init {
-  my ($self) = @_;
+  my ($self, $qp, $denial ) = @_;
-  $self->register_hook("connect", "connect_handler");
+  if ( defined $denial and $denial =~ /^disconnect$/i ) {
-  $self->register_hook("connect", "pickup_handler");
+    $self->{_dnsbl}->{DENY} = DENY_DISCONNECT;
+  }
+  else {
+    $self->{_dnsbl}->{DENY} = DENY;
+  }
+
 }
 
-sub connect_handler {
+sub hook_connect {
   my ($self, $transaction) = @_;
 
   my $remote_ip = $self->connection->remote_ip;
@@ -99,8 +104,9 @@ sub process_txt_result {
     # $qp->finish_continuation if $qp->input_sock->readable;
 }
 
-sub pickup_handler {
+sub hook_rcpt {
-  my ($self, $transaction) = @_;
+  my ($self, $transaction, $rcpt) = @_;
+  my $connection = $self->qp->connection;
 
   # RBLSMTPD being non-empty means it contains the failure message to return
   if (defined ($ENV{'RBLSMTPD'}) && $ENV{'RBLSMTPD'} ne '') {
@@ -115,6 +121,14 @@ sub pickup_handler {
   return DECLINED;
 }
 
+sub hook_disconnect {
+  my ($self, $transaction) = @_;
+
+  $self->qp->connection->notes('dnsbl_sockets', undef);
+
+  return DECLINED;
+}
+
 1;
 
 =head1 NAME

plugins/queue/exim-bsmtp

@@ -0,0 +1,138 @@
+=head1 NAME
+
+exim-bsmtp
+
+$Id$
+
+=head1 DESCRIPTION
+
+This plugin enqueues mail from qpsmtpd into Exim via BSMTP
+
+=head1 INSTALLATION
+
+The qpsmtpd user B<must> be configured in the I<trusted_users> setting
+in your Exim configuration.  If it is not, queueing will still work,
+but sender addresses will not be honored by exim, which will make all
+mail appear to originate from the smtpd user itself.
+
+=head1 CONFIGURATION
+
+The plugin accepts configuration settings in space-delimited name/value
+pairs.  For example:
+
+ queue/exim-bsmtp exim_path /usr/sbin/exim4
+
+=over 4
+
+=item exim_path I<path>
+
+The path to use to execute the Exim BSMTP receiver; by default this is
+I</usr/sbin/rsmtp>.  The commandline switch '-bS' will be added (this is
+actually redundant with rsmtp, but harmless).
+
+=cut
+
+=head1 LICENSE
+
+Copyright (c) 2004 by Devin Carraway <qpsmtpd@devin.com>
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
+=cut
+
+use strict;
+use warnings;
+
+use IO::File;
+use Sys::Hostname qw(hostname);
+use File::Temp qw(tempfile);
+
+sub register {
+    my ($self, $qp, %args) = @_;
+
+    $self->{_exim_path} = $args{exim_path} || '/usr/sbin/rsmtp';
+    $self->{_exim_path} = $1 if $self->{_exim_path} =~ /(.*)/;
+    unless (-x $self->{_exim_path}) {
+        $self->log(LOGERROR, "Could not find exim at $self->{_exim_path};".
+                             " please set exim_path in config/plugins");
+        return undef;
+    }
+}
+
+sub hook_queue {
+    my ($self, $txn) = @_;
+
+    my $tmp_dir = $self->qp->config('spool_dir') || '/tmp';
+    $tmp_dir = $1 if ($tmp_dir =~ /(.*)/);
+    my ($tmp, $tmpfn) = tempfile("exim-bsmtp.$$.XXXXXX", DIR => $tmp_dir);
+    unless ($tmp && $tmpfn) {
+	$self->log(LOGERROR, "Couldn't create tempfile: $!");
+	return (DECLINED, 'Internal error enqueueing mail');
+    }
+
+    print $tmp "HELO ", hostname(), "\n",
+               "MAIL FROM:<", ($txn->sender->address || ''), ">\n";
+    print $tmp "RCPT TO:<", ($_->address || ''), ">\n"
+      for $txn->recipients;
+    print $tmp "DATA\n",
+               $txn->header->as_string, "\n";
+    $txn->body_resetpos;
+    while (my $line = $txn->body_getline) {
+      $line =~ s/^\./../;
+      print $tmp $line;
+    }
+    print $tmp ".\nQUIT\n";
+    close $tmp;
+
+    my $cmd = "$self->{_exim_path} -bS < $tmpfn";
+    $self->log(LOGDEBUG, "executing cmd $cmd");
+    my $exim = new IO::File "$cmd|";
+    unless ($exim) {
+        $self->log(LOGERROR, "Could not execute $self->{_exim_path}: $!");
+        unlink $tmpfn or $self->log(LOGERROR, "unlink: $tmpfn: $!");
+        return (DECLINED, "Internal error enqueuing mail"); 
+    }
+    # Normally exim produces no output in BSMTP mode; anything that
+    # does come out is an error worth logging.
+    my $start = time;
+    while (<$exim>) {
+    	chomp;
+	$self->log(LOGERROR, "exim: $_");
+    }
+    $self->log(LOGDEBUG, "BSMTP finished (".(time - $start)." sec)");
+    $exim->close;
+    my $exit = $?;
+    unlink $tmpfn or $self->log(LOGERROR, "unlink: $tmpfn: $!");
+
+    $self->log(LOGDEBUG, "Exitcode from exim: $exit");
+    if (($exit >> 8) != 0) {
+        $self->log(LOGERROR, 'BSMTP enqueue failed; exitcode '.($exit >> 8).
+                             " from $self->{_exim_path} -bS");
+        return (DECLINED, 'Internal error enqueuing mail');
+    }
+
+    $self->log(LOGINFO, "Enqueued to exim via BSMTP");
+    return (OK, "Queued!");
+}
+
+
+1;
+
+# vi: ts=4 sw=4 expandtab syn=perl
+

plugins/require_resolvable_fromhost

@@ -1,22 +1,29 @@
 #!/usr/bin/perl
-
 use Danga::DNS;
 
-sub register {
+my %invalid = ();
-    my ($self) = @_;
+
-    $self->register_hook("mail", "mail_handler");
+sub init {
-    $self->register_hook("rcpt", "rcpt_handler");
+    my ($self, $qp) = @_;
+    foreach my $i ($qp->config("invalid_resolvable_fromhost")) {
+	$i =~ s/^\s*//;
+	$i =~ s/\s*$//;
+	if ($i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)#) {
+	    $invalid{$1} = $3;
+	}
+    }
 }
 
-sub mail_handler {
+sub hook_mail {
     my ($self, $transaction, $sender) = @_;
+    return DECLINED
+    	if ($self->qp->connection->notes('whitelistclient'));
     
     $self->transaction->notes('resolvable', 1);
     return DECLINED if $sender->format eq "<>";
     return $self->check_dns($sender->host);
 }
 
-
 sub check_dns {
     my ($self, $host) = @_;
     
@@ -66,7 +73,7 @@ sub dns_result {
 }
 
 
-sub rcpt_handler {
+sub hook_rcpt {
     my ($self, $transaction) = @_;
     
     if (!$transaction->notes('resolvable')) {

plugins/rhsbl

@@ -2,14 +2,7 @@
 
 use Danga::DNS;
 
-sub register {
+sub hook_mail {
-  my ($self) = @_;
-
-  $self->register_hook('mail', 'mail_handler');
-  $self->register_hook('rcpt', 'rcpt_handler');
-}
-
-sub mail_handler {
   my ($self, $transaction, $sender) = @_;
 
   my %rhsbl_zones_map = ();
@@ -59,7 +52,7 @@ sub process_result {
     }
 }
 
-sub rcpt_handler {
+sub hook_rcpt {
   my ($self, $transaction, $rcpt) = @_;
 
   my $result = $transaction->notes('rhsbl');

plugins/tls

@@ -39,6 +39,7 @@ sub init {
         SSL_server => 1
     ) or die "Could not create SSL context: $!";
     
+    # now extract the password...
     $self->ssl_context($ssl_ctx);
     
     # Check for possible AUTH mechanisms
@@ -104,10 +105,18 @@ sub hook_unrecognized_command {
         
         my $conn = $self->connection;
         # Create a new connection object with subset of information collected thus far
-        my $newconn = Qpsmtpd::Connection->new();
+        my $newconn = Qpsmtpd::Connection->new(
-        for (qw(local_ip local_port remote_ip remote_port remote_host remote_info relay_client)) {
+	    map { $_ => $conn->$_ }
-            $newconn->$_($conn->$_());
+		qw(
-        }
+	           local_ip
+		   local_port
+		   remote_ip
+		   remote_port
+		   remote_host
+		   remote_info
+		   relay_client
+		),
+	);
         $self->qp->connection($newconn);
         $self->qp->reset_transaction;
         if ($self->qp->isa('Danga::Socket')) {

plugins/virus/clamdscan

@@ -118,7 +118,7 @@ sub hook_data_post {
     unless ( $content_type
         && $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i )
     {
-        $self->log( LOGERROR, "non-multipart mail - skipping" );
+        $self->log( LOGNOTICE, "non-multipart mail - skipping" );
         return DECLINED;
     }
 
@@ -153,7 +153,10 @@ sub hook_data_post {
         $clamd = Clamd->new();    # default unix domain socket
     }
 
-    return (DENYSOFT) unless $clamd->ping();
+    unless ( $clamd->ping() ) {
+	$self->log( LOGERROR, "Cannot ping clamd server - did you provide the correct clamd port or socket?" );
+	return DECLINED;
+    }
 
     if ( my %found = $clamd->scan($filename) ) {
         my $viruses = join( ",", values(%found) );

qpsmtpd

@@ -24,9 +24,6 @@ use Getopt::Long;
 
 $|++;
 
-# For debugging
-# $SIG{USR1} = sub { Carp::confess("USR1") };
-
 use Socket qw(SOMAXCONN IPPROTO_TCP SO_KEEPALIVE TCP_NODELAY SOL_SOCKET);
 
 $SIG{'PIPE'} = "IGNORE";  # handled manually

qpsmtpd-forkserver

@@ -39,7 +39,7 @@ usage: qpsmtpd-forkserver [ options ]
  -u, --user U              : run as a particular user (default 'smtpd')
  -m, --max-from-ip M       : limit connections from a single IP; default 5
      --pid-file P          : print main servers PID to file P
-     --detach              : detach from controlling terminal (daemonize)
+ -d, --detach              : detach from controlling terminal (daemonize)
 EOT
         exit 0;
 }
@@ -51,8 +51,8 @@ GetOptions('h|help' => \&usage,
            'p|port=i' => \$PORT,
            'u|user=s' => \$USER,
            'pid-file=s' => \$PID_FILE,
-           'd|debug+' => \$DEBUG,
+           'debug+' => \$DEBUG,
-           'detach' => \$DETACH,
+           'd|detach' => \$DETACH,
 	  ) || &usage;
 
 # detaint the commandline
@@ -172,6 +172,10 @@ if ($PID_FILE) {
   close PID;
 }
 
+# Populate class cached variables
+$qpsmtpd->spool_dir;
+$qpsmtpd->size_threshold;
+
 while (1) {
   REAPER();
   my $running = scalar keys %childstatus;
@@ -189,7 +193,6 @@ while (1) {
       # possible something condition...
       next;
     }
-    
     # Make this client blocking while we figure out if we actually want to
     # do something with it.
     IO::Handle::blocking($client, 1);
@@ -233,7 +236,17 @@ while (1) {
        ::log(LOGINFO, "Connection Timed Out"); 
        exit; };
   
-    ::log(LOGINFO, "Accepted connection $running/$MAXCONN");
+    my $localsockaddr = getsockname($client);
+    my ($lport, $laddr) = sockaddr_in($localsockaddr);
+    $ENV{TCPLOCALIP} = inet_ntoa($laddr);
+    # my ($port, $iaddr) = sockaddr_in($hisaddr);
+    $ENV{TCPREMOTEIP} = inet_ntoa($iaddr);
+    $ENV{TCPREMOTEHOST} = gethostbyaddr($iaddr, AF_INET) || "Unknown";
+  
+    # don't do this!
+    #$0 = "qpsmtpd-forkserver: $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}";
+  
+    ::log(LOGINFO, "Accepted connection $running/$MAXCONN from $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}");
     
     $::LineMode = 1;
     
@@ -245,11 +258,11 @@ while (1) {
     $qp->push_back_read("Connect\n");
     Qpsmtpd::PollServer->AddTimer(0.1, sub { });
     while (1) {
-        $qp->enable_read;
+	$qp->enable_read;
-        my $line = $qp->get_line;
+	my $line = $qp->get_line;
-        last if !defined($line);
+	last if !defined($line);
-        my $output = $qp->process_line($line);
+	my $output = $qp->process_line($line);
-        $qp->write($output) if $output;
+	$qp->write($output) if $output;
     }
     
     exit;                                   # child leaves

t/qpsmtpd-address.t

@@ -2,7 +2,7 @@
 use strict;
 $^W = 1;
 
-use Test::More tests => 28;
+use Test::More tests => 29;
 
 BEGIN {
     use_ok('Qpsmtpd::Address');
@@ -16,6 +16,11 @@ $ao = Qpsmtpd::Address->parse($as);
 ok ($ao, "parse $as");
 is ($ao->format, $as, "format $as");
 
+$as = '<postmaster>';
+$ao = Qpsmtpd::Address->parse($as);
+ok ($ao, "parse $as");
+is ($ao->format, $as, "format $as");
+
 $as = '<foo@example.com>';
 $ao = Qpsmtpd::Address->parse($as);
 ok ($ao, "parse $as");
@@ -38,21 +43,6 @@ $ao = Qpsmtpd::Address->parse($as);
 ok ($ao, "parse $as");
 is ($ao->format, '<"foo\ bar"@example.com>', "format $as");
 
-
-$as = 'foo@example.com';
-$ao = Qpsmtpd::Address->parse($as);
-is ($ao, undef, "can't parse $as");
-
-$as = '<@example.com>';
-is (Qpsmtpd::Address->parse($as), undef, "can't parse $as");
-
-$as = '<@123>';
-is (Qpsmtpd::Address->parse($as), undef, "can't parse $as");
-
-$as = '<user>';
-is (Qpsmtpd::Address->parse($as), undef, "can't parse $as");
-
-
 $as = 'foo@example.com';
 $ao = Qpsmtpd::Address->new($as);
 ok ($ao, "new $as");
@@ -79,10 +69,35 @@ $as = '<foo@foo.x.example.com>';
 $ao = Qpsmtpd::Address->new($as);
 ok ($ao, "new $as");
 is ($ao->format, $as, "format $as");
+is ("$ao", $as, "overloaded stringify $as");
 
 $as = 'foo@foo.x.example.com';
 ok ($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>");
 is ($ao && $ao->address, $as, "address $as");
+ok ($ao eq $as, "overloaded 'cmp' operator");
 
+my @unsorted_list = map { Qpsmtpd::Address->new($_) }
+	qw(
+	    "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at
+	    foo@example.com
+	    ask@perl.org
+	    foo@foo.x.example.com
+	    jpeacock@cpan.org
+	    test@example.com
+	);
 
+# NOTE that this is sorted by _host_ not by _domain_
+my @sorted_list = map { Qpsmtpd::Address->new($_) }
+	qw(
+	    jpeacock@cpan.org
+	    foo@example.com
+	    test@example.com
+	    foo@foo.x.example.com
+	    ask@perl.org
+	    "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at
+	);
+
+my @test_list = sort @unsorted_list;
+
+is_deeply( \@test_list, \@sorted_list, "sort via overloaded 'cmp' operator");