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
This commit is contained in:
Matt Sergeant 2005-07-05 15:16:36 +00:00
parent 03f8c0d2f8
commit 698fc01595

View File

@ -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) {
open PID, "+<$PID_FILE"
or die "open pid_file: $!\n";
my $running_pid = <PID>; chomp $running_pid;
if ($running_pid =~ /(\d+)/) {
$running_pid = $1;
if (kill 0, $running_pid) {
die "Found an already running qpsmtpd with pid $running_pid.\n";
if ($PID_FILE) {
if ($PID_FILE =~ m#^(/[\w\d/\-.]+)$#) { $PID_FILE = $1 } else { &usage }
if (-e $PID_FILE) {
open PID, "+<$PID_FILE"
or die "open pid_file: $!\n";
my $running_pid = <PID>; chomp $running_pid;
if ($running_pid =~ /(\d+)/) {
$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
or die "Could not seek back to beginning of $PID_FILE: $!\n";
} else {
open PID, ">$PID_FILE"
or die "open pid_file: $!\n";
print PID $$,"\n";
close PID;
}
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
# 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) {
foreach my $rip (values %childstatus) {
++$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;