commit
0c41c01274
37
Changes
37
Changes
@ -1,4 +1,41 @@
|
|||||||
|
|
||||||
|
0.94 ___ NN, 2014
|
||||||
|
|
||||||
|
Updated DMARC plugin to use Mail::DMARC
|
||||||
|
|
||||||
|
Updated SPF & DKIM plugins to store data for DMARC processing
|
||||||
|
|
||||||
|
karma plugin: added spammy TLD penalty
|
||||||
|
|
||||||
|
a few more log prefixes (corralling stragglers)
|
||||||
|
|
||||||
|
|
||||||
|
0.93 Dec 17, 2013
|
||||||
|
|
||||||
|
Added Authentication-Results header
|
||||||
|
moves Authentication-Results to Original-Authentication-Results on inbound.
|
||||||
|
no longer puts auth info in Received header
|
||||||
|
|
||||||
|
TcpServer: ignore DNS search path and explicitely request PTR lookups (speedup)
|
||||||
|
|
||||||
|
store envelope TO/FROM in connection notes
|
||||||
|
|
||||||
|
raised max msg size in clamdscan
|
||||||
|
|
||||||
|
SPF enabled by default (if Mail::SPF available)
|
||||||
|
|
||||||
|
auth_vpopmaild: added taint checking to responses
|
||||||
|
|
||||||
|
added run files for most common deployment methods (easier install)
|
||||||
|
|
||||||
|
untaint config data passed to plugins
|
||||||
|
|
||||||
|
Qpsmtpd.pm: split config args on /\s+/, was / /
|
||||||
|
(compatibility with newer versions of perl)
|
||||||
|
|
||||||
|
dmarc: added subdomain policy handling
|
||||||
|
|
||||||
|
|
||||||
0.92 Apr 20, 2013
|
0.92 Apr 20, 2013
|
||||||
|
|
||||||
new plugins: dmarc, fcrdns
|
new plugins: dmarc, fcrdns
|
||||||
|
18
STATUS
18
STATUS
@ -1,19 +1,11 @@
|
|||||||
|
|
||||||
Qpsmtpd-dev is a fork of Qpsmtpd. Qpsmtpd is a very good SMTP daemon for
|
Qpsmtpd is a very good SMTP daemon for developers and hackers.
|
||||||
developers and hackers (admittedly, its focus). The plugin system is great
|
|
||||||
but the plugin organization, documentation, and consistency left much
|
|
||||||
to be desired.
|
|
||||||
|
|
||||||
The primary focus of the -dev branch is improving the consistency and
|
Current goals are making it easier to install, reducing code duplication,
|
||||||
behavior of the plugins. After using one plugin, the knowledge gained
|
|
||||||
should carry over to other plugins.
|
|
||||||
|
|
||||||
Secondary goals are making it easier to install, reducing code duplication,
|
|
||||||
reducing complexity, and cooperation between plugins. Anything covered
|
reducing complexity, and cooperation between plugins. Anything covered
|
||||||
in Perl Best Practices is also fair game.
|
in Perl Best Practices is fair game.
|
||||||
|
|
||||||
So far, the main changes between the release and dev branches have focused
|
Recent changes have been made towards these goals:
|
||||||
on these goals:
|
|
||||||
|
|
||||||
- plugins use is_immune and is_naughty instead of a local methods
|
- plugins use is_immune and is_naughty instead of a local methods
|
||||||
- plugins log a single entry summarizing their disposition
|
- plugins log a single entry summarizing their disposition
|
||||||
@ -36,7 +28,7 @@ For most sites, even DNSBL, SPF, DKIM, and SpamAssassin tests alone are insuffic
|
|||||||
Roadmap
|
Roadmap
|
||||||
=======
|
=======
|
||||||
|
|
||||||
- https://github.com/qpsmtpd-dev/qpsmtpd-dev/issues
|
- https://github.com/smtpd/qpsmtpd/issues
|
||||||
|
|
||||||
- Bugfixes - qpsmtpd is extremely stable (in production since 2001), but
|
- Bugfixes - qpsmtpd is extremely stable (in production since 2001), but
|
||||||
there are always more things to fix.
|
there are always more things to fix.
|
||||||
|
26
UPGRADING
26
UPGRADING
@ -1,26 +0,0 @@
|
|||||||
|
|
||||||
When upgrading from:
|
|
||||||
|
|
||||||
v 0.84 or below
|
|
||||||
|
|
||||||
CHECK_RELAY, CHECK_NORELAY, RELAY_ONLY
|
|
||||||
|
|
||||||
All 3 plugins are deprecated and replaced with a new 'relay' plugin. The new plugin reads the same config files (see 'perldoc plugins/relay') as the previous plugins. To get the equivalent functionality of enabling 'relay_only', use the 'only' argument to the relay plugin as documented in the RELAY ONLY section of plugins/relay.
|
|
||||||
|
|
||||||
GREYLISTING plugin:
|
|
||||||
|
|
||||||
'mode' config argument is deprecated. Use reject and reject_type instead.
|
|
||||||
|
|
||||||
The greylisting DB format has changed to accommodate IPv6 addresses. (The DB key has colon ':' seperated fields, and IPv6 addresses are colon delimited). The new format converts the IPs into integers. There is a new config option named 'upgrade' that when enabled, updates all the records in your DB to the new format. Simply add 'upgrade 1' to the plugin entry in config/plugins, start up qpsmtpd once, make one connection. A log entry will be made, telling how many records were upgraded. Remove the upgrade option from your config.
|
|
||||||
|
|
||||||
SPF plugin:
|
|
||||||
|
|
||||||
spf_deny setting deprecated. Use reject N setting instead, which provides administrators with more granular control over SPF. For backward compatibility, a spf_deny setting of 1 is mapped to 'reject 3' and a 'spf_deny 2' is mapped to 'reject 4'.
|
|
||||||
|
|
||||||
|
|
||||||
P0F plugin:
|
|
||||||
defaults to p0f v3 (was v2).
|
|
||||||
|
|
||||||
Upgrade p0f to version 3 or add 'version 2' to your p0f line in config/plugins. perldoc plugins/ident/p0f for more details.
|
|
||||||
|
|
||||||
|
|
@ -73,6 +73,7 @@ headers reject 0 reject_type temp require From,Date future 2 past 15
|
|||||||
bogus_bounce log
|
bogus_bounce log
|
||||||
#loop
|
#loop
|
||||||
dkim reject 0
|
dkim reject 0
|
||||||
|
# dmarc requires dkim and SPF to run before it
|
||||||
dmarc
|
dmarc
|
||||||
|
|
||||||
# content filters
|
# content filters
|
||||||
|
@ -89,11 +89,7 @@ connection before any auth succeeds, defaults to C<0>.
|
|||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
<<<<<<< HEAD
|
|
||||||
=head2 Plugin settings
|
|
||||||
=======
|
|
||||||
=head2 Plugin settings files
|
=head2 Plugin settings files
|
||||||
>>>>>>> initial import - based on my qpsmtpd fork
|
|
||||||
|
|
||||||
=over 4
|
=over 4
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@ use Qpsmtpd::Constants;
|
|||||||
|
|
||||||
#use DashProfiler;
|
#use DashProfiler;
|
||||||
|
|
||||||
$VERSION = "0.93";
|
$VERSION = "0.94";
|
||||||
|
|
||||||
my $git;
|
my $git;
|
||||||
|
|
||||||
|
@ -218,7 +218,7 @@ sub compile {
|
|||||||
|
|
||||||
sub get_reject {
|
sub get_reject {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $smtp_mess = shift || "why didn't you pass an error message?";
|
my $smtp_mess = shift || "unspecified error";
|
||||||
my $log_mess = shift || '';
|
my $log_mess = shift || '';
|
||||||
$log_mess = ", $log_mess" if $log_mess;
|
$log_mess = ", $log_mess" if $log_mess;
|
||||||
|
|
||||||
@ -320,17 +320,17 @@ sub is_immune {
|
|||||||
sub is_naughty {
|
sub is_naughty {
|
||||||
my ($self, $setit) = @_;
|
my ($self, $setit) = @_;
|
||||||
|
|
||||||
if ( defined $setit ) {
|
# see plugins/naughty
|
||||||
|
return $self->connection->notes('naughty') if ! defined $setit;
|
||||||
|
|
||||||
$self->connection->notes('naughty', $setit);
|
$self->connection->notes('naughty', $setit);
|
||||||
$self->connection->notes('rejected', $setit);
|
$self->connection->notes('rejected', $setit);
|
||||||
};
|
|
||||||
|
|
||||||
if ($self->connection->notes('naughty')) {
|
if ($self->connection->notes('naughty')) {
|
||||||
|
|
||||||
# see plugins/naughty
|
|
||||||
$self->log(LOGINFO, "skip, naughty");
|
$self->log(LOGINFO, "skip, naughty");
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
if ($self->connection->notes('rejected')) {
|
if ($self->connection->notes('rejected')) {
|
||||||
|
|
||||||
# http://www.steve.org.uk/Software/ms-lite/
|
# http://www.steve.org.uk/Software/ms-lite/
|
||||||
@ -345,7 +345,7 @@ sub adjust_karma {
|
|||||||
|
|
||||||
my $karma = $self->connection->notes('karma') || 0;
|
my $karma = $self->connection->notes('karma') || 0;
|
||||||
$karma += $value;
|
$karma += $value;
|
||||||
$self->log(LOGDEBUG, "karma $value ($karma)");
|
$self->log(LOGINFO, "karma $value ($karma)");
|
||||||
$self->connection->notes('karma', $karma);
|
$self->connection->notes('karma', $karma);
|
||||||
return $value;
|
return $value;
|
||||||
}
|
}
|
||||||
|
@ -23,7 +23,7 @@ use Net::DNS;
|
|||||||
|
|
||||||
# this is only good for forkserver
|
# this is only good for forkserver
|
||||||
# can't set these here, cause forkserver resets them
|
# can't set these here, cause forkserver resets them
|
||||||
#$SIG{ALRM} = sub { respond(421, "Game over pal, game over. You got a timeout; I just can't wait that long..."); exit };
|
#$SIG{ALRM} = sub { respond(421, "timeout; I can't wait that long..."); exit };
|
||||||
#$SIG{ALRM} = sub { warn "Connection Timed Out\n"; exit; };
|
#$SIG{ALRM} = sub { warn "Connection Timed Out\n"; exit; };
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
@ -818,17 +818,24 @@ sub authentication_results {
|
|||||||
sub clean_authentication_results {
|
sub clean_authentication_results {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
# On messages received from the internet, we may want to remove
|
# http://tools.ietf.org/html/draft-kucherawy-original-authres-00.html
|
||||||
# the Authentication-Results headers added by other MTAs, so our downstream
|
|
||||||
# can trust the new A-R header we insert.
|
|
||||||
# We do not want to invalidate DKIM signatures.
|
|
||||||
# TODO: parse the DKIM signature(s) to see if A-R header is signed
|
|
||||||
return if $self->transaction->header->get('DKIM-Signature');
|
|
||||||
|
|
||||||
my @headers = $self->transaction->header->get('Authentication-Results');
|
# On messages received from the internet, move Authentication-Results headers
|
||||||
for ( my $i = 0; $i < scalar @headers; $i++ ) {
|
# to Original-AR, so our downstream can trust the A-R header we insert.
|
||||||
|
|
||||||
|
# TODO: Do not invalidate DKIM signatures.
|
||||||
|
# if $self->transaction->header->get('DKIM-Signature')
|
||||||
|
# Parse the DKIM signature(s)
|
||||||
|
# return if A-R header is signed;
|
||||||
|
# }
|
||||||
|
|
||||||
|
my @ar_headers = $self->transaction->header->get('Authentication-Results');
|
||||||
|
for ( my $i = 0; $i < scalar @ar_headers; $i++ ) {
|
||||||
$self->transaction->header->delete('Authentication-Results', $i);
|
$self->transaction->header->delete('Authentication-Results', $i);
|
||||||
|
$self->transaction->header->add('Original-Authentication-Results', $ar_headers[$i]);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
$self->log(LOGDEBUG, "Authentication-Results moved to Original-Authentication-Results" );
|
||||||
};
|
};
|
||||||
|
|
||||||
sub received_line {
|
sub received_line {
|
||||||
|
@ -191,18 +191,18 @@ sub tcpenv {
|
|||||||
return ($TCPLOCALIP, $TCPREMOTEIP,
|
return ($TCPLOCALIP, $TCPREMOTEIP,
|
||||||
$TCPREMOTEIP ? "[$ENV{TCPREMOTEIP}]" : "[noip!]");
|
$TCPREMOTEIP ? "[$ENV{TCPREMOTEIP}]" : "[noip!]");
|
||||||
}
|
}
|
||||||
my $res = new Net::DNS::Resolver;
|
my $res = Net::DNS::Resolver->new( dnsrch => 0 );
|
||||||
$res->tcp_timeout(3);
|
$res->tcp_timeout(3);
|
||||||
$res->udp_timeout(3);
|
$res->udp_timeout(3);
|
||||||
my $query = $res->query($nto_iaddr);
|
my $query = $res->query($nto_iaddr, 'PTR');
|
||||||
my $TCPREMOTEHOST;
|
my $TCPREMOTEHOST;
|
||||||
if ($query) {
|
if ($query) {
|
||||||
foreach my $rr ($query->answer) {
|
foreach my $rr ($query->answer) {
|
||||||
next unless $rr->type eq "PTR";
|
next if $rr->type ne 'PTR';
|
||||||
$TCPREMOTEHOST = $rr->ptrdname;
|
$TCPREMOTEHOST = $rr->ptrdname;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return ($TCPLOCALIP, $TCPREMOTEIP, $TCPREMOTEHOST || "Unknown");
|
return ($TCPLOCALIP, $TCPREMOTEIP, $TCPREMOTEHOST || 'Unknown');
|
||||||
}
|
}
|
||||||
|
|
||||||
sub check_socket() {
|
sub check_socket() {
|
||||||
|
@ -136,14 +136,14 @@ sub handle_dispatch {
|
|||||||
my ($message, $pid, $line) = @_;
|
my ($message, $pid, $line) = @_;
|
||||||
if ($message =~ /^dispatching MAIL FROM/i) {
|
if ($message =~ /^dispatching MAIL FROM/i) {
|
||||||
my ($from) = $message =~ /<(.*?)>/;
|
my ($from) = $message =~ /<(.*?)>/;
|
||||||
$pids{$pid}{from} = $from;
|
$pids{$pid}{from} = $from || '';
|
||||||
}
|
}
|
||||||
elsif ($message =~ /^dispatching RCPT TO/i) {
|
elsif ($message =~ /^dispatching RCPT TO/i) {
|
||||||
my ($to) = $message =~ /<(.*?)>/;
|
my ($to) = $message =~ /<(.*?)>/;
|
||||||
$pids{$pid}{to} = $to;
|
$pids{$pid}{to} = $to || '';
|
||||||
}
|
}
|
||||||
elsif ($message =~ m/dispatching (EHLO|HELO) (.*)/) {
|
elsif ($message =~ m/dispatching (EHLO|HELO) (.*)/) {
|
||||||
$pids{$pid}{helo_host} = $2;
|
$pids{$pid}{helo_host} = $2 || '';
|
||||||
}
|
}
|
||||||
elsif ($message eq 'dispatching DATA') { }
|
elsif ($message eq 'dispatching DATA') { }
|
||||||
elsif ($message eq 'dispatching QUIT') { }
|
elsif ($message eq 'dispatching QUIT') { }
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
Name: @PACKAGE@
|
Name: %{_package}
|
||||||
Version: @VERSION@
|
Version: %{_version}
|
||||||
Release: @RELEASE@
|
Release: %{_release}
|
||||||
|
|
||||||
Summary: qpsmtpd + qpsmtpd-apache + qpsmtpd-async
|
Summary: qpsmtpd + qpsmtpd-apache + qpsmtpd-async
|
||||||
License: MIT
|
License: MIT
|
||||||
@ -8,7 +8,7 @@ Group: System Environment/Daemons
|
|||||||
URL: http://smtpd.develooper.com/
|
URL: http://smtpd.develooper.com/
|
||||||
BuildRoot: %{_builddir}/%{name}-%{version}-%{release}-root
|
BuildRoot: %{_builddir}/%{name}-%{version}-%{release}-root
|
||||||
BuildRequires: perl >= 0:5.00503
|
BuildRequires: perl >= 0:5.00503
|
||||||
BuildArch: noarch
|
BuildArchitectures: noarch
|
||||||
Requires: perl(Mail::Header), perl(Net::DNS) perl(Net::IP) perl(IPC::Shareable)
|
Requires: perl(Mail::Header), perl(Net::DNS) perl(Net::IP) perl(IPC::Shareable)
|
||||||
Requires(pre): coreutils, shadow-utils, perl
|
Requires(pre): coreutils, shadow-utils, perl
|
||||||
|
|
||||||
@ -52,7 +52,7 @@ qpsmpd-async which uses it.
|
|||||||
%setup -q -n %{name}-%{version}-%{release}
|
%setup -q -n %{name}-%{version}-%{release}
|
||||||
|
|
||||||
%build
|
%build
|
||||||
CFLAGS="$RPM_OPT_FLAGS" perl Makefile.PL PREFIX=%{_prefix}
|
CFLAGS="$RPM_OPT_FLAGS" perl Makefile.PL INSTALLSITELIB=%{_prefix}/lib/perl5/site_perl
|
||||||
make
|
make
|
||||||
|
|
||||||
%clean
|
%clean
|
||||||
@ -69,9 +69,9 @@ then
|
|||||||
make DESTDIR=$RPM_BUILD_ROOT install
|
make DESTDIR=$RPM_BUILD_ROOT install
|
||||||
|
|
||||||
else
|
else
|
||||||
make PREFIX=$RPM_BUILD_ROOT%{_prefix}
|
make PREFIX=$RPM_BUILD_ROOT/usr
|
||||||
find blib/lib -name '*.pm.*' -exec rm -f {} \;
|
find blib/lib -name '*.pm.*' -exec rm -f {} \;
|
||||||
make PREFIX=$RPM_BUILD_ROOT%{_prefix} install
|
make PREFIX=$RPM_BUILD_ROOT/usr install
|
||||||
fi
|
fi
|
||||||
mkdir -p ${RPM_BUILD_ROOT}%{_datadir}/%{name}
|
mkdir -p ${RPM_BUILD_ROOT}%{_datadir}/%{name}
|
||||||
rm -f ${RPM_BUILD_ROOT}%{_datadir}/%{name}/plugins/*.*
|
rm -f ${RPM_BUILD_ROOT}%{_datadir}/%{name}/plugins/*.*
|
||||||
@ -127,7 +127,7 @@ fi
|
|||||||
|
|
||||||
%files apache
|
%files apache
|
||||||
%defattr(-,root,root)
|
%defattr(-,root,root)
|
||||||
%{_datadir}/perl5/Apache/Qpsmtpd.pm
|
%{_prefix}/lib/perl5/site_perl/Apache/Qpsmtpd.pm
|
||||||
%{_mandir}/man3/Apache::Qpsmtpd.3pm.gz
|
%{_mandir}/man3/Apache::Qpsmtpd.3pm.gz
|
||||||
%config(noreplace) %{_sysconfdir}/httpd/conf.d/*
|
%config(noreplace) %{_sysconfdir}/httpd/conf.d/*
|
||||||
%doc %{_docdir}/%{name}-apache-%{version}/README.selinux
|
%doc %{_docdir}/%{name}-apache-%{version}/README.selinux
|
||||||
@ -135,11 +135,11 @@ fi
|
|||||||
%files async
|
%files async
|
||||||
%defattr(-,root,root)
|
%defattr(-,root,root)
|
||||||
%{_bindir}/qpsmtpd-async
|
%{_bindir}/qpsmtpd-async
|
||||||
%{_datadir}/perl5/Danga/Client.pm
|
%{_prefix}/lib/perl5/site_perl/Danga/Client.pm
|
||||||
%{_datadir}/perl5/Danga/TimeoutSocket.pm
|
%{_prefix}/lib/perl5/site_perl/Danga/TimeoutSocket.pm
|
||||||
%{_datadir}/perl5/Qpsmtpd/ConfigServer.pm
|
%{_prefix}/lib/perl5/site_perl/Qpsmtpd/ConfigServer.pm
|
||||||
%{_datadir}/perl5/Qpsmtpd/Plugin/Async/DNSBLBase.pm
|
%{_prefix}/lib/perl5/site_perl/Qpsmtpd/Plugin/Async/DNSBLBase.pm
|
||||||
%{_datadir}/perl5/Qpsmtpd/PollServer.pm
|
%{_prefix}/lib/perl5/site_perl/Qpsmtpd/PollServer.pm
|
||||||
%{_mandir}/man1/qpsmtpd-async.1.gz
|
%{_mandir}/man1/qpsmtpd-async.1.gz
|
||||||
%{_datadir}/%{name}/plugins/async/*
|
%{_datadir}/%{name}/plugins/async/*
|
||||||
|
|
||||||
@ -157,9 +157,6 @@ then
|
|||||||
fi
|
fi
|
||||||
|
|
||||||
%changelog
|
%changelog
|
||||||
* Tue Oct 02 2012 <robin.bowes@yo61.com>
|
|
||||||
- Fix up spec file to build directly from git repo
|
|
||||||
|
|
||||||
* Sun Jul 12 2009 <rpmbuild@robinbowes.com> 0.82-0.1
|
* Sun Jul 12 2009 <rpmbuild@robinbowes.com> 0.82-0.1
|
||||||
- Update to latest release
|
- Update to latest release
|
||||||
- don't add qpsmtpd to start-up by default
|
- don't add qpsmtpd to start-up by default
|
||||||
|
@ -221,13 +221,14 @@ sub validate_it {
|
|||||||
$self->send_message_to_dkim($dkim, $transaction);
|
$self->send_message_to_dkim($dkim, $transaction);
|
||||||
my $result = $dkim->result;
|
my $result = $dkim->result;
|
||||||
my $mess = $self->get_details($dkim);
|
my $mess = $self->get_details($dkim);
|
||||||
|
$self->connection->notes('dkim_result', $result);
|
||||||
|
$self->connection->notes('dkim_verifier', $dkim);
|
||||||
|
|
||||||
my $auth_str = "dkim=" .$dkim->result_detail;
|
my $auth_str = "dkim=" .$dkim->result_detail;
|
||||||
if ( $dkim->signature && $dkim->signature->domain ) {
|
if ( $dkim->signature && $dkim->signature->domain ) {
|
||||||
$auth_str .= " header.i=@" . $dkim->signature->domain;
|
$auth_str .= " header.i=@" . $dkim->signature->domain;
|
||||||
};
|
};
|
||||||
$self->store_auth_results( $auth_str );
|
$self->store_auth_results( $auth_str );
|
||||||
#$self->add_header($mess);
|
|
||||||
|
|
||||||
foreach my $t (qw/ pass fail invalid temperror none /) {
|
foreach my $t (qw/ pass fail invalid temperror none /) {
|
||||||
next if $t ne $result;
|
next if $t ne $result;
|
||||||
@ -482,7 +483,8 @@ sub send_message_to_dkim {
|
|||||||
$self->log(LOGERROR, $@) if $@;
|
$self->log(LOGERROR, $@) if $@;
|
||||||
}
|
}
|
||||||
|
|
||||||
$dkim->CLOSE;
|
eval { $dkim->CLOSE; };
|
||||||
|
$self->log(LOGERROR, $@) if $@;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub get_policies {
|
sub get_policies {
|
||||||
|
472
plugins/dmarc
472
plugins/dmarc
@ -6,7 +6,7 @@ Domain-based Message Authentication, Reporting and Conformance
|
|||||||
|
|
||||||
=head1 SYNOPSIS
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
DMARC is an extremely reliable means to authenticate email.
|
DMARC is a reliable means to authenticate email.
|
||||||
|
|
||||||
=head1 DESCRIPTION
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
@ -14,9 +14,9 @@ From the DMARC Draft: "DMARC operates as a policy layer atop DKIM and SPF. These
|
|||||||
|
|
||||||
DMARC provides a way to exchange authentication information and policies among mail servers.
|
DMARC provides a way to exchange authentication information and policies among mail servers.
|
||||||
|
|
||||||
DMARC benefits domain owners by preventing others from impersonating them. A domain owner can reliably tell other mail servers that "it it doesn't originate from this list of servers (SPF) and it is not signed (DKIM), then reject it!" DMARC also provides domain owners with a means to receive feedback and determine that their policies are working as desired.
|
DMARC benefits domain owners by preventing others from impersonating them. A domain owner can reliably tell other mail servers that "it it doesn't originate from this list of servers (SPF) and it is not signed (DKIM), then [ignore|quarantine|reject] it." DMARC also provides domain owners with a means to receive feedback and determine that their policies are working as desired.
|
||||||
|
|
||||||
DMARC benefits mail server operators by providing them with an extremely reliable (as opposed to DKIM or SPF, which both have reliability issues when used independently) means to block forged emails. Is that message really from PayPal, Chase, Gmail, or Facebook? Since those organizations, and many more, publish DMARC policies, operators have a definitive means to know.
|
DMARC benefits mail server operators by providing them with a more reliable (than SPF or DKIM alone) means to block forged emails. Is that message really from PayPal, Chase, Gmail, or Facebook? Since those organizations publish DMARC policies, operators have a definitive means to know.
|
||||||
|
|
||||||
=head1 HOWTO
|
=head1 HOWTO
|
||||||
|
|
||||||
@ -46,26 +46,21 @@ _dmarc IN TXT "v=DMARC1; p=reject; rua=mailto:dmarc-feedback@example.com;"
|
|||||||
|
|
||||||
=head2 Validate messages with DMARC
|
=head2 Validate messages with DMARC
|
||||||
|
|
||||||
1. install this plugin
|
1. install Mail::DMARC
|
||||||
|
|
||||||
2. install a public suffix list in config/public_suffix_list. See http://publicsuffix.org/list/
|
2. install this plugin
|
||||||
|
|
||||||
3. activate this plugin. (add to config/plugins, listing it after SPF & DKIM. Check that SPF and DKIM are configured to not reject mail.
|
3. activate this plugin. (add to config/plugins, listing it after SPF & DKIM. Check that SPF and DKIM are configured to not reject mail.
|
||||||
|
|
||||||
=head2 Parse dmarc feedback reports into a database
|
|
||||||
|
|
||||||
See http://www.taugh.com/rddmarc/
|
|
||||||
|
|
||||||
=head1 MORE INFORMATION
|
=head1 MORE INFORMATION
|
||||||
|
|
||||||
http://www.dmarc.org/draft-dmarc-base-00-02.txt
|
http://www.dmarc.org/draft-dmarc-base-00-02.txt
|
||||||
|
|
||||||
https://github.com/qpsmtpd-dev/qpsmtpd-dev/wiki/DMARC-FAQ
|
https://github.com/smtpd/qpsmtpd/wiki/DMARC-FAQ
|
||||||
|
|
||||||
=head1 TODO
|
=head1 TODO
|
||||||
|
|
||||||
provide dmarc feedback to domains that request it
|
|
||||||
|
|
||||||
reject messages with multiple From: headers
|
reject messages with multiple From: headers
|
||||||
|
|
||||||
=head1 AUTHORS
|
=head1 AUTHORS
|
||||||
@ -77,402 +72,115 @@ https://github.com/qpsmtpd-dev/qpsmtpd-dev/wiki/DMARC-FAQ
|
|||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
|
use Data::Dumper;
|
||||||
use Qpsmtpd::Constants;
|
use Qpsmtpd::Constants;
|
||||||
|
|
||||||
sub init {
|
sub register {
|
||||||
my ($self, $qp) = (shift, shift);
|
my ($self, $qp, @args) = @_;
|
||||||
$self->{_args} = {@_};
|
|
||||||
|
$self->log(LOGERROR, "Bad arguments") if @args % 2;
|
||||||
|
$self->{_args} = {@args};
|
||||||
|
|
||||||
$self->{_args}{reject} = 1 if !defined $self->{_args}{reject};
|
$self->{_args}{reject} = 1 if !defined $self->{_args}{reject};
|
||||||
$self->{_args}{reject_type} ||= 'perm';
|
$self->{_args}{reject_type} ||= 'perm';
|
||||||
$self->{_args}{p_vals} = {map { $_ => 1 } qw/ none reject quarantine /};
|
$self->{_args}{p_vals} = {map { $_ => 1 } qw/ none reject quarantine /};
|
||||||
|
|
||||||
|
eval "require Mail::DMARC::PurePerl";
|
||||||
|
if ( $@ ) {
|
||||||
|
$self->log(LOGERROR, "failed to load Mail::DMARC::PurePerl" );
|
||||||
}
|
}
|
||||||
|
else {
|
||||||
sub register {
|
$self->{_dmarc} = Mail::DMARC::PurePerl->new();
|
||||||
my $self = shift;
|
|
||||||
|
|
||||||
$self->register_hook('data_post', 'data_post_handler');
|
$self->register_hook('data_post', 'data_post_handler');
|
||||||
|
};
|
||||||
}
|
}
|
||||||
|
|
||||||
sub data_post_handler {
|
sub data_post_handler {
|
||||||
my ($self, $transaction) = @_;
|
my ($self, $transaction) = @_;
|
||||||
|
|
||||||
return DECLINED if $self->is_immune();
|
if ( $self->qp->connection->relay_client() ) {
|
||||||
|
$self->log(LOGINFO, "skip, relay client" );
|
||||||
# 11.1. Extract Author Domain
|
return DECLINED; # disable reporting to ourself
|
||||||
my $from_dom = $self->get_from_dom($transaction) or return DECLINED;
|
|
||||||
my $org_dom = $self->get_organizational_domain($from_dom);
|
|
||||||
|
|
||||||
# 6. Receivers should reject email if the domain appears to not exist
|
|
||||||
my $exists = $self->exists_in_dns($from_dom, $org_dom) or do {
|
|
||||||
$self->log(LOGINFO, "fail, $from_dom not in DNS");
|
|
||||||
return $self->get_reject("RFC5322.From host appears non-existent");
|
|
||||||
};
|
};
|
||||||
|
|
||||||
# 11.2. Determine Handling Policy
|
my $dmarc = $self->{_dmarc};
|
||||||
my $policy = $self->discover_policy($from_dom, $org_dom)
|
$dmarc->init();
|
||||||
or return DECLINED;
|
my $from = $transaction->header->get('From');
|
||||||
|
if ( ! $from ) {
|
||||||
|
$self->log(LOGINFO, "skip, null sender" );
|
||||||
|
return $self->get_reject("empty from address, null sender?");
|
||||||
|
};
|
||||||
|
eval { $dmarc->header_from_raw( $from ); };
|
||||||
|
if ( $@ ) {
|
||||||
|
$self->log(LOGERROR, "unparseable from header: $from" );
|
||||||
|
return $self->get_reject("unparseable from header");
|
||||||
|
};
|
||||||
|
my @recipients = $transaction->recipients;
|
||||||
|
eval { $dmarc->envelope_to( lc $recipients[0]->host ); }; # optional
|
||||||
|
eval { $dmarc->envelope_from( $transaction->sender->host ); }; # may be <>
|
||||||
|
$dmarc->spf( $transaction->notes('dmarc_spf') );
|
||||||
|
my $dkim = $self->connection->notes('dkim_verifier');
|
||||||
|
if ( $dkim ) { $dmarc->dkim( $dkim ); };
|
||||||
|
$dmarc->source_ip( $self->qp->connection->remote_ip );
|
||||||
|
eval { $dmarc->validate(); };
|
||||||
|
if ( $@ ) {
|
||||||
|
$self->log(LOGERROR, $@ );
|
||||||
|
return DECLINED if $self->is_immune;
|
||||||
|
$self->log(LOGINFO, "TODO: handle this validation failure");
|
||||||
|
return DECLINED;
|
||||||
|
return $self->get_reject( $@, $@ );
|
||||||
|
};
|
||||||
|
|
||||||
# 3. Perform DKIM signature verification checks. A single email may
|
#$self->log(LOGINFO, "result: " . Dumper( $dmarc ) );
|
||||||
# contain multiple DKIM signatures. The results MUST include the
|
|
||||||
# value of the "d=" tag from all DKIM signatures that validated.
|
|
||||||
#my $dkim_sigs = $self->connection->notes('dkim_pass_domains') || [];
|
|
||||||
|
|
||||||
# 4. Perform SPF validation checks. The results of this step
|
my $pol;
|
||||||
# MUST include the domain name from the RFC5321.MailFrom if SPF
|
eval { $pol = $dmarc->result->published; };
|
||||||
# evaluation returned a "pass" result.
|
if ( $pol ) {
|
||||||
my $spf_dom = $transaction->notes('spf_pass_host');
|
if ( $dmarc->has_valid_reporting_uri($pol->rua) ) {
|
||||||
|
eval { $dmarc->save_aggregate(); };
|
||||||
|
$self->log(LOGERROR, $@ ) if $@;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$self->log(LOGERROR, "has policy, no report URI" );
|
||||||
|
};
|
||||||
|
};
|
||||||
|
|
||||||
my $effective_policy = ( $self->{_args}{is_subdomain} && defined $policy->{sp} )
|
my $disposition = $dmarc->result->disposition;
|
||||||
? $policy->{sp} : $policy->{p};
|
my $auth_str = "dmarc=$disposition";
|
||||||
|
$auth_str = " (p=" . $pol->p . ")" if $pol;
|
||||||
|
|
||||||
# 5. Conduct identifier alignment checks.
|
if ( $dmarc->result->result eq 'pass' ) {
|
||||||
if ( $self->is_aligned($from_dom, $org_dom, $policy, $spf_dom ) ) {
|
$self->log(LOGINFO, "pass");
|
||||||
$self->store_auth_results("dmarc=pass (p=$effective_policy) d=$from_dom");
|
$self->store_auth_results( $auth_str . " d=" . $dmarc->header_from);
|
||||||
return DECLINED;
|
return DECLINED;
|
||||||
};
|
};
|
||||||
|
|
||||||
# 6. Apply policy. Emails that fail the DMARC mechanism check are
|
my $reason_type = my $comment = '';
|
||||||
# disposed of in accordance with the discovered DMARC policy of the
|
if ( $dmarc->result->reason && $dmarc->result->reason->[0] ) {
|
||||||
# Domain Owner. See Section 6.2 for details.
|
$reason_type = $dmarc->result->reason->[0]->type;
|
||||||
if ( lc $effective_policy eq 'none' ) {
|
if ( $dmarc->result->reason->[0]->comment ) {
|
||||||
$self->store_auth_results("dmarc=fail (p=none) d=$from_dom");
|
$comment = $dmarc->result->reason->[0]->comment;
|
||||||
|
};
|
||||||
|
};
|
||||||
|
if ( $disposition eq 'none' && $comment && $comment eq 'no policy') {
|
||||||
|
$self->log(LOGINFO, "skip, no policy");
|
||||||
return DECLINED;
|
return DECLINED;
|
||||||
};
|
};
|
||||||
|
|
||||||
my $pct = $policy->{pct} || 100;
|
my $log_mess = $dmarc->result->result;
|
||||||
if ( $pct != 100 && int(rand(100)) >= $pct ) {
|
$log_mess .= ", tolerated" if $disposition eq 'none';
|
||||||
$self->log("fail, tolerated, policy, sampled out");
|
$log_mess .= ", $reason_type" if $reason_type;
|
||||||
$self->store_auth_results("dmarc=sampled_out (p=$effective_policy) d=$from_dom");
|
$log_mess .= ", $comment" if $comment;
|
||||||
return DECLINED;
|
$self->log(LOGINFO, $log_mess);
|
||||||
};
|
|
||||||
|
|
||||||
$self->store_auth_results("dmarc=fail (p=$effective_policy) d=$from_dom");
|
$self->store_auth_results( $auth_str . " d=" . $dmarc->header_from);
|
||||||
|
|
||||||
|
return DECLINED if $disposition eq 'none';
|
||||||
|
return DECLINED if ! $disposition; # for safety
|
||||||
|
return DECLINED if $self->is_immune;
|
||||||
|
|
||||||
|
$self->adjust_karma(-3);
|
||||||
|
# at what point do we reject?
|
||||||
return $self->get_reject("failed DMARC policy");
|
return $self->get_reject("failed DMARC policy");
|
||||||
}
|
}
|
||||||
|
|
||||||
sub is_aligned {
|
|
||||||
my ($self, $from_dom, $org_dom, $policy, $spf_dom) = @_;
|
|
||||||
|
|
||||||
# 5. Conduct identifier alignment checks. With authentication checks
|
|
||||||
# and policy discovery performed, the Mail Receiver checks if
|
|
||||||
# Authenticated Identifiers fall into alignment as decribed in
|
|
||||||
# Section 4. If one or more of the Authenticated Identifiers align
|
|
||||||
# with the RFC5322.From domain, the message is considered to pass
|
|
||||||
# the DMARC mechanism check. All other conditions (authentication
|
|
||||||
# failures, identifier mismatches) are considered to be DMARC
|
|
||||||
# mechanism check failures.
|
|
||||||
|
|
||||||
my $dkim_sigs = $self->connection->notes('dkim_pass_domains') || [];
|
|
||||||
foreach (@$dkim_sigs) {
|
|
||||||
if ($_ eq $from_dom) { # strict alignment, requires exact match
|
|
||||||
$self->log(LOGINFO, "pass, DKIM aligned");
|
|
||||||
$self->adjust_karma(1);
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
next if $policy->{adkim} && lc $policy->{adkim} eq 's'; # strict pol.
|
|
||||||
# relaxed policy (default): Org. Dom must match a DKIM sig
|
|
||||||
if ( $_ eq $org_dom ) {
|
|
||||||
$self->log(LOGINFO, "pass, DKIM aligned, relaxed");
|
|
||||||
$self->adjust_karma(1);
|
|
||||||
return 1;
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
||||||
return 0 if ! $spf_dom;
|
|
||||||
if ($spf_dom eq $from_dom) {
|
|
||||||
$self->adjust_karma(1);
|
|
||||||
$self->log(LOGINFO, "pass, SPF aligned");
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
return 0 if ($policy->{aspf} && lc $policy->{aspf} eq 's' ); # strict pol
|
|
||||||
if ($spf_dom eq $org_dom) {
|
|
||||||
$self->adjust_karma(1);
|
|
||||||
$self->log(LOGINFO, "pass, SPF aligned, relaxed");
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
return 0;
|
|
||||||
};
|
|
||||||
|
|
||||||
sub discover_policy {
|
|
||||||
my ($self, $from_dom, $org_dom) = @_;
|
|
||||||
|
|
||||||
# 1. Mail Receivers MUST query the DNS for a DMARC TXT record...
|
|
||||||
my @matches = $self->fetch_dmarc_record($from_dom, $org_dom) or return;
|
|
||||||
|
|
||||||
# 4. Records that do not include a "v=" tag that identifies the
|
|
||||||
# current version of DMARC are discarded.
|
|
||||||
@matches = grep /v=DMARC1/i, @matches;
|
|
||||||
if (0 == scalar @matches) {
|
|
||||||
$self->log(LOGINFO, "skip, no valid record for $from_dom");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
# 5. If the remaining set contains multiple records, processing
|
|
||||||
# terminates and the Mail Receiver takes no action.
|
|
||||||
if (@matches > 1) {
|
|
||||||
$self->log(LOGINFO, "skip, too many records");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
# 6. If a retrieved policy record does not contain a valid "p" tag, or
|
|
||||||
# contains an "sp" tag that is not valid, then:
|
|
||||||
my %policy = $self->parse_policy($matches[0]);
|
|
||||||
if (!$self->has_valid_p(\%policy) || $self->has_invalid_sp(\%policy)) {
|
|
||||||
|
|
||||||
# A. if an "rua" tag is present and contains at least one
|
|
||||||
# syntactically valid reporting URI, the Mail Receiver SHOULD
|
|
||||||
# act as if a record containing a valid "v" tag and "p=none"
|
|
||||||
# was retrieved, and continue processing;
|
|
||||||
# B. otherwise, the Mail Receiver SHOULD take no action.
|
|
||||||
my $rua = $policy{rua};
|
|
||||||
if (!$rua || !$self->has_valid_reporting_uri($rua)) {
|
|
||||||
$self->log(LOGINFO, "skip, no valid reporting rua");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
$policy{v} = 'DMARC1';
|
|
||||||
$policy{p} = 'none';
|
|
||||||
}
|
|
||||||
|
|
||||||
return \%policy;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub has_valid_p {
|
|
||||||
my ($self, $policy) = @_;
|
|
||||||
return 1 if $self->{_args}{p_vals}{$policy};
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub has_invalid_sp {
|
|
||||||
my ($self, $policy) = @_;
|
|
||||||
return 0 if !$self->{_args}{p_vals}{$policy};
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub has_valid_reporting_uri {
|
|
||||||
my ($self, $rua) = @_;
|
|
||||||
return 1 if 'mailto:' eq lc substr($rua, 0, 7);
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get_organizational_domain {
|
|
||||||
my ($self, $from_dom) = @_;
|
|
||||||
|
|
||||||
# 1. Acquire a "public suffix" list, i.e., a list of DNS domain
|
|
||||||
# names reserved for registrations. http://publicsuffix.org/list/
|
|
||||||
# $self->qp->config('public_suffix_list')
|
|
||||||
|
|
||||||
# 2. Break the subject DNS domain name into a set of "n" ordered
|
|
||||||
# labels. Number these labels from right-to-left; e.g. for
|
|
||||||
# "example.com", "com" would be label 1 and "example" would be
|
|
||||||
# label 2.;
|
|
||||||
my @labels = reverse split /\./, $from_dom;
|
|
||||||
|
|
||||||
# 3. Search the public suffix list for the name that matches the
|
|
||||||
# largest number of labels found in the subject DNS domain. Let
|
|
||||||
# that number be "x".
|
|
||||||
my $greatest = 0;
|
|
||||||
for (my $i = 0 ; $i <= scalar @labels ; $i++) {
|
|
||||||
next if !$labels[$i];
|
|
||||||
my $tld = join '.', reverse((@labels)[0 .. $i]);
|
|
||||||
|
|
||||||
# $self->log( LOGINFO, "i: $i, $tld" );
|
|
||||||
#warn "i: $i - tld: $tld\n";
|
|
||||||
if (grep /^$tld/, $self->qp->config('public_suffix_list')) {
|
|
||||||
$greatest = $i + 1;
|
|
||||||
next;
|
|
||||||
}
|
|
||||||
|
|
||||||
# check for wildcards (ex: *.uk should match co.uk)
|
|
||||||
$tld = join '.', '\*', reverse((@labels)[0 .. $i-1]);
|
|
||||||
if (grep /^$tld/, $self->qp->config('public_suffix_list')) {
|
|
||||||
$greatest = $i + 1;
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
||||||
return $from_dom if $greatest == scalar @labels; # same
|
|
||||||
|
|
||||||
# 4. Construct a new DNS domain name using the name that matched
|
|
||||||
# from the public suffix list and prefixing to it the "x+1"th
|
|
||||||
# label from the subject domain. This new name is the
|
|
||||||
# Organizational Domain.
|
|
||||||
return join '.', reverse((@labels)[0 .. $greatest]);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub exists_in_dns {
|
|
||||||
my ($self, $domain, $org_dom) = @_;
|
|
||||||
# 6. Receivers should endeavour to reject or quarantine email if the
|
|
||||||
# RFC5322.From purports to be from a domain that appears to be
|
|
||||||
# either non-existent or incapable of receiving mail.
|
|
||||||
|
|
||||||
# That's all the draft says. I went back to the DKIM ADSP (which led me to
|
|
||||||
# the ietf-dkim email list where some 'experts' failed to agree on The Right
|
|
||||||
# Way to test domain validity. Let alone deliverability. They point out:
|
|
||||||
# MX records aren't mandatory, and A|AAAA as fallback aren't reliable.
|
|
||||||
#
|
|
||||||
# Some experimentation proved both cases in real world usage. Instead, I test
|
|
||||||
# existence by searching for a MX, NS, A, or AAAA record. Since this search
|
|
||||||
# is repeated for the Organizational Name, if the NS query fails, there's no
|
|
||||||
# delegation from the TLD. That's proven very reliable.
|
|
||||||
my $res = $self->init_resolver(8);
|
|
||||||
my @todo = $domain;
|
|
||||||
push @todo, $org_dom if $domain ne $org_dom;
|
|
||||||
foreach ( @todo ) {
|
|
||||||
return 1 if $self->host_has_rr('MX', $res, $_);
|
|
||||||
return 1 if $self->host_has_rr('NS', $res, $_);
|
|
||||||
return 1 if $self->host_has_rr('A', $res, $_);
|
|
||||||
return 1 if $self->host_has_rr('AAAA', $res, $_);
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
||||||
sub host_has_rr {
|
|
||||||
my ($self, $type, $res, $domain) = @_;
|
|
||||||
|
|
||||||
my $query = $res->query($domain, $type) or do {
|
|
||||||
if ($res->errorstring eq 'NXDOMAIN') {
|
|
||||||
$self->log(LOGDEBUG, "fail, non-existent domain: $domain");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
return if $res->errorstring eq 'NOERROR';
|
|
||||||
$self->log(LOGINFO, "error, looking up $domain: " . $res->errorstring);
|
|
||||||
return;
|
|
||||||
};
|
|
||||||
my $matches = 0;
|
|
||||||
for my $rr ($query->answer) {
|
|
||||||
next if $rr->type ne $type;
|
|
||||||
$matches++;
|
|
||||||
}
|
|
||||||
if (0 == $matches) {
|
|
||||||
$self->log(LOGDEBUG, "no $type records for $domain");
|
|
||||||
}
|
|
||||||
return $matches;
|
|
||||||
};
|
|
||||||
|
|
||||||
sub fetch_dmarc_record {
|
|
||||||
my ($self, $zone, $org_dom) = @_;
|
|
||||||
|
|
||||||
# 1. Mail Receivers MUST query the DNS for a DMARC TXT record at the
|
|
||||||
# DNS domain matching the one found in the RFC5322.From domain in
|
|
||||||
# the message. A possibly empty set of records is returned.
|
|
||||||
$self->{_args}{is_subdomain} = defined $org_dom ? 0 : 1;
|
|
||||||
my $res = $self->init_resolver();
|
|
||||||
my $query = $res->send('_dmarc.' . $zone, 'TXT');
|
|
||||||
my @matches;
|
|
||||||
for my $rr ($query->answer) {
|
|
||||||
next if $rr->type ne 'TXT';
|
|
||||||
|
|
||||||
# 2. Records that do not start with a "v=" tag that identifies the
|
|
||||||
# current version of DMARC are discarded.
|
|
||||||
next if 'v=' ne lc substr($rr->txtdata, 0, 2);
|
|
||||||
next if 'v=spf' eq lc substr($rr->txtdata, 0, 5); # SPF commonly found
|
|
||||||
$self->log(LOGINFO, $rr->txtdata);
|
|
||||||
push @matches, join('', $rr->txtdata);
|
|
||||||
}
|
|
||||||
return @matches if scalar @matches; # found one! (at least)
|
|
||||||
|
|
||||||
# 3. If the set is now empty, the Mail Receiver MUST query the DNS for
|
|
||||||
# a DMARC TXT record at the DNS domain matching the Organizational
|
|
||||||
# Domain in place of the RFC5322.From domain in the message (if
|
|
||||||
# different). This record can contain policy to be asserted for
|
|
||||||
# subdomains of the Organizational Domain.
|
|
||||||
if ( defined $org_dom ) { # <- recursion break
|
|
||||||
if ( $org_dom eq $zone ) {
|
|
||||||
$self->log(LOGINFO, "skip, no policy for $zone (same org)");
|
|
||||||
return @matches;
|
|
||||||
};
|
|
||||||
return $self->fetch_dmarc_record($org_dom); # <- recursion
|
|
||||||
};
|
|
||||||
|
|
||||||
$self->log(LOGINFO, "skip, no policy for $zone");
|
|
||||||
return @matches;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get_from_dom {
|
|
||||||
my ($self, $transaction) = @_;
|
|
||||||
|
|
||||||
my $from = $transaction->header->get('From') or do {
|
|
||||||
$self->log(LOGINFO, "error, unable to retrieve From header!");
|
|
||||||
return;
|
|
||||||
};
|
|
||||||
my ($from_dom) = (split /@/, $from)[-1]; # grab everything after the @
|
|
||||||
($from_dom) = split /\s+/, $from_dom; # remove any trailing cruft
|
|
||||||
chomp $from_dom; # remove \n
|
|
||||||
chop $from_dom if '>' eq substr($from_dom, -1, 1); # remove closing >
|
|
||||||
$self->log(LOGDEBUG, "info, from_dom is $from_dom");
|
|
||||||
return $from_dom;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub parse_policy {
|
|
||||||
my ($self, $str) = @_;
|
|
||||||
$str =~ s/\s//g; # remove all whitespace
|
|
||||||
my %dmarc = map { split /=/, $_ } split /;/, $str;
|
|
||||||
|
|
||||||
#warn Data::Dumper::Dumper(\%dmarc);
|
|
||||||
return %dmarc;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub external_report {
|
|
||||||
|
|
||||||
=pod
|
|
||||||
|
|
||||||
The report SHOULD include the following data:
|
|
||||||
|
|
||||||
o Enough information for the report consumer to re-calculate DMARC
|
|
||||||
disposition based on the published policy, message dispositon, and
|
|
||||||
SPF, DKIM, and identifier alignment results. {R12}
|
|
||||||
|
|
||||||
o Data for each sender subdomain separately from mail from the
|
|
||||||
sender's organizational domain, even if no subdomain policy is
|
|
||||||
applied. {R13}
|
|
||||||
|
|
||||||
o Sending and receiving domains {R17}
|
|
||||||
|
|
||||||
o The policy requested by the Domain Owner and the policy actually
|
|
||||||
applied (if different) {R18}
|
|
||||||
|
|
||||||
o The number of successful authentications {R19}
|
|
||||||
|
|
||||||
o The counts of messages based on all messages received even if
|
|
||||||
their delivery is ultimately blocked by other filtering agents {R20}
|
|
||||||
|
|
||||||
=cut
|
|
||||||
|
|
||||||
};
|
|
||||||
|
|
||||||
sub verify_external_reporting {
|
|
||||||
|
|
||||||
=head2 Verify External Destinations
|
|
||||||
|
|
||||||
1. Extract the host portion of the authority component of the URI.
|
|
||||||
Call this the "destination host".
|
|
||||||
|
|
||||||
2. Prepend the string "_report._dmarc".
|
|
||||||
|
|
||||||
3. Prepend the domain name from which the policy was retrieved.
|
|
||||||
|
|
||||||
4. Query the DNS for a TXT record at the constructed name. If the
|
|
||||||
result of this request is a temporary DNS error of some kind
|
|
||||||
(e.g., a timeout), the Mail Receiver MAY elect to temporarily
|
|
||||||
fail the delivery so the verification test can be repeated later.
|
|
||||||
|
|
||||||
5. If the result includes no TXT resource records or multiple TXT
|
|
||||||
resource records, a positive determination of the external
|
|
||||||
reporting relationship cannot be made; stop.
|
|
||||||
|
|
||||||
6. Parse the result, if any, as a series of "tag=value" pairs, i.e.,
|
|
||||||
the same overall format as the policy record. In particular, the
|
|
||||||
"v=DMARC1" tag is mandatory and MUST appear first in the list.
|
|
||||||
If at least that tag is present and the record overall is
|
|
||||||
syntactically valid per Section 6.3, then the external reporting
|
|
||||||
arrangement was authorized by the destination ADMD.
|
|
||||||
|
|
||||||
7. If a "rua" or "ruf" tag is thus discovered, replace the
|
|
||||||
corresponding value extracted from the domain's DMARC policy
|
|
||||||
record with the one found in this record. This permits the
|
|
||||||
report receiver to override the report destination. However, to
|
|
||||||
prevent loops or indirect abuse, the overriding URI MUST use the
|
|
||||||
same destination host from the first step.
|
|
||||||
|
|
||||||
=cut
|
|
||||||
|
|
||||||
}
|
|
||||||
|
@ -24,9 +24,9 @@ MAIL FROM:user@example.com
|
|||||||
sub hook_mail_pre {
|
sub hook_mail_pre {
|
||||||
my ($self, $transaction, $addr) = @_;
|
my ($self, $transaction, $addr) = @_;
|
||||||
unless ($addr =~ /^<.*>$/) {
|
unless ($addr =~ /^<.*>$/) {
|
||||||
$self->log(LOGINFO, "added MAIL angle brackets");
|
|
||||||
$addr = '<' . $addr . '>';
|
$addr = '<' . $addr . '>';
|
||||||
$self->adjust_karma(-1);
|
$self->adjust_karma(-2);
|
||||||
|
$self->log(LOGINFO, "fail, added MAIL angle brackets");
|
||||||
}
|
}
|
||||||
return (OK, $addr);
|
return (OK, $addr);
|
||||||
}
|
}
|
||||||
@ -34,9 +34,9 @@ sub hook_mail_pre {
|
|||||||
sub hook_rcpt_pre {
|
sub hook_rcpt_pre {
|
||||||
my ($self, $transaction, $addr) = @_;
|
my ($self, $transaction, $addr) = @_;
|
||||||
unless ($addr =~ /^<.*>$/) {
|
unless ($addr =~ /^<.*>$/) {
|
||||||
$self->log(LOGINFO, "added RCPT angle brackets");
|
|
||||||
$addr = '<' . $addr . '>';
|
$addr = '<' . $addr . '>';
|
||||||
$self->adjust_karma(-1);
|
$self->adjust_karma(-2);
|
||||||
|
$self->log(LOGINFO, "fail, added RCPT angle brackets");
|
||||||
}
|
}
|
||||||
return (OK, $addr);
|
return (OK, $addr);
|
||||||
}
|
}
|
||||||
|
@ -208,7 +208,8 @@ use IO::Handle;
|
|||||||
use Socket qw(:DEFAULT :crlf);
|
use Socket qw(:DEFAULT :crlf);
|
||||||
|
|
||||||
sub register {
|
sub register {
|
||||||
my ($self, $qp) = (shift, shift);
|
my $self = shift;
|
||||||
|
my $qp = shift;
|
||||||
|
|
||||||
$self->log(LOGERROR, "Bad parameters for the dspam plugin") if @_ % 2;
|
$self->log(LOGERROR, "Bad parameters for the dspam plugin") if @_ % 2;
|
||||||
|
|
||||||
@ -590,20 +591,8 @@ sub train_error_as_ham {
|
|||||||
my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam';
|
my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam';
|
||||||
my $cmd =
|
my $cmd =
|
||||||
"$dspam_bin --user $user --mode=toe --source=error --class=innocent --deliver=summary --stdout";
|
"$dspam_bin --user $user --mode=toe --source=error --class=innocent --deliver=summary --stdout";
|
||||||
my $response = $self->dspam_process($cmd, $transaction);
|
$self->dspam_process($cmd, $transaction);
|
||||||
if ($response) {
|
return;
|
||||||
$transaction->notes('dspam', $response);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$transaction->notes(
|
|
||||||
'dspam',
|
|
||||||
{
|
|
||||||
class => 'Innocent',
|
|
||||||
result => 'Innocent',
|
|
||||||
confidence => 1
|
|
||||||
}
|
|
||||||
);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub train_error_as_spam {
|
sub train_error_as_spam {
|
||||||
@ -614,20 +603,8 @@ sub train_error_as_spam {
|
|||||||
my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam';
|
my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam';
|
||||||
my $cmd =
|
my $cmd =
|
||||||
"$dspam_bin --user $user --mode=toe --source=error --class=spam --deliver=summary --stdout";
|
"$dspam_bin --user $user --mode=toe --source=error --class=spam --deliver=summary --stdout";
|
||||||
my $response = $self->dspam_process($cmd, $transaction);
|
$self->dspam_process($cmd, $transaction);
|
||||||
if ($response) {
|
return;
|
||||||
$transaction->notes('dspam', $response);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$transaction->notes(
|
|
||||||
'dspam',
|
|
||||||
{
|
|
||||||
class => 'Spam',
|
|
||||||
result => 'Spam',
|
|
||||||
confidence => 1
|
|
||||||
}
|
|
||||||
);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub autolearn {
|
sub autolearn {
|
||||||
@ -649,6 +626,7 @@ sub autolearn {
|
|||||||
$self->autolearn_naughty($response, $transaction) and return;
|
$self->autolearn_naughty($response, $transaction) and return;
|
||||||
$self->autolearn_karma($response, $transaction) and return;
|
$self->autolearn_karma($response, $transaction) and return;
|
||||||
$self->autolearn_spamassassin($response, $transaction) and return;
|
$self->autolearn_spamassassin($response, $transaction) and return;
|
||||||
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub autolearn_naughty {
|
sub autolearn_naughty {
|
||||||
@ -723,8 +701,9 @@ sub autolearn_spamassassin {
|
|||||||
$self->log(LOGINFO, "training SA FN as spam");
|
$self->log(LOGINFO, "training SA FN as spam");
|
||||||
$self->train_error_as_spam($transaction);
|
$self->train_error_as_spam($transaction);
|
||||||
return 1;
|
return 1;
|
||||||
}
|
};
|
||||||
elsif ( $sa->{is_spam} eq 'No'
|
|
||||||
|
if ( $sa->{is_spam} eq 'No'
|
||||||
&& $sa->{autolearn} eq 'ham'
|
&& $sa->{autolearn} eq 'ham'
|
||||||
&& $response->{result} eq 'Spam')
|
&& $response->{result} eq 'Spam')
|
||||||
{
|
{
|
||||||
|
@ -196,20 +196,20 @@ sub invalid_date_range {
|
|||||||
my $date = shift || $self->transaction->header->get('Date') or return;
|
my $date = shift || $self->transaction->header->get('Date') or return;
|
||||||
chomp $date;
|
chomp $date;
|
||||||
|
|
||||||
my $ts = str2time($date) or do {
|
my $msg_ts = str2time($date) or do {
|
||||||
$self->log(LOGINFO, "skip, date not parseable ($date)");
|
$self->log(LOGINFO, "skip, date not parseable ($date)");
|
||||||
return;
|
return;
|
||||||
};
|
};
|
||||||
|
|
||||||
my $past = $self->{_args}{past};
|
my $past = $self->{_args}{past};
|
||||||
if ($past && $ts < time - ($past * 24 * 3600)) {
|
if ($past && $msg_ts < time - ($past * 24 * 3600)) {
|
||||||
$self->log(LOGINFO, "fail, date too old ($date)");
|
$self->log(LOGINFO, "fail, date too old ($date)");
|
||||||
$self->adjust_karma(-1);
|
$self->adjust_karma(-1);
|
||||||
return "The Date header is too far in the past";
|
return "The Date header is too far in the past";
|
||||||
}
|
}
|
||||||
|
|
||||||
my $future = $self->{_args}{future};
|
my $future = $self->{_args}{future};
|
||||||
if ($future && $ts > time + ($future * 24 * 3600)) {
|
if ($future && $msg_ts > time + ($future * 24 * 3600)) {
|
||||||
$self->log(LOGINFO, "fail, date in future ($date)");
|
$self->log(LOGINFO, "fail, date in future ($date)");
|
||||||
$self->adjust_karma(-1);
|
$self->adjust_karma(-1);
|
||||||
return "The Date header is too far in the future";
|
return "The Date header is too far in the future";
|
||||||
@ -218,3 +218,79 @@ sub invalid_date_range {
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
=head1 SMTP HEADERS
|
||||||
|
|
||||||
|
http://forum.unifiedemail.net/default.aspx?g=posts&t=68
|
||||||
|
|
||||||
|
=head2 From:
|
||||||
|
|
||||||
|
The eMail address, and optionally the name of the author(s). In many eMail clients not changeable except through changing account settings.
|
||||||
|
|
||||||
|
=head2 To:
|
||||||
|
|
||||||
|
The eMail address(es), and optionally name(s) of the message's recipient(s). Indicates primary recipients (multiple allowed), for secondary recipients see Cc: and Bcc: below.
|
||||||
|
|
||||||
|
=head2 Subject:
|
||||||
|
|
||||||
|
A brief summary of the topic of the message. Certain abbreviations are commonly used in the subject, including "RE:" and "FW:".
|
||||||
|
|
||||||
|
=head2 Date:
|
||||||
|
|
||||||
|
The local time and date when the message was written. Like the From: field, many email clients fill this in automatically when sending. The recipient's client may then display the time in the format and time zone local to him/her.
|
||||||
|
|
||||||
|
=head2 Message-ID:
|
||||||
|
|
||||||
|
Also an automatically generated field; used to prevent multiple delivery and for reference in In-Reply-To: (see below).
|
||||||
|
|
||||||
|
=head2 Bcc:
|
||||||
|
|
||||||
|
Blind Carbon Copy; addresses added to the SMTP delivery list but not (usually) listed in the message data, remaining invisible to other recipients.
|
||||||
|
|
||||||
|
=head2 Cc:
|
||||||
|
|
||||||
|
Carbon copy; Many eMail clients will mark eMail in your inbox differently depending on whether you are in the To: or Cc: list.
|
||||||
|
|
||||||
|
=head2 Content-Type:
|
||||||
|
|
||||||
|
Information about how the message is to be displayed, usually a MIME type.
|
||||||
|
|
||||||
|
=head2 In-Reply-To:
|
||||||
|
|
||||||
|
Message-ID of the message that this is a reply to. Used to link related messages together.
|
||||||
|
|
||||||
|
=head2 Precedence:
|
||||||
|
|
||||||
|
Commonly with values "bulk", "junk", or "list"; used to indicate that automated "vacation" or "out of office" responses should not be returned for this mail, e.g. to prevent vacation notices from being sent to all other subscribers of a mailinglist.
|
||||||
|
|
||||||
|
=head2 Received:
|
||||||
|
|
||||||
|
Tracking information generated by mail servers that have previously handled a message, in reverse order (last handler first).
|
||||||
|
|
||||||
|
=head2 References:
|
||||||
|
|
||||||
|
Message-ID of the message that this is a reply to, and the message-id of the message the previous was reply a reply to, etc.
|
||||||
|
|
||||||
|
=head2 Reply-To:
|
||||||
|
|
||||||
|
Address that should be used to reply to the message.
|
||||||
|
|
||||||
|
=head2 Sender:
|
||||||
|
|
||||||
|
Address of the actual sender acting on behalf of the author listed in the From: field (secretary, list manager, etc.).
|
||||||
|
|
||||||
|
=head2 Return-Path:
|
||||||
|
|
||||||
|
When the delivery SMTP server makes the "final delivery" of a message, it inserts a return-path line at the beginning of the mail data. Thisuse of return-path is required; mail systems MUST support it. The return-path line preserves the information in the from the MAIL command.
|
||||||
|
|
||||||
|
=head2 Error-To:
|
||||||
|
|
||||||
|
Indicates where error messages should be sent. In the absence of this line, they go to the Sender:, and absent that, the From: address.
|
||||||
|
|
||||||
|
=head2 X-*
|
||||||
|
|
||||||
|
No standard header field will ever begin with the characters "X-", so application developers are free to use them for their own purposes.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
@ -253,6 +253,7 @@ sub helo_handler {
|
|||||||
|
|
||||||
if (!$host) {
|
if (!$host) {
|
||||||
$self->log(LOGINFO, "fail, tolerated, no helo host");
|
$self->log(LOGINFO, "fail, tolerated, no helo host");
|
||||||
|
$self->adjust_karma(-2);
|
||||||
return DECLINED;
|
return DECLINED;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -116,10 +116,10 @@ use Qpsmtpd::Constants;
|
|||||||
#use Math::Trig; # eval'ed in set_distance_gc
|
#use Math::Trig; # eval'ed in set_distance_gc
|
||||||
|
|
||||||
sub register {
|
sub register {
|
||||||
my ($self, $qp) = shift, shift;
|
my ($self, $qp, @args) = @_;
|
||||||
|
|
||||||
$self->log(LOGERROR, "Bad arguments") if @_ % 2;
|
$self->log(LOGERROR, "Bad arguments") if @args % 2;
|
||||||
$self->{_args} = {@_};
|
$self->{_args} = {@args};
|
||||||
$self->{_args}{db_dir} ||= '/usr/local/share/GeoIP';
|
$self->{_args}{db_dir} ||= '/usr/local/share/GeoIP';
|
||||||
|
|
||||||
eval 'use Geo::IP';
|
eval 'use Geo::IP';
|
||||||
|
@ -210,8 +210,14 @@ There is little to be gained by listing servers that are already on DNS
|
|||||||
blacklists, send to invalid users, earlytalkers, etc. Those already have
|
blacklists, send to invalid users, earlytalkers, etc. Those already have
|
||||||
very lightweight tests.
|
very lightweight tests.
|
||||||
|
|
||||||
|
=head1 TODO
|
||||||
|
|
||||||
|
* Avoid storing results for DNSBL listed IPs
|
||||||
|
* some type of ASN integration, for tracking karma of 'neighborhoods'
|
||||||
|
|
||||||
=head1 AUTHOR
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
2013 - MS - Addeded penalty for spammy TLDs
|
||||||
2012 - Matt Simerson - msimerson@cpan.org
|
2012 - Matt Simerson - msimerson@cpan.org
|
||||||
|
|
||||||
=head1 ACKNOWLEDGEMENTS
|
=head1 ACKNOWLEDGEMENTS
|
||||||
@ -244,8 +250,8 @@ sub register {
|
|||||||
|
|
||||||
#$self->prune_db(); # keep the DB compact
|
#$self->prune_db(); # keep the DB compact
|
||||||
$self->register_hook('connect', 'connect_handler');
|
$self->register_hook('connect', 'connect_handler');
|
||||||
$self->register_hook('mail_pre', 'from_handler');
|
$self->register_hook('mail', 'from_handler');
|
||||||
$self->register_hook('rcpt_pre', 'rcpt_handler');
|
$self->register_hook('rcpt', 'rcpt_handler');
|
||||||
$self->register_hook('data', 'data_handler');
|
$self->register_hook('data', 'data_handler');
|
||||||
$self->register_hook('data_post', 'data_handler');
|
$self->register_hook('data_post', 'data_handler');
|
||||||
$self->register_hook('disconnect', 'disconnect_handler');
|
$self->register_hook('disconnect', 'disconnect_handler');
|
||||||
@ -323,17 +329,32 @@ sub connect_handler {
|
|||||||
}
|
}
|
||||||
|
|
||||||
sub from_handler {
|
sub from_handler {
|
||||||
my ($self, $transaction, $addr) = @_;
|
my ($self,$transaction, $sender, %args) = @_;
|
||||||
|
|
||||||
# test if sender has placed an illegal (RFC (2)821) space in envelope from
|
# test if sender has placed an illegal (RFC (2)821) space in envelope from
|
||||||
my $full_from = $self->connection->notes('envelope_from');
|
my $full_from = $self->connection->notes('envelope_from');
|
||||||
$self->illegal_envelope_format( $full_from );
|
$self->illegal_envelope_format( $full_from );
|
||||||
|
|
||||||
|
my %spammy_tlds = (
|
||||||
|
map { $_ => 4 } qw/ info pw /,
|
||||||
|
map { $_ => 3 } qw/ tw biz /,
|
||||||
|
map { $_ => 2 } qw/ cl br fr be jp no se sg /,
|
||||||
|
);
|
||||||
|
foreach my $tld ( keys %spammy_tlds ) {
|
||||||
|
my $len = length $tld;
|
||||||
|
my $score = $spammy_tlds{$tld} or next;
|
||||||
|
$len ++;
|
||||||
|
if ( $sender->host && ".$tld" eq substr($sender->host,-$len,$len) ) {
|
||||||
|
$self->log(LOGINFO, "penalizing .$tld envelope sender");
|
||||||
|
$self->adjust_karma(-$score);
|
||||||
|
};
|
||||||
|
};
|
||||||
|
|
||||||
return DECLINED;
|
return DECLINED;
|
||||||
};
|
};
|
||||||
|
|
||||||
sub rcpt_handler {
|
sub rcpt_handler {
|
||||||
my ($self, $transaction, $addr) = @_;
|
my ($self,$transaction, $recipient, %args) = @_;
|
||||||
|
|
||||||
$self->illegal_envelope_format(
|
$self->illegal_envelope_format(
|
||||||
$self->connection->notes('envelope_rcpt'),
|
$self->connection->notes('envelope_rcpt'),
|
||||||
@ -342,7 +363,7 @@ sub rcpt_handler {
|
|||||||
my $count = $self->connection->notes('recipient_count') || 0;
|
my $count = $self->connection->notes('recipient_count') || 0;
|
||||||
$count++;
|
$count++;
|
||||||
if ( $count > 1 ) {
|
if ( $count > 1 ) {
|
||||||
$self->log(LOGINFO, "recipients c: $count ($addr)");
|
$self->log(LOGINFO, "recipients c: $count ($recipient)");
|
||||||
$self->connection->notes('recipient_count', $count);
|
$self->connection->notes('recipient_count', $count);
|
||||||
};
|
};
|
||||||
|
|
||||||
@ -352,7 +373,7 @@ sub rcpt_handler {
|
|||||||
$self->log(LOGDEBUG, "info, no recipient count");
|
$self->log(LOGDEBUG, "info, no recipient count");
|
||||||
return DECLINED;
|
return DECLINED;
|
||||||
};
|
};
|
||||||
$self->log(LOGINFO, "recipients t: $recipients ($addr)");
|
$self->log(LOGINFO, "recipients t: $recipients ($recipient)");
|
||||||
|
|
||||||
my $history = $self->connection->notes('karma_history');
|
my $history = $self->connection->notes('karma_history');
|
||||||
if ( $history > 0 ) {
|
if ( $history > 0 ) {
|
||||||
@ -378,7 +399,7 @@ sub data_handler {
|
|||||||
|
|
||||||
# cutting off a naughty sender at DATA prevents having to receive the message
|
# cutting off a naughty sender at DATA prevents having to receive the message
|
||||||
my $karma = $self->connection->notes('karma');
|
my $karma = $self->connection->notes('karma');
|
||||||
if ( $karma < -3 ) { # bad karma
|
if ( $karma < -4 ) { # bad karma
|
||||||
return $self->get_reject("very bad karma: $karma");
|
return $self->get_reject("very bad karma: $karma");
|
||||||
};
|
};
|
||||||
|
|
||||||
@ -403,7 +424,7 @@ sub disconnect_handler {
|
|||||||
my $history = ($nice || 0) - $naughty;
|
my $history = ($nice || 0) - $naughty;
|
||||||
my $log_mess = '';
|
my $log_mess = '';
|
||||||
|
|
||||||
if ($karma < -1) { # they achieved at least 2 strikes
|
if ($karma < -2) { # they achieved at least 2 strikes
|
||||||
$history--;
|
$history--;
|
||||||
my $negative_limit = 0 - $self->{_args}{negative};
|
my $negative_limit = 0 - $self->{_args}{negative};
|
||||||
if ($history <= $negative_limit) {
|
if ($history <= $negative_limit) {
|
||||||
@ -420,7 +441,7 @@ sub disconnect_handler {
|
|||||||
$log_mess = "negative";
|
$log_mess = "negative";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif ($karma > 1) {
|
elsif ($karma > 2) {
|
||||||
$nice++;
|
$nice++;
|
||||||
$log_mess = "positive";
|
$log_mess = "positive";
|
||||||
}
|
}
|
||||||
@ -439,7 +460,7 @@ sub illegal_envelope_format {
|
|||||||
# test if envelope address has an illegal (RFC (2)821) space
|
# test if envelope address has an illegal (RFC (2)821) space
|
||||||
if ( uc substr($addr,0,6) ne 'FROM:<' && uc substr($addr,0,4) ne 'TO:<' ) {
|
if ( uc substr($addr,0,6) ne 'FROM:<' && uc substr($addr,0,4) ne 'TO:<' ) {
|
||||||
$self->log(LOGINFO, "illegal envelope address format: $addr" );
|
$self->log(LOGINFO, "illegal envelope address format: $addr" );
|
||||||
$self->adjust_karma(-1);
|
$self->adjust_karma(-2);
|
||||||
};
|
};
|
||||||
};
|
};
|
||||||
|
|
||||||
|
@ -140,11 +140,8 @@ sub naughty {
|
|||||||
return DECLINED;
|
return DECLINED;
|
||||||
};
|
};
|
||||||
$self->log(LOGINFO, "disconnecting");
|
$self->log(LOGINFO, "disconnecting");
|
||||||
my $type = $self->get_reject_type(
|
my $rtype = $self->connection->notes( 'naughty_reject_type' );
|
||||||
'disconnect',
|
my $type = $self->get_reject_type( 'disconnect', $rtype );
|
||||||
$self->connection->notes(
|
|
||||||
'naughty_reject_type')
|
|
||||||
);
|
|
||||||
return ($type, $naughty);
|
return ($type, $naughty);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -53,6 +53,7 @@ The reject options are modeled after, and aim to match the functionality of thos
|
|||||||
|
|
||||||
=head1 AUTHOR
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
Matt Simerson - 2013 - populate dmarc_spf note with SPF results
|
||||||
Matt Simerson - 2012 - increased policy options from 3 to 6
|
Matt Simerson - 2012 - increased policy options from 3 to 6
|
||||||
Matt Simerson - 2011 - rewrote using Mail::SPF
|
Matt Simerson - 2011 - rewrote using Mail::SPF
|
||||||
Matt Sergeant - 2003 - initial plugin
|
Matt Sergeant - 2003 - initial plugin
|
||||||
@ -88,11 +89,22 @@ sub register {
|
|||||||
sub mail_handler {
|
sub mail_handler {
|
||||||
my ($self, $transaction, $sender, %param) = @_;
|
my ($self, $transaction, $sender, %param) = @_;
|
||||||
|
|
||||||
return (DECLINED) if $self->is_immune();
|
if ( $self->is_immune() ) {
|
||||||
|
$transaction->notes('dmarc_spf', {
|
||||||
|
domain => $sender->host,
|
||||||
|
scope => 'mfrom',
|
||||||
|
result => 'pass',
|
||||||
|
} );
|
||||||
|
return (DECLINED);
|
||||||
|
};
|
||||||
|
|
||||||
my $format = $sender->format;
|
my $format = $sender->format;
|
||||||
if ($format eq '<>' || !$sender->host || !$sender->user) {
|
if ($format eq '<>' || !$sender->host || !$sender->user) {
|
||||||
$self->log(LOGINFO, "skip, null sender");
|
$self->log(LOGINFO, "skip, null sender");
|
||||||
|
$transaction->notes('dmarc_spf', {
|
||||||
|
scope => 'helo',
|
||||||
|
result => 'none',
|
||||||
|
} );
|
||||||
return (DECLINED, "SPF - null sender");
|
return (DECLINED, "SPF - null sender");
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -114,6 +126,12 @@ sub mail_handler {
|
|||||||
$req_params{helo_identity} = $helo;
|
$req_params{helo_identity} = $helo;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
$transaction->notes('dmarc_spf', {
|
||||||
|
domain => $scope eq 'helo' ? $helo : $sender->host,
|
||||||
|
scope => $scope,
|
||||||
|
result => 'none',
|
||||||
|
} );
|
||||||
|
|
||||||
my $spf_server = Mail::SPF::Server->new();
|
my $spf_server = Mail::SPF::Server->new();
|
||||||
my $request = Mail::SPF::Request->new(%req_params);
|
my $request = Mail::SPF::Request->new(%req_params);
|
||||||
my $result = $spf_server->process($request) or do {
|
my $result = $spf_server->process($request) or do {
|
||||||
@ -133,6 +151,12 @@ sub mail_handler {
|
|||||||
return (DECLINED, "SPF - no response");
|
return (DECLINED, "SPF - no response");
|
||||||
}
|
}
|
||||||
|
|
||||||
|
$transaction->notes('dmarc_spf', {
|
||||||
|
domain => $scope eq 'helo' ? $helo : $sender->host,
|
||||||
|
scope => $scope,
|
||||||
|
result => $code,
|
||||||
|
} );
|
||||||
|
|
||||||
$self->store_auth_results("spf=$code smtp.mailfrom=".$sender->host);
|
$self->store_auth_results("spf=$code smtp.mailfrom=".$sender->host);
|
||||||
|
|
||||||
if ($code eq 'pass') {
|
if ($code eq 'pass') {
|
||||||
|
@ -141,7 +141,7 @@ sub hook_unrecognized_command {
|
|||||||
return DENY, "TLS Negotiation Failed";
|
return DENY, "TLS Negotiation Failed";
|
||||||
}
|
}
|
||||||
|
|
||||||
$self->log(LOGWARN, "TLS setup returning");
|
$self->log(LOGINFO, "TLS setup returning");
|
||||||
return DONE;
|
return DONE;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -10,6 +10,8 @@ A qpsmtpd plugin for virus scanning using the ClamAV scan daemon, clamd.
|
|||||||
|
|
||||||
=head1 RESTRICTIONS
|
=head1 RESTRICTIONS
|
||||||
|
|
||||||
|
If connecting to clamd via TCP/IP host:port, then ignore this restriction.
|
||||||
|
|
||||||
The ClamAV scan daemon, clamd, must have at least execute access to the qpsmtpd
|
The ClamAV scan daemon, clamd, must have at least execute access to the qpsmtpd
|
||||||
spool directory in order to sucessfully scan the messages. You can ensure this
|
spool directory in order to sucessfully scan the messages. You can ensure this
|
||||||
by running clamd as the same user as qpsmtpd does, or by doing the following:
|
by running clamd as the same user as qpsmtpd does, or by doing the following:
|
||||||
@ -47,19 +49,26 @@ You must have the ClamAV::Client module installed to use the plugin.
|
|||||||
|
|
||||||
=item B<clamd_socket>
|
=item B<clamd_socket>
|
||||||
|
|
||||||
Full path to the clamd socket (the recommended mode), if different from the
|
Full path to the clamd socket, if different from the ClamAV::Client defaults.
|
||||||
ClamAV::Client defaults.
|
|
||||||
|
=item B<clamd_host>
|
||||||
|
|
||||||
|
IP address where clamd is listening.
|
||||||
|
|
||||||
|
Default: localhost
|
||||||
|
|
||||||
=item B<clamd_port>
|
=item B<clamd_port>
|
||||||
|
|
||||||
If present, must be the TCP port where the clamd service is running,
|
The TCP port where the clamd service is running, typically 3310.
|
||||||
typically 3310; default disabled. If present, overrides the clamd_socket.
|
|
||||||
|
Default: disabled. When present, overrides clamd_socket.
|
||||||
|
|
||||||
=item B<deny_viruses>
|
=item B<deny_viruses>
|
||||||
|
|
||||||
Whether the scanner will automatically delete messages which have viruses.
|
Whether the scanner will automatically delete messages which have viruses.
|
||||||
Takes either 'yes' or 'no' (defaults to 'yes'). If set to 'no' it will add
|
Takes either 'yes' or 'no'. If set to 'no', adds a header with the virus name.
|
||||||
a header to the message with the virus results.
|
|
||||||
|
Default: yes
|
||||||
|
|
||||||
=item B<defer_on_error>
|
=item B<defer_on_error>
|
||||||
|
|
||||||
@ -71,7 +80,9 @@ backlog or be lost if the condition persists.
|
|||||||
|
|
||||||
=item B<max_size>
|
=item B<max_size>
|
||||||
|
|
||||||
The maximum size, in kilobytes, of messages to scan; defaults to 128k.
|
The maximum size, in kilobytes, of messages to scan.
|
||||||
|
|
||||||
|
Default: 1024 (1 MB)
|
||||||
|
|
||||||
=item B<scan_all>
|
=item B<scan_all>
|
||||||
|
|
||||||
@ -94,6 +105,7 @@ adjusted for ClamAV::Client by Devin Carraway <qpsmtpd/@/devin.com>.
|
|||||||
|
|
||||||
Copyright (c) 2005 John Peacock,
|
Copyright (c) 2005 John Peacock,
|
||||||
Copyright (c) 2007 Devin Carraway
|
Copyright (c) 2007 Devin Carraway
|
||||||
|
Copyright (c) 2013 Matt Simerson
|
||||||
|
|
||||||
Based heavily on the clamav plugin
|
Based heavily on the clamav plugin
|
||||||
|
|
||||||
@ -106,10 +118,13 @@ use strict;
|
|||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
#use ClamAV::Client; # eval'ed in $self->register
|
#use ClamAV::Client; # eval'ed in $self->register
|
||||||
|
use Socket qw(:DEFAULT :crlf);
|
||||||
|
|
||||||
use Qpsmtpd::Constants;
|
use Qpsmtpd::Constants;
|
||||||
|
|
||||||
sub register {
|
sub register {
|
||||||
my ($self, $qp) = shift, shift;
|
my $self = shift;
|
||||||
|
my $qp = shift;
|
||||||
|
|
||||||
$self->log(LOGERROR, "Bad parameters for the clamdscan plugin") if @_ % 2;
|
$self->log(LOGERROR, "Bad parameters for the clamdscan plugin") if @_ % 2;
|
||||||
$self->{'_args'} = {@_};
|
$self->{'_args'} = {@_};
|
||||||
@ -138,7 +153,6 @@ sub register {
|
|||||||
sub data_post_handler {
|
sub data_post_handler {
|
||||||
my ($self, $transaction) = @_;
|
my ($self, $transaction) = @_;
|
||||||
|
|
||||||
my $filename = $self->get_filename($transaction) or return DECLINED;
|
|
||||||
|
|
||||||
if ($self->connection->notes('naughty')) {
|
if ($self->connection->notes('naughty')) {
|
||||||
$self->log(LOGINFO, "skip, naughty");
|
$self->log(LOGINFO, "skip, naughty");
|
||||||
@ -147,8 +161,6 @@ sub data_post_handler {
|
|||||||
return (DECLINED) if $self->is_too_big($transaction);
|
return (DECLINED) if $self->is_too_big($transaction);
|
||||||
return (DECLINED) if $self->is_not_multipart($transaction);
|
return (DECLINED) if $self->is_not_multipart($transaction);
|
||||||
|
|
||||||
$self->set_permission($filename) or return DECLINED;
|
|
||||||
|
|
||||||
my $clamd = $self->get_clamd()
|
my $clamd = $self->get_clamd()
|
||||||
or return $self->err_and_return("Cannot instantiate ClamAV::Client");
|
or return $self->err_and_return("Cannot instantiate ClamAV::Client");
|
||||||
|
|
||||||
@ -159,7 +171,18 @@ sub data_post_handler {
|
|||||||
my ($version) = split(/\//, $clamd->version);
|
my ($version) = split(/\//, $clamd->version);
|
||||||
$version ||= 'ClamAV';
|
$version ||= 'ClamAV';
|
||||||
|
|
||||||
my ($path, $found) = eval { $clamd->scan_path($filename) };
|
my ($path, $found);
|
||||||
|
if ( $self->{_args}{clamd_port} ) {
|
||||||
|
my $message = $self->assemble_message($transaction);
|
||||||
|
$found = eval { $clamd->scan_scalar(\$message) }; # pass scalar ref
|
||||||
|
# $found = eval { $clamd->scan_stream() }; # pass IO handle
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
my $filename = $self->get_filename($transaction) or return DECLINED;
|
||||||
|
$self->set_permission($filename) or return DECLINED;
|
||||||
|
($path, $found) = eval { $clamd->scan_path($filename) };
|
||||||
|
};
|
||||||
|
|
||||||
if ($@) {
|
if ($@) {
|
||||||
return $self->err_and_return("Error scanning mail: $@");
|
return $self->err_and_return("Error scanning mail: $@");
|
||||||
}
|
}
|
||||||
@ -186,6 +209,15 @@ sub data_post_handler {
|
|||||||
return (DECLINED);
|
return (DECLINED);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub assemble_message {
|
||||||
|
my ($self, $transaction) = @_;
|
||||||
|
$transaction->body_resetpos;
|
||||||
|
my $message = $transaction->header->as_string . "\n\n";
|
||||||
|
while (my $line = $transaction->body_getline) { $message .= $line; }
|
||||||
|
$message = join(CRLF, split /\n/, $message);
|
||||||
|
return $message . CRLF;
|
||||||
|
}
|
||||||
|
|
||||||
sub err_and_return {
|
sub err_and_return {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $message = shift;
|
my $message = shift;
|
||||||
|
@ -12,9 +12,7 @@ my $test_email = 'matt@tnpi.net';
|
|||||||
sub register_tests {
|
sub register_tests {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
$self->register_test('test_get_organizational_domain', 3);
|
# TODO: test against newer DMARC plugin that uses Mail::DMARC
|
||||||
$self->register_test("test_fetch_dmarc_record", 3);
|
|
||||||
$self->register_test("test_discover_policy", 1);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub setup_test_headers {
|
sub setup_test_headers {
|
||||||
|
Loading…
Reference in New Issue
Block a user