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