* qpsmtpd-forkserver

Create a single Qpsmtpd::TcpServer object in the parent process and
     then rely on fork to let each child have it's own copy
     
 *   lib/Qpsmtpd/Plugin.pm
     Add new pre-connection and post-connection hooks
     
 *   README.plugins
     Document the above new hooks

 *   lib/Qpsmtpd.pm
     No longer have local value for trace_level() the first time through, which 
     was masking the global value (due to stupid search/replace error).
     Don't call log() from trace_level() since it is only ever called from
     within the varlog() sub when no logging plugin is registered.

 *   plugins/dnsbl
     Config line option to use DENY_DISCONNECT instead of DENY (since any IP
     on a blacklist should not have a chance to send anything for now).
     Add POD to document the new disconnect behavior

 *   lib/Qpsmtpd.pm
     Compatibility changes so test files continue to work
 
 *   t/Test/Qpsmtpd.pm
     Compatibility sub for core subs which call varlog() directly


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

README.plugins

@@ -53,6 +53,21 @@ See more detailed description for each hook below.
 
 =head1 Hooks
 
+=head2 pre-connection
+
+Called by a controlling process (e.g. forkserver or Apache::Qpsmtpd) after
+accepting the remote server, but before beginning a new instance.  Useful for
+load-management and rereading large config files at some frequency less than
+once per session.  The hook doesn't have a predefined additional input value,
+but one can be passed as a hash of name/value pairs.
+
+=head2 post-connection
+
+Like pre-connection only it can be called after an instance has been
+completely finished (e.g. after the child process has ended in forkserver).  
+The hook doesn't have a predefined additional input value, but one can be
+passed as a hash of name/value pairs.
+
 =head2 mail
 
 Called right after the envelope sender address is passed.  The plugin

lib/Qpsmtpd.pm

@@ -9,7 +9,7 @@ $VERSION = "0.30-dev";
 
 sub version { $VERSION };
 
-sub TRACE_LEVEL { trace_level(); }; # leave for plugin compatibility
+sub TRACE_LEVEL { $TraceLevel }; # leave for plugin compatibility
 
 sub load_logging {
   # need to do this differently that other plugins so as to 
@@ -36,20 +36,19 @@ sub trace_level {
 
   my $configdir = $self->config_dir("loglevel");
   my $configfile = "$configdir/loglevel";
-  my ($TraceLevel) = $self->_config_from_file($configfile,'loglevel');
+  $TraceLevel = $self->_config_from_file($configfile,'loglevel');
 
-  if (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) {
-    $TraceLevel = $TraceLevel;
-  }
-  else {
+  unless (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) {
     $TraceLevel = LOGWARN; # Default if no loglevel file found.
   }
 
-  $self->log(LOGINFO, "Loaded default logger");
-
   return $TraceLevel;
 }
 
+sub init_logger { # needed for compatibility purposes
+  shift->trace_level();
+}
+
 sub log {
   my ($self, $trace, @log) = @_;
   $self->varlog($trace,join(" ",@log));

lib/Qpsmtpd/Plugin.pm

@@ -5,7 +5,7 @@ our %hooks = map { $_ => 1 } qw(
     config  queue  data  data_post  quit  rcpt  mail  ehlo  helo
     auth auth-plain auth-login auth-cram-md5
     connect  reset_transaction  unrecognized_command  disconnect
-    deny logging ok
+    deny logging ok pre-connection post-connection
 );
 
 sub new {

plugins/dnsbl

@@ -1,5 +1,14 @@
+#!perl -w
+
 sub register {
-  my ($self, $qp) = @_;
+  my ($self, $qp, $denial ) = @_;
+  if ( defined $denial and $denial =~ /^disconnect$/i ) {
+    $self->{_dnsbl}->{DENY} = DENY_DISCONNECT;
+  }
+  else {
+    $self->{_dnsbl}->{DENY} = DENY;
+  }
+		    
   $self->register_hook("connect", "connect_handler");
   $self->register_hook("rcpt", "rcpt_handler");
   $self->register_hook("disconnect", "disconnect_handler");
@@ -150,7 +159,8 @@ sub rcpt_handler {
     my $result = $ENV{'RBLSMTPD'};
     my $remote_ip = $self->qp->connection->remote_ip;
     $result =~ s/%IP%/$remote_ip/g;
-    return (DENY, join(" ", $self->qp->config('dnsbl_rejectmsg'), $result));
+    return ($self->{_dnsbl}->{DENY}, 
+	join(" ", $self->qp->config('dnsbl_rejectmsg'), $result));
   }
 
   my $note = $self->process_sockets;
@@ -163,7 +173,7 @@ sub rcpt_handler {
       $self->log(2, "Whitelist overrode blacklist: $whitelist");
     }
     else {
-      return (DENY, $note);
+      return ($self->{_dnsbl}->{DENY}, $note);
     }
   }
   return DECLINED;
@@ -189,6 +199,19 @@ dnsbl - handle DNS BlackList lookups
 Plugin that checks the IP address of the incoming connection against
 a configurable set of RBL services.
 
+=head1 Usage
+
+Add the following line to the config/plugins file:
+
+  dnsbl [disconnect]
+
+If you want to immediately drop the connection (since some blacklisted 
+servers attempt multiple sends per session), add the optional keyword 
+"disconnect" (case insensitive) to the config line.  In most cases, an
+IP address that is listed should not be given the opportunity to begin
+a new transaction, since even the most volatile blacklists will return
+the same answer for a short period of time (the minimum DNS cache period).
+
 =head1 Configuration files
 
 This plugin uses the following configuration files. All of these are optional.

qpsmtpd-forkserver

@@ -91,8 +91,8 @@ POSIX::setuid($quid) or
 $> = $quid;
 
 # Load plugins here
-my $plugin_loader = Qpsmtpd::TcpServer->new();
-$plugin_loader->load_plugins;
+my $qpsmtpd = Qpsmtpd::TcpServer->new();
+$qpsmtpd->load_plugins;
 
 ::log(LOGINFO,"Listening on port $PORT");
 ::log(LOGINFO, 'Running as user '.
@@ -173,7 +173,6 @@ while (1) {
     POSIX::dup2(fileno($client), 0);
     POSIX::dup2(fileno($client), 1);
     
-    my $qpsmtpd = Qpsmtpd::TcpServer->new();
     $qpsmtpd->start_connection
       (
        local_ip    => $ENV{TCPLOCALIP},
@@ -188,7 +187,7 @@ while (1) {
 
 sub log {
   my ($level,$message) = @_;
-  $plugin_loader->log($level,$message);
+  $qpsmtpd->log($level,$message);
 }
 
 __END__

t/Test/Qpsmtpd.pm

@@ -81,6 +81,10 @@ sub log {
     print("# " . join(" ", $$, @log) . "\n") if $trace <= $level;
 }
 
+sub varlog {
+    shift->log(@_);
+}
+
 # sub run
 # sub disconnect