Matt Sergeant wrote:
> Looks interesting, but I'm not too keen on that patch. I'd much rather
> see subclasses used for this, since the changes are very particular to
> your daemon (i.e. catching specific die() strings). Should be very
> trivial to do this as a couple of subclasses.
Like the attached?? Note, I have not tested this extensively. I also made a
slight change to the qpsmtpd-highperf script itself (don't need/want to create
$pid_path if the user requested a --pid_file).
John
=== lib/Qpsmtpd/SMTP/Prefork.pm
==================================================================
--- lib/Qpsmtpd/SMTP/Prefork.pm (revision 811)
+++ lib/Qpsmtpd/SMTP/Prefork.pm (local)
@@ -0,0 +1,43 @@
+package Qpsmtpd::SMTP::Prefork;
+use Qpsmtpd::SMTP;
[EMAIL PROTECTED] = 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;
+}
=== lib/Qpsmtpd/TcpServer/Prefork.pm
==================================================================
--- lib/Qpsmtpd/TcpServer/Prefork.pm (revision 811)
+++ lib/Qpsmtpd/TcpServer/Prefork.pm (local)
@@ -0,0 +1,56 @@
+package Qpsmtpd::TcpServer::Prefork;
+use Qpsmtpd::TcpServer;
+use Qpsmtpd::SMTP::Prefork;
+
[EMAIL PROTECTED] = 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;
=== qpsmtpd-highperf
==================================================================
--- qpsmtpd-highperf (revision 811)
+++ qpsmtpd-highperf (local)
@@ -0,0 +1,670 @@
+#!/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, [EMAIL PROTECTED], 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...");
+
+}
+
Property changes on: qpsmtpd-highperf
___________________________________________________________________
Name: svn:executable
+*
