As part of my business, I often am required to send mail to all of my customers updating them of system upgrades and hardware outages. This originally was carried out via an ever-expanding mail alias on the mail server which became quite unweilding before long to say the very least. In addition to this, there was the aspect of security and privacy in that I most certainly did not want just anybody sending mail to my customers - As such, each time I wanted to send my all customers a notice via email, I would have to connect to the mail server, update the mail alias, send the email and then subsequently disable the alias after delivery. This was becoming a quite labourious task given an expanding customer base.

The solution came about through the use of Perl and expansion of the customers@mydomain.com Sendmail alias to a command via the pipe symbol (|) - See man 5 aliases

The Perl code that I put together and an explanation of its operation follows:

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

The mail alias in the Sendmail aliases file would look similar to this:

customers:      |/isp/bin/mail/mail.customers.perl
[download]

The result is that this code basically steps through the headers of the email delivered to the mail alias and extracts the originating hosts' IP address, checks it against the list of allowed IP address ranges and delivers or discards the mail accordingly. Now this approach has worked to date, but of course there is still much which can be done, including:

• Delivery failure notification with mail of delivery rejection returned to the sender
• Matching of IP address against a 'hop count' to ensure that the mail has been delivered from the 'real' host with the matching IP address - Although this count would be susceptible to change if mail was delayed or relayed through alternate exchangers.
• Capture and forwarding of additional mail header information such as X-Mailer, X-Priority and Content-Type - Currently HTML email is not correctly forwarded as the Content-Type header is being ignored

With my scenario where I had an ever expanding customer list, I expanded this code to generate a list of email addresses to deliver the IP-vetted mail to from the local PostgreSQL database. To achieve this, I used the DBI module in conjunction with the Mail::Mailer (and Net::SMTP for mail delivery via SMTP) to pull a list of email addresses (and for politeness, customer names) from the database for delivery. The diff-patch (diff - GNU diffutils version 2.7) for this code (against that above) is given below and shows how the IP-vetted email can subsequently be delivered to other mail receipients.

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.ter
+minationdate = NULL AND customers.activated = 'Y' AND ((mail.id = acc
+ounts.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;
[download]

Well, that's about it - I hope it all makes sense ... I don't know how cool it is, but it is practical and could possibly be a starting point for something much more powerful.

Ooohhh, Rob no beer function well without!