New pre-forking qpsmtpd daemon, courtesy of Lars Roland at SoftScan.
Initial load with minor tweaks by John Peacock. git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.3x@639 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
John Peacock
parent
508be70d26
commit
67dc86e255
43
lib/Qpsmtpd/SMTP/Prefork.pm
Normal file
43
lib/Qpsmtpd/SMTP/Prefork.pm
Normal file
@ -0,0 +1,43 @@
|
||||
package Qpsmtpd::SMTP::Prefork;
|
||||
use Qpsmtpd::SMTP;
|
||||
@ISA = qw(Qpsmtpd::SMTP);
|
||||
|
||||
sub dispatch {
|
||||
my $self = shift;
|
||||
my ($cmd) = lc shift;
|
||||
|
||||
$self->{_counter}++;
|
||||
|
||||
if ($cmd !~ /^(\w{1,12})$/ or !exists $self->{_commands}->{$1}) {
|
||||
my ($rc, @msg) = $self->run_hooks("unrecognized_command", $cmd, @_);
|
||||
@msg = map { split /\n/ } @msg;
|
||||
if ($rc == DENY_DISCONNECT) {
|
||||
$self->respond(521, @msg);
|
||||
$self->disconnect;
|
||||
}
|
||||
elsif ($rc == DENY) {
|
||||
$self->respond(500, @msg);
|
||||
}
|
||||
elsif ($rc == DONE) {
|
||||
1;
|
||||
}
|
||||
else {
|
||||
$self->respond(500, "Unrecognized command");
|
||||
}
|
||||
return 1
|
||||
}
|
||||
$cmd = $1;
|
||||
|
||||
if (1 or $self->{_commands}->{$cmd} and $self->can($cmd)) {
|
||||
my ($result) = eval { $self->$cmd(@_) };
|
||||
if ($@ =~ /^disconnect_tcpserver/) {
|
||||
die "disconnect_tcpserver";
|
||||
} elsif ($@) {
|
||||
$self->log(LOGERROR, "XX: $@") if $@;
|
||||
}
|
||||
return $result if defined $result;
|
||||
return $self->fault("command '$cmd' failed unexpectedly");
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
56
lib/Qpsmtpd/TcpServer/Prefork.pm
Normal file
56
lib/Qpsmtpd/TcpServer/Prefork.pm
Normal file
@ -0,0 +1,56 @@
|
||||
package Qpsmtpd::TcpServer::Prefork;
|
||||
use Qpsmtpd::TcpServer;
|
||||
use Qpsmtpd::SMTP::Prefork;
|
||||
|
||||
@ISA = qw(Qpsmtpd::SMTP::Prefork Qpsmtpd::TcpServer);
|
||||
|
||||
my $first_0;
|
||||
|
||||
sub start_connection {
|
||||
my $self = shift;
|
||||
|
||||
#reset info
|
||||
$self->{_connection} = Qpsmtpd::Connection->new(); #reset connection
|
||||
$self->{_transaction} = Qpsmtpd::Transaction->new(); #reset transaction
|
||||
$self->SUPER::start_connection();
|
||||
}
|
||||
|
||||
sub read_input {
|
||||
my $self = shift;
|
||||
|
||||
my $timeout =
|
||||
$self->config('timeoutsmtpd') # qmail smtpd control file
|
||||
|| $self->config('timeout') # qpsmtpd control file
|
||||
|| 1200; # default value
|
||||
|
||||
alarm $timeout;
|
||||
eval {
|
||||
while (<STDIN>) {
|
||||
alarm 0;
|
||||
$_ =~ s/\r?\n$//s; # advanced chomp
|
||||
$self->log(LOGDEBUG, "dispatching $_");
|
||||
$self->connection->notes('original_string', $_);
|
||||
defined $self->dispatch(split / +/, $_)
|
||||
or $self->respond(502, "command unrecognized: '$_'");
|
||||
alarm $timeout;
|
||||
}
|
||||
};
|
||||
if ($@ =~ /^disconnect_tcpserver/) {
|
||||
die "disconnect_tcpserver";
|
||||
} else {
|
||||
die "died while reading from STDIN (probably broken sender) - $@";
|
||||
}
|
||||
alarm(0);
|
||||
}
|
||||
|
||||
sub respond {
|
||||
my ($self, $code, @messages) = @_;
|
||||
while (my $msg = shift @messages) {
|
||||
my $line = $code . (@messages?"-":" ").$msg;
|
||||
$self->log(LOGDEBUG, $line);
|
||||
print "$line\r\n" or ($self->log(LOGERROR, "Could not print [$line]: $!"), return 0);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
||||
669
qpsmtpd-prefork
Executable file
669
qpsmtpd-prefork
Executable file
@ -0,0 +1,669 @@
|
||||
#!/usr/bin/perl
|
||||
# High performance pre-forking qpsmtpd daemon, Copyright (C) 2006 SoftScan
|
||||
# http://www.softscan.co.uk
|
||||
#
|
||||
# Based on qpsmtpd-forkserver Copyright (C) 2001 Ask Bjoern Hansen
|
||||
# See the LICENSE file for details.
|
||||
#
|
||||
# For more information see http://develooper.com/code/qpsmtpd/
|
||||
#
|
||||
# Last updated: 05-05-2006
|
||||
# Reviewed by: DA, LR
|
||||
|
||||
# safety guards
|
||||
use strict;
|
||||
|
||||
# includes
|
||||
use IO::Socket;
|
||||
use POSIX;
|
||||
use IPC::Shareable(':all');
|
||||
use lib 'lib';
|
||||
use Qpsmtpd::TcpServer::Prefork;
|
||||
use Qpsmtpd::Constants;
|
||||
use Getopt::Long;
|
||||
#use Time::HiRes qw(gettimeofday tv_interval);
|
||||
|
||||
# secure shell
|
||||
$ENV{'PATH'} = '/bin:/usr/bin';
|
||||
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
||||
|
||||
# version
|
||||
my $VERSION = "1.0";
|
||||
|
||||
# qpsmtpd instance
|
||||
my $qpsmtpd;
|
||||
|
||||
#cmd's needed by IPC
|
||||
my $ipcrm = '/usr/bin/ipcrm';
|
||||
my $ipcs = '/usr/bin/ipcs';
|
||||
my $xargs = '/usr/bin/xargs';
|
||||
|
||||
#vars we need
|
||||
my $chld_shmem; #shared memory to keep track of children (and their connections)
|
||||
my %children;
|
||||
my $chld_pool;
|
||||
my $chld_busy;
|
||||
my $d; # socket
|
||||
|
||||
#default settings
|
||||
my $pid_path = '/var/run/qpsmtpd/';
|
||||
my $PID = $pid_path . "/qpsmtpd.pid";
|
||||
my $user = 'qmailq';
|
||||
my $d_port = 25;
|
||||
my $d_addr = "0.0.0.0";
|
||||
my $debug = 0;
|
||||
my $max_children = 15; #max number of child processes to spawn
|
||||
my $idle_children = 5; #number of idle child processes to spawn
|
||||
my $logFile = '/tmp/qpsmtpd_daemon.log';
|
||||
my $maxconnip = 10;
|
||||
my $child_lifetime = 100; #number of times a child may be reused
|
||||
my $loop_sleep = 30; #max number of seconds main_loop sleeps before checking for busy children
|
||||
my $re_nice = 5; #nice process (parent process is reniced with number substracted from current nice level)
|
||||
my $d_start = 0;
|
||||
my $quiet = 0;
|
||||
my $status = 0;
|
||||
my $signal = '';
|
||||
|
||||
# help text
|
||||
sub usage
|
||||
{
|
||||
print <<"EOT";
|
||||
Usage: qpsmtpd-highperf [ options ]
|
||||
--start : Start daemon
|
||||
--stop : Kill daemon (and spawned children)
|
||||
--reload : Reload daemon (does not break current connections)
|
||||
--status : Show daemon status
|
||||
--quiet : Be quiet (even errors are suppressed)
|
||||
--version : Show version information
|
||||
--debug : Enable debug output
|
||||
--debug-path path : Path to debug file (default: $logFile)
|
||||
--interface addr : Interface daemon should listen on (default: $d_addr)
|
||||
--port int : TCP port daemon should listen on (default: $d_port)
|
||||
--max-from-ip int : Limit number of connections from single IP (default: $maxconnip, 0 to disable)
|
||||
--children int : Max number of children that can be spawned (default: $max_children)
|
||||
--idle-children int : Number of idle children to spawn (default: $idle_children, 0 to disable)
|
||||
--user username : User the daemon should run as (default: $user)
|
||||
--pid-file path : Path to pid file
|
||||
--renice-parent int : Subtract value from parent process nice level (default: $re_nice)
|
||||
--help : This message
|
||||
EOT
|
||||
exit 0;
|
||||
}
|
||||
|
||||
# get arguments
|
||||
GetOptions(
|
||||
'start' => \$d_start,
|
||||
'stop' => sub { $signal = 'TERM' },
|
||||
'reload' => sub { $signal = 'HUP' },
|
||||
'status' => \$status,
|
||||
'quiet' => \$quiet,
|
||||
'version' => sub { print "Qpsmtpd Daemon - version $VERSION\n"; exit 0; },
|
||||
'debug' => \$debug,
|
||||
'debug-path=s' => \$logFile,
|
||||
'interface=s' => \$d_addr,
|
||||
'port=i' => \$d_port,
|
||||
'max-from-ip=i' => \$maxconnip,
|
||||
'children=i' => \$max_children,
|
||||
'idle-children=i' => \$idle_children,
|
||||
'user=s' => \$user,
|
||||
'pid-file=s' => \$PID,
|
||||
'renice-parent=i' => \$re_nice,
|
||||
'help' => \&usage,
|
||||
) || &usage;
|
||||
|
||||
# check arguments
|
||||
if ( !$d_start && !$signal && !$status ) {
|
||||
print "Wrong aguments!\nSee qpsmtpd-highperf --help for information on options\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
# misc checks
|
||||
$maxconnip = $max_children if ($maxconnip == 0); #set max from ip to max number of children if option is set to disabled
|
||||
$maxconnip++; #to fix limit counter error in plugin <hosts_allow>
|
||||
$idle_children = $max_children if ( !$idle_children || $idle_children > $max_children || $idle_children < -1 ); #ensure that idle_children matches value given to max_children
|
||||
$chld_pool = $idle_children;
|
||||
|
||||
# show status
|
||||
if ($status) {
|
||||
my $p = get_pid($PID);
|
||||
if ($p) {
|
||||
print "daemon is running (pid: $p)...\n";
|
||||
} else {
|
||||
print "daemon is stopped...\n";
|
||||
}
|
||||
exit 0;
|
||||
}
|
||||
|
||||
#start daemon
|
||||
if ($d_start) {
|
||||
# check if another instance is running (exit if yes)
|
||||
my $p = get_pid($PID);
|
||||
if ($p) {
|
||||
if (kill 0, $p) {
|
||||
print "Daemon is already running (pid: $p)\n";
|
||||
exit 1;
|
||||
} else {
|
||||
info("delete stale PID file <$PID> and cleanup shared memory");
|
||||
unlink("$PID") || die "can not delete stale PID file <$PID>";
|
||||
#check for muribund shared memory
|
||||
my $T_shmid = `$ipcs -pm | $xargs`;
|
||||
if ($T_shmid =~ /(\d+)\s+$user\s+$p\s+\d+$/) {
|
||||
my $shmid = $1;
|
||||
my ($semid, $shmid_key);
|
||||
open(SEMID, "$ipcs -sm |");
|
||||
while(<SEMID>) {
|
||||
$shmid_key = $1 if (/^(0x\w+)\s+$shmid/);
|
||||
$semid = $1 if ($shmid_key && /^$shmid_key\s+(\d+)/);
|
||||
}
|
||||
close(SEMID);
|
||||
system("$ipcrm -m $shmid -s $semid");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# get UUID/GUID
|
||||
my ( $uuid, $ugid, $group );
|
||||
my $T_uuid = `id -u $user`;
|
||||
my $T_ugid = `id -g $user`;
|
||||
my $T_group = `id -n -g $user`;
|
||||
chomp($T_uuid);
|
||||
chomp($T_ugid);
|
||||
chomp($T_group);
|
||||
|
||||
# make the following vars taint happy
|
||||
$uuid = $1 if ( $T_uuid =~ /(\d+)/ );
|
||||
$ugid = $1 if ( $T_ugid =~ /(\d+)/ );
|
||||
$group = $1 if ( $T_group =~ /(\w+)/ );
|
||||
die("FATAL: unknown user <$user> or missing group information")
|
||||
if ( !$uuid || !$ugid );
|
||||
|
||||
# check directory structure
|
||||
if ( $PID =~ /$pid_path/ and !-d $pid_path ) {
|
||||
system("mkdir -p $pid_path");
|
||||
system("chown $user.$group $pid_path");
|
||||
}
|
||||
system "chown", "$user.$group", $logFile if ( -f "$logFile" );
|
||||
|
||||
# create new socket (used by clients to communicate with daemon)
|
||||
$d = new IO::Socket::INET(
|
||||
LocalPort => $d_port,
|
||||
LocalAddr => $d_addr,
|
||||
Proto => 'tcp',
|
||||
Listen => SOMAXCONN,
|
||||
Reuse => 1,
|
||||
);
|
||||
die "FATAL: Failed to start daemon.\nReason: $!\n(It may be nessesary to ".
|
||||
"wait 20 secs before starting daemon again)\n" unless $d;
|
||||
|
||||
info("qpsmtpd-highperf daemon, version: $VERSION, staring on host: $d_addr, port: $d_port (user: $user [$<])");
|
||||
|
||||
#reset priority
|
||||
my $old_nice = getpriority(0, 0);
|
||||
my $new_nice = $old_nice - $re_nice;
|
||||
if ($new_nice < 20 && $new_nice > -20) {
|
||||
setpriority(0, 0, $1) if ( $new_nice =~ /(\-?\d+)/ );
|
||||
info("parent daemon nice level: $1");
|
||||
} else {
|
||||
die "FATAL: new nice level: $new_nice is not between -19 and 19 (old level = $old_nice, renice value = $re_nice)";
|
||||
}
|
||||
|
||||
# change UUID/UGID
|
||||
$) = "$ugid $ugid"; # effective gid
|
||||
$( = $ugid; # real gid
|
||||
$> = $uuid; # effective uid
|
||||
$< = $uuid; # real uid. we now cannot setuid anymore
|
||||
die "FATAL: failed to setuid to user: $user, uid: $uuid\n"
|
||||
if ( $> != $uuid and $> != ( $uuid - 2**32 ) );
|
||||
|
||||
# daemonize
|
||||
&daemonize;
|
||||
|
||||
#setup shared memory
|
||||
$chld_shmem = &shmem("qpsmtpd", 1);
|
||||
untie $chld_shmem;
|
||||
|
||||
#setup qpsmtpd_instance
|
||||
$qpsmtpd = &qpmsptd_instance();
|
||||
|
||||
#child reaper
|
||||
$SIG{CHLD} = \&reaper;
|
||||
&spawn_children;
|
||||
&main_loop;
|
||||
exit;
|
||||
}
|
||||
|
||||
#stop/reload daemon
|
||||
if ($signal) {
|
||||
$SIG{TERM} = $SIG{HUP} = 'IGNORE'; #prevent signals to ourself
|
||||
my $p = get_pid($PID);
|
||||
if ($p) {
|
||||
kill $signal => $p;
|
||||
} else {
|
||||
print "Unable to $signal daemon...\nQpsmtpd-highperf isn't running!\n";
|
||||
}
|
||||
exit;
|
||||
}
|
||||
|
||||
#setup daemon process
|
||||
sub daemonize {
|
||||
|
||||
#redirect std filehandles to the bit bucket
|
||||
open STDIN, "</dev/null" || die "Can't read from: /dev/null - $!\n";
|
||||
open STDOUT, ">/dev/null" || die "Can't write to: /dev/null - $!\n";
|
||||
|
||||
my $pid = fork;
|
||||
defined($pid) or die "Can't start daemon: $!";
|
||||
|
||||
#if this is the shell-called process, let clients know the daemon is now running and detach
|
||||
if ($pid) {
|
||||
|
||||
#write PID file
|
||||
open( PID, "> $PID" ) || die "can't write to file <$PID> - $!";
|
||||
print PID "$pid\n";
|
||||
close PID;
|
||||
|
||||
#exit back to shell
|
||||
exit;
|
||||
}
|
||||
|
||||
#now we're a daemonized parent process!
|
||||
|
||||
#detach from shell, by setting session and making process group
|
||||
POSIX::setsid();
|
||||
|
||||
#redirect errors (too)
|
||||
open STDERR, '>&STDOUT' || die "Can't duplicate stdout - $!\n";
|
||||
|
||||
#set pretty parent name in process listing
|
||||
#$0 = "$0 " . "@ARGV";
|
||||
|
||||
# Set up signals that should be catched
|
||||
$SIG{__WARN__} = sub {
|
||||
info( "WARN: " . join( " ", @_ ) ) if ( !$quiet );
|
||||
};
|
||||
|
||||
$SIG{__DIE__} = sub {
|
||||
my $msg = join (" ", @_);
|
||||
chomp($msg);
|
||||
info( "FATAL: <$msg>" ) if ( !$quiet );
|
||||
die "FATAL: <$msg> - "
|
||||
};
|
||||
|
||||
$SIG{INT} = $SIG{TERM} = sub {
|
||||
# terminate daemon (and children)
|
||||
my $sig = shift;
|
||||
$SIG{$sig} = $SIG{CHLD} = $SIG{HUP} = 'IGNORE'; #prevent another signal and disable reaper
|
||||
unlink("$PID");
|
||||
$d->close(); #close socket
|
||||
my $cnt = kill 'INT' => keys %children;
|
||||
IPC::Shareable->clean_up; #cleanup shared memory
|
||||
info("shutdown of daemon (and $cnt children)");
|
||||
exit;
|
||||
};
|
||||
|
||||
$SIG{HUP} = sub {
|
||||
# reload qpmstpd plugins
|
||||
$qpsmtpd->load_plugins;
|
||||
kill 'HUP' => keys %children;
|
||||
info("reload daemon requested" );
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
# initialize children (only done at daemon startup)
|
||||
sub spawn_children {
|
||||
#block signals while new children are being spawned
|
||||
my $sigset = &block_signal(SIGCHLD);
|
||||
for ( 1 .. $chld_pool ) {
|
||||
&new_child();
|
||||
}
|
||||
#reset block signals
|
||||
&unblock_signal($sigset);
|
||||
}
|
||||
|
||||
# cleanup after child dies
|
||||
sub reaper {
|
||||
my $stiff;
|
||||
my @stiffs;
|
||||
while ( ( $stiff = waitpid( -1, &WNOHANG ) ) > 0 ) {
|
||||
my $res = WEXITSTATUS($?);
|
||||
info("child terminated, pid: $stiff (status $?, res: $res)");
|
||||
delete $children{$stiff}; #delete pid from children
|
||||
push @stiffs, $stiff; #add pid to array so it later can be removed from shared memory
|
||||
}
|
||||
#remove connection info from shared memory
|
||||
$chld_busy = &shmem_opt(undef, \@stiffs, undef, undef); #and get number of busy children (use by main_loop)
|
||||
$SIG{CHLD} = \&reaper;
|
||||
}
|
||||
|
||||
#main_loop: main loop (spawn new children)
|
||||
#arg0: void
|
||||
#ret0: void
|
||||
sub main_loop {
|
||||
while (1) {
|
||||
#sleep EXPR seconds or until signal (i.e. child death) is received
|
||||
my $sleept = sleep $loop_sleep;
|
||||
#block CHLD signals to avoid race, anyway does it matter?
|
||||
my $sigset = &block_signal(SIGCHLD);
|
||||
$chld_busy = &shmem_opt(undef, undef, undef, undef, 1) if ($sleept == $loop_sleep); #get number of busy children, if sleep wasn't interrupted by signal
|
||||
#calculate children in pool (if valid busy children number)
|
||||
if (defined($chld_busy)) {
|
||||
info("busy children: $chld_busy");
|
||||
$chld_pool = $chld_busy + $idle_children;
|
||||
}
|
||||
$chld_pool = $max_children if ($chld_pool > $max_children); #ensure pool limit is max_children
|
||||
#spawn children
|
||||
for ( my $i = scalar (keys %children); $i < $chld_pool ; $i++ ) {
|
||||
&new_child(); #add to the child pool
|
||||
}
|
||||
info("children pool: $chld_pool (currently spawned: ".scalar (keys %children).")");
|
||||
#unblock signals
|
||||
&unblock_signal($sigset);
|
||||
}
|
||||
}
|
||||
|
||||
#block_signal: block signals
|
||||
#arg0..n: int with signal(s) to block
|
||||
#ret0: ref str with sigset (used to later unblock signal)
|
||||
sub block_signal {
|
||||
my @signal = @_; #arg0..n
|
||||
|
||||
my ($sigset, $blockset);
|
||||
|
||||
$sigset = POSIX::SigSet->new();
|
||||
$blockset = POSIX::SigSet->new(@signal);
|
||||
sigprocmask(SIG_BLOCK, $blockset, $sigset)
|
||||
or die "Could not block @signal signals: $!\n";
|
||||
|
||||
return($sigset);
|
||||
|
||||
}
|
||||
|
||||
#unblock_signal: unblock/reset and receive pending signals
|
||||
#arg0: ref str with sigset
|
||||
#ret0: void
|
||||
sub unblock_signal {
|
||||
my $sigset = shift; #arg0
|
||||
|
||||
sigprocmask(SIG_SETMASK, $sigset)
|
||||
or die "Could not restore signals: $!\n";
|
||||
|
||||
}
|
||||
|
||||
#new_child: initialize new child
|
||||
#arg0: void
|
||||
#ret0: void
|
||||
sub new_child {
|
||||
|
||||
# daemonize away from the parent process
|
||||
my $pid;
|
||||
die "Cannot fork child: $!\n" unless defined( $pid = fork );
|
||||
if ($pid) {
|
||||
# in parent
|
||||
$children{$pid} = 1;
|
||||
info("new child, pid: $pid");
|
||||
return;
|
||||
}
|
||||
# in child
|
||||
|
||||
#reset priority
|
||||
setpriority 0, 0, getpriority (0, 0) + $re_nice;
|
||||
|
||||
# reset signals
|
||||
my $sigset = POSIX::SigSet->new();
|
||||
my $blockset = POSIX::SigSet->new(SIGCHLD);
|
||||
sigprocmask(SIG_UNBLOCK, $blockset, $sigset)
|
||||
or die "Could not unblock SIGHUP signal: $!\n";
|
||||
$SIG{CHLD} = $SIG{INT} = $SIG{TERM} = $SIG{ALRM} = 'DEFAULT';
|
||||
|
||||
# child should exit if it receives HUP signal (note: blocked while child is busy, but restored once done)
|
||||
$SIG{HUP} = sub { info("signal HUP received, going to exit");
|
||||
exit 1;
|
||||
};
|
||||
|
||||
# continue to accept connections until "old age" is reached
|
||||
for ( my $i = 0; $i < $child_lifetime ; $i++ ) {
|
||||
|
||||
# accept a connection
|
||||
$0 = 'qpsmtpd child'; # set pretty child name in process listing
|
||||
my ($client, $iinfo) = $d->accept() or die "failed to create new object - $!"; # wait here until client connects
|
||||
info("connect from: " . $client->peerhost . ":" . $client->peerport );
|
||||
|
||||
# set STDIN/STDOUT and autoflush
|
||||
POSIX::dup2(fileno($client), 0) || die "unable to duplicate filehandle to STDIN - $!";
|
||||
POSIX::dup2(fileno($client), 1) || die "unable to duplicate filehandle to STDOUT - $!";
|
||||
$| = 1;
|
||||
|
||||
#connection recieved, block signals
|
||||
my $sigset = &block_signal(SIGHUP);
|
||||
|
||||
#start new qpsmtpd session
|
||||
&qpsmtpd_session($client, $qpsmtpd) if ($iinfo); #only start a session if connection looks valid
|
||||
|
||||
#close connection and cleanup
|
||||
$client->shutdown(2);
|
||||
|
||||
#unset block and receive pending signals
|
||||
&unblock_signal($sigset);
|
||||
|
||||
}
|
||||
exit; # this child has reached its end-of-life
|
||||
}
|
||||
|
||||
# respond to client
|
||||
# arg0: ref to socket object (client)
|
||||
# arg1: int with SMTP reply code
|
||||
# arg2: arr with message
|
||||
# ret0: int 0|1 (0 = failure, 1 = success)
|
||||
sub respond_client {
|
||||
my ($client, $code, @message) = @_;
|
||||
$client->autoflush(1);
|
||||
while (my $msg = shift @message) {
|
||||
my $line = $code . (@message?"-":" ").$msg;
|
||||
info("reply to client: <$line>");
|
||||
print $client "$line\r\n"
|
||||
or (&info("Could not print [$line]: $!"), return 0);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#get_pid: get pid of running qpsmtpd-highperf process
|
||||
#arg0: str with path to pid file
|
||||
#ret0: int with pid (undef if process isn't running or unable to get pid from file)
|
||||
sub get_pid {
|
||||
my $pid_path = shift; #arg0
|
||||
|
||||
open(PID, "<$pid_path") || return;
|
||||
my $p = <PID>;
|
||||
close(PID);
|
||||
$p = $1 if ($p =~ /^(\d+)$/);
|
||||
|
||||
return($p);
|
||||
}
|
||||
|
||||
#qpsmtpd_instance: setup qpsmtpd instance
|
||||
#arg0: void
|
||||
#ret0: ref to qpsmtpd_instance
|
||||
sub qpmsptd_instance {
|
||||
|
||||
my $qpsmtpd = Qpsmtpd::TcpServer::Prefork->new();
|
||||
$qpsmtpd->load_plugins;
|
||||
$qpsmtpd->spool_dir;
|
||||
$qpsmtpd->size_threshold;
|
||||
|
||||
return($qpsmtpd);
|
||||
}
|
||||
|
||||
#shmem: tie to shared memory hash
|
||||
#arg0: str with glue
|
||||
#arg1: int 0|1 (0 = don't create shmem, 1 = create shmem)
|
||||
#ret0: ref to shared hash
|
||||
sub shmem {
|
||||
my $glue = shift; #arg0
|
||||
my $create = shift || 0; #arg1
|
||||
|
||||
my %options = (
|
||||
create => $create,
|
||||
exclusive => 0,
|
||||
mode => 0640,
|
||||
destroy => 0,
|
||||
);
|
||||
|
||||
my %shmem_hash;
|
||||
eval {
|
||||
tie %shmem_hash, 'IPC::Shareable', $glue, { %options } || die "unable to tie to shared memory - $!";
|
||||
};
|
||||
if ($@) {
|
||||
info("$@");
|
||||
return;
|
||||
}
|
||||
|
||||
return(\%shmem_hash);
|
||||
}
|
||||
|
||||
#shmem_opt: connect to shared memory and perform options
|
||||
#arg0: ref to hash where shared memory should be copied to
|
||||
#arg1: ref to arr with pid(s) to delete
|
||||
#arg2: int with pid to add (key)
|
||||
#arg3: str with packed iaddr to add (value)
|
||||
#arg4: int 0|1 check and cleanup shared memory (0 = no, 1 = yes - default 0)
|
||||
#ret0: int with number of busy children (undef if error)
|
||||
sub shmem_opt {
|
||||
my $ref_shmem = shift; #arg0
|
||||
my $ref_pid_del = shift; #arg1
|
||||
my $pid_add_key = shift; #arg2
|
||||
my $pid_add_value = shift; #arg3
|
||||
my $check = shift || 0; #arg4
|
||||
|
||||
#check arguments
|
||||
return if ( (defined($pid_add_key) && !defined($pid_add_value)) || (!defined($pid_add_key) && defined($pid_add_value)) );
|
||||
|
||||
my ($chld_shmem, $chld_busy);
|
||||
eval {
|
||||
$chld_shmem = &shmem("qpsmtpd", 0); #connect to shared memory hash
|
||||
|
||||
if (tied %{$chld_shmem}) {
|
||||
#perform options
|
||||
(tied %{$chld_shmem})->shlock(LOCK_EX);
|
||||
#delete
|
||||
if ($ref_pid_del) {
|
||||
foreach my $pid_del (@{$ref_pid_del}) {
|
||||
delete $$chld_shmem{$pid_del};
|
||||
}
|
||||
}
|
||||
$$chld_shmem{$pid_add_key} = $pid_add_value if ($pid_add_key); #add
|
||||
%{$ref_shmem} = %{$chld_shmem} if($ref_shmem); #copy
|
||||
#loop through pid list and delete orphaned processes
|
||||
if ($check) {
|
||||
foreach my $pid (keys %{$chld_shmem}) {
|
||||
if (! kill 0, $pid) {
|
||||
delete $$chld_shmem{$pid};
|
||||
warn("orphaned child, pid: $pid - removed from shared memory");
|
||||
}
|
||||
}
|
||||
}
|
||||
#count number of busy children
|
||||
$chld_busy = scalar(keys %{$chld_shmem});
|
||||
(tied %{$chld_shmem})->shunlock;
|
||||
untie $chld_shmem || die "unable to untie from shared memory"; #untie from shared memory
|
||||
}
|
||||
};
|
||||
#check for error
|
||||
if ($@) {
|
||||
undef($chld_busy);
|
||||
warn("$@");
|
||||
}
|
||||
|
||||
return($chld_busy);
|
||||
}
|
||||
|
||||
# info: write info
|
||||
# arg0: str with debug text
|
||||
sub info {
|
||||
my $text = shift; #arg0
|
||||
return if ( !$debug );
|
||||
|
||||
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time);
|
||||
my $nowtime = sprintf "%02d/%02d/%02d %02d:%02d:%02d", $mday, $mon + 1,
|
||||
$year + 1900, $hour, $min, $sec;
|
||||
|
||||
chomp($text);
|
||||
system("echo \"$nowtime:$$: $text\" >> $logFile");
|
||||
}
|
||||
|
||||
#start qpmstpd session
|
||||
# arg0: ref to socket object
|
||||
# arg1: ref to qpsmtpd instance
|
||||
# ret0: void
|
||||
sub qpsmtpd_session {
|
||||
my $client = shift; #arg0
|
||||
my $qpsmtpd = shift; #arg1
|
||||
|
||||
#get local/remote hostname, port and ip address
|
||||
my ($port, $iaddr) = sockaddr_in(getpeername($client)); #remote
|
||||
my ($lport, $laddr) = sockaddr_in(getsockname($client)); #local
|
||||
|
||||
#get current connected ip addresses (from shared memory)
|
||||
my %children;
|
||||
&shmem_opt(\%children, undef, $$, $iaddr);
|
||||
|
||||
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 %children],
|
||||
);
|
||||
if ($rc == DENYSOFT || $rc == DENYSOFT_DISCONNECT || $rc == DENY || $rc == DENY_DISCONNECT ) {
|
||||
my $rc_reply = 451; #smtp return code to reply client with (seed with soft deny)
|
||||
unless ($msg[0]) {
|
||||
if ($rc == DENYSOFT || $rc == DENYSOFT_DISCONNECT) {
|
||||
@msg = ("Sorry, try again later");
|
||||
} else {
|
||||
@msg = ("Sorry, service not available to you");
|
||||
$rc_reply = 550;
|
||||
}
|
||||
}
|
||||
&respond_client($client, $rc_reply, @msg);
|
||||
&shmem_opt(undef, [$$], undef, undef); #remove pid from shared memory
|
||||
return; #retur so child can be reused
|
||||
}
|
||||
|
||||
# all children should have different seeds, to prevent conflicts
|
||||
srand( time ^ ($$ + ($$ << 15)) );
|
||||
|
||||
# $SIG{$_} = 'DEFAULT' for keys %SIG;
|
||||
$SIG{ALRM} = sub {
|
||||
print $client "421 Connection Timed Out\n";
|
||||
&info("Connection Timed Out");
|
||||
exit 1; #this will kill the child, but who cares?
|
||||
};
|
||||
|
||||
#set enviroment variables
|
||||
$ENV{TCPLOCALIP} = inet_ntoa($laddr);
|
||||
$ENV{TCPREMOTEIP} = inet_ntoa($iaddr);
|
||||
$ENV{TCPREMOTEHOST} = gethostbyaddr($iaddr, AF_INET) || "Unknown";
|
||||
|
||||
#run qpmsptd functions
|
||||
$SIG{__DIE__} = 'DEFAULT';
|
||||
eval {
|
||||
$qpsmtpd->start_connection (
|
||||
local_ip => $ENV{TCPLOCALIP},
|
||||
local_port => $lport,
|
||||
remote_ip => $ENV{TCPREMOTEIP},
|
||||
remote_port => $client->peerport,
|
||||
);
|
||||
$qpsmtpd->run();
|
||||
$qpsmtpd->run_hooks("post-connection");
|
||||
};
|
||||
if($@ !~ /^(disconnect_tcpserver|died while reading from STDIN)/ ) {
|
||||
warn("$@");
|
||||
}
|
||||
|
||||
#done - this child is now idle again
|
||||
&shmem_opt(undef, [$$], undef, undef); #remove pid from shared memory
|
||||
|
||||
info("remote host: $ENV{TCPREMOTEIP} left...");
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user