#!perl -w

=head1 SYNOPSIS

relay - control whether relaying is permitted

=head1 DESCRIPTION

relay - check the following places to see if relaying is allowed:

I<$ENV{RELAYCLIENT}>

I<config/norelayclients>, I<config/relayclients>, I<config/morerelayclients>

The search order is as shown and cascades until a match is found or the list
is exhausted.

Note that I<norelayclients> is the first file checked. A match there will
override matches in the subsequent files.

=head1 CONFIG

Enable this plugin by adding it to config/plugins above the rcpt_* plugins

 # other plugins...

 relay

 # rcpt_* go here

=head2 relayclients

A list of IP addresses that are permitted to relay mail through this server.

Each line in I<relayclients> is one of:
 - a full IP address

 - partial IP address terminated by a dot or colon for matching whole networks
     192.168.42.
     2001:db8:e431:ae06:
     ...

 - a network/mask, aka a CIDR block
     10.1.0.0/24
     2001:db8:e431:ae06::/64
     ...

=head2 morerelayclients

Additional IP addresses that are permitted to relay. The syntax of the config
file is identical to I<relayclients> except that CIDR (net/mask) entries are
not supported. If you have many (>50) IPs allowed to relay, most should likely
be listed in I<morerelayclients> where lookups are faster.


=head2 norelayclients

I<norelayclients> allows specific clients, such as a mail gateway, to be denied
relaying, even though they would be allowed by I<relayclients>. This is most
useful when a block of IPs is allowed in relayclients, but several IPs need to
be excluded.

The file format is the same as morerelayclients.

=head2 RELAY ONLY

The relay only option restricts connections to only clients that have relay
permission. All other connections are denied during the RCPT phase of the
SMTP conversation.

This option is useful when a server is used as the smart relay host for
internal users and external/authenticated users, but should not be considered
a normal inbound MX server.

It should be configured to be run before other RCPT hooks! Only clients that
have authenticated or are listed in the relayclient file will be allowed to
send mail.

To enable relay only mode, set the B<only> option to any true value in
I<config/plugins> as shown:

  relay only 1

=head1 AUTHOR

2012 - Matt Simerson - Merged check_relay, check_norelay, and relayonly

2006 - relay_only  - John Peackock

2005 - check_norelay - Copyright Gordon Rowell <gordonr@gormand.com.au>

2002 - check_relay - Ask Bjorn Hansen

=head1 LICENSE

This software is free software and may be distributed under the same
terms as qpsmtpd itself.

=cut

use strict;
use warnings;

use Qpsmtpd::Constants;
use Net::IP qw(:PROC);

sub register {
    my ($self, $qp) = (shift, shift);
    $self->log(LOGERROR, "Bad arguments") if @_ % 2;
    $self->{_args} = {@_};

    if ($self->{_args}{only}) {
        $self->register_hook('rcpt', 'relay_only');
    }
}

sub is_in_norelayclients {
    my $self = shift;

    my %no_relay_clients = map { $_ => 1 } $self->qp->config('norelayclients');

    my $ip = $self->qp->connection->remote_ip;

    while ($ip) {
        if (exists $no_relay_clients{$ip}) {
            $self->log(LOGINFO, "$ip in norelayclients");
            return 1;
        }
        $ip =~ s/(\d|\w)+(:|\.)?$// or last;    # strip off another octet
    }

    $self->log(LOGDEBUG, "no match in norelayclients");
    return;
}

sub populate_relayclients {
    my $self = shift;

    foreach ($self->qp->config('relayclients')) {
        my ($network, $netmask) = ip_splitprefix($_);
        if ($netmask) {
            push @{$self->{_cidr_blocks}}, $_;
            next;
        }
        $self->{_octets}{$_} = 1;    # no prefix, split
    }
}

sub is_in_cidr_block {
    my $self = shift;

    my $ip = $self->qp->connection->remote_ip or do {
        $self->log(LOGINFO, "err, no remote_ip?");
        return;
    };
    my $cversion = ip_get_version($ip);
    for (@{$self->{_cidr_blocks}}) {
        my ($network, $mask) = ip_splitprefix($_);    # split IP & CIDR range
        my $rversion = ip_get_version($network);      # get IP version (4 vs 6)
        my ($begin, $end) = ip_normalize($_, $rversion);    # get pool start/end

        # expand the client address (zero pad it) before converting to binary
        my $bin_ip = ip_iptobin(ip_expand_address($ip, $cversion), $cversion)
          or next;

        next if !$begin || !$end;    # probably not a netmask entry

        if (   ip_bincomp($bin_ip, 'gt', ip_iptobin($begin, $rversion))
            && ip_bincomp($bin_ip, 'lt', ip_iptobin($end, $rversion)))
        {
            $self->log(LOGINFO, "pass, cidr match ($ip)");
            return 1;
        }
    }

    $self->log(LOGDEBUG, "no cidr match");
    return;
}

sub is_octet_match {
    my $self = shift;

    my $ip = $self->qp->connection->remote_ip;

    if ($ip eq '::1') {
        $self->log(LOGINFO, "pass, octet matched localhost ($ip)");
        return 1;
    }

    my $more_relay_clients = $self->qp->config('morerelayclients', 'map');

    my $ipv6 = $ip =~ /:/ ? 1 : 0;

    if ($ipv6 && $ip =~ /::/) {    # IPv6 compressed notation
        $ip = Net::IP::ip_expand_address($ip, 6);
    }

    while ($ip) {
        if (exists $self->{_octets}{$ip}) {
            $self->log(LOGINFO, "pass, octet match in relayclients ($ip)");
            return 1;
        }

        if (exists $more_relay_clients->{$ip}) {
            $self->log(LOGINFO, "pass, octet match in morerelayclients ($ip)");
            return 1;
        }

        # added IPv6 support (Michael Holzt - 2012-11-14)
        if ($ipv6) {
            $ip =~ s/[0-9a-f]:?$//;    # strip off another nibble
            chop $ip if ':' eq substr($ip, -1, 1);
        }
        else {
            $ip =~ s/\d+\.?$// or last;    # strip off another 8 bits
        }
    }

    $self->log(LOGDEBUG, "no octet match");
    return;
}

sub hook_connect {
    my ($self, $transaction) = @_;

    if ($self->is_in_norelayclients()) {
        $self->qp->connection->relay_client(0);
        delete $ENV{RELAYCLIENT};
        $self->log(LOGINFO, "fail, disabled by norelayclients");
        return DECLINED;
    }

    if (defined $ENV{RELAYCLIENT}) {
        $self->qp->connection->relay_client(1);
        $self->log(LOGINFO, "pass, enabled by env");
        return DECLINED;
    }

    $self->populate_relayclients();

    # 95586 (connect) relay: pass, octet match in relayclients (127.0.0.)

    if ($self->is_in_cidr_block() || $self->is_octet_match()) {
        $self->qp->connection->relay_client(1);
        return DECLINED;
    }

    $self->log(LOGINFO, "skip, no match");
    return DECLINED;
}

sub relay_only {
    my $self = shift;
    if ($self->qp->connection->relay_client) {
        return OK;
    }
    return DENY;
}