Fixup qpsmtpd-prefork, et al, to correctly load Constants.

Make child process pretty name optional for qpsmtpd-prefork.
Ignore rather than crash for uninstalled plugins.

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

Changes

@@ -1,4 +1,10 @@
 0.3x
+  Instead of failing with cryptic message, ignore lines in config/plugins
+  for uninstalled plugins. (John Peacock)
+
+  Patch to prefork code to make it run (Leonardo Helman). Add --pretty
+  option to qpsmtpd-prefork to change $0 for child processes (John Peacock).
+
   Add support for multiple plugin directories, whose paths are given by the
   'plugin_dirs' configuration.  (Devin Carraway, Nick Leverton)
 

lib/Qpsmtpd.pm

@@ -122,8 +122,8 @@ sub config {
 sub config_dir {
   my ($self, $config) = @_;
   my $configdir = ($ENV{QMAIL} || '/var/qmail') . '/control';
-  my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
+  my ($path) = ($ENV{PROCESS} ? $ENV{PROCESS} : $0) =~ m!(.*?)/([^/]+)$!;
-  $configdir = "$name/config" if (-e "$name/config/$config");
+  $configdir = "$path/config" if (-e "$path/config/$config");
   if (exists $ENV{QPSMTPD_CONFIG}) {
     $ENV{QPSMTPD_CONFIG} =~ /^(.*)$/; # detaint
     $configdir = $1 if -e "$1/$config";
@@ -136,8 +136,8 @@ sub plugin_dirs {
     my @plugin_dirs = $self->config('plugin_dirs');
     
     unless (@plugin_dirs) {
-        my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
+        my ($path) = ($ENV{PROCESS} ? $ENV{PROCESS} : $0) =~ m!(.*?)/([^/]+)$!;
-        @plugin_dirs = ( "$name/plugins" );
+        @plugin_dirs = ( "$path/plugins" );
     }
     return @plugin_dirs;
 }
@@ -263,7 +263,8 @@ sub load_plugins {
   my @loaded;
 
   for my $plugin_line (@plugins) {
-    push @loaded, $self->_load_plugin($plugin_line, $self->plugin_dirs);
+    my $this_plugin = $self->_load_plugin($plugin_line, $self->plugin_dirs);
+    push @loaded, $this_plugin if $this_plugin;
   }
 
   return @loaded;
@@ -319,6 +320,10 @@ sub _load_plugin {
             unless $plugin_line =~ /logging/;
           last PLUGIN_DIR;
         }
+	else {
+	  $self->log(LOGDEBUG, "Failed to load plugin - $plugin - ignoring");
+	  return 0;
+	}
       }
     }
   }

lib/Qpsmtpd/SMTP/Prefork.pm

@@ -1,5 +1,6 @@
 package Qpsmtpd::SMTP::Prefork;
 use Qpsmtpd::SMTP;
+use Qpsmtpd::Constants;
 @ISA = qw(Qpsmtpd::SMTP);
 
 sub dispatch {

lib/Qpsmtpd/TcpServer/Prefork.pm

@@ -1,6 +1,7 @@
 package Qpsmtpd::TcpServer::Prefork;
 use Qpsmtpd::TcpServer;
 use Qpsmtpd::SMTP::Prefork;
+use Qpsmtpd::Constants;
 
 @ISA = qw(Qpsmtpd::SMTP::Prefork Qpsmtpd::TcpServer);
 
@@ -12,7 +13,7 @@ sub start_connection {
     #reset info
     $self->{_connection} = Qpsmtpd::Connection->new(); #reset connection
     $self->{_transaction} = Qpsmtpd::Transaction->new(); #reset transaction
-    $self->SUPER::start_connection();
+    $self->SUPER::start_connection(@_);
 }
 
 sub read_input {
@@ -53,4 +54,12 @@ sub respond {
   return 1;
 }
 
+sub disconnect {
+  my $self = shift;
+  $self->log(LOGDEBUG,"click, disconnecting");
+  $self->SUPER::disconnect(@_);
+  $self->run_hooks("post-connection");
+  die "disconnect_tcpserver";
+}
+
 1;

qpsmtpd-prefork

@@ -59,6 +59,7 @@ my $d_start         = 0;
 my $quiet           = 0;
 my $status          = 0;
 my $signal          = '';
+my $pretty          = 0;
 my $user;
 
 # help text
@@ -73,6 +74,7 @@ Usage: qpsmtpd-prefork [ options ]
 --max-from-ip int   : Limit number of connections from single IP (default: $maxconnip, 0 to disable)
 --children int      : Max number of children that can be spawned (default: $max_children)
 --idle-children int : Number of idle children to spawn (default: $idle_children, 0 to disable)
+--pretty-child      : Change child process name (default: 0)
 --user username     : User the daemon should run as
 --pid-file path	    : Path to pid file
 --renice-parent int : Subtract value from parent process nice level (default: $re_nice)
@@ -91,6 +93,7 @@ GetOptions(
     'max-from-ip=i'   => \$maxconnip,
     'children=i'      => \$max_children,
     'idle-children=i' => \$idle_children,
+    'pretty-child'    => \$pretty,
     'user=s'          => \$user,
     'renice-parent=i' => \$re_nice,
     'help'            => \&usage,
@@ -338,7 +341,10 @@ sub new_child {
     # continue to accept connections until "old age" is reached
     for (my $i = 0 ; $i < $child_lifetime ; $i++) {
         # accept a connection
-        #$0 = 'qpsmtpd child';    # set pretty child name in process listing
+	if ( $pretty ) {
+	    $ENV{PROCESS} = $0 if not defined $ENV{PROCESS}; # 1st time only
+	    $0 = 'qpsmtpd child'; # set pretty child name in process listing
+	}
         my ($client, $iinfo) = $d->accept()
           or die
           "failed to create new object - $!";  # wait here until client connects