376 lines
10 KiB
Perl
Executable File
376 lines
10 KiB
Perl
Executable File
#!/usr/bin/perl -Tw
|
|
use strict;
|
|
# Copyright (c) 2001-2010 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://smtpd.github.io/qpsmtpd/
|
|
#
|
|
|
|
use lib 'lib';
|
|
use Qpsmtpd::Constants;
|
|
use Qpsmtpd::TcpServer;
|
|
use IO::Socket;
|
|
use IO::Select;
|
|
use Socket;
|
|
use Getopt::Long qw(:config no_ignore_case);
|
|
use POSIX qw(:sys_wait_h :errno_h :signal_h);
|
|
$| = 1;
|
|
|
|
my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6;
|
|
|
|
# Configuration
|
|
my $MAXCONN = 15; # max simultaneous connections
|
|
my @PORT; # port number(s)
|
|
my @LOCALADDR; # ip address(es) to bind to
|
|
my $MAXCONNIP = 5; # max simultaneous connections from one IP
|
|
my $PID_FILE = '';
|
|
my $DETACH; # daemonize on startup
|
|
my $NORDNS;
|
|
|
|
my $USER = (getpwuid $>)[0]; # user to suid to
|
|
$USER = 'smtpd' if $USER eq 'root';
|
|
|
|
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. IPv6
|
|
addresses must be inside square brackets [], and
|
|
don't need to be zero padded.
|
|
Default is [::] (if has_ipv6) or 0.0.0.0 (if not)
|
|
-p, --port P : listen on a specific port; default 2525; can be
|
|
specified multiple times for multiple bindings.
|
|
-c, --limit-connections N : limit concurrent connections to N; default 15
|
|
-u, --user U : run as a particular user (default '$USER')
|
|
-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)
|
|
-H, --no-rdns : don't perform reverse DNS lookups
|
|
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=s' => \@PORT,
|
|
'u|user=s' => \$USER,
|
|
'pid-file=s' => \$PID_FILE,
|
|
'd|detach' => \$DETACH,
|
|
'H|no-rdns' => \$NORDNS,
|
|
)
|
|
|| &usage;
|
|
|
|
# detaint the commandline
|
|
if ($has_ipv6) {
|
|
@LOCALADDR = ('[::]') if !@LOCALADDR;
|
|
}
|
|
else {
|
|
@LOCALADDR = ('0.0.0.0') if !@LOCALADDR;
|
|
}
|
|
@PORT = 2525 if !@PORT;
|
|
|
|
my @LISTENADDR;
|
|
for (0 .. $#LOCALADDR) {
|
|
if ($LOCALADDR[$_] !~ /^(\[.*\]|[\d\w\-.]+)(?::(\d+))?$/) {
|
|
&usage;
|
|
}
|
|
if (defined $2) {
|
|
push @LISTENADDR, {'addr' => $1, 'port' => $2};
|
|
next;
|
|
}
|
|
|
|
my $addr = $1;
|
|
for (0 .. $#PORT) {
|
|
if ($PORT[$_] !~ /^(\d+)$/) {
|
|
&usage;
|
|
}
|
|
push @LISTENADDR, {'addr' => $addr, 'port' => $1};
|
|
}
|
|
}
|
|
|
|
if ($USER !~ /^([\w\-]+)$/) { &usage; }
|
|
$USER = $1;
|
|
if ($MAXCONN !~ /^(\d+)$/) { &usage; }
|
|
$MAXCONN = $1;
|
|
|
|
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;
|
|
my $server;
|
|
|
|
# establish SERVER socket(s), bind and listen.
|
|
for my $listen_addr (@LISTENADDR) {
|
|
my @Socket_opts = (
|
|
LocalPort => $listen_addr->{'port'},
|
|
LocalAddr => $listen_addr->{'addr'},
|
|
Proto => 'tcp',
|
|
Reuse => 1,
|
|
Blocking => 0,
|
|
Listen => SOMAXCONN
|
|
);
|
|
|
|
if ($has_ipv6) {
|
|
$server = IO::Socket::INET6->new(@Socket_opts)
|
|
or die
|
|
"Creating TCP socket $listen_addr->{'addr'}:$listen_addr->{'port'}: $!\n";
|
|
}
|
|
else {
|
|
$server = IO::Socket::INET->new(@Socket_opts)
|
|
or die
|
|
"Creating TCP socket $listen_addr->{'addr'}:$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";
|
|
}
|
|
}
|
|
endgrent;
|
|
$) = $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;
|
|
|
|
foreach my $addr (@LISTENADDR) {
|
|
::log(LOGINFO, "Listening on $addr->{addr}:$addr->{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;
|
|
|
|
$SIG{HUP} = sub {
|
|
$qpsmtpd = Qpsmtpd::TcpServer->new('restart' => 1);
|
|
$qpsmtpd->load_plugins;
|
|
$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;
|
|
|
|
next if !$hisaddr;
|
|
IO::Handle::blocking($client, 1);
|
|
|
|
# get local/remote hostname, port and ip address
|
|
my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr) =
|
|
$qpsmtpd->lrpip($server, $client, $hisaddr);
|
|
|
|
my ($rc, @msg) =
|
|
$qpsmtpd->run_hooks(
|
|
'pre-connection',
|
|
remote_ip => $nto_iaddr,
|
|
remote_port => $port,
|
|
local_ip => $nto_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;
|
|
}
|
|
if ($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
|
|
$running++;
|
|
close $client;
|
|
next;
|
|
}
|
|
|
|
# child
|
|
|
|
close $_ for $select->handles;
|
|
|
|
$SIG{$_} = 'DEFAULT' for keys %SIG;
|
|
$SIG{ALRM} = sub {
|
|
print $client "421 Connection Timed Out\n";
|
|
::log(LOGINFO, "Connection Timed Out");
|
|
exit;
|
|
};
|
|
|
|
# set enviroment variables
|
|
($ENV{TCPLOCALIP}, $ENV{TCPREMOTEIP}, $ENV{TCPREMOTEHOST}) =
|
|
$qpsmtpd->tcpenv($nto_laddr, $nto_iaddr);
|
|
|
|
# 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($client);
|
|
$qpsmtpd->run_hooks('post-connection');
|
|
$qpsmtpd->connection->reset;
|
|
close $client;
|
|
exit; # child
|
|
}
|
|
}
|
|
|
|
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;
|