perltidy -b qpsmtpd*

This commit is contained in:
Matt Simerson 2013-04-21 00:34:07 -04:00
parent 5b06929e95
commit 6b431807c3
4 changed files with 490 additions and 406 deletions

View File

@ -21,11 +21,11 @@ $ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';
my $qpsmtpd = Qpsmtpd::TcpServer->new(); my $qpsmtpd = Qpsmtpd::TcpServer->new();
$qpsmtpd->load_plugins(); $qpsmtpd->load_plugins();
$qpsmtpd->start_connection(); $qpsmtpd->start_connection();
$qpsmtpd->run(\*STDIN); # pass the "socket" like -prefork/-forkserver $qpsmtpd->run(\*STDIN); # pass the "socket" like -prefork/-forkserver
$qpsmtpd->run_hooks("post-connection"); $qpsmtpd->run_hooks("post-connection");
$qpsmtpd->connection->reset; $qpsmtpd->connection->reset;
# needed for Qpsmtpd::TcpServer::check_socket(): # needed for Qpsmtpd::TcpServer::check_socket():
# emulate IO::Socket::connected on STDIN. STDIN was used instead of STDOUT # emulate IO::Socket::connected on STDIN. STDIN was used instead of STDOUT
# because the other code also calls getpeername(STDIN). # because the other code also calls getpeername(STDIN).
sub IO::Handle::connected { return getpeername(shift) } sub IO::Handle::connected { return getpeername(shift) }

View File

