#!perl -w

=head1 NAME

hosts_allow - decide if a host is allowed to connect

=head1 DESCRIPTION

The B<hosts_allow> module decides before the SMTP-Greeting if a host is
allowed to connect. It checks for too many (running) connections from one
host (see -m/--max-from-ip options in qpsmtpd-forkserver) and the config
file I<hosts_allow>.

The plugin takes no config/plugin arguments.

This plugin only works with the forkserver and prefork deployment models. It
does not work with the tcpserver deployment model. See SEE ALSO below.

=head1 CONFIG

The I<hosts_allow> config file contains lines with two or three items. The
first is an IP address or a network/mask pair. The second is a (valid) return
code from Qpsmtpd::Constants. The last is a comment which will be returned to
the connecting client if the return code is DENY or DENYSOFT (and of course
DENY_DISCONNECT and DENYSOFT_DISCONNECT).

Example:

  192.168.3.4    DECLINED
  192.168.3.0/24 DENY Sorry, known spam only source

This would exclude 192.168.3.4 from the DENY of 192.168.3.0/24.

=head1 SEE ALSO

To get similar functionality for the tcpserver deployment model, use
tcpserver's -x feature. Create a tcp.smtp file with entries like this:

  70.65.227.235:deny
  183.7.90.207:deny
  :allow

compile the tcp.smtp file like this:

  /usr/local/bin/tcprules tcp.smtp.cdb tcp.smtp.tmp < tcp.smtp

and add the file to the chain of arguments to tcpserver in your run file.

See also: http://cr.yp.to/ucspi-tcp.html

=cut

use strict;
use warnings;

use Qpsmtpd::Constants;
use Socket;

sub hook_pre_connection {
    my ($self, $transaction, %args) = @_;

    # remote_ip    => inet_ntoa($iaddr),
    # remote_port  => $port,
    # local_ip     => inet_ntoa($laddr),
    # local_port   => $lport,
    # max_conn_ip  => $MAXCONNIP,
    # child_addrs  => [values %childstatus],

    my $remote = $args{remote_ip};
    my $max    = $args{max_conn_ip};
    my $karma  = $self->connection->notes('karma_history');

    if ($max) {
        my $num_conn = 1;                    # seed with current value
        my $raddr    = inet_aton($remote);
        foreach my $rip (@{$args{child_addrs}}) {
            ++$num_conn if (defined $rip && $rip eq $raddr);
        }
        $max = $self->karma_bump($karma, $max) if defined $karma;
        if ($num_conn > $max) {
            my $err_mess = "too many connections from $remote";
            $self->log(LOGINFO, "fail: $err_mess ($num_conn > $max)");
            return (DENYSOFT, "$err_mess, try again later");
        }
    }

    my @r = $self->in_hosts_allow($remote);
    return @r if scalar @r;

    $self->log(LOGDEBUG, "pass");
    return (DECLINED);
}

sub in_hosts_allow {
    my $self   = shift;
    my $remote = shift;

    foreach ($self->qp->config('hosts_allow')) {
        s/^\s*//;    # trim leading whitespace
        my ($ipmask, $const, $message) = split /\s+/, $_, 3;
        next unless defined $const;

        my ($net, $mask) = split /\//, $ipmask, 2;
        $mask = 32 if !defined $mask;
        $mask = pack "B32", "1" x ($mask) . "0" x (32 - $mask);
        if (join('.', unpack('C4', inet_aton($remote) & $mask)) eq $net) {
            $const = Qpsmtpd::Constants::return_code($const) || DECLINED;
            if ($const =~ /deny/i) {
                $self->log(LOGINFO, "fail, $message");
            }
            $self->log(LOGDEBUG, "pass, $const, $message");
            return ($const, $message);
        }
    }

    return;
}

sub karma_bump {
    my ($self, $karma, $max) = @_;

    if ($karma > 5) {
        $self->log(LOGDEBUG, "connect limit +3 for positive karma");
        return $max + 3;
    }
    if ($karma <= 0) {
        $self->log(LOGINFO, "connect limit 1, karma $karma");
        return 1;
    }
    return $max;
}