- move configuration to top. (still suboptimal)

- child limiting
- logging helper


git-svn-id: https://svn.perl.org/qpsmtpd/trunk@229 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Robert Spier 2004-04-15 02:19:01 +00:00
parent f84bd18601
commit d8c8d40ef6

View File

@ -15,38 +15,39 @@ use POSIX qw(:sys_wait_h :errno_h :signal_h);
use strict; use strict;
$| = 1; $| = 1;
# Configuration
my $MAXCONN = 15; # max simultaneous connections
my $PORT = 25; # port number
my $LOCALADDR = '0.0.0.0'; # ip address to bind to
my $USER = 'smtpd'; # user to suid to
delete $ENV{ENV}; delete $ENV{ENV};
$ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin'; $ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';
my %childstatus = ();
sub REAPER { sub REAPER {
while (defined(my $child = waitpid(-1, WNOHANG)) ) { while ( defined(my $chld = waitpid(-1, WNOHANG)) ){
if ($child == -1) { last unless $chld > 0;
# No child here? Loop back warn("$$ cleaning up after $chld\n");
} delete $childstatus{$chld};
elsif (WIFEXITED($?)) { }
# Process exited
last;
}
else {
# Possibly SIGSTOP on child...
last;
}
}
} }
$SIG{CHLD} = \&REAPER; $SIG{CHLD} = \&REAPER;
# establish SERVER socket, bind and listen. # establish SERVER socket, bind and listen.
my $server = IO::Socket::INET->new(LocalPort => 25, my $server = IO::Socket::INET->new(LocalPort => $PORT,
LocalAddr => $LOCALADDR,
Proto => 'tcp', Proto => 'tcp',
Reuse => 1, Reuse => 1,
Listen => SOMAXCONN ) Listen => SOMAXCONN )
or die "making socket: $@\n"; or die "making socket: $@\n";
# Drop priviledges # Drop priviledges
my $user = 'smtpd'; my $user = 'mailfw';
my (undef, undef, $quid, $qgid) = getpwnam $user or my (undef, undef, $quid, $qgid) = getpwnam $USER or
die "unable to determine uid/gid for $user\n"; die "unable to determine uid/gid for $USER\n";
$) = ""; $) = "";
POSIX::setgid($qgid) or POSIX::setgid($qgid) or
die "unable to change gid: $!\n"; die "unable to change gid: $!\n";
@ -58,9 +59,15 @@ $> = $quid;
my $plugin_loader = Qpsmtpd::TcpServer->new(); my $plugin_loader = Qpsmtpd::TcpServer->new();
$plugin_loader->load_plugins; $plugin_loader->load_plugins;
# $plugin_loader->log(LOGINFO, "Listening on port 25"); ::log(LOGINFO,"Listening on port $PORT\n");
while (1) { while (1) {
my $running = scalar keys %childstatus;
while ($running >= $MAXCONN) {
::log(LOGINFO,"Too many connections: $running >= $MAXCONN. Waiting one second.");
sleep(1) ;
$running = scalar keys %childstatus;
}
my $hisaddr = accept(my $client, $server); my $hisaddr = accept(my $client, $server);
if (!$hisaddr) { if (!$hisaddr) {
# possible something condition... # possible something condition...
@ -68,6 +75,9 @@ while (1) {
} }
my $pid = fork; my $pid = fork;
if ($pid) { if ($pid) {
# parent
$childstatus{$pid} = 1; # add to table
$running++;
close($client); close($client);
next; next;
} }
@ -85,6 +95,11 @@ while (1) {
my ($port, $iaddr) = sockaddr_in($hisaddr); my ($port, $iaddr) = sockaddr_in($hisaddr);
$ENV{TCPREMOTEIP} = inet_ntoa($iaddr); $ENV{TCPREMOTEIP} = inet_ntoa($iaddr);
$ENV{TCPREMOTEHOST} = gethostbyaddr($iaddr, AF_INET) || "Unknown"; $ENV{TCPREMOTEHOST} = gethostbyaddr($iaddr, AF_INET) || "Unknown";
# 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 # dup to STDIN/STDOUT
POSIX::dup2(fileno($client), 0); POSIX::dup2(fileno($client), 0);
@ -97,6 +112,12 @@ while (1) {
exit; # child leaves exit; # child leaves
} }
sub log {
my ($level,$message) = @_;
# $level not used yet. this is reimplemented from elsewhere anyway
warn("$$ $message\n");
}
__END__ __END__
1; 1;