103 lines
2.5 KiB
Perl
Executable File
103 lines
2.5 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;
|
|
|
|
delete $ENV{ENV};
|
|
$ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';
|
|
|
|
sub REAPER {
|
|
while (defined(my $child = waitpid(-1, WNOHANG)) ) {
|
|
if ($child == -1) {
|
|
# No child here? Loop back
|
|
}
|
|
elsif (WIFEXITED($?)) {
|
|
# Process exited
|
|
last;
|
|
}
|
|
else {
|
|
# Possibly SIGSTOP on child...
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
|
|
$SIG{CHLD} = \&REAPER;
|
|
|
|
# establish SERVER socket, bind and listen.
|
|
my $server = IO::Socket::INET->new(LocalPort => 25,
|
|
Proto => 'tcp',
|
|
Reuse => 1,
|
|
Listen => SOMAXCONN )
|
|
or die "making socket: $@\n";
|
|
|
|
# Drop priviledges
|
|
my $user = 'smtpd';
|
|
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;
|
|
|
|
# $plugin_loader->log(LOGINFO, "Listening on port 25");
|
|
|
|
while (1) {
|
|
my $hisaddr = accept(my $client, $server);
|
|
if (!$hisaddr) {
|
|
# possible something condition...
|
|
next;
|
|
}
|
|
my $pid = fork;
|
|
if ($pid) {
|
|
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";
|
|
|
|
# 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
|
|
}
|
|
|
|
__END__
|
|
|
|
1;
|