I spent some time today implementing a Unified SPF postfix
policy daemon. It follows the AGUPI model described at
http://spf.pobox.com/aspen/email-future-1.png
I have it currently set to reject, by default, all mail that
doesn't pass both authentication and policy tests.
http://spf.pobox.com/slides/unified%20spf/0335.html
Right now it only supports spf/PTR, spf/HELO, and
spf/MAILFROM authentication methods. In the future I hope
to add the following authentication methods:
spf/SUBMITTER
spf/PRA
CSV
SPF Lite
PGP
S/MIME
Domain Keys
and any other cryptographic systems
Under my implementation of the Unified model,
First, all the known identities are tested in search of a
positive result. (A positive result requires that both
authentication and policy tests pass.) If the policy test
passes, that means "the purported sender is known not to be
a spammer domain"; if the authentication test also passes,
that means "the sender really is from that domain."
Second, we scan the identities for a policy failure, which
triggers an instant rejection. A policy failure means "this
is known to be a spammer domain."
Third, any authentication FAILs that occur are respected.
Finally, the default disposition applies. The default
disposition can be (under AGUPI) to simply reject all mail
by default if it doesn't meet the twin requirements of
authentication and policy. Or we can subject messages to
additional content filtering.
Right now the inputs to the policy test are:
Does rating.cloudmark.com like the domain? --> PASS
Have I sent mail to the domain before? --> PASS
Is it listed on an RHSBL? --> FAIL
I expect to add other policy tests soon, such as:
Does Gossip like the domain? --> PASS
Has anybody I know (LOAF) sent mail to it? --> PASS
Is it accredited on ISIPP's IADB? --> PASS
Is it accredited by Bonded Sender? --> PASS
Is it listed on the VDL? --> PASS
Is it listed on the Habeas whitelist? --> PASS
Cloudmark: http://rating.cloudmark.com/senderid/
Gossip: http://www.sufficiently-advanced.net/
LOAF: http://loaf.cantbedone.org/
VDL: http://www.verisign.com/printablePages/page_012782.html
Habeas: http://www.bondedsender.com/
Bonded Sender: http://www.bondedsender.com/
ISIPP IADB: http://www.isipp.org/iadb.php
Many small domains are not listed on rating.cloudmark.com.
To remedy this, I have extracted my "addressbook" --- I have
built a list of all the email addresses I have sent mail to.
If we assume that anyone I have sent mail to, I also will
read mail from, that list constitutes a useful local
reputation service for me.
I constructed that list using the following code:
20040909-21:39:12 mengwong(_at_)dumbo:~/Mail% cat *(.) | formail -s procmail
-m ~/.procmailrc-people-ive-mailed
20040909-21:48:09 mengwong(_at_)dumbo:~/Mail% cat
~/.procmailrc-people-ive-mailed
:0
* ! $ ^From:.*$LOGNAME
/dev/null
:0i
|/usr/bin/formail -c -x "To:" -x "CC:" >> /var/tmp/addressbook/procmail-tos
20040909-22:00:13 mengwong(_at_)dumbo:~/Mail% perl -MMail::Address -nle 'my
@addresses = eval { Mail::Address->parse($_) } or next; foreach my $address
(@addresses) { my ($localpart, $domain) = split /\@/, $address->address;
$all{lc $domain}{lc $localpart}++; } } { foreach my $domain (keys %all) { my
$sum = 0; foreach my $localpart (keys %{ $all{$domain} }) { $sum+=
$all{$domain}{$localpart}; } printf "%6d %20s %s\n", $sum, $domain, join " ",
keys %{$all{$domain}}; }' < /var/tmp/addressbook/procmail-tos | sort -n >
/var/tmp/addressbook/procmail-tos-counted
here are some of the results:
20040909-22:02:07 mengwong(_at_)dumbo:~/Mail% wc -l
/var/tmp/addressbook/procmail-tos-counted
1346 /var/tmp/addressbook/procmail-tos-counted
20040909-22:02:40 mengwong(_at_)dumbo:~/Mail% (head
/var/tmp/addressbook/procmail-tos-counted; tail
/var/tmp/addressbook/procmail-tos-counted ) | awk '{ print $1, $2 }'
1 babe
1 dolly
1 em.ca
1 snarf
1 analog
1 c2.com
1 gmx.de
1 hjp.at
1 hut.fi
1 mat.cc
280 arh.com.sg
293 yahoo.com
365 icewall.net
398 shock.pobox.com
479 down.net
826 icgroup.com
1102 dumbo.pobox.com
2474 pobox.com
3890 v2.listbox.com
4399 listbox.com
20040909-22:03:04 mengwong(_at_)dumbo:~/Mail%
Obviously the list needs to be pruned of non-FQDN, expired,
or nonexistent domains, but that can be done trivially.
When Wayne mailed me at mengwong(_at_)spf(_dot_)pobox(_dot_)com, I got the
message, with this added header:
X-SPF: agupimail approved of authenticated sender (dumbo.pobox.com: domain
of midwestcs.com designates 206.222.212.234 as permitted sender; midwestcs.com
found in dnswl.mengwong.com)
This means that I can treat mail to mengwong(_at_)spf(_dot_)pobox(_dot_)com
as "first-class", because I'm pretty confident spam won't
get through --- however, strangers may not be able to send
me mail at that address.
The policy daemon plugin follows. It is very very alpha.
#!/usr/bin/perl -sw-
# mengwong(_at_)spf(_dot_)pobox(_dot_)com
# version 1.00, 20040909-2236
# see http://spf.pobox.com/
use Socket;
use Fcntl;
use Sys::Syslog qw(:DEFAULT setlogsock);
use strict;
use vars qw($use_prepend);
# ----------------------------------------------------------
# configuration
# ----------------------------------------------------------
# to use SPF, install Mail::SPF::Query from CPAN or from the SPF website at
http://spf.pobox.com/downloads.html
my @HANDLERS;
push @HANDLERS, "testing";
push @HANDLERS, "aspen";
my %AGUPI_DOMAINS = ( "spf.pobox.com" => 1 );
my @IDENTITIES = qw(ptr helo sender); # ip
my @IP_BLACKLISTS = qw(bl.spamcop.net cbl.abuseat.org dnsbl.njabl.org
dnsbl.sorbs.net dynablock.njabl.org list.dsbl.org sbl.spamhaus.org);
my @IP_WHITELISTS = qw(wl.trusted-forwarder.org);
my @RHS_WHITELISTS = qw(wl.trusted-forwarder.org dnswl.mengwong.com);
my @RHS_BLACKLISTS = qw(bulk.rhs.mailpolice.com rhsbl.ahbl.org);
my $VERBOSE = 1;
my $DEFAULT_RESPONSE = "DUNNO";
#
# Syslogging options for verbose mode and for fatal errors.
# NOTE: comment out the $syslog_socktype line if syslogging does not
# work on your system.
#
my $syslog_socktype = 'unix'; # inet, unix, stream, console
my $syslog_facility = "mail";
my $syslog_options = "pid";
my $syslog_priority = "info";
my $syslog_ident = "postfix/agupimail";
# ----------------------------------------------------------
# minimal documentation
# ----------------------------------------------------------
# ----------------------------------------------------------
# initialization
# ----------------------------------------------------------
#
# Log an error and abort.
#
sub fatal_exit {
syslog(err => "fatal_exit: @_");
syslog(warning => "fatal_exit: @_");
syslog(info => "fatal_exit: @_");
die "fatal: @_";
}
#
# Unbuffer standard output.
#
select((select(STDOUT), $| = 1)[0]);
#
# This process runs as a daemon, so it can't log to a terminal. Use
# syslog so that people can actually see our messages.
#
setlogsock $syslog_socktype;
openlog $syslog_ident, $syslog_options, $syslog_facility;
# ----------------------------------------------------------
# main
# ----------------------------------------------------------
#
# Receive a bunch of attributes, evaluate the policy, send the result.
#
my %attr;
while (<STDIN>) {
chomp;
if (/=/) { my ($k, $v) = split (/=/, $_, 2); $attr{$k} = $v; next }
elsif (length) { syslog(warning=>sprintf("warning: ignoring garbage: %.100s",
$_)); next; }
if ($VERBOSE and $AGUPI_DOMAINS{lc domain_part($attr{recipient})}) {
for (sort keys %attr) {
syslog(debug=> "Attribute: %s=%s", $_, $attr{$_});
}
}
fatal_exit ("unrecognized request type: '$attr{request}'") unless
$attr{request} eq "smtpd_access_policy";
my $action = $DEFAULT_RESPONSE;
my %responses;
foreach my $handler (@HANDLERS) {
no strict 'refs';
my $response = $handler->(attr=>\%attr);
# syslog(debug=> "handler %s: %s", $handler, $response);
if ($response and $response !~ /^dunno/i) {
# syslog(info=> "agupimail handler %s: %s is decisive.", $handler,
$response);
$action = $response; last;
}
}
syslog(info=> "agupimail overall: decided action=%s", $action) if
$AGUPI_DOMAINS{lc domain_part($attr{recipient})};
print STDOUT "action=$action\n\n";
%attr = ();
}
# ---------------------------------------------------------- plugin: aspen
sub aspen {
# ---------------------------------------------------------- accept a message
if it passes authentication and policy tests.
local %_ = @_;
my %attr = %{ $_{attr} };
if (not $AGUPI_DOMAINS{lc domain_part($attr{recipient})}) {
syslog(info=>"agupimail declining to handle recipient=$attr{recipient}
because not in agupi domains.");
return "DUNNO";
}
my %identity_results; # ( helo => { auth => "pass", policy => "fail", ... },
... )
# in first pass, search for a positive result among all the identities.
# if a positive result is not found, preserve the result for the second pass.
foreach my $identity (@IDENTITIES) {
my $identity_value = ( $identity eq "ptr" ? $attr{client_name}
: $identity eq "helo" ? $attr{helo_name}
: $identity eq "sender" ? $attr{sender}
: $identity eq "ip" ? $attr{client_address}
: ""
);
# todo: add SUBMITTER
my ($policy_result, $policy_reason) = policy_status(@_,
identity=>$identity, identity_value => $identity_value);
syslog(info=>"agupimail policy_status for $identity identity
$identity_value returned $policy_result: $policy_reason");
syslog(info=>"agupimail now going to look for auth_status...");
my ($auth_result, $auth_reason) = ($policy_result eq "FAIL"
? ("unchecked", "auth status not checked
because $identity failed policy tests")
: auth_status(@_, identity=>$identity,
identity_value => $identity_value));
syslog(info=>"agupimail auth_result for $identity identity $identity_value
is $auth_result");
return "PREPEND X-SPF: agupimail approved of authenticated sender
($auth_reason; $policy_reason)" if $auth_result eq "PASS" and $policy_result eq
"PASS";
$identity_results{$identity}->{auth_result} = $auth_result;
$identity_results{$identity}->{auth_reason} = $auth_reason;
$identity_results{$identity}->{policy_result} = $policy_result;
$identity_results{$identity}->{policy_reason} = $policy_reason;
}
# in the second pass, reject if we find a policy fail.
foreach my $identity (@IDENTITIES) {
if ($identity_results{$identity}->{policy_result} eq "FAIL") {
return "REJECT agupimail observed policy failure for $identity:
$identity_results{$identity}->{policy_reason}";
}
}
# in the third pass, reject if we find an authentication fail.
foreach my $identity (@IDENTITIES) {
if ($identity_results{$identity}->{auth_result} eq "FAIL") {
return "REJECT agupimail observed authentication failure for $identity:
$identity_results{$identity}->{auth_reason}";
}
}
# if any of the identities has an authentication tempError, return 450.
foreach my $identity (@IDENTITIES) {
if ($identity_results{$identity}->{auth_result} =~
/^(4\d\d|temperror|error)/i) {
return "450 agupimail encountered transient error during authentication
of $identity: $identity_results{$identity}->{auth_reason}";
}
}
# if none of the identities passed the policy test, reject with a friendly
message.
my @policy_passed_identities = grep { $identity_results{$_}->{policy_result}
eq "PASS" } @IDENTITIES;
if (not @policy_passed_identities) {
return "REJECT agupimail recognized your @policy_passed_identities, but was
unable to authenticate you because your mail was not transmitted over an
authenticated channel. Please consider publishing an SPF record for those
identities.";
# TODO: in the future, defer this rejection until we've had a chance to
examine the message body for a crypto sig.
}
# if we're here, then at least one of the identities passed authentication,
but we had no policy result for that identity.
# if none of the identities passed authentication, reject.
my @auth_passed_identities = grep { $identity_results{$_}->{auth_result} eq
"PASS" } @IDENTITIES;
if (not @auth_passed_identities) {
return "REJECT agupimail was unable to authenticate the sender. Please
send mail using an authenticated channel.";
# TODO: in the future, defer this rejection until we've had a chance to
examine the message body for a crypto sig.
}
# to enable greylisting, don't do this rejection here.
return "REJECT Sorry, agupimail requires that your message be sent through an
authenticated channel, and that the sender be recognized by the receiving
system.";
# if we're here, then at least one of the identities passed authentication,
but we had no policy result for that identity.
# what do we do? we greylist.
my ($greylist_result, $greylist_reason) = greylist_status(@_);
if ($greylist_result eq "PASS") {
return "PREPEND X-SPF: Sender authentication passed for
@auth_passed_identities; policy engine had no opinion; greylisting passed.";
}
else {
return "450 Sender authentication passed for @auth_passed_identities;
policy engine had no opinion; greylisting asks that you try back later.";
}
}
# ---------------------------------------------------------- greylist_status
sub greylist_status {
# ----------------------------------------------------------
local %_ = @_;
my %attr = %{ $_{attr} };
return "PASS";
}
# ---------------------------------------------------------- plugin: testing
sub testing {
# ----------------------------------------------------------
local %_ = @_;
my %attr = %{ $_{attr} };
if (not $AGUPI_DOMAINS{lc domain_part($attr{recipient})}) {
return "DUNNO";
}
if (lc address_stripped($attr{sender}) eq
lc address_stripped($attr{recipient})
and
$attr{recipient} =~ /policyblock/) {
syslog(info=>"testing: will block as requested");
return "REJECT smtpd-policy blocking $attr{recipient}";
}
else {
syslog(info=>"testing: stripped sender=%s, stripped rcpt=%s",
address_stripped($attr{sender}),
address_stripped($attr{recipient}),
);
}
return "DUNNO";
}
# ---------------------------------------------------------- procedure:
auth_status
sub auth_status {
# ----------------------------------------------------------
local %_ = @_;
my %attr = %{ $_{attr} };
my $identity = $_{identity};
my $identity_value = $_{identity_value};
use Mail::SPF::Query;
my ($auth_result, $auth_reason) = ("UNKNOWN", "default auth result for
unrecognized identity");
if ($identity eq "helo") { ($auth_result, $auth_reason) =
helo_status(@_); }
if ($identity eq "ptr") { ($auth_result, $auth_reason) =
ptr_status(@_); }
if ($identity eq "sender") { ($auth_result, $auth_reason) =
mailfrom_status(@_); }
# todo: add identity eq submitter
# identity=ip always returns unknown
return ($auth_result, $auth_reason);
}
# request=smtpd_access_policy
# protocol_state=RCPT
# protocol_name=SMTP
# helo_name=some.domain.tld
# queue_id=8045F2AB23
# sender=foo(_at_)bar(_dot_)tld
# recipient=bar(_at_)foo(_dot_)tld
# client_address=1.2.3.4
# client_name=another.domain.tld
# [empty line]
# ---------------------------------------------------------- procedure:
ptr_status
sub ptr_status {
# ---------------------------------------------------------- check spf/PTR
local %_ = @_;
my %attr = %{ $_{attr} };
syslog(debug=>"%s: ptr_status: testing $attr{client_name}");
if ($attr{client_name} eq "unknown" or not $attr{client_name}) { return
"UNKNOWN", "no PTR record found" }
my $query = eval { new Mail::SPF::Query (ip =>$attr{client_address},
sender=>$attr{client_name},
) };
if ($@) {
syslog(info=>"ptr_status: Mail::SPF::Query->new(%s, %s) failed: %s",
$attr{client_address}, $attr{client_name}, $@);
return "error", "$@";
}
my ($result, $smtp_comment, $header_comment) = $query->result();
syslog(info=>"%s: spf/PTR smtp_comment=%s, header_comment=%s", $result,
$smtp_comment, $header_comment);
if ($result eq "fail") { return "FAIL", $smtp_comment || $header_comment;
}
elsif ($result eq "error") { return "ERROR", "temporary failure:
$smtp_comment"; }
elsif ($result eq "pass") { return "PASS", "$header_comment"; }
else { return "UNKNOWN", "$header_comment"; }
}
# ---------------------------------------------------------- procedure:
helo_status
sub helo_status {
# ---------------------------------------------------------- check spf/HELO and
CSV and SPF Lite
local %_ = @_;
my %attr = %{ $_{attr} };
my $query = eval { new Mail::SPF::Query (ip =>$attr{client_address},
sender=>$attr{helo_name},
) };
if ($@) {
syslog(info=>"Mail::SPF::Query->new(%s, %s, %s) failed: %s",
$attr{client_address}, $attr{helo_name}, $attr{helo_name}, $@);
return "error", "$@";
}
my ($result, $smtp_comment, $header_comment) = $query->result();
syslog(info=>"%s: spf/HELO smtp_comment=%s, header_comment=%s", $result,
$smtp_comment, $header_comment);
if ($result eq "fail") { return "FAIL", $smtp_comment || $header_comment;
}
elsif ($result eq "error") { return "ERROR", "temporary failure:
$smtp_comment"; }
elsif ($result eq "pass") { return "PASS", "$header_comment"; }
else { return "UNKNOWN", "$header_comment"; }
}
# ---------------------------------------------------------- procedure:
mailfrom_status
sub mailfrom_status {
# ---------------------------------------------------------- check spf/MAILFROM
for spfv1 and spfv2
local %_ = @_;
my %attr = %{ $_{attr} };
my $query = eval { new Mail::SPF::Query (ip =>$attr{client_address},
sender=>$attr{sender},
helo =>$attr{helo_name},
guess => 0,
fallback => { "yahoo.com" => {
record => "v=spf1 ptr -all" }, },
) };
if ($@) {
syslog(info=>"Mail::SPF::Query->new(%s, %s, %s) failed: %s",
$attr{client_address}, $attr{helo_name}, $attr{helo_name}, $@);
return "error", "$@";
}
my ($result, $smtp_comment, $header_comment) = $query->result();
syslog(info=>"%s: spf/MAILFROM smtp_comment=%s, header_comment=%s", $result,
$smtp_comment, $header_comment);
if ($result eq "fail") { return "FAIL", $smtp_comment || $header_comment;
}
elsif ($result eq "error") { return "ERROR", "temporary failure:
$smtp_comment"; }
elsif ($result eq "pass") { return "PASS", "$header_comment"; }
my ($guess_result, $guess_smtp_comment, $guess_header_comment) =
$query->best_guess();
syslog(info=>"%s: spf/MAILFROM(guess) smtp_comment=%s, header_comment=%s"
, $guess_result, $guess_smtp_comment, $guess_header_comment);
if ($result eq "pass") { return "PASS", "$guess_header_comment"; }
return "UNKNOWN", "$header_comment";
}
# ---------------------------------------------------------- procedure:
policy_status
sub policy_status {
# ---------------------------------------------------------- check multiple
reputation and accreditation systems
local %_ = @_;
my %attr = %{ $_{attr} };
my $identity = $_{identity};
my $identity_value = $_{identity_value};
my ($policy_result, $policy_reason) = ("UNKNOWN", "default policy result for
unrecognized identity");
if (not $identity_value or $identity_value eq "unknown") { return "UNKNOWN",
"identity $identity was not defined" }
my @policy_tests;
if ($identity eq "ip") { @policy_tests = qw(local_ip ip_query); }
else { @policy_tests = qw(local_rhs karma_query); }
foreach my $policy_test (@policy_tests) {
no strict 'refs';
($policy_result, $policy_reason) = $policy_test->(@_);
last if ($policy_result ne "UNKNOWN");
}
return ($policy_result, $policy_reason);
}
# ---------------------------------------------------------- procedure: local_ip
sub local_ip {
# ---------------------------------------------------------- whitelist by IP
local %_ = @_;
my %attr = %{ $_{attr} };
my $identity = $_{identity};
my $identity_value = $_{identity_value};
# if ($identity_value eq "209.2.32.36") { return "PASS", "newbabe's IP is
explicitly whitelisted in local_ip" }
return "UNKNOWN", "local_ip had no opinion";
}
# ---------------------------------------------------------- procedure:
local_rhs
sub local_rhs {
# ---------------------------------------------------------- whitelist by IP
local %_ = @_;
my %attr = %{ $_{attr} };
my $identity = $_{identity};
my $identity_value = $_{identity_value};
# if ($identity_value =~ /\bmengwong.com$/) { return "PASS", "all hostnames
under mengwong.com are locally whitelisted" }
return "UNKNOWN", "local_rhs had no opinion";
}
# ---------------------------------------------------------- procedure:
karma_query
sub karma_query {
# ---------------------------------------------------------- check the
reputation of a hostname using multiple means
local %_ = @_;
my %attr = %{ $_{attr} };
my $identity = $_{identity};
my $identity_value = $_{identity_value};
for my $cloudmark_rating (qw(rating.cloudmark.com)) {
my $hostname_to_query = join(".", domain_part($identity_value),
$cloudmark_rating);
syslog(info=>"karma_query($identity:$identity_value): querying
$hostname_to_query...");
my ($name,$aliases,$addrtype,$length,@addrs) = eval {
gethostbyname($hostname_to_query); };
if ($@) { return "ERROR", "DNS error while looking up $hostname_to_query:
$@" }
if (grep { $_ eq "127.1.100.100" } @addrs) { return "PASS",
"$identity_value found in $cloudmark_rating"; }
}
for my $rhs_list (@RHS_WHITELISTS) {
my $hostname_to_query = join(".", domain_part($identity_value), $rhs_list);
syslog(info=>"karma_query($identity:$identity_value): querying
$hostname_to_query...");
my ($name,$aliases,$addrtype,$length,@addrs) = eval {
gethostbyname($hostname_to_query); };
if ($@) { return "ERROR", "DNS error while looking up $hostname_to_query:
$@" }
if (@addrs) { return "PASS", "$identity_value found in $rhs_list"; }
}
for my $rhs_list (@RHS_BLACKLISTS) {
my $hostname_to_query = join(".", domain_part($identity_value), $rhs_list);
syslog(info=>"karma_query($identity:$identity_value): querying
$hostname_to_query...");
my ($name,$aliases,$addrtype,$length,@addrs) = eval {
gethostbyname($hostname_to_query); };
if ($@) { return "ERROR", "DNS error while looking up $hostname_to_query:
$@" }
if (@addrs) { return "FAIL", "$identity_value found in $rhs_list"; }
}
return "UNKNOWN", "no result from the karma system.";
}
# ---------------------------------------------------------- procedure: ip_query
sub ip_query {
# ---------------------------------------------------------- check the
reputation of an IP address
local %_ = @_;
my %attr = %{ $_{attr} };
my $identity = $_{identity};
my $identity_value = $_{identity_value};
foreach my $ip_list (@IP_WHITELISTS) {
my $hostname_to_query = join(".", (reverse split /\./, $identity_value),
$ip_list);
syslog(info=>"karma_query($identity:$identity_value): querying
$ip_list...");
my ($name,$aliases,$addrtype,$length,@addrs) = eval {
gethostbyname($hostname_to_query); };
if ($@) { return "ERROR", "DNS error while looking up $hostname_to_query:
$@" }
if (@addrs) { return "PASS", "$identity_value found in $ip_list"; }
}
foreach my $ip_list (@IP_BLACKLISTS) {
my $hostname_to_query = join(".", (reverse split /\./, $identity_value),
$ip_list);
syslog(info=>"karma_query($identity:$identity_value): querying
$ip_list...");
my ($name,$aliases,$addrtype,$length,@addrs) = eval {
gethostbyname($hostname_to_query); };
if ($@) { return "ERROR", "DNS error while looking up $hostname_to_query:
$@" }
if (@addrs) { return "FAIL", "$identity_value found in $ip_list"; }
}
return "UNKNOWN", "ip_query had no opinion.";
}
# ----------------------------------------------------------
# utility functions
# ----------------------------------------------------------
sub address_stripped {
# my $foo = address_stripped('foo+bar(_at_)baz(_dot_)com'); # returns
'foo(_at_)baz(_dot_)com'
my $string = shift;
for ($string) {
s/[+-].*\@/\@/;
}
return $string;
}
sub domain_part {
# my $foo = domain_part('foo+bar(_at_)baz(_dot_)com'); # returns 'baz.com'
my $string = shift;
for ($string) {
s/.*\@//;
}
return $string;
}
