postfix-policyd-spf-perl/postfix-policyd-spf-perl.in

469 lines
15 KiB
Perl
Executable file

#!/usr/bin/perl
# postfix-policyd-spf-perl
# https://launchpad.net/postfix-policyd-spf-perl
# http://www.openspf.org/Software
# version 2.011
#
# (C) 2007-2008,2012,2018 Scott Kitterman <scott@kitterman.com>
# (C) 2018 Scott Savarese <https://launchpad.net/~scottsavarese>
# (C) 2012 Allison Randal <allison@perl.org>
# (C) 2007 Julian Mehnle <julian@mehnle.net>
# (C) 2003-2004 Meng Weng Wong <mengwong@pobox.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use version; our $VERSION = qv('2.011');
use strict;
use IO::Handle;
use Sys::Syslog qw(:DEFAULT setlogsock);
use NetAddr::IP;
use Mail::SPF;
use Sys::Hostname::Long 'hostname_long';
# ----------------------------------------------------------
# configuration
# ----------------------------------------------------------
my $resolver = Net::DNS::Resolver->new(
retrans => 5, # Net::DNS::Resolver default: 5
retry => 2, # Net::DNS::Resolver default: 4
# Makes for a total timeout for UDP queries of 5s * 2 = 10s.
);
# query_rr_type_all will query both type TXT and type SPF. This upstream
# default is changed due to there being essentiall no type SPF deployment.
my $spf_server = Mail::SPF::Server->new(
dns_resolver => $resolver,
query_rr_types => Mail::SPF::Server->query_rr_type_txt,
default_authority_explanation =>
'Please see http://www.openspf.net/Why?s=%{_scope};id=%{S};ip=%{C};r=%{R}'
);
# Adding more handlers is easy:
my @HANDLERS = (
{
name => 'exempt_localhost',
code => \&exempt_localhost
},
{
name => 'exempt_relay',
code => \&exempt_relay
},
{
name => 'exempt_domains',
code => \&exempt_domains
},
{
name => 'sender_policy_framework',
code => \&sender_policy_framework
}
);
my $VERBOSE = 0;
my $DEFAULT_RESPONSE = 'DUNNO';
# Read in exemption lists
my $exempt_domains = get_exempt_domains( "@@CDIR@@/exempt_spf_domains" );
my $relay_addresses = get_exempt_address("@@CDIR@@/exempt_spf_addresses");
#
# 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_ident = 'postfix/policy-spf';
use constant localhost_addresses => map(
NetAddr::IP->new($_),
qw( 127.0.0.0/8 ::ffff:127.0.0.0/104 ::1 )
); # Does Postfix ever say "client_address=::ffff:<ipv4-address>"?
# Fully qualified hostname, if available, for use in authentication results
# headers now provided by the localhost and whitelist checks.
my $host = hostname_long;
my %results_cache; # by message instance
# ----------------------------------------------------------
# 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.
#
STDOUT->autoflush(1);
#
# 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 ($key, $value) =split (/=/, $_, 2);
$attr{$key} = $value;
next;
}
elsif (length) {
syslog(warning => sprintf("warning: ignoring garbage: %.100s", $_));
next;
}
if ($VERBOSE) {
for (sort keys %attr) {
syslog(debug => "Attribute: %s=%s", $_ || '<UNKNOWN>', $attr{$_} || '<UNKNOWN>');
}
};
my $message_instance = $attr{instance};
my $cache = defined($message_instance) ? $results_cache{$message_instance} ||= {} : {};
my $action = $DEFAULT_RESPONSE;
foreach my $handler (@HANDLERS) {
my $handler_name = $handler->{name};
my $handler_code = $handler->{code};
my $response = $handler_code->(attr => \%attr, cache => $cache);
if ($VERBOSE) {
syslog(debug => "handler %s: %s", $handler_name || '<UNKNOWN>', $response || '<UNKNOWN>');
};
# Pick whatever response is not 'DUNNO'
if ($response and $response !~ /^DUNNO/i) {
if ($VERBOSE) {
syslog(info => "handler %s: is decisive.", $handler_name || '<UNKNOWN>');
}
$action = $response;
last;
}
}
syslog(info => "Policy action=%s", $action || '<UNKNOWN>');
STDOUT->print("action=$action\n\n");
%attr = ();
}
# ----------------------------------------------------------
# handler: domain exemption
# ----------------------------------------------------------
sub get_exempt_domains {
my ( $file ) = @_;
my $list = {};
# Return nothing if file not found
if ( ! -r $file ) {
return $list;
}
# Read the file into one variable, split on space or comma (or all)
open ( FILE, $file ) or die "Can't open $file: $!\n";
my $text = "";
while ( my $tmp = <FILE> ) {
$text .= $tmp;
}
close( FILE );
foreach my $domain ( split( /[\s,]+/, $text ) ) {
$list->{$domain} = 1;
}
return $list;
}
sub exempt_domains {
my %options = @_;
my $attr = $options{attr};
my $domain = ( split( /\@/, $attr->{sender} ) )[1];
return 'DUNNO' if ( ( ! defined( $domain ) ) or ( $domain eq '' ) );
# Check the domain against our list of ignored domains
if ( defined( $exempt_domains->{$domain} ) ) {
return "PREPEND Authentication-Results: $host; none " .
"(SPF exempted by policy)";
}
return 'DUNNO';
}
# ----------------------------------------------------------
# handler: localhost exemption
# ----------------------------------------------------------
sub exempt_localhost {
my %options = @_;
my $attr = $options{attr};
if ($attr->{client_address} ne '') {
my $client_address = NetAddr::IP->new($attr->{client_address});
return "PREPEND Authentication-Results: $host; none (SPF not checked for localhost)"
if grep($_->contains($client_address), localhost_addresses);
};
return 'DUNNO';
}
# ----------------------------------------------------------
# handler: relay exemption
# ----------------------------------------------------------
sub get_exempt_address {
my ( $file ) = @_;
my $list = [];
# Return nothing if file not found
if ( ! -r $file ) {
return $list;
}
# Read the file into one variable, split on space or comma (or all)
open ( FILE, $file ) or die "Can't open $file: $!\n";
my $text = "";
while ( my $tmp = <FILE> ) {
$text .= $tmp;
}
close( FILE );
foreach my $addr ( split( /[\s,]+/, $text ) ) {
push( @$list, NetAddr::IP->new($addr) );
}
return $list;
}
sub exempt_relay {
my %options = @_;
my $attr = $options{attr};
if ($attr->{client_address} ne '') {
my $client_address = NetAddr::IP->new($attr->{client_address});
return "PREPEND Authentication-Results: $host; none (SPF not checked for whitelisted relay)"
if grep($_->contains($client_address), @$relay_addresses);
};
return 'DUNNO';
}
# ----------------------------------------------------------
# handler: SPF
# ----------------------------------------------------------
sub sender_policy_framework {
my %options = @_;
my $attr = $options{attr};
my $cache = $options{cache};
# -------------------------------------------------------------------------
# Always do HELO check first. If no HELO policy, it's only one lookup.
# This avoids the need to do any MAIL FROM processing for null sender.
# -------------------------------------------------------------------------
my $helo_result = $cache->{helo_result};
if (not defined($helo_result)) {
# No HELO result has been cached from earlier checks on this message.
my $helo_request = eval {
Mail::SPF::Request->new(
scope => 'helo',
identity => $attr->{helo_name},
ip_address => $attr->{client_address}
);
};
if ($@) {
# An unexpected error occurred during request creation,
# probably due to invalid input data!
my $errmsg = $@;
$errmsg = $errmsg->text if UNIVERSAL::isa($@, 'Mail::SPF::Exception');
if ($VERBOSE) {
syslog(
info => "HELO check failed - Mail::SPF->new(%s, %s, %s) failed: %s",
$attr->{client_address} || '<UNKNOWN>',
$attr->{sender} || '<UNKNOWN>', $attr->{helo_name} || '<UNKNOWN>',
$errmsg || '<UNKNOWN>'
);
};
return;
}
$helo_result = $cache->{helo_result} = $spf_server->process($helo_request);
}
my $helo_result_code = $helo_result->code; # 'pass', 'fail', etc.
my $helo_local_exp = nullchomp($helo_result->local_explanation);
my $helo_authority_exp = nullchomp($helo_result->authority_explanation)
if $helo_result->is_code('fail');
my $helo_spf_header = $helo_result->received_spf_header;
if ($VERBOSE) {
syslog(
info => "SPF %s: HELO/EHLO: %s, IP Address: %s, Recipient: %s",
$helo_result || '<UNKNOWN>',
$attr->{helo_name} || '<UNKNOWN>', $attr->{client_address} || '<UNKNOWN>',
$attr->{recipient} || '<UNKNOWN>'
);
};
# Reject on HELO fail. Defer on HELO temperror if message would otherwise
# be accepted. Use the HELO result and return for null sender.
if ($helo_result->is_code('fail')) {
if ($VERBOSE) {
syslog(
info => "SPF %s: HELO/EHLO: %s",
$helo_result || '<UNKNOWN>',
$attr->{helo_name} || '<UNKNOWN>'
);
};
return "550 $helo_authority_exp";
}
elsif ($helo_result->is_code('temperror')) {
if ($VERBOSE) {
syslog(
info => "SPF %s: HELO/EHLO: %s",
$helo_result || '<UNKNOWN>',
$attr->{helo_name} || '<UNKNOWN>'
);
};
return "DEFER_IF_PERMIT SPF-Result=$helo_local_exp";
}
elsif ($attr->{sender} eq '') {
if ($VERBOSE) {
syslog(
info => "SPF %s: HELO/EHLO (Null Sender): %s",
$helo_result || '<UNKNOWN>',
$attr->{helo_name} || '<UNKNOWN>'
);
};
return "PREPEND $helo_spf_header"
unless $cache->{added_spf_header}++;
}
# -------------------------------------------------------------------------
# Do MAIL FROM check (as HELO did not give a definitive result)
# -------------------------------------------------------------------------
my $mfrom_result = $cache->{mfrom_result};
if (not defined($mfrom_result)) {
# No MAIL FROM result has been cached from earlier checks on this message.
my $mfrom_request = eval {
Mail::SPF::Request->new(
scope => 'mfrom',
identity => $attr->{sender},
ip_address => $attr->{client_address},
helo_identity => $attr->{helo_name} # for %{h} macro expansion
);
};
if ($@) {
# An unexpected error occurred during request creation,
# probably due to invalid input data!
my $errmsg = $@;
$errmsg = $errmsg->text if UNIVERSAL::isa($@, 'Mail::SPF::Exception');
if ($VERBOSE) {
syslog(
info => "Mail From (sender) check failed - Mail::SPF->new(%s, %s, %s) failed: %s",
$attr->{client_address} || '<UNKNOWN>',
$attr->{sender} || '<UNKNOWN>', $attr->{helo_name} || '<UNKNOWN>', $errmsg || '<UNKNOWN>'
);
};
return;
}
$mfrom_result = $cache->{mfrom_result} = $spf_server->process($mfrom_request);
}
my $mfrom_result_code = $mfrom_result->code; # 'pass', 'fail', etc.
my $mfrom_local_exp = nullchomp($mfrom_result->local_explanation);
my $mfrom_authority_exp = nullchomp($mfrom_result->authority_explanation)
if $mfrom_result->is_code('fail');
my $mfrom_spf_header = $mfrom_result->received_spf_header;
if ($VERBOSE) {
syslog(
info => "SPF %s: Envelope-from: %s, IP Address: %s, Recipient: %s",
$mfrom_result || '<UNKNOWN>',
$attr->{sender} || '<UNKNOWN>', $attr->{client_address} || '<UNKNOWN>',
$attr->{recipient} || '<UNKNOWN>'
);
};
# Same approach as HELO....
if ($VERBOSE) {
syslog(
info => "SPF %s: Envelope-from: %s",
$mfrom_result || '<UNKNOWN>',
$attr->{sender} || '<UNKNOWN>'
);
};
if ($mfrom_result->is_code('fail')) {
return "550 $mfrom_authority_exp";
}
elsif ($mfrom_result->is_code('temperror')) {
return "DEFER_IF_PERMIT SPF-Result=$mfrom_local_exp";
}
else {
return "PREPEND $mfrom_spf_header"
unless $cache->{added_spf_header}++;
}
return;
}
# ----------------------------------------------------------
# utility, string cleaning
# ----------------------------------------------------------
sub nullchomp {
my $value = shift;
# Remove one or more null characters from the
# end of the input.
$value =~ s/\0+$//;
return $value;
}