#!/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;