Make pid-file optional

Use known-safe fork code for forking
No more SIGCHLD for managing zombies (Peter Holzer)
Don't block on accept() so we can call REAPER every second


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

qpsmtpd-forkserver

@@ -10,6 +10,7 @@ use lib 'lib';
 use Qpsmtpd::TcpServer;
 use Qpsmtpd::Constants;
 use IO::Socket;
+use IO::Select;
 use Socket;
 use Getopt::Long;
 use POSIX qw(:sys_wait_h :errno_h :signal_h);
@@ -22,7 +23,7 @@ my $PORT      = 2525;				# port number
 my $LOCALADDR = '0.0.0.0';		# ip address to bind to
 my $USER      = 'smtpd';		# user to suid to
 my $MAXCONNIP = 5;              # max simultaneous connections from one IP
-my $PID_FILE   = '/var/run/qpsmtpd.pid';
+my $PID_FILE   = '';
 
 sub usage {
         print <<"EOT";
@@ -43,7 +44,7 @@ GetOptions('h|help' => \&usage,
            'm|max-from-ip=i' => \$MAXCONNIP,
            'p|port=i' => \$PORT,
            'u|user=s' => \$USER,
-	   'pid-file=s' => \$PID_FILE,
+           'pid-file=s' => \$PID_FILE,
 	  ) || &usage;
 
 # detaint the commandline
@@ -51,7 +52,6 @@ if ($PORT =~ /^(\d+)$/) { $PORT = $1 } else { &usage }
 if ($LOCALADDR =~ /^([\d\w\-.]+)$/) { $LOCALADDR = $1 } else { &usage }
 if ($USER =~ /^([\w\-]+)$/) { $USER = $1 } else { &usage }
 if ($MAXCONN =~ /^(\d+)$/) { $MAXCONN = $1 } else { &usage }
-if ($PID_FILE =~ m#^(/[\w\d/\-.]+)$#) { $PID_FILE = $1 } else { &usage }
 
 delete $ENV{ENV};
 $ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';
@@ -59,7 +59,6 @@ $ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';
 my %childstatus = ();
 
 sub REAPER {
-  $SIG{CHLD} = \&REAPER;
   while ( defined(my $chld = waitpid(-1, WNOHANG)) ){
     last unless $chld > 0;
     ::log(LOGINFO,"cleaning up after $chld");
@@ -73,7 +72,6 @@ sub HUNTSMAN {
   exit(0);
 }
 
-$SIG{CHLD} = \&REAPER;
 $SIG{INT} = \&HUNTSMAN;
 $SIG{TERM} = \&HUNTSMAN;
 
@@ -82,27 +80,38 @@ my $server = IO::Socket::INET->new(LocalPort => $PORT,
 				   LocalAddr => $LOCALADDR,
                                    Proto     => 'tcp',
                                    Reuse     => 1,
+                                   Blocking  => 0,
                                    Listen    => SOMAXCONN )
   or die "Creating TCP socket $LOCALADDR:$PORT: $!\n";
+IO::Handle::blocking($server, 0);
+my $sel = IO::Select->new();
+$sel->add($server);
 
-if (-e $PID_FILE) {
+if ($PID_FILE) {
-  open PID, "+<$PID_FILE"
+  if ($PID_FILE =~ m#^(/[\w\d/\-.]+)$#) { $PID_FILE = $1 } else { &usage }
-    or die "open pid_file: $!\n";
+  if (-e $PID_FILE) {
-  my $running_pid = <PID>; chomp $running_pid;
+    open PID, "+<$PID_FILE"
-  if ($running_pid =~ /(\d+)/) {
+      or die "open pid_file: $!\n";
-    $running_pid = $1;
+    my $running_pid = <PID>; chomp $running_pid;
-    if (kill 0, $running_pid) {
+    if ($running_pid =~ /(\d+)/) {
-      die "Found an already running qpsmtpd with pid $running_pid.\n";
+      $running_pid = $1;
+      if (kill 0, $running_pid) {
+        die "Found an already running qpsmtpd with pid $running_pid.\n";
+      }
     }
+    seek PID, 0, 0
+      or die "Could not seek back to beginning of $PID_FILE: $!\n";
+  } else {
+    open PID, ">$PID_FILE"
+      or die "open pid_file: $!\n";
   }
-  seek PID, 0, 0
+  print PID $$,"\n";
-    or die "Could not seek back to beginning of $PID_FILE: $!\n";
+  close PID;
-} else {
-  open PID, ">$PID_FILE"
-    or die "open pid_file: $!\n";
 }
-print PID $$,"\n";
+
-close PID;
+# Load plugins here
+my $qpsmtpd = Qpsmtpd::TcpServer->new();
+$qpsmtpd->load_plugins;
 
 # Drop privileges
 my (undef, undef, $quid, $qgid) = getpwnam $USER or
@@ -122,10 +131,6 @@ POSIX::setuid($quid) or
       die "unable to change uid: $!\n";
 $> = $quid;
 
-# Load plugins here
-my $qpsmtpd = Qpsmtpd::TcpServer->new();
-$qpsmtpd->load_plugins;
-
 ::log(LOGINFO,"Listening on port $PORT");
 ::log(LOGINFO, 'Running as user '.
 	(getpwuid($>) || $>) .
@@ -133,26 +138,28 @@ $qpsmtpd->load_plugins;
 	(getgrgid($)) || $)));
 
 while (1) {
+  REAPER();
   my $running = scalar keys %childstatus;
   while ($running >= $MAXCONN) { 
     ::log(LOGINFO,"Too many connections: $running >= $MAXCONN.  Waiting one second.");
     sleep(1) ;
+    REAPER();
     $running = scalar keys %childstatus;
+  }
+  if (!$sel->can_read(1)) {
+    next;
   }
     my $hisaddr = accept(my $client, $server);
     if (!$hisaddr) {
         # possible something condition...
         next;
     }
+    IO::Handle::blocking($client, 1);
     my ($port, $iaddr) = sockaddr_in($hisaddr);
     if ($MAXCONNIP) {
         my $num_conn = 1; # seed with current value
 
-        # If we for-loop directly over values %childstatus, a SIGCHLD
+        foreach my $rip (values %childstatus) {
-        # can call REAPER and slip $rip out from under us.  Causes
-        # "Use of freed value in iteration" under perl 5.8.4.
-        my @rip = values %childstatus;
-        foreach my $rip (@rip) {
           ++$num_conn if (defined $rip && $rip eq $iaddr);
         }
 
@@ -166,7 +173,7 @@ while (1) {
             next;
         }
     }
-    my $pid = fork;
+    my $pid = safe_fork();
     if ($pid) {
         # parent
         $childstatus{$pid} = $iaddr;	# add to table
@@ -175,7 +182,6 @@ while (1) {
         close($client);
         next;
     }
-    die "fork: $!" unless defined $pid;     # failure
     # otherwise child
 
     # all children should have different seeds, to prevent conflicts
@@ -213,7 +219,7 @@ while (1) {
        remote_port => $port,
       );
     $qpsmtpd->run();
-
+    
     exit;                                   # child leaves
 }
 
@@ -222,6 +228,30 @@ sub log {
   $qpsmtpd->log($level,$message);
 }
 
+### routine to protect process during fork
+sub safe_fork {
+  
+  ### block signal for fork
+  my $sigset = POSIX::SigSet->new(SIGINT);
+  POSIX::sigprocmask(SIG_BLOCK, $sigset)
+    or die "Can't block SIGINT for fork: [$!]\n";
+  
+  ### fork off a child
+  my $pid = fork;
+  unless( defined $pid ){
+    die "Couldn't fork: [$!]\n";
+  }
+
+  ### make SIGINT kill us as it did before
+  $SIG{INT} = 'DEFAULT';
+
+  ### put back to normal
+  POSIX::sigprocmask(SIG_UNBLOCK, $sigset)
+    or die "Can't unblock SIGINT for fork: [$!]\n";
+
+  return $pid;
+}
+
 __END__
 
 1;