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();
$qpsmtpd->load_plugins();
$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->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
# because the other code also calls getpeername(STDIN).
sub IO::Handle::connected { return getpeername(shift) }

View File

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

View File

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

View File

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