qpsmtpd/qpsmtpd-forkserver

#!/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 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 = '0.0.0.0';		# ip address to bind to
my $USER      = 'smtpd';		# user to suid to
my $MAXCONNIP = 5;              # max simultaneous connections from one IP

sub usage {
        print <<"EOT";
usage: qpsmtpd-forkserver [ options ]
 -l, --listen-address addr : listen on a specific address; default 0.0.0.0
 -p, --port P              : listen on a specific port; default 25
 -c, --limit-connections N : limit concurrent connections to N; default 15
 -u, --user U              : run as a particular user (defualt 'smtpd')
EOT
        exit 0;
}

GetOptions('h|help' => \&usage,
           'l|listen-address=s' => \$LOCALADDR,
           'c|limit-connections=i' => \$MAXCONN,
           'p|port=i' => \$PORT,
           'u|user=s' => \$USER) || &usage;

# detaint the commandline
if ($PORT =~ /^(\d+)$/) { $PORT = $1 } else { &usage }
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 {
  $SIG{CHLD} = \&REAPER;
  while ( defined(my $chld = waitpid(-1, WNOHANG)) ){
    last unless $chld > 0;
    warn("$$ cleaning up after $chld\n");
    delete $childstatus{$chld};
  }
}

sub HUNTSMAN {
  $SIG{CHLD} = 'DEFAULT';
  kill 'INT' => keys %childstatus;
  exit(0);
}

$SIG{CHLD} = \&REAPER;
$SIG{INT} = \&HUNTSMAN;
$SIG{TERM} = \&HUNTSMAN;

# establish SERVER socket, bind and listen.
my $server = IO::Socket::INET->new(LocalPort => $PORT,
				   LocalAddr => $LOCALADDR,
                                   Proto     => 'tcp',
                                   Reuse     => 1,
                                   Listen    => SOMAXCONN )
  or die "Creating TCP socket $LOCALADDR:$PORT: $!\n";
::log(LOGINFO,"Listening on port $PORT");

# Drop priviledges
my (undef, undef, $quid, $qgid) = getpwnam $USER or
      die "unable to determine uid/gid for $USER\n";
$) = "";
POSIX::setgid($qgid) or
      die "unable to change gid: $!\n";
POSIX::setuid($quid) or
      die "unable to change uid: $!\n";
$> = $quid;

::log(LOGINFO, 'Running as user '.
	(getpwuid($>) || $>) .
	', group '.
	(getgrgid($)) || $)));

# Load plugins here
my $plugin_loader = Qpsmtpd::TcpServer->new();
$plugin_loader->load_plugins;


while (1) {
  my $running = scalar keys %childstatus;
  while ($running >= $MAXCONN) { 
    ::log(LOGINFO,"Too many connections: $running >= $MAXCONN.  Waiting one second.");
    sleep(1) ;
    $running = scalar keys %childstatus;
  }
    my $hisaddr = accept(my $client, $server);
    if (!$hisaddr) {
        # possible something condition...
        next;
    }
    my ($port, $iaddr) = sockaddr_in($hisaddr);
    if ($MAXCONNIP) {
        my $num_conn = 1; # seed with current value

        # If we for-loop directly over values %childstatus, a SIGCHLD
        # can call REAPER and slip $rip out from under us.  Causes
        # "Use of freed value in iteration" under perl 5.8.4.
        my @rip = values %childstatus;
        foreach my $rip (@rip) {
          ++$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 = fork;
    if ($pid) {
        # parent
        $childstatus{$pid} = $iaddr;	# add to table
        # $childstatus{$pid} = 1;	# add to table
        $running++;
        close($client);
        next;
    }
    die "fork: $!" unless defined $pid;     # failure
    # otherwise child

    # all children should have different seeds, to prevent conflicts
    srand( time ^ ($$ + ($$ << 15)) );

    close($server);

    $SIG{$_} = 'DEFAULT' for keys %SIG;
    
    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);
    
    my $qpsmtpd = Qpsmtpd::TcpServer->new();
    $qpsmtpd->start_connection();
    $qpsmtpd->run();

    exit;                                   # child leaves
}

sub log {
  my ($level,$message) = @_;
  # $level not used yet.  this is reimplemented from elsewhere anyway
  warn("$$ $message\n");
}

__END__

1;