# -*- perl -*-
#
# $Id: check_validrcptto_cdb 47 2007-10-24 09:15:49Z robin $

=head1 NAME

check_validrcptto_cdb - checks for valid mail recipients in a cdb file.

=head1 DESCRIPTION

Validates the email address given in the RCPT TO: command of the SMTP
conversation against a list of recipients for which mail should be
accepted.

The list of recipients is stored in cdb format for lookup speed.

=head1 REQUIREMENTS

Requires the CDB_File module.

=head1 CONFIGURATION

Add a line to C<config/plugins> as follows:

check_validrcptto_cdb cdb_file [/path/to/file] qmail_ext [character]

=head2 cdb_file [/path/to/file]

=over 4 

The cdb file containing the list of email addresses for which mail should
be accepted.

Default is C<config/validrcptto.cdb>

This file is created from a raw file containing a list of
email addresses in the following format:

=over 4

=item user1@example1.com

=item user1-default@example1.com

=item user2@example1.com

=item @example2.com>

=back

This says:

=over 4

=item 1. accept mail addressed to user1@example1.com

=item 2. accept mail addressed to user-anything-at-all@example1.com

=item 3. accept mail addressed to user2@example1.com

=item 4. accept mail addressed to any-local-part@example2.com

=back

=back

=head2 qmail_ext [character]

=over 4

The character used as the qmail-ext separator character.

Default is C<->.

=back

=head1 PRODUCING THE CDB FILE

To convert the list of email addresses to cdb format you will need djb's
cdb package [3].

Use a command something like this:

C<cdbmake-12 validrcptto.cdb validrcptto.tmp < validrcptto.txt>

where validrcptto.txt is a list of addresses in the format above.

John Simpson has a perl script [1] that produces a list of email addresses
in the correct format.  His page describing his qmail validrcptto.cdb
patch [2] is also worth reading for more background information.

Note that until 2006-01-11, John's script had a bug which meant it didn't
work correctly with vpopmail if vpopmail was compiled with the
C<--enable-qmail-ext> option.

If you are using John's script, pipe the output directly into cdbmake-12
as follows:

C<mkvalidrcptto | cdbmake-12 validrcptto.cdb validrcptto.tmp>

=head2 Links

[1] L<http://qmail.jms1.net/scripts/mkvalidrcptto>

[2] L<http://qmail.jms1.net/patches/validrcptto.cdb.shtml>

[3] L<http://cr.yp.to/cdb.html>

=head1 ALGORITHM

I will use the email address C<local-ext1-ext2-ext3@example1.com> as an
illustration.

The algorithm used to check for valid email addresses is as follows:

=over 4

=item 1. Check for @example1.com

=item 2. Check for local-ext1-ext2-ext3@example1.com

=item 3. Check for local-ext1-ext2-default@example1.com

=item 4. Check for local-ext1-default@example1.com

=item 5. Check for local-default@example1.com

=back

=head1 AUTHOR

Copyright 2006 Robin Bowes <robin@robinbowes.com>

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

=cut

use CDB_File;

my %DEFAULT = (
    cdb_file  => q{config/validrcptto.cdb},
    qmail_ext => q{-},
);

sub register {
    my ( $self, $qp, %args ) = @_;

    $self->{_cdb_file} = $DEFAULT{cdb_file};
    if ( defined( $args{cdb_file} ) ) {

        # make sure file is readable
        if ( -r $args{cdb_file} ) {
            $self->{_cdb_file} = $args{cdb_file};
        }
        else {

            # throw an error here
        }
    }
    $self->log( LOGINFO, "Using cdb file: $self->{_cdb_file}" );

    $self->{_qmail_ext} = $DEFAULT{qmail_ext};
    if ( defined( $args{qmail_ext} ) ) {

        # ensure qmail_ext is only one character, if specified.
        if ( length( $args{qmail_ext} ) == 1 ) {
            $self->{_qmail_ext} = $args{qmail_ext};
        }
        else {

            # throw an error here
        }
    }

    $self->register_hook( "rcpt", "check_validrcptto" );
}

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

    # Don't check if we're relaying
    if ( $self->qp->connection->relay_client() ) {
        $self->log( LOGINFO, "Relaying detected - skipping recipient check" );
        return (DECLINED);
    }

    # don't check if user not yet defined
    if ( !defined $recipient->user ) {
        $self->log( LOGINFO,
            "Recipient not yet defined - skipping recipient check" );
        return (DECLINED);
    }

    # don't check if file not readable
    if ( !-r $self->{_cdb_file} ) {
        $self->log( LOGCRIT,
            "$self->{_cdb_file} not readable - skipping recipient check" );
        return (DECLINED);
    }

    # Open the cdb file and tie to hash
    my %validrcptto;
    if ( !tie %validrcptto, 'CDB_File', $self->{_cdb_file} ) {
        $self->log( LOGCRIT,
            "tie to cdb file failed - skipping recipient check" );
        return (DECLINED);
    }

    # build addresses to check:
    my $host = '@' . lc( $recipient->host );
    my $user = lc( $recipient->user );

    my $matched_addr = '';

    if ( exists $validrcptto{$host} ) {
        $matched_addr = $host;
    }
    else {
        if ( exists $validrcptto{ $user . $host } ) {
            $matched_addr = $user . $host;
        }
        else {
        EXTADDR:
            while ( $user =~ /^(.+)$self->{_qmail_ext}/ ) {
                $user = $1;
                if (exists $validrcptto{ $user
                            . $self->{_qmail_ext}
                            . 'default'
                            . $host } )
                {
                    $matched_addr
                        = $user . $self->{_qmail_ext} . 'default' . $host;
                    last EXTADDR;
                }
            }
        }
    }

    untie %validrcptto;

    if ($matched_addr) {
        $self->log( LOGINFO,
            "Accepting mail for $recipient (matched $matched_addr)" );
        return (DECLINED);
    }
    else {
        return ( DENY, "Sorry, $recipient is not in my validrcptto list" );
    }
}