@ -1,6 +1,7 @@
#!/usr/bin/perl #!/usr/bin/perl
use lib "./lib"; use lib "./lib";
BEGIN { BEGIN {
delete $ENV{ENV}; delete $ENV{ENV};
delete $ENV{BASH_ENV}; delete $ENV{BASH_ENV};
@ -14,6 +15,7 @@ BEGIN {
use strict; use strict;
use vars qw($DEBUG); use vars qw($DEBUG);
use FindBin qw(); use FindBin qw();
# TODO: need to make this taint friendly # TODO: need to make this taint friendly
use lib "$FindBin::Bin/lib"; use lib "$FindBin::Bin/lib";
use Danga::Socket; use Danga::Socket;
@ -29,25 +31,26 @@ use List::Util qw(shuffle);
$|++; $|++;
use Socket qw(SOMAXCONN IPPROTO_TCP SO_KEEPALIVE TCP_NODELAY SOL_SOCKET AF_UNIX SOCK_STREAM PF_UNSPEC); use Socket
qw(SOMAXCONN IPPROTO_TCP SO_KEEPALIVE TCP_NODELAY SOL_SOCKET AF_UNIX SOCK_STREAM PF_UNSPEC);
$SIG{'PIPE'} = "IGNORE"; # handled manually $SIG{'PIPE'} = "IGNORE"; # handled manually
$DEBUG = 0; $DEBUG = 0;
my $CONFIG_PORT = 20025; my $CONFIG_PORT = 20025;
my $CONFIG_LOCALADDR = '127.0.0.1'; my $CONFIG_LOCALADDR = '127.0.0.1';
my $PORT = 2525; my $PORT = 2525;
my $LOCALADDR = '0.0.0.0'; my $LOCALADDR = '0.0.0.0';
my $PROCS = 1; my $PROCS = 1;
my $USER = (getpwuid $>)[0]; # user to suid to my $USER = (getpwuid $>)[0]; # user to suid to
$USER = "smtpd" if $USER eq "root"; $USER = "smtpd" if $USER eq "root";
my $PAUSED = 0; my $PAUSED = 0;
my $NUMACCEPT = 20; my $NUMACCEPT = 20;
my $PID_FILE = ''; my $PID_FILE = '';
my $ACCEPT_RSET; my $ACCEPT_RSET;
my $DETACH; # daemonize on startup my $DETACH; # daemonize on startup
# make sure we don't spend forever doing accept() # make sure we don't spend forever doing accept()
use constant ACCEPT_MAX => 1000; use constant ACCEPT_MAX => 1000;
@ -77,30 +80,39 @@ EOT
} }
GetOptions( GetOptions(
'p|port=i' => \$PORT, 'p|port=i' => \$PORT,
'l|listen-address=s' => \$LOCALADDR, 'l|listen-address=s' => \$LOCALADDR,
'j|procs=i' => \$PROCS, 'j|procs=i' => \$PROCS,
'v|verbose+' => \$DEBUG, 'v|verbose+' => \$DEBUG,
'u|user=s' => \$USER, 'u|user=s' => \$USER,
'pid-file=s' => \$PID_FILE, 'pid-file=s' => \$PID_FILE,
'd|detach' => \$DETACH, 'd|detach' => \$DETACH,
'h|help' => \&help, 'h|help' => \&help,
'config-port=i' => \$CONFIG_PORT, 'config-port=i' => \$CONFIG_PORT,
) || help(); )
|| help();
# detaint the commandline # detaint the commandline
if ($PORT =~ /^(\d+)$/) { $PORT = $1 } else { &help } if ($PORT =~ /^(\d+)$/) { $PORT = $1 }
if ($LOCALADDR =~ /^([\d\w\-.]+)$/) { $LOCALADDR = $1 } else { &help } else { &help }
if ($USER =~ /^([\w\-]+)$/) { $USER = $1 } else { &help } if ($LOCALADDR =~ /^([\d\w\-.]+)$/) { $LOCALADDR = $1 }
if ($PROCS =~ /^(\d+)$/) { $PROCS = $1 } else { &help } else { &help }
if ($USER =~ /^([\w\-]+)$/) { $USER = $1 }
else { &help }
if ($PROCS =~ /^(\d+)$/) { $PROCS = $1 }
else { &help }
sub force_poll { sub force_poll {
$Danga::Socket::HaveEpoll = 0; $Danga::Socket::HaveEpoll = 0;
$Danga::Socket::HaveKQueue = 0; $Danga::Socket::HaveKQueue = 0;
} }
my $POLL = "with " . ($Danga::Socket::HaveEpoll ? "epoll()" : my $POLL = "with "
$Danga::Socket::HaveKQueue ? "kqueue()" : "poll()"); . (
$Danga::Socket::HaveEpoll ? "epoll()"
: $Danga::Socket::HaveKQueue ? "kqueue()"
: "poll()"
);
my $SERVER; my $SERVER;
my $CONFIG_SERVER; my $CONFIG_SERVER;
@ -113,12 +125,13 @@ my %childstatus = ();
if ($PID_FILE && -r $PID_FILE) { if ($PID_FILE && -r $PID_FILE) {
open PID, "<$PID_FILE" open PID, "<$PID_FILE"
or die "open_pidfile $PID_FILE: $!\n"; or die "open_pidfile $PID_FILE: $!\n";
my $running_pid = <PID> || ''; chomp $running_pid; my $running_pid = <PID> || '';
chomp $running_pid;
if ($running_pid =~ /^(\d+)/) { if ($running_pid =~ /^(\d+)/) {
if (kill 0, $running_pid) { if (kill 0, $running_pid) {
die "Found an already running qpsmtpd with pid $running_pid.\n"; die "Found an already running qpsmtpd with pid $running_pid.\n";
} }
} }
close(PID); close(PID);
} }
@ -133,32 +146,36 @@ sub _fork {
# Fixup Net::DNS randomness after fork # Fixup Net::DNS randomness after fork
srand($$ ^ time); srand($$ ^ time);
local $^W; local $^W;
delete $INC{'Net/DNS/Header.pm'}; delete $INC{'Net/DNS/Header.pm'};
require Net::DNS::Header; require Net::DNS::Header;
# cope with different versions of Net::DNS # cope with different versions of Net::DNS
eval { eval {
$Net::DNS::Resolver::global{id} = 1; $Net::DNS::Resolver::global{id} = 1;
$Net::DNS::Resolver::global{id} = int(rand(Net::DNS::Resolver::MAX_ID())); $Net::DNS::Resolver::global{id} =
int(rand(Net::DNS::Resolver::MAX_ID()));
# print "Next DNS ID: $Net::DNS::Resolver::global{id}\n"; # print "Next DNS ID: $Net::DNS::Resolver::global{id}\n";
}; };
if ($@) { if ($@) {
# print "Next DNS ID: " . Net::DNS::Header::nextid() . "\n"; # print "Next DNS ID: " . Net::DNS::Header::nextid() . "\n";
} }
# Fixup lost kqueue after fork # Fixup lost kqueue after fork
$Danga::Socket::HaveKQueue = undef; $Danga::Socket::HaveKQueue = undef;
} }
sub spawn_child { sub spawn_child {
my $plugin_loader = shift || Qpsmtpd::SMTP->new; my $plugin_loader = shift || Qpsmtpd::SMTP->new;
socketpair(my $reader, my $writer, AF_UNIX, SOCK_STREAM, PF_UNSPEC) || die "Unable to create a pipe"; socketpair(my $reader, my $writer, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
|| die "Unable to create a pipe";
$writer->autoflush(1); $writer->autoflush(1);
$reader->autoflush(1); $reader->autoflush(1);
if (my $pid = _fork) { if (my $pid = _fork) {
$childstatus{$pid} = $writer; $childstatus{$pid} = $writer;
return $pid; return $pid;
@ -167,15 +184,14 @@ sub spawn_child {
$SIG{CHLD} = $SIG{INT} = $SIG{TERM} = 'DEFAULT'; $SIG{CHLD} = $SIG{INT} = $SIG{TERM} = 'DEFAULT';
$SIG{PIPE} = 'IGNORE'; $SIG{PIPE} = 'IGNORE';
$SIG{HUP} = 'IGNORE'; $SIG{HUP} = 'IGNORE';
close $CONFIG_SERVER; close $CONFIG_SERVER;
Qpsmtpd::PollServer->Reset; Qpsmtpd::PollServer->Reset;
Qpsmtpd::PollServer->OtherFds( Qpsmtpd::PollServer->OtherFds(
fileno($reader) => sub { command_handler($reader) }, fileno($reader) => sub { command_handler($reader) },
fileno($SERVER) => \&accept_handler, fileno($SERVER) => \&accept_handler,);
);
$ACCEPT_RSET = Danga::Socket->AddTimer(30, \&reset_num_accept); $ACCEPT_RSET = Danga::Socket->AddTimer(30, \&reset_num_accept);
@ -194,7 +210,7 @@ sub sig_hup {
sub sig_chld { sub sig_chld {
my $spawn_count = 0; my $spawn_count = 0;
while ( (my $child = waitpid(-1,WNOHANG)) > 0) { while ((my $child = waitpid(-1, WNOHANG)) > 0) {
if (!defined $childstatus{$child}) { if (!defined $childstatus{$child}) {
next; next;
} }
@ -205,7 +221,8 @@ sub sig_chld {
$spawn_count++; $spawn_count++;
} }
if ($spawn_count) { if ($spawn_count) {
for (1..$spawn_count) { for (1 .. $spawn_count) {
# restart a new child if in poll server mode # restart a new child if in poll server mode
my $pid = spawn_child(); my $pid = spawn_child();
} }
@ -223,34 +240,40 @@ sub HUNTSMAN {
} }
sub run_as_server { sub run_as_server {
# establish SERVER socket, bind and listen. # establish SERVER socket, bind and listen.
$SERVER = IO::Socket::INET->new(LocalPort => $PORT, $SERVER = IO::Socket::INET->new(
LocalPort => $PORT,
LocalAddr => $LOCALADDR, LocalAddr => $LOCALADDR,
Type => SOCK_STREAM, Type => SOCK_STREAM,
Proto => IPPROTO_TCP, Proto => IPPROTO_TCP,
Blocking => 0, Blocking => 0,
Reuse => 1, Reuse => 1,
Listen => SOMAXCONN ) Listen => SOMAXCONN
or die "Error creating server $LOCALADDR:$PORT : $@\n"; )
or die "Error creating server $LOCALADDR:$PORT : $@\n";
IO::Handle::blocking($SERVER, 0); IO::Handle::blocking($SERVER, 0);
binmode($SERVER, ':raw'); binmode($SERVER, ':raw');
$CONFIG_SERVER = IO::Socket::INET->new(LocalPort => $CONFIG_PORT, $CONFIG_SERVER =
LocalAddr => $CONFIG_LOCALADDR, IO::Socket::INET->new(
Type => SOCK_STREAM, LocalPort => $CONFIG_PORT,
Proto => IPPROTO_TCP, LocalAddr => $CONFIG_LOCALADDR,
Blocking => 0, Type => SOCK_STREAM,
Reuse => 1, Proto => IPPROTO_TCP,
Listen => 1 ) Blocking => 0,
or die "Error creating server $CONFIG_LOCALADDR:$CONFIG_PORT : $@\n"; Reuse => 1,
Listen => 1
)
or die "Error creating server $CONFIG_LOCALADDR:$CONFIG_PORT : $@\n";
IO::Handle::blocking($CONFIG_SERVER, 0); IO::Handle::blocking($CONFIG_SERVER, 0);
binmode($CONFIG_SERVER, ':raw'); binmode($CONFIG_SERVER, ':raw');
# Drop priviledges # Drop priviledges
my (undef, undef, $quid, $qgid) = getpwnam $USER or my (undef, undef, $quid, $qgid) = getpwnam $USER
die "unable to determine uid/gid for $USER\n"; or die "unable to determine uid/gid for $USER\n";
my $groups = "$qgid $qgid"; my $groups = "$qgid $qgid";
while (my (undef, undef, $gid, $members) = getgrent) { while (my (undef, undef, $gid, $members) = getgrent) {
my @m = split(/ /, $members); my @m = split(/ /, $members);
@ -260,40 +283,43 @@ sub run_as_server {
} }
endgrent; endgrent;
$) = $groups; $) = $groups;
POSIX::setgid($qgid) or POSIX::setgid($qgid)
die "unable to change gid: $!\n"; or die "unable to change gid: $!\n";
POSIX::setuid($quid) or POSIX::setuid($quid)
die "unable to change uid: $!\n"; or die "unable to change uid: $!\n";
$> = $quid; $> = $quid;
# Load plugins here # Load plugins here
my $plugin_loader = Qpsmtpd::SMTP->new(); my $plugin_loader = Qpsmtpd::SMTP->new();
$plugin_loader->load_plugins; $plugin_loader->load_plugins;
if ($DETACH) { if ($DETACH) {
open STDIN, '/dev/null' or die "/dev/null: $!"; open STDIN, '/dev/null' or die "/dev/null: $!";
open STDOUT, '>/dev/null' or die "/dev/null: $!"; open STDOUT, '>/dev/null' or die "/dev/null: $!";
open STDERR, '>&STDOUT' or die "open(stderr): $!"; open STDERR, '>&STDOUT' or die "open(stderr): $!";
defined (my $pid = fork) or die "fork: $!"; defined(my $pid = fork) or die "fork: $!";
exit 0 if $pid; exit 0 if $pid;
POSIX::setsid or die "setsid: $!"; POSIX::setsid or die "setsid: $!";
} }
if ($PID_FILE) { if ($PID_FILE) {
open PID, ">$PID_FILE" || die "$PID_FILE: $!"; open PID, ">$PID_FILE" || die "$PID_FILE: $!";
print PID $$,"\n"; print PID $$, "\n";
close PID; close PID;
} }
$plugin_loader->log(LOGINFO, 'Running as user '. $plugin_loader->log(LOGINFO,
(getpwuid($>) || $>) . 'Running as user '
', group '. . (getpwuid($>) || $>)
(getgrgid($)) || $))); . ', group '
. (getgrgid($)) || $))
);
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN; $SIG{INT} = $SIG{TERM} = \&HUNTSMAN;
###################### ######################
# more Profiling code # more Profiling code
=pod =pod
$plugin_loader->run_hooks('post-fork'); $plugin_loader->run_hooks('post-fork');
@ -315,38 +341,39 @@ sub run_as_server {
Qpsmtpd::PollServer->EventLoop; Qpsmtpd::PollServer->EventLoop;
exit; exit;
=cut =cut
##################### #####################
for (1..$PROCS) { for (1 .. $PROCS) {
my $pid = spawn_child($plugin_loader); my $pid = spawn_child($plugin_loader);
} }
$plugin_loader->log(LOGDEBUG, "Listening on $PORT with $PROCS children $POLL"); $plugin_loader->log(LOGDEBUG,
"Listening on $PORT with $PROCS children $POLL");
$SIG{CHLD} = \&sig_chld; $SIG{CHLD} = \&sig_chld;
$SIG{HUP} = \&sig_hup; $SIG{HUP} = \&sig_hup;
Qpsmtpd::PollServer->OtherFds( Qpsmtpd::PollServer->OtherFds(fileno($CONFIG_SERVER) => \&config_handler,);
fileno($CONFIG_SERVER) => \&config_handler,
);
Qpsmtpd::PollServer->EventLoop; Qpsmtpd::PollServer->EventLoop;
exit; exit;
} }
sub config_handler { sub config_handler {
my $csock = $CONFIG_SERVER->accept(); my $csock = $CONFIG_SERVER->accept();
if (!$csock) { if (!$csock) {
# warn("accept failed on config server: $!"); # warn("accept failed on config server: $!");
return; return;
} }
binmode($csock, ':raw'); binmode($csock, ':raw');
printf("Config server connection\n") if $DEBUG; printf("Config server connection\n") if $DEBUG;
IO::Handle::blocking($csock, 0); IO::Handle::blocking($csock, 0);
setsockopt($csock, IPPROTO_TCP, TCP_NODELAY, pack("l", 1)) or die; setsockopt($csock, IPPROTO_TCP, TCP_NODELAY, pack("l", 1)) or die;
my $client = Qpsmtpd::ConfigServer->new($csock); my $client = Qpsmtpd::ConfigServer->new($csock);
$client->watch_read(1); $client->watch_read(1);
return; return;
@ -354,21 +381,23 @@ sub config_handler {
sub command_handler { sub command_handler {
my $reader = shift; my $reader = shift;
chomp(my $command = <$reader>); chomp(my $command = <$reader>);
#print "Got command: $command\n"; #print "Got command: $command\n";
my $real_command = "cmd_$command"; my $real_command = "cmd_$command";
no strict 'refs'; no strict 'refs';
$real_command->(); $real_command->();
} }
sub cmd_hup { sub cmd_hup {
# clear cache # clear cache
print "Clearing cache\n"; print "Clearing cache\n";
Qpsmtpd::clear_config_cache(); Qpsmtpd::clear_config_cache();
# should also reload modules... but can't do that yet. # should also reload modules... but can't do that yet.
} }
@ -377,7 +406,7 @@ sub accept_handler {
for (1 .. $NUMACCEPT) { for (1 .. $NUMACCEPT) {
return unless _accept_handler(); return unless _accept_handler();
} }
# got here because we have accept's left. # got here because we have accept's left.
# So double the number we accept next time. # So double the number we accept next time.
$NUMACCEPT *= 2; $NUMACCEPT *= 2;
@ -391,26 +420,29 @@ use Errno qw(EAGAIN EWOULDBLOCK);
sub _accept_handler { sub _accept_handler {
my $csock = $SERVER->accept(); my $csock = $SERVER->accept();
if (!$csock) { if (!$csock) {
# warn("accept() failed: $!"); # warn("accept() failed: $!");
return; return;
} }
binmode($csock, ':raw'); binmode($csock, ':raw');
printf("Listen child making a Qpsmtpd::PollServer for %d.\n", fileno($csock)) printf("Listen child making a Qpsmtpd::PollServer for %d.\n",
if $DEBUG; fileno($csock))
if $DEBUG;
IO::Handle::blocking($csock, 0); IO::Handle::blocking($csock, 0);
#setsockopt($csock, IPPROTO_TCP, TCP_NODELAY, pack("l", 1)) or die; #setsockopt($csock, IPPROTO_TCP, TCP_NODELAY, pack("l", 1)) or die;
#print "Got connection\n"; #print "Got connection\n";
my $client = Qpsmtpd::PollServer->new($csock); my $client = Qpsmtpd::PollServer->new($csock);
if ($PAUSED) { if ($PAUSED) {
$client->write("451 Sorry, this server is currently paused\r\n"); $client->write("451 Sorry, this server is currently paused\r\n");
$client->close; $client->close;
return 1; return 1;
} }
$client->process_line("Connect\n"); $client->process_line("Connect\n");
$client->watch_read(1); $client->watch_read(1);
$client->pause_read(); $client->pause_read();
@ -420,12 +452,13 @@ sub _accept_handler {
######################################################################## ########################################################################
sub log { sub log {
my ($level,$message) = @_; my ($level, $message) = @_;
# $level not used yet. this is reimplemented from elsewhere anyway
warn("$$ fd:? $message\n"); # $level not used yet. this is reimplemented from elsewhere anyway
warn("$$ fd:? $message\n");
} }
sub pause { sub pause {
my ($pause) = @_; my ($pause) = @_;
$PAUSED = $pause; $PAUSED = $pause;
} }

View File

@ -21,19 +21,19 @@ $| = 1;
my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6; my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6;
# Configuration # Configuration
my $MAXCONN = 15; # max simultaneous connections my $MAXCONN = 15; # max simultaneous connections
my @PORT; # port number(s) my @PORT; # port number(s)
my @LOCALADDR; # ip address(es) to bind to my @LOCALADDR; # ip address(es) to bind to
my $MAXCONNIP = 5; # max simultaneous connections from one IP my $MAXCONNIP = 5; # max simultaneous connections from one IP
my $PID_FILE = ''; my $PID_FILE = '';
my $DETACH; # daemonize on startup my $DETACH; # daemonize on startup
my $NORDNS; my $NORDNS;
my $USER = (getpwuid $>)[0]; # user to suid to my $USER = (getpwuid $>)[0]; # user to suid to
$USER = "smtpd" if $USER eq "root"; $USER = "smtpd" if $USER eq "root";
sub usage { sub usage {
print <<"EOT"; print <<"EOT";
usage: qpsmtpd-forkserver [ options ] usage: qpsmtpd-forkserver [ options ]
-l, --listen-address addr : listen on specific address(es); can be specified -l, --listen-address addr : listen on specific address(es); can be specified
multiple times for multiple bindings. IPv6 multiple times for multiple bindings. IPv6
@ -49,51 +49,58 @@ usage: qpsmtpd-forkserver [ options ]
-d, --detach : detach from controlling terminal (daemonize) -d, --detach : detach from controlling terminal (daemonize)
-H, --no-rdns : don't perform reverse DNS lookups -H, --no-rdns : don't perform reverse DNS lookups
EOT EOT
exit 0; exit 0;
} }
GetOptions('h|help' => \&usage, GetOptions(
'l|listen-address=s' => \@LOCALADDR, 'h|help' => \&usage,
'l|listen-address=s' => \@LOCALADDR,
'c|limit-connections=i' => \$MAXCONN, 'c|limit-connections=i' => \$MAXCONN,
'm|max-from-ip=i' => \$MAXCONNIP, 'm|max-from-ip=i' => \$MAXCONNIP,
'p|port=s' => \@PORT, 'p|port=s' => \@PORT,
'u|user=s' => \$USER, 'u|user=s' => \$USER,
'pid-file=s' => \$PID_FILE, 'pid-file=s' => \$PID_FILE,
'd|detach' => \$DETACH, 'd|detach' => \$DETACH,
'H|no-rdns' => \$NORDNS, 'H|no-rdns' => \$NORDNS,
) || &usage; )
|| &usage;
# detaint the commandline # detaint the commandline
if ($has_ipv6) { if ($has_ipv6) {
@LOCALADDR = ( '[::]' ) if !@LOCALADDR; @LOCALADDR = ('[::]') if !@LOCALADDR;
} }
else { else {
@LOCALADDR = ( '0.0.0.0' ) if !@LOCALADDR; @LOCALADDR = ('0.0.0.0') if !@LOCALADDR;
} }
@PORT = ( 2525 ) if !@PORT; @PORT = (2525) if !@PORT;
my @LISTENADDR; my @LISTENADDR;
for (0..$#LOCALADDR) { for (0 .. $#LOCALADDR) {
if ($LOCALADDR[$_] =~ /^(\[.*\]|[\d\w\-.]+)(?::(\d+))?$/) { if ($LOCALADDR[$_] =~ /^(\[.*\]|[\d\w\-.]+)(?::(\d+))?$/) {
if ( defined $2 ) { if (defined $2) {
push @LISTENADDR, { 'addr' => $1, 'port' => $2 }; push @LISTENADDR, {'addr' => $1, 'port' => $2};
} else { }
my $addr = $1; else {
for (0..$#PORT) { my $addr = $1;
if ( $PORT[$_] =~ /^(\d+)$/ ) { for (0 .. $#PORT) {
push @LISTENADDR, { 'addr' => $addr, 'port' => $1 }; if ($PORT[$_] =~ /^(\d+)$/) {
} else { push @LISTENADDR, {'addr' => $addr, 'port' => $1};
&usage; }
else {
&usage;
}
}
} }
}
} }
} else { else {
&usage; &usage;
} }
} }
if ($USER =~ /^([\w\-]+)$/) { $USER = $1 } else { &usage } if ($USER =~ /^([\w\-]+)$/) { $USER = $1 }
if ($MAXCONN =~ /^(\d+)$/) { $MAXCONN = $1 } else { &usage } else { &usage }
if ($MAXCONN =~ /^(\d+)$/) { $MAXCONN = $1 }
else { &usage }
delete $ENV{ENV}; delete $ENV{ENV};
$ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin'; $ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';
@ -101,23 +108,23 @@ $ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';
my %childstatus = (); my %childstatus = ();
sub REAPER { sub REAPER {
while ( defined(my $chld = waitpid(-1, WNOHANG)) ){ while (defined(my $chld = waitpid(-1, WNOHANG))) {
last unless $chld > 0; last unless $chld > 0;
::log(LOGINFO,"cleaning up after $chld"); ::log(LOGINFO, "cleaning up after $chld");
delete $childstatus{$chld}; delete $childstatus{$chld};
} }
} }
sub HUNTSMAN { sub HUNTSMAN {
$SIG{CHLD} = 'DEFAULT'; $SIG{CHLD} = 'DEFAULT';
kill 'INT' => keys %childstatus; kill 'INT' => keys %childstatus;
if ($PID_FILE && -e $PID_FILE) { if ($PID_FILE && -e $PID_FILE) {
unlink $PID_FILE or ::log(LOGERROR, "unlink: $PID_FILE: $!"); unlink $PID_FILE or ::log(LOGERROR, "unlink: $PID_FILE: $!");
} }
exit(0); exit(0);
} }
$SIG{INT} = \&HUNTSMAN; $SIG{INT} = \&HUNTSMAN;
$SIG{TERM} = \&HUNTSMAN; $SIG{TERM} = \&HUNTSMAN;
my $select = new IO::Select; my $select = new IO::Select;
@ -125,89 +132,99 @@ my $server;
# establish SERVER socket(s), bind and listen. # establish SERVER socket(s), bind and listen.
for my $listen_addr (@LISTENADDR) { for my $listen_addr (@LISTENADDR) {
my @Socket_opts = (LocalPort => $listen_addr->{'port'}, my @Socket_opts = (
LocalAddr => $listen_addr->{'addr'}, LocalPort => $listen_addr->{'port'},
Proto => 'tcp', LocalAddr => $listen_addr->{'addr'},
Reuse => 1, Proto => 'tcp',
Blocking => 0, Reuse => 1,
Listen => SOMAXCONN); Blocking => 0,
if ($has_ipv6) { Listen => SOMAXCONN
$server = IO::Socket::INET6->new(@Socket_opts) );
or die "Creating TCP socket $listen_addr->{'addr'}:$listen_addr->{'port'}: $!\n"; if ($has_ipv6) {
} $server = IO::Socket::INET6->new(@Socket_opts)
else { or die
$server = IO::Socket::INET->new(@Socket_opts) "Creating TCP socket $listen_addr->{'addr'}:$listen_addr->{'port'}: $!\n";
or die "Creating TCP socket $listen_addr->{'addr'}:$listen_addr->{'port'}: $!\n"; }
} else {
IO::Handle::blocking($server, 0); $server = IO::Socket::INET->new(@Socket_opts)
$select->add($server); or die
"Creating TCP socket $listen_addr->{'addr'}:$listen_addr->{'port'}: $!\n";
}
IO::Handle::blocking($server, 0);
$select->add($server);
} }
if ($PID_FILE) { if ($PID_FILE) {
if ($PID_FILE =~ m#^(/[\w\d/\-.]+)$#) { $PID_FILE = $1 } else { &usage } if ($PID_FILE =~ m#^(/[\w\d/\-.]+)$#) { $PID_FILE = $1 }
if (-e $PID_FILE) { else { &usage }
open PID, "+<$PID_FILE" if (-e $PID_FILE) {
or die "open pid_file: $!\n"; open PID, "+<$PID_FILE"
my $running_pid = <PID> || ''; chomp $running_pid; or die "open pid_file: $!\n";
if ($running_pid =~ /(\d+)/) { my $running_pid = <PID> || '';
$running_pid = $1; 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";
truncate PID, 0
or die "Could not truncate $PID_FILE at 0: $!";
}
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";
truncate PID, 0
or die "Could not truncate $PID_FILE at 0: $!";
} else {
open PID, ">$PID_FILE"
or die "open pid_file: $!\n";
}
} }
# Load plugins here # Load plugins here
my $qpsmtpd = Qpsmtpd::TcpServer->new(); my $qpsmtpd = Qpsmtpd::TcpServer->new();
# Drop privileges # Drop privileges
my (undef, undef, $quid, $qgid) = getpwnam $USER or my (undef, undef, $quid, $qgid) = getpwnam $USER
die "unable to determine uid/gid for $USER\n"; or die "unable to determine uid/gid for $USER\n";
my $groups = "$qgid $qgid"; my $groups = "$qgid $qgid";
while (my ($name,$passwd,$gid,$members) = getgrent()) { while (my ($name, $passwd, $gid, $members) = getgrent()) {
my @m = split(/ /, $members); my @m = split(/ /, $members);
if (grep {$_ eq $USER} @m) { if (grep { $_ eq $USER } @m) {
$groups .= " $gid"; $groups .= " $gid";
} }
} }
endgrent; endgrent;
$) = $groups; $) = $groups;
POSIX::setgid($qgid) or POSIX::setgid($qgid)
die "unable to change gid: $!\n"; or die "unable to change gid: $!\n";
POSIX::setuid($quid) or POSIX::setuid($quid)
die "unable to change uid: $!\n"; or die "unable to change uid: $!\n";
$> = $quid; $> = $quid;
$qpsmtpd->load_plugins; $qpsmtpd->load_plugins;
foreach my $listen_addr ( @LISTENADDR ) { foreach my $listen_addr (@LISTENADDR) {
::log(LOGINFO,"Listening on $listen_addr->{'addr'}:$listen_addr->{'port'}"); ::log(LOGINFO,
"Listening on $listen_addr->{'addr'}:$listen_addr->{'port'}");
} }
::log(LOGINFO, 'Running as user '. ::log(LOGINFO,
(getpwuid($>) || $>) . 'Running as user '
', group '. . (getpwuid($>) || $>)
(getgrgid($)) || $))); . ', group '
. (getgrgid($)) || $))
);
if ($DETACH) { if ($DETACH) {
open STDIN, '/dev/null' or die "/dev/null: $!"; open STDIN, '/dev/null' or die "/dev/null: $!";
open STDOUT, '>/dev/null' or die "/dev/null: $!"; open STDOUT, '>/dev/null' or die "/dev/null: $!";
open STDERR, '>&STDOUT' or die "open(stderr): $!"; open STDERR, '>&STDOUT' or die "open(stderr): $!";
defined (my $pid = fork) or die "fork: $!"; defined(my $pid = fork) or die "fork: $!";
exit 0 if $pid; exit 0 if $pid;
POSIX::setsid or die "setsid: $!"; POSIX::setsid or die "setsid: $!";
} }
if ($PID_FILE) { if ($PID_FILE) {
print PID $$,"\n"; print PID $$, "\n";
close PID; close PID;
} }
# Populate class cached variables # Populate class cached variables
@ -222,137 +239,149 @@ $SIG{HUP} = sub {
}; };
while (1) { while (1) {
REAPER(); REAPER();
my $running = scalar keys %childstatus; my $running = scalar keys %childstatus;
if ($running >= $MAXCONN) { if ($running >= $MAXCONN) {
::log(LOGINFO,"Too many connections: $running >= $MAXCONN. Waiting one second."); ::log(LOGINFO,
sleep(1); "Too many connections: $running >= $MAXCONN. Waiting one second."
next; );
} sleep(1);
my @ready = $select->can_read(1); next;
next if !@ready;
while (my $server = shift @ready) {
my ($client, $hisaddr) = $server->accept;
if (!$hisaddr) {
# possible something condition...
next;
} }
IO::Handle::blocking($client, 1); my @ready = $select->can_read(1);
# get local/remote hostname, port and ip address next if !@ready;
my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr) = Qpsmtpd::TcpServer::lrpip($server, $client, $hisaddr); while (my $server = shift @ready) {
my ($client, $hisaddr) = $server->accept;
my ($rc, @msg) = $qpsmtpd->run_hooks("pre-connection", if (!$hisaddr) {
remote_ip => $nto_iaddr,
remote_port => $port, # possible something condition...
local_ip => $nto_laddr, next;
local_port => $lport, }
max_conn_ip => $MAXCONNIP, IO::Handle::blocking($client, 1);
child_addrs => [values %childstatus],
); # get local/remote hostname, port and ip address
if ($rc == DENYSOFT || $rc == DENYSOFT_DISCONNECT) { my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr) =
unless ($msg[0]) { Qpsmtpd::TcpServer::lrpip($server, $client, $hisaddr);
@msg = ("Sorry, try again later");
} my ($rc, @msg) =
&respond_client($client, 451, @msg); $qpsmtpd->run_hooks(
close $client; "pre-connection",
next; remote_ip => $nto_iaddr,
} remote_port => $port,
elsif ($rc == DENY || $rc == DENY_DISCONNECT) { local_ip => $nto_laddr,
unless ($msg[0]) { local_port => $lport,
@msg = ("Sorry, service not available for you"); max_conn_ip => $MAXCONNIP,
} child_addrs => [values %childstatus],
&respond_client($client, 550, @msg); );
close $client; if ($rc == DENYSOFT || $rc == DENYSOFT_DISCONNECT) {
next; unless ($msg[0]) {
@msg = ("Sorry, try again later");
}
&respond_client($client, 451, @msg);
close $client;
next;
}
elsif ($rc == DENY || $rc == DENY_DISCONNECT) {
unless ($msg[0]) {
@msg = ("Sorry, service not available for you");
}
&respond_client($client, 550, @msg);
close $client;
next;
}
my $pid = safe_fork();
if ($pid) {
# parent
$childstatus{$pid} = $iaddr; # add to table
# $childstatus{$pid} = 1; # add to table
$running++;
close($client);
next;
}
# otherwise child
close $_ for $select->handles;
$SIG{$_} = 'DEFAULT' for keys %SIG;
$SIG{ALRM} = sub {
print $client "421 Connection Timed Out\n";
::log(LOGINFO, "Connection Timed Out");
exit;
};
# set enviroment variables
($ENV{TCPLOCALIP}, $ENV{TCPREMOTEIP}, $ENV{TCPREMOTEHOST}) =
Qpsmtpd::TcpServer::tcpenv($nto_laddr, $nto_iaddr);
# don't do this!
#$0 = "qpsmtpd-forkserver: $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}";
::log(LOGINFO,
"Accepted connection $running/$MAXCONN from $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}"
);
# dup to STDIN/STDOUT
POSIX::dup2(fileno($client), 0);
POSIX::dup2(fileno($client), 1);
$qpsmtpd->start_connection(
local_ip => $ENV{TCPLOCALIP},
local_port => $lport,
remote_ip => $ENV{TCPREMOTEIP},
remote_port => $port,
);
$qpsmtpd->run($client);
$qpsmtpd->run_hooks("post-connection");
$qpsmtpd->connection->reset;
close $client;
exit; # child leaves
} }
my $pid = safe_fork();
if ($pid) {
# parent
$childstatus{$pid} = $iaddr; # add to table
# $childstatus{$pid} = 1; # add to table
$running++;
close($client);
next;
}
# otherwise child
close $_ for $select->handles;
$SIG{$_} = 'DEFAULT' for keys %SIG;
$SIG{ALRM} = sub {
print $client "421 Connection Timed Out\n";
::log(LOGINFO, "Connection Timed Out");
exit; };
# set enviroment variables
($ENV{TCPLOCALIP}, $ENV{TCPREMOTEIP}, $ENV{TCPREMOTEHOST}) = Qpsmtpd::TcpServer::tcpenv($nto_laddr, $nto_iaddr);
# don't do this!
#$0 = "qpsmtpd-forkserver: $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}";
::log(LOGINFO, "Accepted connection $running/$MAXCONN from $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}");
# dup to STDIN/STDOUT
POSIX::dup2(fileno($client), 0);
POSIX::dup2(fileno($client), 1);
$qpsmtpd->start_connection
(
local_ip => $ENV{TCPLOCALIP},
local_port => $lport,
remote_ip => $ENV{TCPREMOTEIP},
remote_port => $port,
);
$qpsmtpd->run($client);
$qpsmtpd->run_hooks("post-connection");
$qpsmtpd->connection->reset;
close $client;
exit; # child leaves
}
} }
sub log { sub log {
my ($level,$message) = @_; my ($level, $message) = @_;
$qpsmtpd->log($level,$message); $qpsmtpd->log($level, $message);
} }
sub respond_client { sub respond_client {
my ($client, $code, @message) = @_; my ($client, $code, @message) = @_;
$client->autoflush(1); $client->autoflush(1);
while (my $msg = shift @message) { while (my $msg = shift @message) {
my $line = $code . (@message?"-":" ").$msg; my $line = $code . (@message ? "-" : " ") . $msg;
::log(LOGDEBUG, $line); ::log(LOGDEBUG, $line);
print $client "$line\r\n" print $client "$line\r\n"
or (::log(LOGERROR, "Could not print [$line]: $!"), return 0); or (::log(LOGERROR, "Could not print [$line]: $!"), return 0);
} }
return 1; return 1;
} }
### routine to protect process during fork ### routine to protect process during fork
sub safe_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 ### block signal for fork
$SIG{INT} = 'DEFAULT'; my $sigset = POSIX::SigSet->new(SIGINT);
POSIX::sigprocmask(SIG_BLOCK, $sigset)
or die "Can't block SIGINT for fork: [$!]\n";
### put back to normal ### fork off a child
POSIX::sigprocmask(SIG_UNBLOCK, $sigset) my $pid = fork;
or die "Can't unblock SIGINT for fork: [$!]\n"; unless (defined $pid) {
die "Couldn't fork: [$!]\n";
}
return $pid; ### 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__ __END__

View File

@ -36,8 +36,7 @@ my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6;
#get available signals #get available signals
my %sig_num; my %sig_num;
my $i = 0; my $i = 0;
foreach my $sig_name ( split( /\s/, $Config{sig_name} ) ) foreach my $sig_name (split(/\s/, $Config{sig_name})) {
{
$sig_num{$sig_name} = $i++; $sig_num{$sig_name} = $i++;
} }
@ -53,32 +52,32 @@ my $ipcs = '/usr/bin/ipcs';
my $xargs = '/usr/bin/xargs'; my $xargs = '/usr/bin/xargs';
# vars we need # vars we need
my $chld_shmem; # shared mem to keep track of children (and their connections) my $chld_shmem; # shared mem to keep track of children (and their connections)
my %children; my %children;
my $chld_pool; my $chld_pool;
my $chld_busy; my $chld_busy;
my @children_term; # terminated children, their death pending processing my @children_term; # terminated children, their death pending processing
# by the main loop # by the main loop
my $select = new IO::Select; # socket(s) my $select = new IO::Select; # socket(s)
# default settings # default settings
my $pid_file; my $pid_file;
my $d_port = 25; my $d_port = 25;
my @d_addr; # default applied after getopt call my @d_addr; # default applied after getopt call
my $debug = 0; my $debug = 0;
my $max_children = 15; # max number of child processes to spawn my $max_children = 15; # max number of child processes to spawn
my $idle_children = 5; # number of idle child processes to spawn my $idle_children = 5; # number of idle child processes to spawn
my $maxconnip = 10; my $maxconnip = 10;
my $child_lifetime = 100; # number of times a child may be reused my $child_lifetime = 100; # number of times a child may be reused
my $loop_sleep = 15; # seconds main_loop sleeps before checking children my $loop_sleep = 15; # seconds main_loop sleeps before checking children
my $re_nice = 5; # substracted from parents current nice level my $re_nice = 5; # substracted from parents current nice level
my $d_start = 0; my $d_start = 0;
my $quiet = 0; my $quiet = 0;
my $status = 0; my $status = 0;
my $signal = ''; my $signal = '';
my $pretty = 0; my $pretty = 0;
my $detach = 0; my $detach = 0;
my $user; my $user;
# help text # help text
@ -108,35 +107,39 @@ EOT
# get arguments # get arguments
GetOptions( GetOptions(
'quiet' => \$quiet, 'quiet' => \$quiet,
'version' => sub { print "Qpsmtpd Daemon - version $VERSION\n"; exit 0; }, 'version' => sub { print "Qpsmtpd Daemon - version $VERSION\n"; exit 0; },
'debug' => \$debug, 'debug' => \$debug,
'interface|listen-address=s' => \@d_addr, 'interface|listen-address=s' => \@d_addr,
'port=i' => \$d_port, 'port=i' => \$d_port,
'max-from-ip=i' => \$maxconnip, 'max-from-ip=i' => \$maxconnip,
'children=i' => \$max_children, 'children=i' => \$max_children,
'idle-children=i' => \$idle_children, 'idle-children=i' => \$idle_children,
'pretty-child' => \$pretty, 'pretty-child' => \$pretty,
'user=s' => \$user, 'user=s' => \$user,
'renice-parent=i' => \$re_nice, 'renice-parent=i' => \$re_nice,
'detach' => \$detach, 'detach' => \$detach,
'pid-file=s' => \$pid_file, 'pid-file=s' => \$pid_file,
'help' => \&usage, 'help' => \&usage,
) || &usage; )
|| &usage;
if ($user && $user =~ /^([\w\-]+)$/) { $user = $1 } else { &usage } if ($user && $user =~ /^([\w\-]+)$/) { $user = $1 }
else { &usage }
if (@d_addr) { if (@d_addr) {
for my $i (0..$#d_addr) { for my $i (0 .. $#d_addr) {
if ($d_addr[$i] =~ /^(\[.*\]|[\d\w\-.]+)(?::(\d+))?$/) { if ($d_addr[$i] =~ /^(\[.*\]|[\d\w\-.]+)(?::(\d+))?$/) {
$d_addr[$i] = { 'addr' => $1, 'port' => $2 || $d_port }; $d_addr[$i] = {'addr' => $1, 'port' => $2 || $d_port};
} else { }
else {
print STDERR "Malformed listen address '$d_addr[$i]'\n"; print STDERR "Malformed listen address '$d_addr[$i]'\n";
&usage; &usage;
} }
} }
} else { }
@d_addr = ( { addr => $has_ipv6 ? "[::]" : "0.0.0.0", port => $d_port } ); else {
@d_addr = ({addr => $has_ipv6 ? "[::]" : "0.0.0.0", port => $d_port});
} }
# set max from ip to max number of children if option is set to disabled # set max from ip to max number of children if option is set to disabled
@ -151,11 +154,13 @@ $idle_children = $max_children
$chld_pool = $idle_children; $chld_pool = $idle_children;
if ($pid_file) { if ($pid_file) {
if ($pid_file =~ m#^(/[\w\d/\-.]+)$#) { $pid_file = $1 } else { &usage } if ($pid_file =~ m#^(/[\w\d/\-.]+)$#) { $pid_file = $1 }
else { &usage }
if (-e $pid_file) { if (-e $pid_file) {
open PID, "+<$pid_file" open PID, "+<$pid_file"
or die "open pid_file: $!\n"; or die "open pid_file: $!\n";
my $running_pid = <PID> || ''; chomp $running_pid; my $running_pid = <PID> || '';
chomp $running_pid;
if ($running_pid =~ /(\d+)/) { if ($running_pid =~ /(\d+)/) {
$running_pid = $1; $running_pid = $1;
die "Found an already running qpsmtpd with pid $running_pid.\n" die "Found an already running qpsmtpd with pid $running_pid.\n"
@ -176,15 +181,16 @@ run();
#start daemon #start daemon
sub run { sub run {
# get UUID/GUID # get UUID/GUID
my ($quid, $qgid, $groups); my ($quid, $qgid, $groups);
if ($user) { if ($user) {
(undef, undef, $quid, $qgid) = getpwnam $user (undef, undef, $quid, $qgid) = getpwnam $user
or die "unable to determine uid/gid for $user\n"; or die "unable to determine uid/gid for $user\n";
$groups = "$qgid $qgid"; $groups = "$qgid $qgid";
while (my ($name,$passwd,$gid,$members) = getgrent()) { while (my ($name, $passwd, $gid, $members) = getgrent()) {
my @m = split(/ /, $members); my @m = split(/ /, $members);
if (grep {$_ eq $user} @m) { if (grep { $_ eq $user } @m) {
$groups .= " $gid"; $groups .= " $gid";
} }
} }
@ -199,24 +205,25 @@ sub run {
Listen => SOMAXCONN, Listen => SOMAXCONN,
Reuse => 1, Reuse => 1,
); );
# create new socket (used by clients to communicate with daemon) # create new socket (used by clients to communicate with daemon)
my $s; my $s;
if ($has_ipv6) { if ($has_ipv6) {
$s = IO::Socket::INET6->new(@Socket_opts); $s = IO::Socket::INET6->new(@Socket_opts);
} }
else { else {
$s = IO::Socket::INET->new(@Socket_opts); $s = IO::Socket::INET->new(@Socket_opts);
} }
die "FATAL: Failed to open socket on $addr->{addr}:$addr->{port} ($@)" die "FATAL: Failed to open socket on $addr->{addr}:$addr->{port} ($@)"
. "\nIt may be necessary to wait 20 secs before starting daemon" . "\nIt may be necessary to wait 20 secs before starting daemon"
. " again." . " again."
unless $s; unless $s;
$select->add($s); $select->add($s);
} }
info("qpsmtpd-prefork daemon, version: $VERSION, staring on host: " info( "qpsmtpd-prefork daemon, version: $VERSION, staring on host: "
. join(', ', map { "$_->{addr}:$_->{port}"} @d_addr) . join(', ', map { "$_->{addr}:$_->{port}" } @d_addr)
. " (user: $user [$<])"); . " (user: $user [$<])");
# reset priority # reset priority
my $old_nice = getpriority(0, 0); my $old_nice = getpriority(0, 0);
@ -231,6 +238,7 @@ sub run {
} }
if ($user) { if ($user) {
# change UUID/UGID # change UUID/UGID
$) = $groups; $) = $groups;
POSIX::setgid($qgid) or die "unable to change gid: $!\n"; POSIX::setgid($qgid) or die "unable to change gid: $!\n";
@ -241,11 +249,12 @@ sub run {
} }
# setup shared memory # setup shared memory
$chld_shmem = shmem($d_port."qpsmtpd", 1); $chld_shmem = shmem($d_port . "qpsmtpd", 1);
untie $chld_shmem; untie $chld_shmem;
# Interrupt handler # Interrupt handler
$SIG{INT} = $SIG{TERM} = sub { $SIG{INT} = $SIG{TERM} = sub {
# terminate daemon (and children) # terminate daemon (and children)
my $sig = shift; my $sig = shift;
@ -271,8 +280,9 @@ sub run {
# Hup handler # Hup handler
$SIG{HUP} = sub { $SIG{HUP} = sub {
# reload qpmstpd plugins # reload qpmstpd plugins
$qpsmtpd = qpsmtpd_instance('restart' => 1); # reload plugins... $qpsmtpd = qpsmtpd_instance('restart' => 1); # reload plugins...
$qpsmtpd->load_plugins; $qpsmtpd->load_plugins;
kill 'HUP' => keys %children; kill 'HUP' => keys %children;
info("reload daemon requested"); info("reload daemon requested");
@ -282,16 +292,16 @@ sub run {
$qpsmtpd = qpsmtpd_instance(); $qpsmtpd = qpsmtpd_instance();
if ($detach) { if ($detach) {
open STDIN, '/dev/null' or die "/dev/null: $!"; open STDIN, '/dev/null' or die "/dev/null: $!";
open STDOUT, '>/dev/null' or die "/dev/null: $!"; open STDOUT, '>/dev/null' or die "/dev/null: $!";
open STDERR, '>&STDOUT' or die "open(stderr): $!"; open STDERR, '>&STDOUT' or die "open(stderr): $!";
defined (my $pid = fork) or die "fork: $!"; defined(my $pid = fork) or die "fork: $!";
exit 0 if $pid; exit 0 if $pid;
} }
POSIX::setsid or die "setsid: $!"; POSIX::setsid or die "setsid: $!";
if ($pid_file) { if ($pid_file) {
print PID $$,"\n"; print PID $$, "\n";
close PID; close PID;
} }
@ -304,6 +314,7 @@ sub run {
# initialize children (only done at daemon startup) # initialize children (only done at daemon startup)
sub spawn_children { sub spawn_children {
# block signals while new children are being spawned # block signals while new children are being spawned
my $sigset = block_signal(SIGCHLD); my $sigset = block_signal(SIGCHLD);
for (1 .. $chld_pool) { for (1 .. $chld_pool) {
@ -336,6 +347,7 @@ sub reaper {
sub main_loop { sub main_loop {
my $created_children = $idle_children; my $created_children = $idle_children;
while (1) { while (1) {
# if there is no child death to process, then sleep EXPR seconds # if there is no child death to process, then sleep EXPR seconds
# or until signal (i.e. child death) is received # or until signal (i.e. child death) is received
sleep $loop_sleep / ($created_children * 2 + 1) unless @children_term; sleep $loop_sleep / ($created_children * 2 + 1) unless @children_term;
@ -345,6 +357,7 @@ sub main_loop {
# get number of busy children # get number of busy children
if (@children_term) { if (@children_term) {
# remove dead children info from shared memory # remove dead children info from shared memory
$chld_busy = shmem_opt(undef, \@children_term, undef, undef); $chld_busy = shmem_opt(undef, \@children_term, undef, undef);
@children_term = (); @children_term = ();
@ -377,7 +390,7 @@ sub main_loop {
# spawn children # spawn children
$created_children = $chld_pool - keys %children; $created_children = $chld_pool - keys %children;
$created_children = 0 if $created_children < 0; $created_children = 0 if $created_children < 0;
new_child() for 1..$created_children; new_child() for 1 .. $created_children;
# unblock signals # unblock signals
unblock_signal($sigset); unblock_signal($sigset);
@ -413,10 +426,12 @@ sub unblock_signal {
# arg0: void # arg0: void
# ret0: void # ret0: void
sub new_child { sub new_child {
# daemonize away from the parent process # daemonize away from the parent process
my $pid; my $pid;
die "Cannot fork child: $!\n" unless defined($pid = fork); die "Cannot fork child: $!\n" unless defined($pid = fork);
if ($pid) { if ($pid) {
# in parent # in parent
$children{$pid} = 1; $children{$pid} = 1;
info("new child, pid: $pid"); info("new child, pid: $pid");
@ -444,10 +459,11 @@ sub new_child {
# continue to accept connections until "old age" is reached # continue to accept connections until "old age" is reached
for (my $i = 0 ; $i < $child_lifetime ; $i++) { for (my $i = 0 ; $i < $child_lifetime ; $i++) {
# accept a connection # accept a connection
if ( $pretty ) { if ($pretty) {
$ENV{PROCESS} = $0 if not defined $ENV{PROCESS}; # 1st time only $ENV{PROCESS} = $0 if not defined $ENV{PROCESS}; # 1st time only
$0 = 'qpsmtpd child'; # set pretty child name in process listing $0 = 'qpsmtpd child'; # set pretty child name in process listing
} }
my @ready = $select->can_read(); my @ready = $select->can_read();
next unless @ready; next unless @ready;
@ -456,19 +472,19 @@ sub new_child {
or die or die
"failed to create new object - $!"; # wait here until client connects "failed to create new object - $!"; # wait here until client connects
info("connect from: " . $client->peerhost . ":" . $client->peerport); info("connect from: " . $client->peerhost . ":" . $client->peerport);
# clear a previously running instance by creating a new instance # clear a previously running instance by creating a new instance
$qpsmtpd = qpsmtpd_instance(); $qpsmtpd = qpsmtpd_instance();
# set STDIN/STDOUT and autoflush # set STDIN/STDOUT and autoflush
# ... no longer use POSIX::dup2: it failes after a few # ... no longer use POSIX::dup2: it failes after a few
# million connections # million connections
close(STDIN); close(STDIN);
open(STDIN, "+<&".fileno($client)) open(STDIN, "+<&" . fileno($client))
or die "unable to duplicate filehandle to STDIN - $!"; or die "unable to duplicate filehandle to STDIN - $!";
close(STDOUT); close(STDOUT);
open(STDOUT, "+>&".fileno($client)) open(STDOUT, "+>&" . fileno($client))
or die "unable to duplicate filehandle to STDOUT - $!"; or die "unable to duplicate filehandle to STDOUT - $!";
select(STDOUT); select(STDOUT);
$| = 1; $| = 1;
@ -509,7 +525,7 @@ sub respond_client {
# arg0: void # arg0: void
# ret0: ref to qpsmtpd_instance # ret0: ref to qpsmtpd_instance
sub qpsmtpd_instance { sub qpsmtpd_instance {
my %args = @_; my %args = @_;
my $qpsmtpd = Qpsmtpd::TcpServer::Prefork->new(%args); my $qpsmtpd = Qpsmtpd::TcpServer::Prefork->new(%args);
$qpsmtpd->load_plugins; $qpsmtpd->load_plugins;
$qpsmtpd->spool_dir; $qpsmtpd->spool_dir;
@ -523,7 +539,7 @@ sub qpsmtpd_instance {
# arg1: int 0|1 (0 = don't create shmem, 1 = create shmem) # arg1: int 0|1 (0 = don't create shmem, 1 = create shmem)
# ret0: ref to shared hash # ret0: ref to shared hash
sub shmem { sub shmem {
my $glue = shift; #arg0 my $glue = shift; #arg0
my $create = shift || 0; #arg1 my $create = shift || 0; #arg1
my %options = ( my %options = (
@ -569,7 +585,8 @@ sub shmem_opt {
my ($chld_shmem, $chld_busy); my ($chld_shmem, $chld_busy);
eval { eval {
$chld_shmem = &shmem($d_port."qpsmtpd", 0); #connect to shared memory hash $chld_shmem =
&shmem($d_port . "qpsmtpd", 0); #connect to shared memory hash
if (tied %{$chld_shmem}) { if (tied %{$chld_shmem}) {
@ -593,13 +610,16 @@ sub shmem_opt {
delete $$chld_shmem{$pid_del}; delete $$chld_shmem{$pid_del};
} }
} }
# add # add
$$chld_shmem{$pid_add_key} = $pid_add_value if ($pid_add_key); $$chld_shmem{$pid_add_key} = $pid_add_value if ($pid_add_key);
# copy # copy
%{$ref_shmem} = %{$chld_shmem} if ($ref_shmem); %{$ref_shmem} = %{$chld_shmem} if ($ref_shmem);
# check # check
if ($check) { if ($check) {
# loop through pid list and delete orphaned processes # loop through pid list and delete orphaned processes
foreach my $pid (keys %{$chld_shmem}) { foreach my $pid (keys %{$chld_shmem}) {
if (!kill 0, $pid) { if (!kill 0, $pid) {
@ -659,7 +679,7 @@ sub qpsmtpd_session {
# get local/remote hostname, port and ip address # get local/remote hostname, port and ip address
my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr) = my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr) =
Qpsmtpd::TcpServer::lrpip($socket, $client, $iinfo); Qpsmtpd::TcpServer::lrpip($socket, $client, $iinfo);
# get current connected ip addresses (from shared memory) # get current connected ip addresses (from shared memory)
my %children; my %children;
@ -713,7 +733,8 @@ sub qpsmtpd_session {
}; };
# set enviroment variables # set enviroment variables
($ENV{TCPLOCALIP}, $ENV{TCPREMOTEIP}, $ENV{TCPREMOTEHOST}) = Qpsmtpd::TcpServer::tcpenv($nto_laddr, $nto_iaddr); ($ENV{TCPLOCALIP}, $ENV{TCPREMOTEIP}, $ENV{TCPREMOTEHOST}) =
Qpsmtpd::TcpServer::tcpenv($nto_laddr, $nto_iaddr);
# run qpmsptd functions # run qpmsptd functions
$SIG{__DIE__} = 'DEFAULT'; $SIG{__DIE__} = 'DEFAULT';
@ -737,6 +758,7 @@ sub qpsmtpd_session {
# remove pid from shared memory # remove pid from shared memory
unless (defined(shmem_opt(undef, [$$], undef, undef))) { unless (defined(shmem_opt(undef, [$$], undef, undef))) {
# exit because parent is down or shared memory is corrupted # exit because parent is down or shared memory is corrupted
info("parent seems to be down, going to exit"); info("parent seems to be down, going to exit");
exit 1; exit 1;