Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 271 lines (232 sloc) 7.612 kb
#!/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; # 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 = '';
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
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 }
@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};
$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;
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";
} 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;
}
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;
}
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;
Jump to Line
Something went wrong with that request. Please try again.