qpsmtpd/qpsmtpd-forkserver

291 lines
8.0 KiB
Plaintext
Raw Normal View History

#!/usr/bin/perl -Tw
# Copyright (c) 2001 Ask Bjoern Hansen. See the LICENSE file for details.
# The "command dispatch" system is taken from colobus - http://trainedmonkey.com/colobus/
#
# For more information see http://develooper.com/code/qpsmtpd/
#
#
use lib 'lib';
use Qpsmtpd::TcpServer;
use Qpsmtpd::Constants;
use IO::Socket;
use IO::Select;
use Qpsmtpd::PollServer;
use Socket;
use Getopt::Long;
use POSIX qw(:sys_wait_h :errno_h :signal_h);
use strict;
$| = 1;
# Configuration
my $MAXCONN = 15; # max simultaneous connections
my $PORT = 2525; # port number
my @LOCALADDR; # ip address(es) to bind to
my $USER = 'smtpd'; # user to suid to
my $MAXCONNIP = 5; # max simultaneous connections from one IP
my $PID_FILE = ''; # file to which server PID will be written
my $DETACH; # daemonize on startup
our $DEBUG = 0;
sub usage {
print <<"EOT";
usage: qpsmtpd-forkserver [ options ]
-l, --listen-address addr : listen on specific address(es); can be specified
multiple times for multiple bindings. Default is
0.0.0.0 (all interfaces).
-p, --port P : listen on a specific port; default 2525
-c, --limit-connections N : limit concurrent connections to N; default 15
-u, --user U : run as a particular user (default 'smtpd')
-m, --max-from-ip M : limit connections from a single IP; default 5
--pid-file P : print main servers PID to file P
--detach : detach from controlling terminal (daemonize)
EOT
exit 0;
}
GetOptions('h|help' => \&usage,
'l|listen-address=s' => \@LOCALADDR,
'c|limit-connections=i' => \$MAXCONN,
'm|max-from-ip=i' => \$MAXCONNIP,
'p|port=i' => \$PORT,
'u|user=s' => \$USER,
'pid-file=s' => \$PID_FILE,
'd|debug+' => \$DEBUG,
'detach' => \$DETACH,
) || &usage;
# detaint the commandline
if ($PORT =~ /^(\d+)$/) { $PORT = $1 } else { &usage }
@LOCALADDR = ( '0.0.0.0' ) if !@LOCALADDR;
for (0..$#LOCALADDR) {
if ($LOCALADDR[$_] =~ /^([\d\w\-.]+)$/) {
$LOCALADDR[$_] = $1;
} else {
&usage;
}
}
if ($USER =~ /^([\w\-]+)$/) { $USER = $1 } else { &usage }
if ($MAXCONN =~ /^(\d+)$/) { $MAXCONN = $1 } else { &usage }
delete @ENV{'ENV','CDPATH','IFS','BASH_ENV'};
$ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';
my %childstatus = ();
sub REAPER {
while ( defined(my $chld = waitpid(-1, WNOHANG)) ){
last unless $chld > 0;
Add plugable logging support include sample plugin which replicates the existing core code. Add OK hook. * lib/Qpsmtpd.pm (init_logger): replaced with log_level() (load_logging): NEW - load logging plugins without calling log() (log_level): NEW - set/get global $LogLevel scalar (log): now just a wrapper for varlog(); called only by core code (varlog): initializes logging if not already done, calls logging plugins in turn and falls back to interal logging unless plugins OK or DECLINED (_load_plugins): only display "Loading plugin" when actually loading one (run_hooks): load logging plugins without calling log(); add OK hook as else of the DENY* case (spool_dir): use global $Spool_dir scalar to cache location * lib/Qpsmtpd/Plugin.pm (%hooks): add "logging" and "ok" (register_hook): add local _hook to object cache (log): call varlog() with additional parameters hook and plugin_name except for logging hook (compile): add accessor sub for local _hook scalar * lib/Qpsmtpd/SMTP.pm (mail, rcpt): change loglevel to LOGALERT instead of LOGWARN for from/to * qpsmtpd-forkserver (REAPER): use package ::log() instead of warn() (main): defer calling log until $plugin_loader has been initialized (log): call logging using the $plugin_loader object * plugins/logging/warn NEW: sample plugin which replicates the core logging functionality * plugins/logging/devnull NEW: sample plugin which logs nothing (for testing multiple logging plugin functionality) * config.sample/logging sample configuration file for logging plugins * plugins/virus/uvscan plugins/virus/clamav Increase loglevel for non-serious warnings to LOGWARN from LOGERROR git-svn-id: https://svn.perl.org/qpsmtpd/trunk@398 958fd67b-6ff1-0310-b445-bb7760255be9
2005-03-24 22:16:35 +01:00
::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{INT} = \&HUNTSMAN;
$SIG{TERM} = \&HUNTSMAN;
my $select = new IO::Select;
# establish SERVER socket(s), bind and listen.
for my $listen_addr (@LOCALADDR) {
my $server = IO::Socket::INET->new(LocalPort => $PORT,
LocalAddr => $listen_addr,
Proto => 'tcp',
Reuse => 1,
Blocking => 0,
Listen => SOMAXCONN )
or die "Creating TCP socket $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";
}
}
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 $groups = "$qgid $qgid";
while (my ($name,$passwd,$gid,$members) = getgrent()) {
my @m = split(/ /, $members);
if (grep {$_ eq $USER} @m) {
$groups .= " $gid";
}
}
$) = $groups;
POSIX::setgid($qgid) or
die "unable to change gid: $!\n";
POSIX::setuid($quid) or
die "unable to change uid: $!\n";
$> = $quid;
$qpsmtpd->load_plugins;
Add plugable logging support include sample plugin which replicates the existing core code. Add OK hook. * lib/Qpsmtpd.pm (init_logger): replaced with log_level() (load_logging): NEW - load logging plugins without calling log() (log_level): NEW - set/get global $LogLevel scalar (log): now just a wrapper for varlog(); called only by core code (varlog): initializes logging if not already done, calls logging plugins in turn and falls back to interal logging unless plugins OK or DECLINED (_load_plugins): only display "Loading plugin" when actually loading one (run_hooks): load logging plugins without calling log(); add OK hook as else of the DENY* case (spool_dir): use global $Spool_dir scalar to cache location * lib/Qpsmtpd/Plugin.pm (%hooks): add "logging" and "ok" (register_hook): add local _hook to object cache (log): call varlog() with additional parameters hook and plugin_name except for logging hook (compile): add accessor sub for local _hook scalar * lib/Qpsmtpd/SMTP.pm (mail, rcpt): change loglevel to LOGALERT instead of LOGWARN for from/to * qpsmtpd-forkserver (REAPER): use package ::log() instead of warn() (main): defer calling log until $plugin_loader has been initialized (log): call logging using the $plugin_loader object * plugins/logging/warn NEW: sample plugin which replicates the core logging functionality * plugins/logging/devnull NEW: sample plugin which logs nothing (for testing multiple logging plugin functionality) * config.sample/logging sample configuration file for logging plugins * plugins/virus/uvscan plugins/virus/clamav Increase loglevel for non-serious warnings to LOGWARN from LOGERROR git-svn-id: https://svn.perl.org/qpsmtpd/trunk@398 958fd67b-6ff1-0310-b445-bb7760255be9
2005-03-24 22:16:35 +01:00
::log(LOGINFO,"Listening on port $PORT");
::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: $!";
}
if ($PID_FILE) {
print PID $$,"\n";
close PID;
}
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;
}
# Make this client blocking while we figure out if we actually want to
# do something with it.
IO::Handle::blocking($client, 1);
my ($port, $iaddr) = sockaddr_in($hisaddr);
if ($MAXCONNIP) {
my $num_conn = 1; # seed with current value
foreach my $rip (values %childstatus) {
++$num_conn if (defined $rip && $rip eq $iaddr);
}
if ($num_conn > $MAXCONNIP) {
my $rem_ip = inet_ntoa($iaddr);
::log(LOGINFO,"Too many connections from $rem_ip: "
."$num_conn > $MAXCONNIP. Denying connection.");
$client->autoflush(1);
print $client "451 Sorry, too many connections from $rem_ip, try again later\r\n";
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
# all children should have different seeds, to prevent conflicts
srand( time ^ ($$ + ($$ << 15)) );
close($server);
$SIG{$_} = 'DEFAULT' for keys %SIG;
$SIG{ALRM} = sub {
print $client "421 Connection Timed Out\n";
::log(LOGINFO, "Connection Timed Out");
exit; };
::log(LOGINFO, "Accepted connection $running/$MAXCONN");
$::LineMode = 1;
# Make this client non-blocking so it works with the Danga framework
IO::Handle::blocking($client, 0);
my $qp = Qpsmtpd::PollServer->new($client);
$qp->load_plugins;
$qp->init_logger;
$qp->push_back_read("Connect\n");
Qpsmtpd::PollServer->AddTimer(0.1, sub { });
while (1) {
$qp->enable_read;
my $line = $qp->get_line;
last if !defined($line);
my $output = $qp->process_line($line);
$qp->write($output) if $output;
}
exit; # child leaves
}
}
sub log {
my ($level,$message) = @_;
$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;