#!/usr/bin/perl

use Net::Patricia;
use strict;

#   The Net::Patricia module uses a Patricia Trie data structure
#   to quickly perform IP address prefix matching for applications
#   such as IP subnet, network and routing table lookups.
#
my ($allowed) = new Net::Patricia;
$allowed->add_string(q!203.47.102.32/27!);
$allowed->add_string(q!127.0.0.0/8!);

#   Split the message up into header and body portions
#
undef $/;
my ($message) = <>;
my ($headers, $body) = split(/\n\n/, $message, 2);
my (@headers) = (split(/\n/, $headers));

#   Step through each line in the header portion of the email and
#   extract the To, From and Subject header lines (for readdressing
#   the email to the real receipient of the mail alias)
#
my (%headers);
foreach my $header (@headers) {
    my ($prefix);
    ($prefix, $headers{q/To/}) = split(/: /, $header) if ($header =~ m/^To:/);
    ($prefix, $headers{q/From/}) = split(/: /, $header) if ($header =~ m/^From:/);
    ($prefix, $headers{q/Subject/}) = split(/: /, $header) if ($header =~ m/^Subject:/);

    #   Extract the IP address of only the originating host in the
    #   list of received-from hosts
    #
    unless (defined($headers{q/Received/})) {
        ($headers{q/Received/}) = $1 if ($header =~ m/^Received:.+\[(/\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/)\]/);
    }
}

#   Exit silently if the IP address of the originating host is not
#   in the list of allowed IP subnet ranges
#
exit 0 unless (defined($headers{q/Received/}));
exit 0 unless (defined($allowed->match_string($headers{q/Received/})));

.
.

#   Code to handle the IP-vetted mail follows here - The sender's
#   email address, mail alias address and email subject are all
#   stored in the %headers hash - An example of this delivery will
#   follow.

exit 0;

##</code><code>##

customers:      |/isp/bin/mail/mail.customers.perl

##</code><code>##

2a3,4
> use DBI;
> use Mail::Mailer;
3a6
> use Net::SMTP;
5a9,17
> my (%db) = (
>     'database'  =>  'isp',
>     'username'  =>  'mailinglist',
>     'password'  =>  'password',
>     'hostname'  =>  'db.mydomain.com',
> );
>
> my ($dsn) = "DBI:Pg:dbname=$db{'database'};host=$db{'hostname'}";
>
49a62,82
>
> my ($dbh);
> unless ($dbh = DBI->connect($dsn, $db{q/username/}, $db{q/password/})) {
>     print STDERR qq/Cannot connect to data source $dsn - $!\n/;
>     exit 1;
> }
> my $users = $dbh->prepare(qq/SELECT mail.email, customers.firstname, customers.lastname FROM mail, accounts, customers WHERE accounts.terminationdate = NULL AND customers.activated = 'Y' AND ((mail.id = accounts.id) AND (accounts.customerid = customers.id)) ORDER BY mail.id/);
> $users->execute;
> while (my ($email, $firstname, $lastname) = $users->fetchrow_array) {
>     my ($mail) = Mail::Mailer->new(qq/smtp/, Server => qq/localhost/);
>     my (%output) = (
>         'To'        =>  qq/$email ($firstname $lastname)/,
>         'From'      =>  qq/$headers{q!From!}/,
>         'Subject'   =>  qq/$headers{q!Subject!}/
>     );
>     $mail->open(\%output);
>     print $mail $body;
>     $mail->close;
> }
> $users->finish;
> $dbh->disconnect;