291 lines
8.1 KiB
Perl
Executable File
291 lines
8.1 KiB
Perl
Executable File
#!/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;
|
|
::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();
|
|
$qpsmtpd->load_plugins;
|
|
|
|
# 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) {
|
|
::log(LOGINFO,"$USER is member of group $name($gid)");
|
|
$groups .= " $gid";
|
|
}
|
|
}
|
|
$) = $groups;
|
|
POSIX::setgid($qgid) or
|
|
die "unable to change gid: $!\n";
|
|
POSIX::setuid($quid) or
|
|
die "unable to change uid: $!\n";
|
|
$> = $quid;
|
|
|
|
::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;
|