Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 317 lines (273 sloc) 9.053 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 = '';
my $DETACH; # daemonize on startup
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
-d, --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|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};
$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();
# 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;
::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;
}
# Populate class cached variables
$qpsmtpd->spool_dir;
$qpsmtpd->size_threshold;
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);
my $localsockaddr = getsockname($client);
my ($lport, $laddr) = sockaddr_in($localsockaddr);
my ($rc, @msg) = $qpsmtpd->run_hooks("pre-connection",
remote_ip => inet_ntoa($iaddr),
remote_port => $port,
local_ip => inet_ntoa($laddr),
local_port => $lport,
max_conn_ip => $MAXCONNIP,
child_addrs => [values %childstatus],
);
if ($rc == DENYSOFT || $rc == DENYSOFT_DISCONNECT) {
unless ($msg[0]) {
@msg = ("Sorry, try again later");
}
&respond_client($client, 451, @msg);
close $client;
next;
}
elsif ($rc == DENY || $rc == DENY_DISCONNECT) {
unless ($msg[0]) {
@msg = ("Sorry, service not available for you");
}
&respond_client($client, 550, @msg);
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; };
$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();
$qpsmtpd->run_hooks("post-connection");
exit; # child leaves
}
}
sub log {
my ($level,$message) = @_;
$qpsmtpd->log($level,$message);
}
sub respond_client {
my ($client, $code, @message) = @_;
$client->autoflush(1);
while (my $msg = shift @message) {
my $line = $code . (@message?"-":" ").$msg;
::log(LOGDEBUG, $line);
print $client "$line\r\n"
or (::log(LOGERROR, "Could not print [$line]: $!"), return 0);
}
return 1;
}
### 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.