qpsmtpd/qpsmtpd-forkserver

#!/usr/bin/perl -w
# 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 POSIX qw(:sys_wait_h :errno_h :signal_h);
use strict;
$| = 1;

# Configuration
my $MAXCONN   = 15;				# max simultaneous connections
my $PORT      = 25;				# port number
my $LOCALADDR = '0.0.0.0';		# ip address to bind to
my $USER      = 'smtpd';		# user to suid to

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;
    warn("$$ cleaning up after $chld\n");
    delete $childstatus{$chld};
  }
}

$SIG{CHLD} = \&REAPER;

# establish SERVER socket, bind and listen.
my $server = IO::Socket::INET->new(LocalPort => $PORT,
				   LocalAddr => $LOCALADDR,
                                   Proto     => 'tcp',
                                   Reuse     => 1,
                                   Listen    => SOMAXCONN )
  or die "making socket: $@\n";

# Drop priviledges
my $user = 'mailfw';
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;

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

::log(LOGINFO,"Listening on port $PORT\n");

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 $pid = fork;
    if ($pid) {
        # parent
        $childstatus{$pid} = 1;	# add to table
        $running++;
        close($client);
        next;
    }
    die "fork: $!" unless defined $pid;     # failure
    # otherwise child

    close($server);

    $SIG{CHLD} = $SIG{HUP} = $SIG{PIPE} = $SIG{INT} = 
        $SIG{TERM} = $SIG{QUIT} = 'DEFAULT';
    
    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;