257 lines
7.1 KiB
Perl
Executable File
257 lines
7.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 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 = '0.0.0.0'; # ip address to bind to
|
|
my $USER = 'smtpd'; # user to suid to
|
|
my $MAXCONNIP = 5; # max simultaneous connections from one IP
|
|
my $PID_FILE = '';
|
|
|
|
sub usage {
|
|
print <<"EOT";
|
|
usage: qpsmtpd-forkserver [ options ]
|
|
-l, --listen-address addr : listen on a specific address; default 0.0.0.0
|
|
-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
|
|
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,
|
|
) || &usage;
|
|
|
|
# detaint the commandline
|
|
if ($PORT =~ /^(\d+)$/) { $PORT = $1 } else { &usage }
|
|
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};
|
|
$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;
|
|
exit(0);
|
|
}
|
|
|
|
$SIG{INT} = \&HUNTSMAN;
|
|
$SIG{TERM} = \&HUNTSMAN;
|
|
|
|
# establish SERVER socket, bind and listen.
|
|
my $server = IO::Socket::INET->new(LocalPort => $PORT,
|
|
LocalAddr => $LOCALADDR,
|
|
Proto => 'tcp',
|
|
Reuse => 1,
|
|
Blocking => 0,
|
|
Listen => SOMAXCONN )
|
|
or die "Creating TCP socket $LOCALADDR:$PORT: $!\n";
|
|
IO::Handle::blocking($server, 0);
|
|
my $sel = IO::Select->new();
|
|
$sel->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";
|
|
} else {
|
|
open PID, ">$PID_FILE"
|
|
or die "open pid_file: $!\n";
|
|
}
|
|
print PID $$,"\n";
|
|
close PID;
|
|
}
|
|
|
|
# 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($)) || $)));
|
|
|
|
while (1) {
|
|
REAPER();
|
|
my $running = scalar keys %childstatus;
|
|
if ($running >= $MAXCONN) {
|
|
::log(LOGINFO,"Too many connections: $running >= $MAXCONN. Waiting one second.");
|
|
sleep(1);
|
|
next;
|
|
}
|
|
if (!$sel->can_read(1)) {
|
|
next;
|
|
}
|
|
my $hisaddr = accept(my $client, $server);
|
|
if (!$hisaddr) {
|
|
# possible something condition...
|
|
next;
|
|
}
|
|
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; };
|
|
|
|
my $localsockaddr = getsockname($client);
|
|
my ($lport, $laddr) = sockaddr_in($localsockaddr);
|
|
$ENV{TCPLOCALIP} = inet_ntoa($laddr);
|
|
# my ($port, $iaddr) = sockaddr_in($hisaddr);
|
|
$ENV{TCPREMOTEIP} = inet_ntoa($iaddr);
|
|
$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
|
|
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();
|
|
|
|
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;
|