132 lines
3.4 KiB
Perl
Executable File
132 lines
3.4 KiB
Perl
Executable File
#!/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 {
|
|
$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 "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{$_} = '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;
|