smeserver-email/root/usr/local/sbin/smtp-auth-proxy.pl

175 lines
5.1 KiB
Perl
Raw Permalink Normal View History

#!/usr/bin/perl -w -T
package esmith::SMTPAuthProxy;
use strict;
use vars qw(@ISA);
use Net::Server::Fork;
use Net::SMTP;
use Net::SMTP::SSL;
use esmith::ConfigDB;
@ISA = qw(Net::Server::Fork);
sub options {
my $self = shift;
my $prop = $self->{server};
my $ref = shift;
$self->SUPER::options($ref);
my $config = esmith::ConfigDB->open_ro || die "Could not open config db";
my $smtp_proxy_rec = $config->get('smtp-auth-proxy');
$prop->{SMTPSmartHost} = $config->get_value('SMTPSmartHost');
$prop->{Blacklist} = $smtp_proxy_rec->prop('Blacklist') || " ";
$prop->{Userid} = $smtp_proxy_rec->prop('Userid');
$prop->{Passwd} = $smtp_proxy_rec->prop('Passwd');
$prop->{Debug} = $smtp_proxy_rec->prop('Debug');
$prop->{SystemName} = $config->get_value('SystemName');
$prop->{DomainName} = $config->get_value('DomainName');
$prop->{PeerPort} = $smtp_proxy_rec->prop('PeerPort') || 25;
$prop->{Helo} = $config->get('qpsmtpd')->prop('HeloHost') ||
"$prop->{SystemName}.$prop->{DomainName}";
}
esmith::SMTPAuthProxy->run(
max_servers => 4,
proto => 'tcp',
user => 'nobody',
group => 'nobody',
host => 'localhost',
port => 26);
exit;
### over-ridden subs below
sub process_request
{
my $self = shift;
my $kidpid;
my $smarthost = $self->get_property('SMTPSmartHost');
my $port = $self->get_property('PeerPort');
my $user = $self->get_property('user');
my $domain_name = $self->get_property('DomainName');
my $system_name = $self->get_property('SystemName');
my $helo = $self->get_property('Helo');
my $name = $self->get_property('Userid');
my $pass = $self->get_property('Passwd');
my $debug = (($self->get_property('Debug') || 'disabled') eq 'enabled')
? 1 : 0;
unless ($smarthost && $system_name && $domain_name && $name && $pass)
{
print "421 Internal error\n";
warn "Insufficient configuration for smtp-auth-proxy (SystemName)!\n"
unless $system_name;
warn "Insufficient configuration for smtp-auth-proxy (DomainName)!\n"
unless $domain_name;
warn "Insufficient configuration for smtp-auth-proxy (SMTPSmartHost)!\n"
unless $smarthost;
warn "Insufficient configuration for smtp-auth-proxy (Userid)!\n"
unless $name;
warn "Insufficient configuration for smtp-auth-proxy (Passwd)!\n"
unless $pass;
exit;
}
my $class = ($port == 465) ? 'Net::SMTP::SSL' : 'Net::SMTP';
my $smtp = $class->new($smarthost,
Hello => $helo,
Debug => $debug,
Port => $port,
);
unless ($smtp)
{
print "451 Upstream SMTP server not available\n";
warn "No SMTP connection to server $smarthost on port $port\n";
exit;
}
my @ehlo = $smtp->message;
if (grep { /STARTTLS$/ } @ehlo)
{
$smtp->command('STARTTLS');
my $response = $smtp->response;
my $status = $smtp->message;
use IO::Socket::SSL;
my $sslret = IO::Socket::SSL->start_SSL(
$smtp,
Timeout => 30,
SSL_startHandshake => 1
);
unless ($sslret) {
my $error = IO::Socket::SSL::errstr();
print("454 TLS not available due to temporary reason [$error]");
}
bless $smtp, 'Net::SMTP::SSL';
$smtp->reset;
$smtp->hello("${system_name}.${domain_name}");
@ehlo = $smtp->message;
}
if ($smtp->supports("AUTH"))
{
my $authenticated = 0;
my $blacklist = $self->get_property('Blacklist') || "";;
foreach my $method (split (/ /, ${*$smtp}{'net_smtp_esmtp'}->{"AUTH"}))
{
# Skip $method if in the blacklist
if ($blacklist =~ /$method/)
{
warn "Skipping blacklisted method $method\n" if $debug;
next;
}
warn "Trying authentication method $method\n" if $debug;
# Only present one auth method at a time to NET::SMTP
{${*$smtp}{'net_smtp_esmtp'}->{"AUTH"} = $method;}
eval { $authenticated = $smtp->auth($name, $pass); };
if ($@)
{
warn "exception during authentication (with $method): $@\n";
next;
}
last if $authenticated;
warn "SMTP authentication (with $method) with ISP server failed\n";
}
unless ($authenticated)
{
print "451 Could not auth to mail server\n";
warn "all SMTP authentication methods failed\n";
$smtp->quit;
exit;
}
}
else
{
warn "Upstream SMTP server does not support authentication\n";
}
print "220 ", $smtp->banner;
my $discard = <STDIN>; # Swallow EHLO
while (my $msg = shift @ehlo) {
my $sep = (@ehlo ? "-" : " ");
print "250$sep$msg";
}
die "can't fork: $!" unless defined ($kidpid = fork());
if ($kidpid)
{
print $smtp $_ while <STDIN>;
kill ("TERM" => $kidpid);
}
else
{
print while <$smtp>;
kill ("TERM" => getppid());
}
}
1;