r1820 - in packages: . libmail-spf-query-perl
libmail-spf-query-perl/branches
libmail-spf-query-perl/branches/upstream
libmail-spf-query-perl/branches/upstream/current
libmail-spf-query-perl/branches/upstream/current/bin
libmail-spf-query-perl/branches/upstream/current/debian
libmail-spf-query-perl/branches/upstream/current/examples
libmail-spf-query-perl/branches/upstream/current/lib
libmail-spf-query-perl/branches/upstream/current/lib/Mail
libmail-spf-query-perl/branches/upstream/current/lib/Mail/SPF
libmail-spf-query-perl/branches/upstream/current/t
Julian Mehnle
jmehnle-guest at costa.debian.org
Sun Jan 1 18:10:34 UTC 2006
Author: jmehnle-guest
Date: 2006-01-01 18:09:38 +0000 (Sun, 01 Jan 2006)
New Revision: 1820
Added:
packages/libmail-spf-query-perl/
packages/libmail-spf-query-perl/branches/
packages/libmail-spf-query-perl/branches/upstream/
packages/libmail-spf-query-perl/branches/upstream/current/
packages/libmail-spf-query-perl/branches/upstream/current/CHANGES
packages/libmail-spf-query-perl/branches/upstream/current/MANIFEST
packages/libmail-spf-query-perl/branches/upstream/current/META.yml
packages/libmail-spf-query-perl/branches/upstream/current/Makefile.PL
packages/libmail-spf-query-perl/branches/upstream/current/README
packages/libmail-spf-query-perl/branches/upstream/current/bin/
packages/libmail-spf-query-perl/branches/upstream/current/bin/spfd
packages/libmail-spf-query-perl/branches/upstream/current/bin/spfquery
packages/libmail-spf-query-perl/branches/upstream/current/debian/
packages/libmail-spf-query-perl/branches/upstream/current/debian/changelog
packages/libmail-spf-query-perl/branches/upstream/current/debian/compat
packages/libmail-spf-query-perl/branches/upstream/current/debian/control
packages/libmail-spf-query-perl/branches/upstream/current/debian/copyright
packages/libmail-spf-query-perl/branches/upstream/current/debian/rules
packages/libmail-spf-query-perl/branches/upstream/current/examples/
packages/libmail-spf-query-perl/branches/upstream/current/examples/README
packages/libmail-spf-query-perl/branches/upstream/current/examples/exim-acl
packages/libmail-spf-query-perl/branches/upstream/current/examples/postfix-policyd-spf
packages/libmail-spf-query-perl/branches/upstream/current/examples/sendmail-milter
packages/libmail-spf-query-perl/branches/upstream/current/examples/sendmail-milter-INSTALL.txt
packages/libmail-spf-query-perl/branches/upstream/current/lib/
packages/libmail-spf-query-perl/branches/upstream/current/lib/Mail/
packages/libmail-spf-query-perl/branches/upstream/current/lib/Mail/SPF/
packages/libmail-spf-query-perl/branches/upstream/current/lib/Mail/SPF/Query.pm
packages/libmail-spf-query-perl/branches/upstream/current/t/
packages/libmail-spf-query-perl/branches/upstream/current/t/00_all.t
packages/libmail-spf-query-perl/branches/upstream/current/t/test.dat
packages/libmail-spf-query-perl/tags/
Log:
[svn-inject] Installing original source of libmail-spf-query-perl
Added: packages/libmail-spf-query-perl/branches/upstream/current/CHANGES
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/CHANGES 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/CHANGES 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,169 @@
+# Legend:
+# --- = A new release
+# x = Changed something significant, or removed a feature
+# * = Fixed a bug, or made a minor improvement
+# + = Added a feature (in a backwards compatible way)
+
+--- 1.998 (2005-12-31 23:00)
+
+ Mail::SPF::Query:
+ x Require Perl 5.6 or better.
+ x Require URI::Escape module, not URI module.
+ x Removed obsolete Caller-ID support (closes Debian bugs #337319, #337500).
+ x Always use Sys::Hostname::Long. And thus, require Sys::Hostname::Long to be
+ installed (closes Debian bugs #332952, #342629).
+ * Changed local machine hostname macro from "xr" to "r" (closes rt.cpan.org
+ bug #9744).
+ x Restrict the number of SPF record lookups to a maximum of 10 (was: 20).
+ Thanks to Craig Whitmore!
+ * Fixes to mechanisms implementation:
+ * a, mx: Check if domain is a valid FQDN, i.e. ends in ".<toplabel>".
+ * ip4: Return "unknown" (PermError) if no argument was specified. Also,
+ don't auto-complete "1.2.3" CIDR specs to "1.2.3.0", as such an
+ abbreviated syntax is forbidden by the SPF spec anyway.
+ Thanks to Craig Whitmore!
+ * Lots of minor code and documentation fixes/improvements.
+
+ spfd:
+ + Added complete POD documentation/man-page.
+ * Both "--xxx" and "-xxx" forms of command-line options are now supported.
+ x Renamed most of the command-line options:
+ --path => --socket
+ --pathuser => --socket-user
+ --pathgroup => --socket-group
+ --pathmode => --socket-perms
+ --setuser => --set-user
+ --setgroup => --set-group
+ The old option names are still supported for backwards compatibility.
+ * Do not print usage information when neither "--port" nor "--socket" are
+ specified (i.e. when the default TCP port would just be used). Print a
+ more specific hint instead.
+ * Added "--help" option to print usage information.
+ * Some minor code fixes/improvements.
+
+ spfquery:
+ + Added complete POD documentation/man-page.
+ * Exit with code 0 and do not print usage hint on '-v' (was Debian bug
+ #237751, has been already resolved in Debian release 1.997-3).
+ * Both "--xxx" and "-xxx" forms of command-line options are now supported.
+ Also, a "-x" (short) form is now supported for the most important options.
+ x Renamed the "--max-lookup" option to "--max-lookup-count" to match the
+ Mail::SPF::Query API. "--max-lookup" is still supported for backwards
+ compatibility.
+ * Added "--mail-from" and "-m" synonyms for the "--sender" option for
+ consistency with the "--helo" option.
+ * Cleaned up the "--help" usage output.
+ * Lots of minor code improvements.
+
+ Tests:
+ * Some minor tests improvements.
+ * Turned test.pl into .t file in t/ directory, so testing output is parsed
+ (closes rt.cpan.org bug #7748).
+ * Plan the correct number of tests, not just the number of non-comment lines
+ in test data file.
+
+ Debian:
+ + Added Debian package control files. This is now also a native Debian
+ package!
+
+ Miscellaneous:
+ x Updated URLs everywhere:
+ http://spf.pobox.com -> http://www.openspf.org
+ http://www.anarres.org/projects/srs/ -> http://www.libsrs2.org
+ http://asarian-host.net/srs/sendmailsrs.htm
+ -> http://srs-socketmap.info/sendmailsrs.htm
+ x Point out everywhere the "non-standard"-ness of best guess processing,
+ trusted forwarder accreditation checking, and several other features.
+ * Cleaned up source package file and directory layout:
+ Query.pm -> lib/Mail/SPF/Query.pm
+ Changes -> CHANGES
+ test.* -> t/
+ spf{d,query} -> bin/
+ sample/ -> examples/
+ + Added META.yml.
+ * postfix-policyd-spf:
+ * Generate "Received-SPF:" header unless rejecting (fail/Fail) or deferring
+ (error/TempError) the message.
+ * Verbose mode is disabled by default.
+ Thanks to Arjen de Korte!
+ x spf.py: Removed, because it was really old, and this is a Perl package, not
+ a Python one.
+ * Did I mention lots of minor code and documentation fixes/improvements?
+
+--- 1.997 (2004-04-26 06:07)
+
+ * Svn revs 72..76
+
+--- 1.996 (2004-02-27 18:39)
+
+ * Svn revs 71
+
+--- 1.994 (2004-02-26 22:55)
+
+ * Svn revs 68..70
+ * Bugfix for Net::CIDR::Lite -- we now recognize 1.2.3/0 syntax, not just
+ 1.2.3.4/0.
+
+--- 1.993 (2004-02-26 04:20)
+
+ * Svn revs 65..67
+ * Added support for Microsoft Caller-ID.
+
+--- 1.992 (2004-02-26 03:30)
+
+ * Svn revs 62..64
+ * Added fallback and override logic.
+ * Minor bugfixes.
+
+--- 1.991 (2004-01-29 06:29)
+
+ * Svn rev 61 (parts)
+
+--- 1.990 (2004-01-24 02:01)
+
+ * Svn rev 61 (parts)
+
+--- 1.980 (2004-01-14 03:40)
+
+ * Svn revs 58..60
+
+--- 1.970 (2004-01-10 00:20)
+
+ * Svn revs 53..57
+
+--- 1.960 (2003-12-19 03:21)
+
+ * Svn revs 51..52
+
+--- 1.010 (2003-12-18 19:33)
+
+--- 1.009.6 (2003-12-17 22:29)
+
+ * Svn revs 49..50
+
+--- 1.009.5 (2003-12-15 22:59)
+
+ * Svn revs 46..48
+
+--- 1.009.4 (2003-12-12 04:58)
+
+ * Svn revs 43..45
+
+--- 1.009.3 (2003-12-11 23:01)
+
+ * Svn revs 38..42
+
+--- 1.009.1 (2003-11-30 08:58)
+
+ * Svn rev 37
+
+--- 1.009 (2003-11-29 21:39)
+
+ * Svn revs 10..36
+
+--- 1.006 (2003-07-24 22:19)
+
+ * First public release.
+
+# $Id$
+# vim:tw=79 syn=changelog
Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/CHANGES
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ "Author Date Id Rev URL"
Name: svn:eol-style
+ native
Added: packages/libmail-spf-query-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/MANIFEST 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/MANIFEST 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,20 @@
+bin/spfd
+bin/spfquery
+CHANGES
+debian/changelog
+debian/compat
+debian/control
+debian/copyright
+debian/rules
+examples/exim-acl
+examples/postfix-policyd-spf
+examples/README
+examples/sendmail-milter
+examples/sendmail-milter-INSTALL.txt
+lib/Mail/SPF/Query.pm
+Makefile.PL
+MANIFEST
+META.yml Module meta-data (added by MakeMaker)
+README
+t/00_all.t
+t/test.dat
Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/MANIFEST
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ "Author Date Id Rev URL"
Name: svn:eol-style
+ native
Added: packages/libmail-spf-query-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/META.yml 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/META.yml 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,14 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Mail-SPF-Query
+version: 1.998
+version_from: lib/Mail/SPF/Query.pm
+installdirs: site
+requires:
+ Net::CIDR::Lite: 0.15
+ Net::DNS: 0.46
+ Sys::Hostname::Long: 0
+ URI::Escape: 0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/META.yml
___________________________________________________________________
Name: svn:mime-type
+ text/yaml
Name: svn:keywords
+ "Author Date Id Rev URL"
Name: svn:eol-style
+ native
Added: packages/libmail-spf-query-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/Makefile.PL 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/Makefile.PL 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,20 @@
+use 5.006;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'Mail::SPF::Query',
+ VERSION_FROM => 'lib/Mail/SPF/Query.pm',
+ ABSTRACT_FROM => 'lib/Mail/SPF/Query.pm',
+ AUTHOR => 'Meng Weng Wong <mengwong+spf at pobox.com>',
+ PREREQ_PM => {
+ Sys::Hostname::Long => 0,
+ Net::DNS => 0.46,
+ Net::CIDR::Lite => 0.15,
+ URI::Escape => 0
+ },
+ EXE_FILES => [
+ 'bin/spfd',
+ 'bin/spfquery'
+ ]
+);
Added: packages/libmail-spf-query-perl/branches/upstream/current/README
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/README 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/README 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,53 @@
+Mail::SPF::Query 1.998
+======================
+
+The SPF protocol relies on sender domains to publish a DNS whitelist of their
+designated outbound mailers. Given an envelope sender, Mail::SPF::Query
+determines the legitimacy of an SMTP client IP.
+
+About SPF: http://www.openspf.org
+Mail::SPF::Query: http://search.cpan.org/dist/Mail-SPF-Query
+
+USAGE
+
+ perl -MMail::SPF::Query -le \
+ 'print for Mail::SPF::Query->new( helo=>shift, ipv4=>shift, sender=>shift )->result' \
+ helohost.example.com 1.2.3.4 user at example.com
+
+ pass (client 1.2.3.4 is an authorized mailer for sender domain example.com)
+ fail (client 1.2.3.4 is not an authorized mailer for sender domain example.com)
+ softfail (client 1.2.3.4 is not an authorized mailer for transitioning sender domain example.com)
+ neutral (client 1.2.3.4 is neither authorized nor denied by sender domain example.com)
+ none (sender domain example.com does not designate sender policy)
+ error (temporary failure while resolving sender policy for sender domain example.com)
+ unknown (sender domain example.com has an invalid sender policy)
+
+NON-STANDARD FEATURES
+
+ * trusted-forwarder.org support
+ * best_guess support
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules:
+
+ Sys::Hostname::Long
+ Net::DNS 0.46+
+ Net::CIDR::Lite 0.15+
+ URI::Escape
+
+COPYRIGHT AND LICENCE
+
+Released under the same terms as Perl, i.e. the GPL-2 and Artistic License.
+
+Copyright (C) 2003-2005 Meng Weng Wong <mengwong+spf at pobox.com>
+Contributions by various members of the SPF project <http://www.openspf.org>
Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/README
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ "Author Date Id Rev URL"
Name: svn:eol-style
+ native
Added: packages/libmail-spf-query-perl/branches/upstream/current/bin/spfd
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/bin/spfd 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/bin/spfd 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,349 @@
+#!/usr/bin/perl
+
+# spfd: Simple forking daemon to provide SPF query services
+# 2005-12-27 16:17 UTC
+# (C) 2003-2004 Meng Weng Wong <mengwong+spf at pobox.com>
+# Improved argument parsing added by Julian Mehnle <julian at mehnle.net>
+# If you're reading source code, you should probably be on spf-devel at v2.listbox.com.
+
+=head1 NAME
+
+spfd - simple forking daemon to provide SPF query services
+
+=head1 VERSION
+
+2005-12-27
+
+=head1 SYNOPSIS
+
+B<spfd> B<--port> I<port> [B<--set-user> I<uid>|I<username>] [B<--set-group>
+I<gid>|I<groupname>]
+
+B<spfd> B<--socket> I<filename> [B<--socket-user> I<uid>|I<username>]
+[B<--socket-group> I<gid>|I<groupname>] [B<--socket-perms> I<octal-perms>]
+[B<--set-user> I<uid>|I<username>] [B<--set-group> I<gid>|I<groupname>]
+
+B<spfd> B<--help>
+
+=head1 DESCRIPTION
+
+B<spfd> is a simple forking Sender Policy Framework (SPF) query proxy server.
+spfd receives and answers SPF query requests on a TCP/IP or UNIX domain
+socket.
+
+The B<--port> form listens on a TCP/IP socket on the specified I<port>. The
+default port is B<5970>.
+
+The B<--socket> form listens on a UNIX domain socket that is created with the
+specified I<filename>. The socket can be assigned specific user and group
+ownership with the B<--socket-user> and B<--socket-group> options, and specific
+filesystem permissions with the B<--socket-perms> option.
+
+Generally, spfd can be instructed with the B<--set-user> and B<--set-group>
+options to drop root privileges and change to another user and group before it
+starts listening for requests.
+
+The B<--help> form prints usage information for B<spfd>.
+
+=head1 REQUEST
+
+A request consists of a series of lines delimited by \x0A (LF) characters (or
+whatever your system considers a newline). Each line must be of the form
+I<key>B<=>I<value>, where the following keys are required:
+
+=over
+
+=item B<ip>
+
+The sender IP address.
+
+=item B<sender>
+
+The envelope sender address (from the SMTP C<MAIL FROM> command).
+
+=item B<helo>
+
+The envelope sender hostname (from the SMTP C<HELO> command).
+
+=back
+
+=head1 RESPONSE
+
+spfd responds to query requests with similar series of lines of the form
+I<key>B<=>I<value>. The most important response keys are:
+
+=over
+
+=item B<result>
+
+The result of the SPF query:
+
+=over 10
+
+=item I<pass>
+
+The specified IP address is an authorized mailer for the sender domain/address.
+
+=item I<fail>
+
+The specified IP address is not an authorized mailer for the sender
+domain/address.
+
+=item I<softfail>
+
+The specified IP address is not an authorized mailer for the sender
+domain/address, however the domain is still in the process of transitioning to
+SPF.
+
+=item I<neutral>
+
+The sender domain makes no assertion about the status of the IP address.
+
+=item I<unknown>
+
+The sender domain has a syntax error in its SPF record.
+
+=item I<error>
+
+A temporary DNS error occurred while resolving the sender policy. Try again
+later.
+
+=item I<none>
+
+There is no SPF record for the sender domain.
+
+=back
+
+=item B<smtp_comment>
+
+The text that should be included in the receiver's SMTP response.
+
+=item B<header_comment>
+
+The text that should be included as a comment in the message's C<Received-SPF:>
+header.
+
+=item B<spf_record>
+
+The SPF record of the envelope sender domain.
+
+=back
+
+For the description of other response keys see L<Mail::SPF::Query>.
+
+For more information on SPF see L<http://www.openspf.org>.
+
+=head1 EXAMPLE
+
+A running spfd could be tested using the C<netcat> utility like this:
+
+ $ echo -e "ip=11.22.33.44\nsender=user at pobox.com\nhelo=spammer.example.net\n" | nc localhost 5970
+ result=neutral
+ smtp_comment=Please see http://spf.pobox.com/why.html?sender=user%40pobox.com&ip=11.22.33.44&receiver=localhost
+ header_comment=localhost: 11.22.33.44 is neither permitted nor denied by domain of user at pobox.com
+ guess=neutral
+ smtp_guess=
+ header_guess=
+ guess_tf=neutral
+ smtp_tf=
+ header_tf=
+ spf_record=v=spf1 ?all
+
+=head1 SEE ALSO
+
+L<Mail::SPF::Query>, L<http://www.openspf.org>
+
+=head1 AUTHORS
+
+This version of B<spfd> was written by Meng Weng Wong <mengwong+spf at pobox.com>.
+Improved argument parsing was added by Julian Mehnle <julian at mehnle.net>.
+
+This man-page was written by Julian Mehnle <julian at mehnle.net>.
+
+=cut
+
+use warnings;
+use strict;
+
+use Mail::SPF::Query;
+use Getopt::Long qw(:config gnu_compat);
+use Socket;
+
+use constant DEBUG => $ENV{DEBUG};
+
+sub usage () {
+ print STDERR <<'EOT';
+Usage:
+ spfd --port <port>
+ [--set-user <uid>|<username>] [--set-group <gid>|<groupname>]
+ spfd --socket <filename> [--socket-user <uid>|<username>]
+ [--socket-group <gid>|<groupname>] [--socket-perms <octal-perms>]
+ [--set-user <uid>|<username>] [--set-group <gid>|<groupname>]
+EOT
+}
+
+my %opt;
+
+my $getopt_result = GetOptions(
+ \%opt,
+ 'port=i',
+ 'socket|path=s',
+ 'socket-user|pathuser=s',
+ 'socket-group|pathgroup=s',
+ 'socket-perms|pathmode=s',
+ 'set-user|setuser=s',
+ 'set-group|setgroup=s',
+ 'help!'
+);
+
+if ($opt{help}) {
+ usage;
+ exit 0;
+}
+
+if ($opt{port} and $opt{socket}) {
+ usage;
+ exit 1;
+}
+
+if (not $opt{port} and not $opt{socket}) {
+ print STDERR "Using default TCP/IP port. Run `spfd --help` for possible options.\n";
+ $opt{port} = 5970;
+}
+
+$| = 1;
+
+my @args;
+my $sock_type;
+
+if ($opt{port}) {
+ $sock_type = 'inet';
+ @args = (Listen => 1,
+ LocalAddr => '127.0.0.1',
+ LocalPort => $opt{port},
+ ReuseAddr => 1
+ );
+ print "$$: will listen on TCP port $opt{port}\n";
+ $0 = "spfd listening on TCP port $opt{port}";
+} elsif ($opt{socket}) {
+ $sock_type = 'unix';
+ unlink $opt{socket} if -S $opt{socket};
+ @args = (Listen => 1,
+ Local => $opt{socket},
+ );
+ print "$$: will listen at UNIX socket $opt{socket}\n";
+ $0 = "spfd listening at UNIX socket $opt{socket}";
+}
+
+print "$$: creating server with args @args\n";
+
+my $server = $sock_type eq 'inet' ? IO::Socket::INET->new(@args) : IO::Socket::UNIX->new(@args);
+
+if ($opt{socket}) {
+ if (defined $opt{'socket-user'} or defined $opt{'socket-group'}) {
+ $opt{'socket-user'} = -1 if not defined($opt{'socket-user'});
+ $opt{'socket-group'} = -1 if not defined($opt{'socket-group'});
+
+ if ($opt{'socket-user'} =~ /\D/) {
+ $opt{'socket-user'} = getpwnam($opt{'socket-user'}) || die "User: $opt{'socket-user'} not found\n";
+ }
+
+ if ($opt{'socket-group'} =~ /\D/) {
+ $opt{'socket-group'} = getgrnam($opt{'socket-group'}) || die "Group: $opt{'socket-group'} not found\n";
+ }
+
+ chown $opt{'socket-user'}, $opt{'socket-group'}, $opt{socket} or die "chown call failed on $opt{socket}: $!\n";
+ }
+ if (defined $opt{'socket-perms'}) {
+ chmod oct($opt{'socket-perms'}), $opt{socket} or die "Cannot fixup perms on $opt{socket}: $!\n";
+ }
+}
+
+DEBUG and print "$$: server is $server\n";
+
+if ($opt{'set-group'}) {
+ if ($opt{'set-group'} =~ /\D/) {
+ $opt{'set-group'} = getgrnam($opt{'set-group'}) || die "Group: $opt{'set-group'} not found\n";
+ }
+ $( = $opt{'set-group'};
+ $) = $opt{'set-group'};
+ unless ($( == $opt{'set-group'} and $) == $opt{'set-group'}) {
+ die( "setgid($opt{'set-group'}) call failed: $!\n" );
+ }
+}
+
+if ($opt{'set-user'}) {
+ if ($opt{'set-user'} =~ /\D/) {
+ $opt{'set-user'} = getpwnam($opt{'set-user'}) || die "User: $opt{'set-user'} not found\n";
+ }
+ $< = $opt{'set-user'};
+ $> = $opt{'set-user'};
+ unless ($< == $opt{'set-user'} and $> == $opt{'set-user'}) {
+ die( "setuid($opt{'set-user'}) call failed: $!\n" );
+ }
+}
+
+while (my $sock = $server->accept()) {
+ if (fork) { close $sock; wait; next; } # this is the grandfather trick.
+ elsif (fork) { exit; } # the child exits immediately, so no zombies.
+
+ my $oldfh = select($sock); $| = 1; select($oldfh);
+
+ my %in;
+
+ while (<$sock>) {
+ chomp; chomp;
+ last if (/^$/);
+ my ($lhs, $rhs) = split /=/, $_, 2;
+ $in{lc $lhs} = $rhs;
+ }
+
+ my $peerinfo = $sock_type eq "inet" ? ($sock->peerhost . "/" . gethostbyaddr($sock->peeraddr, AF_INET)) : "";
+
+ my $time = localtime;
+
+ DEBUG and print "$time $peerinfo\n";
+ foreach my $key (sort keys %in) { DEBUG and print "learned $key = $in{$key}\n" };
+
+ my %q = map { exists $in{$_} ? ($_ => $in{$_}) : () } qw ( ip ipv4 ipv6 sender helo guess_mechs trusted local );
+
+ my %a;
+
+ my $query = eval { Mail::SPF::Query->new(%q); };
+
+ my $error = $@; for ($error) { s/\n/ /; s/\s+$//; }
+
+ if ($@) { @a{qw(result smtp_comment header_comment)} = ("unknown", $error, "SPF error: $error"); }
+ else {
+ @a{qw(result smtp_comment header_comment spf_record)} = $query->result();
+ @a{qw(guess smtp_guess header_guess )} = $query->best_guess();
+ @a{qw(guess_tf smtp_tf header_tf )} = $query->trusted_forwarder();
+ }
+
+ if (DEBUG) {
+ for (qw(result smtp_comment header_comment
+ guess smtp_guess header_guess
+ guess_tf smtp_tf header_tf
+ spf_record
+ )) {
+ print "moo! $_=$a{$_}\n";
+ }
+ }
+
+ for (qw(result smtp_comment header_comment
+ guess smtp_guess header_guess
+ guess_tf smtp_tf header_tf
+ spf_record
+ )) {
+ no warnings 'uninitialized';
+ print $sock "$_=$a{$_}\n";
+ }
+
+ DEBUG and print "moo! output all done.\n";
+ print $sock "\n";
+ DEBUG and print "\n";
+
+ close $sock;
+
+ exit;
+}
Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/bin/spfd
___________________________________________________________________
Name: svn:executable
+
Added: packages/libmail-spf-query-perl/branches/upstream/current/bin/spfquery
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/bin/spfquery 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/bin/spfquery 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,485 @@
+#!/usr/bin/perl
+
+# spfquery - Sender Permitted From command line utility
+#
+# Author: Wayne Schlitt <wayne at midwestcs.com>
+#
+# File: spfquery.c
+# Desc: SPF command line utility
+#
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of either:
+#
+# a) The GNU Lesser General Public License as published by the Free
+# Software Foundation; either version 2.1, or (at your option) any
+# later version,
+#
+# OR
+#
+# b) The two-clause BSD license.
+#
+#
+# The two-clause BSD license:
+#
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+#
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+=head1 NAME
+
+spfquery - checks if an IP address is an SPF-authorized SMTP sender for a
+domain
+
+=head1 VERSION
+
+2.2
+
+=head1 SYNOPSIS
+
+B<spfquery> B<--mail-from>|B<-m>|B<--sender>|B<-s> I<email-address>|I<domain>
+B<--ip>|B<-i> I<ip-address> [B<--rcpt-to>|B<-r> I<email-address>] [I<OPTIONS>]
+
+B<spfquery> B<--helo>|B<-h> I<hostname> B<--ip>|B<-i> I<ip-address>
+[B<--rcpt-to>|B<-r> I<email-address>] [I<OPTIONS>]
+
+B<spfquery> B<--file>|B<-f> I<filename>|B<-> [I<OPTIONS>]
+
+B<spfquery> B<--version>|B<-V>
+
+B<spfquery> B<--help>
+
+=head1 DESCRIPTION
+
+B<spfquery> performs Sender Policy Framework (SPF) authorization checks based
+on the command-line arguments or data given in a file or on standard input.
+For information on SPF see L<http://www.openspf.org>.
+
+The B<--mail-from> form checks if the given I<ip-address> is an authorized SMTP
+sender for the given envelope sender I<domain> or I<email-address> (so-called
+C<MAIL FROM> check).
+
+The B<--helo> form checks if the given I<ip-address> is an authorized SMTP
+sender for the given C<HELO> I<hostname> (so-called C<HELO> check).
+
+The B<--file> form reads (I<ip-address>, I<sender-address>, I<helo-hostname>)
+tuples from the file with the specified I<filename>, or from standard input if
+I<filename> is B<->.
+
+The B<--version> form prints version information of spfquery. The B<--help>
+form prints usage information for spfquery.
+
+=head1 OPTIONS
+
+The B<--mail-from>, B<--helo>, and B<--file> forms optionally take any of the
+following additional I<OPTIONS>:
+
+=over
+
+=item B<--debug>
+
+Print out debug information.
+
+=item B<--local> I<spf-terms>
+
+Process I<spf-terms> as local policy before resorting to a default result
+(the implicit or explicit C<all> mechanism at the end of the domain's SPF
+record). For example, this could be used for white-listing one's secondary
+MXes: C<mx:mydomain.example.org>.
+
+=item B<--trusted>
+
+=item B<--no-trusted>
+
+Do (not) perform C<trusted-forwarder.org> accreditation checking. Disabled by
+default. B<This is a non-standard feature.>
+
+=item B<--guess> I<spf-terms>
+
+Use I<spf-terms> as a default record if no SPF record is found. B<This is a
+non-standard feature.>
+
+=item B<--default-explanation> I<string>
+
+Use the specified I<string> as the default explanation if the SPF record does
+not specify an explanation string itself.
+
+=item B<--max-lookup-count> I<n>
+
+Perform a maximum of I<n> SPF record lookups. Defaults to B<10>.
+
+=item B<--sanitize>
+
+=item B<--no-sanitize>
+
+Do (not) sanitize the output by condensing consecutive white-space into a
+single space and replacing non-printable characters with question marks.
+Enabled by default.
+
+=item B<--name> I<hostname>
+
+Use I<hostname> as the hostname of the local system instead of auto-detecting
+it.
+
+=item B<--override> I<...>
+
+=item B<--fallback> I<...>
+
+Set overrides and fallbacks. See L<Mail::SPF::Query>.
+
+=item B<--keep-comments>
+
+=item B<--no-keep-comments>
+
+Do (not) print any comments found when reading from a file or from standard
+input.
+
+=back
+
+=head1 RESULT CODES
+
+=over 10
+
+=item B<pass>
+
+The specified IP address is an authorized mailer for the sender domain/address.
+
+=item B<fail>
+
+The specified IP address is not an authorized mailer for the sender
+domain/address.
+
+=item B<softfail>
+
+The specified IP address is not an authorized mailer for the sender
+domain/address, however the domain is still in the process of transitioning to
+SPF.
+
+=item B<neutral>
+
+The sender domain makes no assertion about the status of the IP address.
+
+=item B<unknown>
+
+The sender domain has a syntax error in its SPF record.
+
+=item B<error>
+
+A temporary DNS error occurred while resolving the sender policy. Try again
+later.
+
+=item B<none>
+
+There is no SPF record for the sender domain.
+
+=back
+
+=head1 EXIT CODES
+
+=over
+
+=item B<0>
+
+pass
+
+=item B<1>
+
+fail
+
+=item B<2>
+
+softfail
+
+=item B<3>
+
+neutral
+
+=item B<4>
+
+unknown
+
+=item B<5>
+
+error
+
+=item B<6>
+
+none
+
+=back
+
+=head1 EXAMPLES
+
+ spfquery -i 11.22.33.44 -m user at example.com -h spammer.example.net
+ spfquery -f test_data
+ echo "127.0.0.1 user at example.com helohost.example.com" | spfquery -f -
+
+=head1 SEE ALSO
+
+L<Mail::SPF::Query>, L<spfd>
+
+=head1 AUTHORS
+
+This version of B<spfquery> was written by Wayne Schlitt <wayne at midwestcs.com>.
+
+This man-page was written by Julian Mehnle <julian at mehnle.net>, based on a
+man-page written by S. Zachariah Sprackett for an older version of B<spfquery>.
+
+=cut
+
+our $VERSION = "2.2";
+
+use warnings;
+use strict;
+
+use Mail::SPF::Query;
+use Getopt::Long qw(:config gnu_compat);
+
+sub usage()
+{
+ printf STDERR <<'EOT';
+Usage:
+ spfquery [ control options | data options ]
+
+Use the --help option for more information.
+EOT
+}
+
+sub help()
+{
+ print STDERR <<'EOT';
+Usage:
+ spfquery [ control options | data options ]
+
+Valid data options are:
+ --mail-from <sender-address>
+ The email address used as the envelope sender address
+ (SMTP MAIL FROM command). If no local part is given,
+ 'postmaster' will be assumed.
+ --helo <hostname> The domain name given as the envelope sender hostname
+ (SMTP HELO command).
+ --file <filename> Read parameters from a file. Use '-' to read from
+ stdin.
+
+ --ip <ip-address> The IP address that is sending email.
+ --rcpt-to <email-addresses>
+ A comma-separated lists of email addresses that will
+ have email from their secondary MXes automatically
+ allowed.
+
+Any one of --sender, --helo, or --file is required. The --rcpt-to option is
+optional. The --file option conflicts with all the other data options
+
+Valid control options are:
+ --debug Output debugging information.
+ --local <spf-terms> Local policy for whitelisting.
+ --trusted Check trusted-forwarder.org white-list.
+ --guess <spf-terms> Default checks if no SPF record is found.
+ --default-explanation <string>
+ Default explanation string to use.
+ --max-lookup-count <n>
+ Maximum number of DNS lookups to allow.
+ --no-sanitize Do not clean up invalid characters in output.
+ --name <hostname> The name of the system doing the SPF checking.
+ --fallback <...> Fallback SPF records for domains.
+ --override <...> Override SPF records for domains.
+ --keep-comments Print comments found when reading from a file.
+
+ --version Print version of spfquery.
+ --help Print out these options.
+
+Examples:
+ spfquery -i 11.22.33.44 -m user at example.com -h spammer.example.net
+ spfquery -f test_data
+ echo "127.0.0.1 user at example.com helohost.example.com" | spfquery -f -
+EOT
+}
+
+my %opt;
+
+my $result = GetOptions(
+ \%opt,
+
+ 'file|f=s',
+ 'ip|ipv4|i=s',
+ 'mail-from|mfrom|m|sender|s=s',
+ 'helo|h=s',
+ 'rcpt-to|r=s',
+
+ 'debug!',
+ 'local=s',
+ 'trusted!',
+ 'guess=s',
+ 'default-explanation=s',
+ 'max-lookup-count|max-lookup=i',
+ 'sanitize!',
+ 'name=s',
+ 'fallback=s',
+ 'override=s',
+ 'keep-comments!',
+
+ 'version|V!',
+ 'help!'
+);
+
+$opt{name} = 'spfquery' if not defined($opt{name});
+
+if ($opt{help}) {
+ help();
+ exit 255;
+}
+
+if (!$result) {
+ usage();
+ exit 255;
+}
+
+if ($opt{version}) {
+ printf STDERR "spfquery version %s\n\n", $VERSION;
+ exit 0;
+}
+
+#
+# process the SPF request
+#
+my $res;
+
+if (!defined($opt{ip}) || (!defined($opt{sender}) && !defined($opt{helo}))) {
+ if (!defined($opt{file}) ||
+ defined($opt{ip}) || defined($opt{sender}) || defined($opt{helo})) {
+ usage();
+ exit 255;
+ }
+
+ #
+ # the requests are on STDIN
+ #
+
+ local *FIN;
+
+ if ( $opt{file} eq "-" ) {
+ *FIN = \*STDIN;
+ }
+ else {
+ open( FIN, $opt{file} ) || die "Could not open: %s\n", $opt{file};
+ }
+
+ while ( <FIN> ) {
+ chomp;
+
+ if ( /^\s*$/ || /^\s*#/ ) {
+ if ( $opt{'keep-comments'} ) {
+ printf "%s\n", $_;
+ }
+
+ next;
+ }
+ s/^\s*//;
+
+ ($opt{ip}, $opt{sender}, $opt{helo}, $opt{'rcpt-to'}) = split;
+
+ $res = do_query();
+ }
+}
+else {
+ if (defined($opt{file})) {
+ usage();
+ exit 255;
+ }
+
+ $res = do_query();
+}
+
+exit $res;
+
+
+
+sub do_query {
+
+
+ #
+ # Process the SPF request and print the results
+ #
+
+ $opt{sender} = '' if not defined($opt{sender});
+ $opt{helo} = '' if not defined($opt{helo});
+
+ my $query = new Mail::SPF::Query (ipv4 => $opt{ip},
+ sender => $opt{sender},
+ helo => $opt{helo},
+ local => $opt{local},
+ trusted => $opt{trusted},
+ guess => $opt{guess},
+ default_explanation => $opt{exp},
+ max_lookup_count => $opt{'max-lookup-count'},
+ sanitize => $opt{sanitize},
+ myhostname => $opt{name},
+ fallback => $opt{fallback},
+ override => $opt{override},
+ debug => $opt{debug}
+ );
+
+ my ($result, $smtp_comment, $header_comment);
+ my $per_result;
+ if (!defined($opt{'rcpt-to'}) || $opt{'rcpt-to'} eq '') {
+ ($result, $smtp_comment, $header_comment) = $query->result;
+ $per_result = $result;
+ }
+ else {
+ $result = "";
+ foreach my $recip (split(',', $opt{'rcpt-to'})) {
+
+ ($per_result, $smtp_comment, $header_comment) = $query->result2( split(';', $recip));
+ if ($result eq "" ) {
+ $result = $per_result;
+ }
+ else {
+ $result .= ",".$per_result;
+ }
+ }
+ ($per_result, $smtp_comment, $header_comment) = $query->message_result2;
+
+ if ($result eq "" ) {
+ $result = $per_result;
+ }
+ else {
+ $result .= ",".$per_result;
+ }
+ }
+
+ my $received_spf;
+ $received_spf = "Received-SPF: $per_result ($header_comment) client-ip=$opt{ip};";
+ $received_spf .= " envelope-from=$opt{sender};" if defined($opt{sender});
+ $received_spf .= " helo=$opt{helo};" if defined($opt{helo});
+ { no warnings 'uninitialized';
+ print "$result\n$smtp_comment\n$header_comment\n$received_spf\n";
+ }
+
+ return 0 if $result eq "pass";
+ return 1 if $result eq "fail";
+ return 2 if $result eq "softfail";
+ return 3 if $result eq "neutral";
+ return 4 if $result eq "unknown";
+ return 5 if $result eq "error";
+ return 6 if $result eq "none";
+
+ return 255;
+}
Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/bin/spfquery
___________________________________________________________________
Name: svn:executable
+
Added: packages/libmail-spf-query-perl/branches/upstream/current/debian/changelog
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/debian/changelog 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/debian/changelog 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,127 @@
+libmail-spf-query-perl (1.998) unstable; urgency=low
+
+ Debian:
+ * New maintainer: Julian Mehnle <julian at mehnle.net>.
+ * Unversioned Build-Depends and Depends on liburi-perl.
+ * Updated package description.
+ * Cleaned up debian/rules.
+ * Updated copyright file to reflect new Debian and upstream maintainership.
+ * spfquery man-page has been included (and updated) upstream.
+
+ Mail::SPF::Query:
+ * Removed obsolete Caller-ID support (closes: #337319, #337500).
+ * Always use Sys::Hostname::Long. And thus, depend on libsys-hostname-long
+ (closes: #332952, #342629).
+ * Changed local machine hostname macro from "xr" to "r" (closes rt.cpan.org
+ bug #9744).
+ * Restrict the number of SPF record lookups to a maximum of 10 (was: 20).
+ Thanks to Craig Whitmore!
+ * Fixes to mechanisms implementation:
+ * a, mx: Check if domain is a valid FQDN, i.e. ends in ".<toplabel>".
+ * ip4: Return "unknown" (PermError) if no argument was specified. Also,
+ don't auto-complete "1.2.3" CIDR specs to "1.2.3.0", as such an
+ abbreviated syntax is forbidden by the SPF spec anyway.
+ Thanks to Craig Whitmore!
+ * Lots of minor code and documentation fixes/improvements.
+
+ spfd:
+ * Added complete POD documentation/man-page.
+ * Both "--xxx" and "-xxx" forms of command-line options are now supported.
+ * Renamed most of the command-line options:
+ --path => --socket
+ --pathuser => --socket-user
+ --pathgroup => --socket-group
+ --pathmode => --socket-perms
+ --setuser => --set-user
+ --setgroup => --set-group
+ The old option names are still supported for backwards compatibility.
+ * Do not print usage information when neither "--port" nor "--socket" are
+ specified (i.e. when the default TCP port would just be used). Print a
+ more specific hint instead.
+ * Added "--help" option to print usage information.
+ * Some minor code fixes/improvements.
+
+ spfquery:
+ * Added complete POD documentation/man-page.
+ * Both "--xxx" and "-xxx" forms of command-line options are now supported.
+ Also, a "-x" (short) form is now supported for the most important options.
+ * Renamed the "--max-lookup" option to "--max-lookup-count" to match the
+ Mail::SPF::Query API. "--max-lookup" is still supported for backwards
+ compatibility.
+ * Added "--mail-from" and "-m" synonyms for the "--sender" option for
+ consistency with the "--helo" option.
+ * Cleaned up the "--help" usage output.
+ * Lots of minor code improvements.
+
+ Tests:
+ * Some minor tests improvements.
+ * Turned test.pl into .t file in t/ directory, so testing output is parsed
+ (closes rt.cpan.org bug #7748).
+ * Plan the correct number of tests, not just the number of non-comment lines
+ in test data file.
+
+ Miscellaneous:
+ * Updated URLs everywhere:
+ http://spf.pobox.com -> http://www.openspf.org
+ http://www.anarres.org/projects/srs/ -> http://www.libsrs2.org
+ http://asarian-host.net/srs/sendmailsrs.htm
+ -> http://srs-socketmap.info/sendmailsrs.htm
+ * Point out everywhere the "non-standard"-ness of best guess processing,
+ trusted forwarder accreditation checking, and several other features.
+ * Cleaned up source package file and directory layout:
+ Query.pm -> lib/Mail/SPF/Query.pm
+ Changes -> CHANGES
+ test.* -> t/
+ spf{d,query} -> bin/
+ sample/ -> examples/
+ * postfix-policyd-spf:
+ * Generate "Received-SPF:" header unless rejecting (fail/Fail) or deferring
+ (error/TempError) the message.
+ * Verbose mode is disabled by default.
+ Thanks to Arjen de Korte!
+ * spf.py: Removed, because it was really old, and this is a Perl package, not
+ a Python one.
+ * Did I mention lots of minor code and documentation fixes/improvements?
+
+ -- Julian Mehnle <julian at mehnle.net> Thu, 31 Dec 2005 23:00:00 +0000
+
+libmail-spf-query-perl (1.997-3) unstable; urgency=low
+
+ * Preserve $@ when testing for presence of Sys::Hostname::Long.
+ This should clean up SpamAssassin logs. (Closes: #332952)
+ * After 'spfquery -v' prints version, exit with zero status.
+ (Closes: #237751)
+ * Install 'sample' directory as documentation. (Closes: #245367)
+ * Increase Standards-Version to 3.6.2
+
+ -- Chip Salzenberg <chip at debian.org> Mon, 10 Oct 2005 15:05:03 -0700
+
+libmail-spf-query-perl (1.997-2) unstable; urgency=low
+
+ * Include man page for spfquery, contributed by Zac Sprackett
+ <zac at sprackett.com>. (Closes: #264112)
+ * Fix typo in package description. (Closes: #252160)
+ * Depend on a newer version of libnet-dns-perl. (Closes: #238247)
+
+ -- Chip Salzenberg <chip at debian.org> Sun, 10 Apr 2005 13:21:40 -0400
+
+libmail-spf-query-perl (1.997-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- Chip Salzenberg <chip at debian.org> Tue, 8 Mar 2005 12:25:13 -0500
+
+libmail-spf-query-perl (1.996-1) unstable; urgency=low
+
+ * New upstream release.
+ * Include upstream's experimental new version of spfquery.
+ (At least now we have error checking on command options.)
+
+ -- Chip Salzenberg <chip at debian.org> Thu, 11 Mar 2004 14:37:28 -0500
+
+libmail-spf-query-perl (1.991-1) unstable; urgency=low
+
+ * Initial Release.
+
+ -- Chip Salzenberg <chip at debian.org> Wed, 4 Feb 2004 11:20:21 -0500
+
Added: packages/libmail-spf-query-perl/branches/upstream/current/debian/compat
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/debian/compat 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/debian/compat 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1 @@
+4
Added: packages/libmail-spf-query-perl/branches/upstream/current/debian/control
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/debian/control 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/debian/control 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,20 @@
+Source: libmail-spf-query-perl
+Section: perl
+Priority: optional
+Build-Depends-Indep: debhelper (>= 4.0.2), perl (>= 5.8.0-7), libsys-hostname-long-perl, libnet-dns-perl (>= 0.46), libnet-cidr-lite-perl (>= 0.15), liburi-perl
+Maintainer: Julian Mehnle <julian at mehnle.net>
+Standards-Version: 3.6.2
+
+Package: libmail-spf-query-perl
+Architecture: all
+Depends: ${perl:Depends}, ${misc:Depends}, libsys-hostname-long-perl, libnet-dns-perl (>= 0.46), libnet-cidr-lite-perl (>= 0.15), liburi-perl
+Description: query SPF (Sender Policy Framework) to validate mail senders
+ The Sender Policy Framework (SPF) protocol relies on sender domains to publish
+ a DNS whitelist of their designated outbound mailers. This module, given an
+ envelope sender, determines whether a given client IP address is a legitimate
+ mail source.
+ .
+ This package also includes spfquery, a command line interface to the module,
+ and spfd, a query proxy for some mail server configurations.
+ .
+ For more information on SPF, see <http://www.openspf.org>.
Added: packages/libmail-spf-query-perl/branches/upstream/current/debian/copyright
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/debian/copyright 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/debian/copyright 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,17 @@
+This is the Debian package for the Mail-SPF-Query CPAN distribution, which is
+available from <http://search.cpan.org/dist/Mail-SPF-Query>.
+
+The Debian package was initially created by Chip Salzenberg <chip at pobox.com>
+and then adopted by Julian Mehnle <julian at mehnle.net> through the pkg-perl
+Alioth project.
+
+The upstream author is Meng Weng Wong <mengwong+spf at pobox.com>.
+
+This is free software; you can redistribute it and/or modify it under the same
+terms as Perl itself, that is under the terms of either the GNU General Public
+License (version 2 or later) or the Artistic License.
+
+On Debian GNU/Linux systems, the complete text of these licenses can be found
+in these files:
+ /usr/share/common-licenses/GPL-2
+ /usr/share/common-licenses/Artistic
Added: packages/libmail-spf-query-perl/branches/upstream/current/debian/rules
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/debian/rules 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/debian/rules 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,64 @@
+#!/usr/bin/make -f
+
+PACKAGE = $(shell dh_listpackages)
+
+ifndef PERL
+ PERL = /usr/bin/perl
+endif
+
+TMP = $(CURDIR)/debian/$(PACKAGE)
+
+BUILD = ./Build
+
+build: build-stamp
+build-stamp:
+ dh_testdir
+ $(PERL) Makefile.PL INSTALLDIRS=vendor
+ $(MAKE)
+ touch build-stamp
+
+clean:
+ dh_testdir
+ dh_testroot
+ -$(MAKE) distclean
+ dh_clean build-stamp install-stamp
+
+install: install-stamp
+install-stamp: build-stamp
+ dh_testdir
+ dh_testroot
+ dh_clean -k
+
+ $(MAKE) test
+ $(MAKE) install DESTDIR=$(TMP)/
+
+ # Put spfd in /usr/sbin:
+ mkdir -p $(TMP)/usr/sbin
+ mv $(TMP)/usr/bin/spfd $(TMP)/usr/sbin
+
+ touch install-stamp
+
+# Build architecture-independent files here:
+binary-indep: build install
+ dh_testdir
+ dh_testroot
+ dh_installdocs README
+ dh_installchangelogs CHANGES
+ dh_installexamples examples/*
+ #dh_installman
+ dh_install
+ dh_compress
+ dh_fixperms
+ dh_installdeb
+ dh_perl /usr/bin /usr/sbin
+ dh_gencontrol
+ dh_md5sums
+ dh_builddeb
+
+# Build architecture-dependent files here:
+binary-arch:
+ # Nothing to do.
+
+binary: binary-indep binary-arch
+
+.PHONY: build clean binary-indep binary-arch binary install
Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/debian/rules
___________________________________________________________________
Name: svn:executable
+
Added: packages/libmail-spf-query-perl/branches/upstream/current/examples/README
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/examples/README 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/examples/README 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,23 @@
+* sendmail-milter
+
+ If you run sendmail, this milter will plug right in.
+ You don't need to run spfd.
+
+ You do, however, need to give the milter an "mx" argument
+ if your MTA serves as the primary MX for domains which
+ have secondary MXes that you don't know about. When a
+ secondary MX relays mail to you, you want to bypass SPF
+ checks. With an "mx" argument, the milter will look at
+ each recipient's domain and detects if the connecting
+ client is a secondary MX. If you don't understand what
+ this means, you probably don't need to do this.
+
+* exim-acl
+
+ If you use Exim 4, this ACL will plug right in.
+ You will need to run spfd for this ACL to talk to.
+
+* postfix-policyd-spf
+
+ If you run a recent version of Postfix, this policy server
+ will plug right in. You don't need to run spfd.
Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/examples/README
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ "Author Date Id Rev URL"
Name: svn:eol-style
+ native
Added: packages/libmail-spf-query-perl/branches/upstream/current/examples/exim-acl
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/examples/exim-acl 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/examples/exim-acl 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,90 @@
+# SPF Auth test for Exim 4.xx
+# Version 2.09 by david @ ols . es
+#
+# Features:
+#
+# Full SPF support via spfd socket
+#
+# Warning:
+#
+# Will use acl_m9, acl_m8, acl_m7
+#
+# Requires
+#
+# Mail::SPF::Query ver 1.9.1
+#
+# Usage instructions:
+#
+# 1. copy this file to your /usr/local/exim
+#
+# 2. add this line to your exim configuration file after your
+# begin acl:
+#
+# .include /usr/local/exim/spf.acl
+#
+# 3. Grab a copy of Mail::SPF::Query from
+# http://www.openspf.org/downloads.html and install it
+#
+# 4. Run spfd -path=/tmp/spfd as the same user as Exim runs
+#
+# 5. Now you can use the test on your RCPT/MAIL ACL this way:
+#
+# deny !acl = spf_rcpt_acl
+#
+# And on your DATA ACL:
+#
+# deny senders = :
+# !acl = spf_from_acl
+#
+# now acl_m8 will hold 'pass','fail', 'unknown', ...
+# so you can take other decisions based on the result
+# like being more strict on some circumstances:
+#
+# deny senders = :
+# condition = ${if eq {$acl_m8}{softfail}{yes}{no}}
+# message = Not authorized by SPF
+
+spf_rcpt_acl:
+
+ # Check envelope sender
+
+ warn set acl_m8 = $sender_address
+ deny !acl = spf_check
+ warn message = Received-SPF: $acl_m8 ($acl_m7)
+ accept
+
+spf_from_acl:
+
+ # Check header From:
+
+ warn set acl_m8 = ${address:$h_from:}
+ deny !acl = spf_check
+ warn message = Received-SPF: $acl_m8 ($acl_m7)
+ accept
+
+spf_check:
+
+ warn set acl_m9 = ${readsocket{/tmp/spfd}\
+ {ip=$sender_host_address\n\
+ helo=${if def:sender_helo_name\
+ {$sender_helo_name}{NOHELO}}\
+ \nsender=$acl_m8\n\n}{20s}{\n}{socket failure}}
+
+ # Defer on socket error
+
+ defer condition = ${if eq{$acl_m9}{socket failure}{yes}{no}}
+ message = Cannot connect to spfd
+
+ # Prepare answer and get results
+
+ warn set acl_m9 = ${sg{$acl_m9}{\N=(.*)\n\N}{=\"\$1\" }}
+ set acl_m8 = ${extract{result}{$acl_m9}{$value}{unknown}}
+ set acl_m7 = ${extract{header_comment}{$acl_m9}{$value}{}}
+
+ # Check for fail
+
+ deny condition = ${if eq{$acl_m8}{fail}{yes}{no}}
+ message = ${extract{smtp_comment}{$acl_m9}{$value}{}}
+ log_message = Not authorized by SPF
+
+ accept
Added: packages/libmail-spf-query-perl/branches/upstream/current/examples/postfix-policyd-spf
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/examples/postfix-policyd-spf 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/examples/postfix-policyd-spf 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,239 @@
+#!/usr/bin/perl
+
+# postfix-policyd-spf
+# http://www.openspf.org
+# version 1.06
+# $Id$
+
+use Fcntl;
+use Sys::Syslog qw(:DEFAULT setlogsock);
+use strict;
+
+# ----------------------------------------------------------
+# configuration
+# ----------------------------------------------------------
+
+# to use SPF, install Mail::SPF::Query from CPAN or from the SPF website at http://www.openspf.org/downloads.html
+
+ my @HANDLERS;
+ push @HANDLERS, "testing";
+ push @HANDLERS, "sender_permitted_from"; use Mail::SPF::Query;
+
+my $VERBOSE = 0;
+
+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/policy-spf";
+
+# ----------------------------------------------------------
+# minimal documentation
+# ----------------------------------------------------------
+
+#
+# Usage: smtpd-policy.pl [-v]
+#
+# Demo delegated Postfix SMTPD policy server.
+# This server implements SPF.
+# Another server implements greylisting.
+# Postfix has a pluggable policy server architecture.
+# You can call one or both from Postfix.
+#
+# The SPF handler uses Mail::SPF::Query to do the heavy lifting.
+#
+# This documentation assumes you have read Postfix's README_FILES/SMTPD_POLICY_README
+#
+# Logging is sent to syslogd.
+#
+# How it works: each time a Postfix SMTP server process is started
+# it connects to the policy service socket, and Postfix runs one
+# instance of this PERL script. By default, a Postfix SMTP server
+# process terminates after 100 seconds of idle time, or after serving
+# 100 clients. Thus, the cost of starting this PERL script is smoothed
+# out over time.
+#
+# To run this from /etc/postfix/master.cf:
+#
+# policy unix - n n - - spawn
+# user=nobody argv=/usr/bin/perl /usr/libexec/postfix/smtpd-policy.pl
+#
+# To use this from Postfix SMTPD, use in /etc/postfix/main.cf:
+#
+# smtpd_recipient_restrictions =
+# ...
+# reject_unauth_destination
+# check_policy_service unix:private/policy
+# ...
+#
+# NOTE: specify check_policy_service AFTER reject_unauth_destination
+# or else your system can become an open relay.
+#
+# To test this script by hand, execute:
+#
+# % perl smtpd-policy.pl
+#
+# Each query is a bunch of attributes. Order does not matter, and
+# the demo script uses only a few of all the attributes shown below:
+#
+# request=smtpd_access_policy
+# protocol_state=RCPT
+# protocol_name=SMTP
+# helo_name=some.domain.tld
+# queue_id=8045F2AB23
+# sender=foo at bar.tld
+# recipient=bar at foo.tld
+# client_address=1.2.3.4
+# client_name=another.domain.tld
+# [empty line]
+#
+# The policy server script will answer in the same style, with an
+# attribute list followed by a empty line:
+#
+# action=dunno
+# [empty line]
+#
+
+# Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: client_address=208.210.125.227
+# Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: client_name=newbabe.mengwong.com
+# Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: helo_name=newbabe.mengwong.com
+# Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: protocol_name=ESMTP
+# Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: protocol_state=RCPT
+# Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: queue_id=
+# Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: recipient=mengwong at dumbo.pobox.com
+# Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: request=smtpd_access_policy
+# Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: sender=mengwong at newbabe.mengwong.com
+
+# ----------------------------------------------------------
+# initialization
+# ----------------------------------------------------------
+
+#
+# Log an error and abort.
+#
+sub fatal_exit {
+ syslog(err => "fatal_exit: @_");
+ syslog(warn => "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(warn=>sprintf("warning: ignoring garbage: %.100s", $_)); next; }
+
+ if ($VERBOSE) {
+ 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=> "handler %s: %s is decisive.", $handler, $response);
+ $action = $response; last;
+ }
+ }
+
+ syslog(info=> "decided action=%s", $action);
+
+ print STDOUT "action=$action\n\n";
+ %attr = ();
+}
+
+# ----------------------------------------------------------
+# plugin: SPF
+# ----------------------------------------------------------
+sub sender_permitted_from {
+ local %_ = @_;
+ my %attr = %{ $_{attr} };
+
+ my $query = eval { new Mail::SPF::Query (ip =>$attr{client_address},
+ sender=>$attr{sender},
+ helo =>$attr{helo_name}) };
+ if ($@) {
+ syslog(info=>"%s: Mail::SPF::Query->new(%s, %s, %s) failed: %s",
+ $attr{queue_id}, $attr{client_address}, $attr{sender}, $attr{helo_name}, $@);
+ return "DUNNO";
+ }
+ my ($result, $smtp_comment, $header_comment) = $query->result();
+
+ syslog(info=>"%s: SPF %s: smtp_comment=%s, header_comment=%s",
+ $attr{queue_id}, $result, $smtp_comment, $header_comment);
+
+ if ($result eq "fail") { return "REJECT $smtp_comment"; }
+ elsif ($result eq "error") { return "DEFER_IF_PERMIT $smtp_comment"; }
+ else { return "PREPEND Received-SPF: $result ($header_comment)"; }
+}
+
+# ----------------------------------------------------------
+# plugin: testing
+# ----------------------------------------------------------
+sub testing {
+ local %_ = @_;
+ my %attr = %{ $_{attr} };
+
+ if (lc address_stripped($attr{sender}) eq
+ lc address_stripped($attr{recipient})
+ and
+ $attr{recipient} =~ /policyblock/) {
+
+ syslog(info=>"%s: testing: will block as requested",
+ $attr{queue_id});
+ return "REJECT smtpd-policy blocking $attr{recipient}";
+ }
+ else {
+ syslog(info=>"%s: testing: stripped sender=%s, stripped rcpt=%s",
+ $attr{queue_id},
+ address_stripped($attr{sender}),
+ address_stripped($attr{recipient}),
+ );
+
+ }
+ return "DUNNO";
+}
+
+sub address_stripped {
+ # my $foo = localpart_lhs('foo+bar at baz.com'); # returns 'foo at baz.com'
+ my $string = shift;
+ for ($string) {
+ s/[+-].*\@/\@/;
+ }
+ return $string;
+}
Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/examples/postfix-policyd-spf
___________________________________________________________________
Name: svn:executable
+
Added: packages/libmail-spf-query-perl/branches/upstream/current/examples/sendmail-milter
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/examples/sendmail-milter 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/examples/sendmail-milter 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,884 @@
+#!/usr/bin/perl
+#
+# Sendmail Milter to perform SPF lookups
+#
+# (If you use the shebang line, make sure it contains
+# a thread-enabled Perl!)
+#
+# Code by Mark Kramer <admin at asarian-host.net> on December 3, 2003
+#
+# Version 1.40
+#
+# Last revision: March 27, 2004
+#
+# With thanks to Alain Knaff for adding improved "Getopt" functionality,
+# waitpid stuff to ensure spf-milter parent does not exit until child
+# is really up and running, a new option to kill the milter, and one to
+# add local policy.
+
+# Tested under Perl, v5.8.0 built for i386-freebsd-thread-multi,
+# using the Sendmail::Milter 0.18 engine.
+#
+# Licensed under GPL
+#
+# see: http://www.openspf.org
+# http://www.libsrs2.org/srs/srs.pdf
+#
+# availability: bundled with Mail::SPF::Query on CPAN
+# or at http://www.openspf.org/downloads.html
+#
+# this version is compatible with SPF draft 02.9.7.
+#
+
+# INSTALLATION:
+# =============
+#
+# Basic INSTALL doc at http://www.openspf.org/sendmail-milter-INSTALL.txt
+#
+# Adiitional install notes by Alain Knaff:
+#
+# The milter must be started/stopped explicitly before/after sendmail.
+# Add the following to /etc/init.d/sendmail to start it (must be
+# before starting sendmail):
+#
+# $SPF_MILTER -l 'include:local-forwarders' mail
+#
+# where local-forwarders is the name of a pseudo-domain holding an SPF
+# record describing all hosts allowed to bypass SPF checks (typically,
+# foreign hosts on which your users have set up .forwards pointing
+# towards addresses hosted by you). If none of your users have set up
+# any forwarding, you can leave this away
+#
+# Add the following to stop it (must be after stopping sendmail):
+#
+# $SPF_MILTER -k
+#
+# Note: This milter looks for the sendmail.cf file in /etc/mail. If
+# your sendmail.cf lives elsewhere (SuSE), establish a symlink:
+# ln -s /etc/sendmail.cf /etc/mail/sendmail.cf
+#
+# ==============
+
+# ----------------------------------------------------------
+# config
+# ----------------------------------------------------------
+
+# where do we store pid, sock, and logs? No trailing / please!
+# Set it at will, like '/var/spool/spf-milter', as long as it
+# ends in "spf-milter". Sanity check, further down the road,
+# will ensure that it does!
+#
+# If you change $basedir, be sure to make the same change to
+# INPUT_MAIL_FILTER in your mc file!
+
+my $basedir = '/var/spf-milter';
+
+# Our main SRS object; adjust this to your server's needs!
+
+my $srs = new Mail::SRS (Secret => 'whateverfloatsyourboat', MaxAge => 4, HashLength => 8, HashMin => 8, AlwaysRewrite => 1, Separator => '+');
+
+# where do we log SPF activity?
+
+my $SPF_LOG_FILENAME = POSIX::strftime ($basedir . "/spflog-%Y%m.log", localtime);
+
+# do we feel a need to flock the SPF logfile?
+
+use constant FLOCK_SPFLOG => 0;
+
+# ----------------------------------------------------------
+# no user-serviceable parts below this line
+# ----------------------------------------------------------
+
+use POSIX qw (:sys_wait_h);
+use Sendmail::Milter;
+use Socket;
+use Mail::SPF::Query;
+use Mail::SRS;
+use threads;
+use threads::shared;
+use strict;
+use Getopt::Std;
+use Errno qw (ESRCH EINTR);
+require 5.8.0;
+
+use vars qw/$opt_k $opt_l $opt_t $opt_m $opt_S $opt_r $opt_h $opt_T/;
+
+my $pidFile = $basedir . '/spf-milter.pid';
+my $sock = $basedir . '/spf-milter.sock';
+
+my @extraParams : shared = ();
+
+my $mx_mode : shared = 0;
+my $our_hostname : shared = 0;
+my $trust : shared = 1;
+my $require_srs_dsn : shared = 0;
+my $will_relay_srs1 : shared = 0;
+my $tagOnly : shared = 0;
+
+my ($conn, $user, $pid, $login, $pass, $uid, $gid);
+
+# Feel free to replace this with your preferred logging scheme, eg Sys::Syslog or Log::Dispatch
+
+sub write_log : locked {
+ open (SPFLOG, "+>>".$SPF_LOG_FILENAME) || (warn "$0: unable to write to $SPF_LOG_FILENAME: $!" && return);
+ if (FLOCK_SPFLOG) {
+ flock (SPFLOG, 2);
+ seek (SPFLOG, 0, 2);
+ }
+ print SPFLOG localtime () . ": @_\n";
+ close (SPFLOG);
+}
+
+sub log_error_and_exit : locked {
+ write_log (@_);
+ print STDERR "spf-milter: @_\n";
+ exit 1;
+}
+
+# To accomodate the thread-unsafe Socket package, the one
+# "socket_call" provides an additional pseudo-lock mechanism for use
+# within the same thread. Since socket_call has the 'locked' attribute,
+# within a single thread only one call can be made to it at the time. The
+# first parameter to the call is either 1 or 2. The former returns the IP
+# address of sockaddr_in; the latter does SPF::Query. Thus providing
+# exclusivity within the same thread.
+#
+# Though I know you will try anyway, do NOT remove the 'locked' attribute;
+# spf-milter WILL crash, sooner rather than later. The serialization
+# effect of the extra locking mechanism is negligible; it will only occur
+# when connect_callback and envfrom_callback (from two different threads)
+# should wish to access socket_call at the same time. At any rate, I
+# designed spf-milter to run super-stable. Adjust the code if your
+# priority lies elsewhere.
+
+sub socket_call : locked {
+ # usage:
+ # socket_call (0) => undef
+ # socket_call (1, sockaddr_in)
+ # socket_call (2, "1.2.3.4", 'sender at example.com', 'helohostname.example.com')
+
+ my $choice = shift;
+
+ return undef if not $choice;
+
+ if ($choice == 1) {
+
+ # connect_callback parses (defined $sockaddr_in) as first parameter, thus
+ # forming choice 1, or none at all. As with all calls to external
+ # packages, we run them within an eval {} clause to prevent spf-milter
+ # from dying on us.
+
+ my ($port, $iaddr);
+ eval {
+ ($port, $iaddr) = sockaddr_in (shift);
+ $choice = inet_ntoa ($iaddr);
+ };
+ return ($choice);
+ } elsif ($choice == 2) {
+
+ # Here we do SPF::Query. We parse $priv_data along from envfrom_callback,
+ # as we want to store $smtp_comment for later use in eom_callback.
+ #
+ # We will not use the alternate 'best_guess' method here. Risking a 'fail'
+ # from best_guess, prior to "Sunrise Date", is too rich for my blood.
+
+ my $priv_data = shift;
+
+ if (my $query = eval {new Mail::SPF::Query (ip => shift, sender => shift, helo => shift, @extraParams)}) {
+ my ($call_status, $result, $smtp_comment, $header_comment, $spf_record);
+
+ # In "mx" mode, we make a call to result2 (), instead of to result (),
+ # to which we parse an extra parameter, $priv_data->{'to'}, so
+ # result2 () can check against secondaries for the recipent.
+
+ if ($mx_mode) {
+ $call_status = eval {($result, $smtp_comment, $header_comment, $spf_record) = $query->result2 (shift)};
+ } else {
+ $call_status = eval {($result, $smtp_comment, $header_comment, $spf_record) = $query->result ()};
+ }
+
+ if ($call_status) {
+
+ # Return $smtp_comment, if defined, else the prefab $header_comment.
+
+ $smtp_comment ||= $header_comment;
+
+ # Need to escape unprotected % characters in spf_smtp_comment,
+ # or sendmail will use the default "Command rejected" message instead.
+ # Noted by Paul Howarth
+
+ $smtp_comment =~ s/%/%%/g;
+
+ # Since $smtp_comment can be whatever is returned, we consider it highly
+ # tainted, and first run it through a 'garbage' filter, so as to clear it
+ # of weird characters, newlines, etc., that could potentially crash your
+ # mailer (possible exploits?).
+
+ ($priv_data->{'spf_smtp_comment'} = $smtp_comment) =~ tr/\000-\010\012-\037\200-\377/ /s;
+ ($priv_data->{'spf_header_comment'} = $header_comment) =~ tr/\000-\010\012-\037\200-\377/ /s;
+ return ($result);
+ } else {
+ return undef;
+ }
+ } else {
+ return undef;
+ }
+ } else {
+ return undef;
+ }
+}
+
+# For some reason, the widespread misconception seems to have crept in
+# that Sendmail::Milter private data must somehow be "frozen/thawed"
+# before processing (a.l.a the namesake FreezeThaw package). This is not
+# the case. FreezeThaw, and similar functions, which freeze referenced
+# Perl structures into serialized versions, and thaw these serialized
+# structures back into references, are ONLY required should you wish to
+# transport entire hashes and such. But there is no need to do that. On a
+# per-connection basis, at connect_callback, we declare a private hash,
+# and set use "$ctx->setpriv" to set the reference to that hash:
+#
+# my $priv_data = {};
+# $ctx->setpriv($priv_data);
+#
+
+sub connect_callback : locked {
+ my $ctx = shift;
+ my $priv_data = {};
+ $priv_data->{'hostname'} = shift;
+ my $sockaddr_in = shift;
+ $priv_data->{'ipaddr'} = socket_call ((defined $sockaddr_in), $sockaddr_in);
+
+ # Our hostname can be extracted from the j macro; idea by Alain Knaff
+ # There is no need to reset it on each connection, though. It is now
+ # a global variable, and has been taken out of the per-connection hash.
+
+ $our_hostname ||= $ctx -> getsymval ('j');
+ $ctx->setpriv($priv_data);
+ return SMFIS_CONTINUE;
+}
+
+sub helo_callback : locked {
+ my $ctx = shift;
+ my $priv_data = $ctx->getpriv();
+ $priv_data->{'helo'} = shift;
+
+ # We also allow a bypass for STARTTLS authenticated users!
+
+ $priv_data->{'is_authenticated'} = ($ctx -> getsymval ('{verify}') eq 'OK');
+ $ctx->setpriv($priv_data);
+ return SMFIS_CONTINUE;
+}
+
+sub envfrom_callback : locked {
+ my $ctx = shift;
+ my $priv_data = $ctx->getpriv();
+ ($priv_data->{'from'} = lc (shift)) =~ s/[<>]//g;
+
+ # Is this a DSN?
+
+ $priv_data->{'bounce'} = ($priv_data->{'from'} eq '');
+
+ # In case of a valid MAIL FROM: <>, SPF::Query checks against the HELO string,
+ # with 'postmaster' as localpart, but will leave an empty $priv_data->{'from'}
+ # variable (which, for instance, shows up in $header_comment as a double space
+ # after "domain of"). Here we compensate for that.
+
+ $priv_data->{'from'} ||= "postmaster\@$priv_data->{'helo'}";
+
+ # Are we authenticated via SASL? Do not set if
+ # we're already STARTTLS authenticated.
+
+ $priv_data->{'is_authenticated'} ||= $ctx -> getsymval ('{auth_authen}');
+
+ # envfrom_callback can be called more than once within the same connection;
+ # delete $priv_data->{'spf_result'} on entry!
+
+ delete $priv_data->{'spf_result'};
+
+ # SASL/STARTTLS authenticated IP addresses always pass!
+
+ if ($priv_data->{'is_authenticated'}) {
+ $priv_data->{'spf_result'} = "pass";
+ $priv_data->{'spf_header_comment'} = "$our_hostname: $priv_data->{'ipaddr'} is authenticated by a trusted mechanism";
+ $ctx -> setpriv ($priv_data);
+ return SMFIS_CONTINUE;
+ }
+
+ $ctx->setpriv($priv_data);
+
+ # Do the Milter equivalent of "PrivacyOptions=needmailhelo". Needed for SPF.
+
+ if (not $priv_data->{'helo'}) {
+ $ctx->setreply('503', '5.0.0', "Polite people say HELO first");
+ return SMFIS_REJECT;
+ }
+
+ # Did we start in "mx" mode? If so, we will delay SPF checks until
+ # envrcpt_callback.
+
+ return SMFIS_CONTINUE if ($mx_mode);
+
+ # Make the SPF query, and immediately store the result in our private hash;
+ # we may also need it later, at eom_callback.
+
+ if ($priv_data->{'spf_result'} = socket_call (2, $priv_data, $priv_data->{'ipaddr'}, $priv_data->{'from'}, $priv_data->{'helo'})) {
+ if ($priv_data->{'spf_result'} eq 'fail') {
+ if ($tagOnly) {
+ write_log ("SPF \"fail\" from ip=".$priv_data->{'ipaddr'}.
+ " helo=".$priv_data->{'helo'}.
+ " from=".$priv_data->{'from'});
+ } else {
+ $ctx->setreply('550', '5.7.1', "$priv_data->{'spf_smtp_comment'}");
+ return SMFIS_REJECT;
+ }
+ } elsif ($priv_data->{'spf_result'} eq 'error') {
+ $ctx->setreply('451', '4.7.1', "$priv_data->{'spf_smtp_comment'}");
+ return SMFIS_TEMPFAIL;
+ }
+ }
+
+ $ctx -> setpriv ($priv_data);
+ return SMFIS_CONTINUE;
+}
+
+sub envrcpt_callback : locked {
+ my $ctx = shift;
+ my $priv_data = $ctx->getpriv();
+ my ($envelope_to, $reversed_recipient);
+
+ # Keep the old recipient too, exactly as it appeared
+ # in the SMTP dialoge!
+
+ ($priv_data->{'to'} = ($envelope_to = shift)) =~ s/[<>]//g;
+
+ # Are we relaying or receiving? The bulk of our labor is at local delivery.
+
+ if ($ctx -> getsymval ('{rcpt_mailer}') eq 'local') {
+
+ # If we require that all DSN messages are SRS signed (-S option),
+ # then here we check whether we have a valid SRS address
+ # in case of a DSN.
+ #
+ # Before you use this option, make sure you are well
+ # familiar with its possible consequences! Basically, you
+ # will be denying access to ALL non-SRS signed recipients,
+ # in case of a DSN. Only use this when you have implemented
+ # a SRS signing scheme in your MTA, which will sign ALL outgoing
+ # envelope-from addresses. Unfortunately, spf-milter cannot do
+ # that for you, as the Milter specs do not allow for a method
+ # to change the envelope-from address.
+ #
+ # Also, be sure to visit:
+ #
+ # http://www.libsrs2.org
+ # http://www.openspf.org/srs.html
+ # http://srs-socketmap.info/sendmailsrs.htm
+ #
+ # The -S option is for people with a specific, deliberate
+ # purpose in mind. Do not haphazardly enable this just
+ # because the idea of 'signed' addresses makes you feel safer;
+ # if you did not specifically set up your MTA for this purpose,
+ # then this option is not for you.
+
+ if ($require_srs_dsn) {
+ if ($priv_data->{'bounce'}) {
+
+ # First scenario; we receive a SRS0 address; a one-pass
+ # reversal should 'eval' to tell us whether it is really
+ # ours, and valid.
+
+ if ($priv_data->{'to'} =~ /^SRS0[+-=]/i) {
+ if (not (eval {$reversed_recipient = $srs -> reverse ($priv_data->{'to'})})) {
+ $ctx -> setreply ('550', '5.7.5', "Invalid SRS signature!");
+ $ctx -> setpriv ($priv_data);
+ return SMFIS_REJECT;
+ } else {
+
+ # We will store reversed recipients in pairs:
+ # the orginal recipient (exactly as it appeared in
+ # the SMTP dialogue) + its reversed counterpart.
+ #
+ # At eom_callback, as per the Milter protocol,
+ # we will avail ourselves of the first best
+ # opportunity to use a corresponding delrcpt/addrcpt
+ # combo to change the recipients in the envelope.
+
+ $priv_data->{'reversed_recipients'} .= "$envelope_to $reversed_recipient ";
+ }
+
+ # Second scenario; we will use a two-pass reversal on the SRS1 address.
+ # If it is still ours thereafter, we will accept it.
+
+ } elsif ($priv_data->{'to'} =~ /^SRS1[+-=]/i) {
+ if (not (eval {$_ = $srs -> reverse ($priv_data->{'to'})})) {
+ $ctx -> setreply ('550', '5.7.5', "Invalid SRS signature!");
+ $ctx -> setpriv ($priv_data);
+ return SMFIS_REJECT;
+ } elsif (not (eval {$reversed_recipient = $srs -> reverse ($_)})) {
+ if (not $will_relay_srs1) {
+ $ctx -> setreply ('551', '5.7.1', "User not local; please try <$_> directly");
+ $ctx -> setpriv ($priv_data);
+ return SMFIS_REJECT;
+ } else {
+
+ # Since the outer SRS1 address was targeted locally, it did
+ # not trigger sendmail's relay rules. If the reversal of the
+ # SRS1 address appears to be non-local after all, sendmail,
+ # still working under the assumption that this was a local
+ # delivery, will relay without question!
+ #
+ # Please, do not worry about being an open relay, though: SRS1
+ # addresses now have an extra hash to prevent forgery.
+
+ $reversed_recipient = $_;
+ }
+ }
+ $priv_data->{'reversed_recipients'} .= "$envelope_to $reversed_recipient ";
+
+ # Okay, no SRS address found; and we really should have. If the
+ # recipient is not postmaster@ or abuse@ (or abuse-report@, etc),
+ # we complain; otherwise, we turn a blind eye.
+ #
+ # N.B. Future versions of spf-milter may remove this 'bypass'.
+ # For now, while SPF is still in the early stages of its
+ # adoption phase, we will allow for this exception.
+
+ } elsif (not ($priv_data->{'to'} =~ /^(postmaster|abuse)\b/i)) {
+ $ctx -> setreply ('550', '5.7.5', "Bounce address not SRS signed!");
+ $ctx -> setpriv ($priv_data);
+ return SMFIS_REJECT;
+ }
+
+ # We only expect to see SRS in DSN. Mind you, this is a two-way
+ # street! We do not accept incoming SRS addresses outside the
+ # context of DSN; and, likewise, you cannot send out to (local)
+ # SRS recipients, other than using an empty envelope-from!
+
+ } elsif ($priv_data->{'to'} =~ /^SRS[01][+-=]/i) {
+ $ctx -> setreply ('550', '5.7.6', "SRS only supported in DSN!");
+ $ctx -> setpriv ($priv_data);
+ return SMFIS_REJECT;
+ }
+ }
+
+ # We are relaying. Only a single, outer check here: are
+ # we sending to an SRS1 address? If so, a one-pass reversal
+ # must 'eval'. The inner reverse may, or may not, 'eval'
+ # (in fact, it will probably not, as the result will likely
+ # be a third-party SRS0 address).
+ #
+ # N.B. Please notice the absence of a separate outer SRS0
+ # check. We only arrive here in 'relay' mode (which means:
+ # any SRS0 target will always have a non-local domain name
+ # part, which we will not be able to 'eval' anyway).
+
+ } elsif ($priv_data->{'to'} =~ /^SRS[01][+-=]/i) {
+ if (not $priv_data->{'bounce'}) {
+ $ctx -> setreply ('550', '5.7.6', "SRS only supported in DSN!");
+ $ctx -> setpriv ($priv_data);
+ return SMFIS_REJECT;
+ } elsif ($priv_data->{'to'} =~ /^SRS1[+-=]/i) {
+ if (not (eval {$_ = $srs -> reverse ($priv_data->{'to'})})) {
+ $ctx -> setreply ('550', '5.7.5', "Invalid SRS signature!");
+ $ctx -> setpriv ($priv_data);
+ return SMFIS_REJECT;
+ } elsif (not (eval {$reversed_recipient = $srs -> reverse ($_)})) {
+ if (not $will_relay_srs1) {
+ $ctx -> setreply ('551', '5.7.1', "User not local; please try <$_> directly");
+ $ctx -> setpriv ($priv_data);
+ return SMFIS_REJECT;
+ } else {
+
+ # Yes, this could be a non-local recipient. Please,
+ # do not worry about being an open relay here;
+ # since the outer SRS1 address was non-local to begin
+ # with, only authorized IP-space can make this relay
+ # happen anyway.
+
+ $reversed_recipient = $_;
+ }
+ }
+ $priv_data->{'reversed_recipients'} .= "$envelope_to $reversed_recipient ";
+ }
+ }
+
+ $ctx->setpriv($priv_data);
+
+ # We're done if we're already authenticated.
+
+ return SMFIS_CONTINUE if ($priv_data->{'is_authenticated'});
+
+ # Here we do the opposite check of envfrom_callback: if not "mx" mode,
+ # we bale rightaway.
+
+ return SMFIS_CONTINUE if (not $mx_mode);
+
+ # We also need to purge $priv_data->{'spf_result'} for each recipient!
+
+ delete $priv_data->{'spf_result'};
+
+ $ctx->setpriv($priv_data);
+
+ if ($priv_data->{'spf_result'} = socket_call (2, $priv_data, $priv_data->{'ipaddr'}, $priv_data->{'from'}, $priv_data->{'helo'}, $priv_data->{'to'})) {
+ if ($priv_data->{'spf_result'} eq 'fail') {
+ if ($tagOnly) {
+ write_log ("SPF \"fail\" from ip=".$priv_data->{'ipaddr'}.
+ " helo=".$priv_data->{'helo'}.
+ " from=".$priv_data->{'from'}.
+ " to=".$priv_data->{'to'});
+ } else {
+ $ctx->setreply('550', '5.7.1', "$priv_data->{'spf_smtp_comment'}");
+ return SMFIS_REJECT;
+ }
+ } elsif ($priv_data->{'spf_result'} eq 'error') {
+ $ctx->setreply('451', '4.7.1', "$priv_data->{'spf_smtp_comment'}");
+ return SMFIS_TEMPFAIL;
+ }
+ }
+
+ $ctx -> setpriv ($priv_data);
+ return SMFIS_CONTINUE;
+}
+
+sub eom_callback : locked {
+ my $ctx = shift;
+ my $priv_data = $ctx->getpriv();
+
+ # Did we get an SPF result? If so, add the appropriate header. There is no
+ # longer a need to use the "chgheader" method to replace the first
+ # occurance of a Received-SPF header; "addheader" will automatically
+ # prepend the new Received-SPF header.
+
+ if ($priv_data->{'spf_result'}) {
+ $ctx->addheader('Received-SPF', $priv_data->{'spf_result'} . ' (' . $priv_data->{'spf_header_comment'} . ')');
+ }
+
+ # Only at eom_callback can we substitute SRS recipients.
+
+ if ($priv_data->{'bounce'}) {
+ my ($old_recipient, $new_recipient);
+
+ # The convenient twin structure of a hash makes it possible
+ # to just suck in the entire split string, and have it neatly
+ # be distributed over "$old_recipient, $new_recipient" pairs.
+ # Cute, eh?
+
+ my %srs = split (/ /, $priv_data->{'reversed_recipients'});
+ while (($old_recipient, $new_recipient) = each %srs) {
+ $ctx -> delrcpt ($old_recipient);
+ $ctx -> addrcpt ($new_recipient);
+ }
+ }
+
+ $ctx->setpriv($priv_data);
+
+ return SMFIS_CONTINUE;
+}
+
+# On RSET, forget everything except the HELO name. Noted by Paul Howarth
+#
+# (note by me: we also need to preserve the hostname of the sender,
+# our own hostname, and the IP address of the sender! Best, therefore, to
+# use a negative logic, and just delete the things that need to go)
+#
+# BTW, we keep 'is_authenticated' in 1.40; during an entire session
+# the connection should remain authenticated (unless a new HELO sounds
+# the possible start of a new STARTTLS session).
+
+sub abort_callback : locked {
+ my $ctx = shift;
+ my $priv_data = $ctx->getpriv();
+ delete $priv_data->{'spf_result'};
+ delete $priv_data->{'from'};
+ delete $priv_data->{'to'};
+ delete $priv_data->{'bounce'};
+ delete $priv_data->{'reversed_recipients'};
+ $ctx->setpriv($priv_data);
+ return SMFIS_CONTINUE;
+}
+
+sub close_callback {
+ my $ctx = shift;
+ $ctx->setpriv(undef);
+ return SMFIS_CONTINUE;
+}
+
+my %my_callbacks =
+(
+ 'connect' => \&connect_callback,
+ 'helo' => \&helo_callback,
+ 'envfrom' => \&envfrom_callback,
+ 'envrcpt' => \&envrcpt_callback,
+ 'eom' => \&eom_callback,
+ 'close' => \&close_callback,
+ 'abort' => \&abort_callback,
+);
+
+############################################################
+# Main code
+
+# We start spf-milter as root for the same reason we do NOT run spf-milter
+# as root: security. And we start it with at least one parameter, the user
+# to run as. Spf-milter expects to create/read/write its log, pid, and socket,
+# all in /var/spf-milter/, and will itself create the directory, if need be,
+# and set all appropriate permissions/ownerships.
+#
+# Add "mx" as second parameter to run spf-milter in "mx" mode. In "mx" mode
+# spf-milter makes its SPF checks at envrcpt_callback, instead of envfrom_callback,
+# and calls result2 (), instead of result (), to allow for an early-out for
+# secondaries. The default mode performs SPF checks at envfrom_callback.
+#
+# Per default, spf-milter queries trusted-fowarder.org (on 'fail' only), to
+# check whether the trusted-fowarder domain yields a 'pass' after all. You can
+# override the default behavior, adding "dt" (disable trust) as second parameter
+# (or third, if you run in "mx" mode). You need at least Mail::SPF::Query 1.99
+# for this functionality!
+
+getopts("kl:tmSrhT");
+
+sub usage {
+ my ($ret) = @_;
+ print STDERR "Usage: $0 [-k] [-l local_trust] [-t] [-m] [-S] [-r] [-h] <user> [mx] [dt]\n";
+ print STDERR " -k kill running milter\n";
+ print STDERR " -l add local trust record\n";
+ print STDERR " -t don't add trusted-forwarder.org record\n";
+ print STDERR " -m trust recipient's MX hosts\n";
+ print STDERR " -S only allow SRS signed bounces (see documentation!)\n";
+ print STDERR " -r will relay SRS1\n";
+ print STDERR " -T don't reject failed messages, tag only\n";
+ print STDERR " -h print this help message\n";
+ print STDERR " <user> user to run this script as\n";
+ print STDERR " mx trust recipient's MX hosts (same as -m)\n";
+ print STDERR " dt don't add trusted-forwarder.org (same as -t)\n";
+ exit ($ret);
+}
+
+if ($opt_h) {
+ usage (0);
+}
+
+# Basic, but vital, sanity-check against $basedir. Since we set
+# permissions/ownerships on everything (!) in our $basedir, we
+# must avoid disasters, such as setting $basedir to /var/run/.
+# Therefore, we require that $basedir ends in "spf-milter".
+
+if (not ($basedir =~ /spf-milter$/i)) {
+ die '$basedir' . " ('$basedir') must end in /spf-milter!\n";
+}
+
+my $oldPid;
+if (-f $pidFile) {
+ open (PIDFILE, $pidFile) || die "Could not read pid file: $!\n";
+ chomp ($oldPid = <PIDFILE>);
+ close (PIDFILE);
+}
+
+if (defined $opt_k) {
+ die "SPF milter not running\n" if (not $oldPid);
+
+ # We need to kill the milter using signal 3, it apparently doesn't react
+ # to more "usual" signals...
+
+ if (not kill (3, $oldPid)) {
+ if ($!{ESRCH}) {
+ print STDERR "Sendmail milter not running, cleaning files\n";
+
+ # Files will be cleaned by END block
+
+ exit 0;
+ } else {
+
+ # Prevent cleaning away of the running milter's files
+
+ $pid = 1;
+
+ die "Could not kill SPF milter: $!\n";
+ }
+ }
+
+ my $needNl = 0;
+ select (STDERR);
+ $| = 1;
+
+ # Waiting for milter to die
+
+ for (my $i = 0; $i < 79; $i++) {
+ select (undef, undef, undef, 0.25);
+ if (not kill (0, $oldPid) && $!{ESRCH}) {
+ print STDERR "\n" if ($needNl);
+ exit 0; # Milter dead
+ }
+ print STDERR ".";
+ $needNl = 1;
+ }
+
+ print STDERR "\nForcefully killing milter\n";
+ kill (9, $oldPid);
+ exit 0;
+}
+
+if ($oldPid) {
+ my $r = kill (0, $oldPid);
+ if (not $!{ESRCH}) {
+
+ # Prevent cleaning away of the running milter's files
+
+ $pid = 1;
+
+ die "SPF milter already running\n";
+ }
+}
+
+unlink $sock;
+unlink $pidFile;
+
+if (not $user = lc ($ARGV[0])) {
+ print STDERR "Missing user\n";
+ usage (1);
+} elsif ($>) {
+ print STDERR "You need to start spf-milter as root!\n";
+ exit 1;
+}
+
+$mx_mode = 1 if ($opt_m || (lc ($ARGV[1]) eq 'mx'));
+
+$trust = 0 if ($opt_t || (lc ($ARGV[1]) eq 'dt') || (lc ($ARGV[2]) eq 'dt'));
+push (@extraParams, trusted => $trust);
+
+if ($opt_l) {
+ push (@extraParams, local => $opt_l);
+}
+
+if ($opt_T) {
+ $tagOnly = 1;
+}
+
+$require_srs_dsn = 1 if ($opt_S);
+$will_relay_srs1 = 1 if ($opt_r);
+
+# Since we will daemonize, play nice.
+
+chdir ('/') or exit 1;
+
+umask (0077);
+
+if (not (-e $basedir)) {
+ if (not mkdir $basedir) {
+ print STDERR "Odd; cannot create $basedir/\n";
+ exit 1;
+ }
+}
+
+# The Sendmail::Milter 0.18 engine has a small bug, causing it to extract
+# the wrong socket-name when, next to the F flags, there's an additional flag
+# in the Milter definition, (see: http://rt.cpan.org/NoAuth/Bug.html?id=3892
+# for details). Since the extra flag is useful (T for timeouts), we preset our
+# connection string to "local:/var/spf-milter/spf-milter.sock", with "spf-milter"
+# as Milter name. A corresponding line in sendmail.cf could look like this:
+#
+# Xspf-milter, S=local:/var/spf-milter/spf-milter.sock, F=T, T=C:4m;S:4m;R:8m;E:16m
+
+if (not $conn = Sendmail::Milter::auto_getconn ('spf-milter', '/etc/mail/sendmail.cf')) {
+ log_error_and_exit ("Milter for 'spf-milter' not found!");
+}
+
+if ($conn =~ /^local:(.+)/) {
+ if (not Sendmail::Milter::setconn ("local:$sock")) {
+ log_error_and_exit ("Failed to set connection information!");
+ }
+
+ # Now we set a fairly large timeout. The idea here is to set it so large, that
+ # the Milter will not try and compete with the sendmail T= timings, which allow
+ # for a more fine-grained tuning.
+
+ if (not Sendmail::Milter::settimeout ('8192')) {
+ log_error_and_exit ("Failed to set timeout value!");
+ }
+ if (not Sendmail::Milter::register ('spf-milter', \%my_callbacks, SMFI_CURR_ACTS)) {
+ log_error_and_exit ("Failed to register callbacks!");
+ }
+
+ # Get info on the user we want to run as. If $uid is undefined, the user
+ # does not exist on the system; if zero, it is the UID of root!
+
+ ($login, $pass, $uid, $gid) = getpwnam ($user);
+ if (not defined ($uid)) {
+ log_error_and_exit ("$user is not a valid user on this system!");
+ } elsif (not $uid) {
+ log_error_and_exit ("You cannot run spf-milter as root!");
+ }
+ write_log ("Starting Sendmail::Milter $Sendmail::Milter::VERSION engine");
+
+ # Set all proper permissions/ownerships, according to the user we run as.
+
+ if ((not chown $uid, $gid, $basedir, glob ($basedir . '/*')) ||
+ (not chmod 0700, $basedir)) {
+ log_error_and_exit ("Cannot set proper permissions!");
+ }
+
+ # Drop the Sendmail::Milter privileges!
+
+ $) = $gid;
+ $( = $gid;
+ $> = $uid;
+ $< = $uid;
+
+ # Give us a pretty proc-title to look at in 'ps ax'. :)
+
+ $0 = 'spf-milter' . (($mx_mode) ? (" [mx mode]") : (""));
+
+ # Fork and give us a pid file.
+
+ if ($pid = fork ()) {
+ open (USERLOG, ">". $pidFile) or exit 1;
+ flock (USERLOG, 2);
+ seek (USERLOG, 0, 0);
+ print USERLOG " $pid";
+ close (USERLOG);
+
+ # Wait until either milter socket appears or child dies
+
+ my $kid = 0;
+ while (not -x $sock) {
+ select (undef,undef,undef,0.01);
+ $kid = waitpid (-1, WNOHANG);
+ if ($kid > 0) {
+ $pid = 0; # trigger cleanup
+ die "Could not start milter\n";
+ }
+ }
+ exit 0;
+ }
+
+ # Redirect all input/output from/to null
+
+ open (STDIN, '/dev/null');
+ open (STDOUT, '>/dev/null');
+
+ # Complete de daemonization process.
+
+ POSIX::setsid () or exit 1;
+
+ open (STDERR, '>&STDOUT');
+
+ if (Sendmail::Milter::main ()) {
+ write_log ("Successful exit from the Sendmail::Milter engine");
+ } else {
+ write_log ("Unsuccessful exit from the Sendmail::Milter engine");
+ }
+} else {
+ log_error_and_exit ("$conn is not a valid connection object!");
+}
+
+END {
+
+ # On exit (child only!) we clean up the mess.
+
+ if (not $pid) {
+ unlink ($pidFile);
+ unlink ($sock);
+ }
+}
+
+exit 0;
Added: packages/libmail-spf-query-perl/branches/upstream/current/examples/sendmail-milter-INSTALL.txt
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/examples/sendmail-milter-INSTALL.txt 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/examples/sendmail-milter-INSTALL.txt 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,311 @@
+ by Mark, System Administrator Asarian-host.org
+
+1. INTRODUCTION
+---------------
+
+spf-milter is a Milter, which works with Sendmail 8.12 and up, and provides
+an SPF-compliant extension to the SMTP communication between your MTA and
+connecting clients. See http://www.openspf.org for details about SPF itself.
+
+spf-milter is written entirely in Perl, and uses the native threaded Milter
+model. spf-milter is licensed under GPL.
+
+
+2. PREREQUISITES
+----------------
+
+spf-milter requires:
+
+1): Perl 5.8.x, or higher.
+
+2): Perl modules:
+
+ Sendmail::Milter (version 0.18)
+ Mail::SPF::Query (at least version 1.99!)
+ Mail::SRS (version 0.30)
+
+
+3. INSTALLATION
+---------------
+
+Since spf-milter is written in Perl, you need, for starters,
+Sendmail::Milter (at CPAN). The Milter API is threaded, so you need a
+thread-enabled Perl (compiled with -Duseithreads) as well. If you do not
+know whether you Perl supports threads, try and install Sendmail::Milter
+first. It will itself test the ithread functionality of your Perl for
+compatibility with Sendmail::Milter.
+
+I built and tested spf-milter under Perl, v5.8.0 built for
+i386-freebsd-thread-multi. Earlier versions of Perl versions may or may
+not be suitable.
+
+
+A) Sendmail
+
+You must be using Sendmail 8.12.x
+---------------------------------
+
+Obtain the latest Sendmail 8.12.x source release from
+http://www.sendmail.org. Unpack it. Add the following lines to
+devtools/Site/site.config.m4:
+
+ APPENDDEF(`conf_libmilter_ENVDEF', `-DMILTER')
+ APPENDDEF(`conf_sendmail_ENVDEF', `-DMILTER')
+
+This enables the Milter functionality. Now build Sendmail as usual
+("sh Build" in the sendmail/ directory).
+
+Add the following lines to your Sendmail "m4" configuration file
+(*.mc, in the cf/cf/ directory):
+
+ define(`confMILTER_LOG_LEVEL',`9')dnl
+ define(`confMILTER_MACROS_HELO', confMILTER_MACROS_HELO`, {verify}')dnl
+ INPUT_MAIL_FILTER(`spf-milter', `S=local:/var/spf-milter/spf-milter.sock, F=T, T=C:4m;S:4m;R:8m;E:10m')
+
+Adjust the MILTER_LOG_LEVEL and T timings to your liking. Now build
+sendmail.cf as usual ("./Build sendmail.cf" in the cf/cf/ directory). Your
+newly generated sendmail.cf will now contain a section that looks like this:
+
+# Milter options
+O Milter.LogLevel=9
+O Milter.macros.connect=j, _, {daemon_name}, {if_name}, {if_addr}
+O Milter.macros.helo={tls_version}, {cipher}, {cipher_bits}, {cert_subject}, {cert_issuer}, {verify}
+O Milter.macros.envfrom=i, {auth_type}, {auth_authen}, {auth_ssf}, {auth_author}, {mail_mailer}, {mail_host}, {mail_addr}
+O Milter.macros.envrcpt={rcpt_mailer}, {rcpt_host}, {rcpt_addr}
+
+And this:
+
+######################################################################
+######################################################################
+#####
+##### MAILER DEFINITIONS
+#####
+######################################################################
+######################################################################
+
+Xspf-milter, S=local:/var/spf-milter/spf-milter.sock, F=T, T=C:4m;S:4m;R:8m;E:10m
+
+Inspect your new sendmail.cf, to see whether it does indeed contain these things.
+
+
+B) Startup
+
+You are already ready to start spf-milter! :)
+
+Sendmail does not need to "find" the spf-milter script. You can run it from
+pretty much every location. The only thing sendmail needs to do, is to be
+able to find the local domain socket to connect to (spf-milter creates
+"/var/spf-milter/spf-milter.sock" per default). If you successfully followed
+the above steps, then your new sendmail.cf will contain the proper local
+socket name.
+
+Backup your old sendmail.cf. Now, stop sendmail, and copy the new
+sendmail.cf to its proper location.
+
+Now, start spf-milter first! Depending on where your thread-enabled Perl
+resides, of course, you can, in its simplest form, start spf-milter like
+this:
+
+/usr/local/perl-threaded/bin/perl /usr/local/spf/sendmail-milter.pl milter
+
+We start spf-milter with at least one parameter, the user to run as.
+spf-milter expects to create/read/write its log, pid, and socket, all in
+/var/spf-milter/, and will itself create the directory, if need be, and set
+all appropriate permissions/ownerships.
+
+You cannot run spf-milter as root.
+
+If everything went okay, try 'ps ax', and your spf-milter will show up as:
+
+"spf-milter (perl)"
+
+Restart sendmail. Now you're done. :)
+
+
+C) Testing spf-milter functionality
+
+Perform two basic tests:
+
+1) Make sure legitimate mail gets through!
+
+2) Confirm that forged mail is rejected; forging mail from
+ mengwong at vw.mailzone.com will do the trick (address used
+ with permission).
+
+If properly rejected, you will get a 550 response, and a text with a
+reference to "http://www.openspf.org/why.html? ..." in the line.
+
+N.B. The actual return-text may vary from MTA to MTA, but the 550 response
+code SHOULD always be the same (an extended SMTP code, '550', '5.7.1').
+
+
+4. SRS AND FAKE DSN DETECTION
+-----------------------------
+
+
+A) Outline
+
+As of version 1.40, spf-milter comes with a new functionality: fake DSN
+detection. It is activated by the -S option; and, when enabled, will spot
+and REJECT unsigned DSN recipients. Signatures are based on SRS (Mail::SRS).
+This is an advanced option; it requires an MTA counterpart installation to
+sign outgoing envelope-from addresses, and should not be used unless you are
+well familiar with the entire scheme and its possible ramifications.
+
+The idea, in a nutshell, is as follows. Have an MTA sign all outgoing
+envelope-from addresses. Then, when we receive a DSN (bounce message with a
+MAIL FROM: <>), we will REJECT this DSN, unless the recipient was SRS
+signed. Based on the old "what goes around, comes around" adage (or rather,
+"what does not go around, should not come around"): if we do not ever send
+out unsigned envelope-from addresses, then we know we are dealing with a
+forgery when we receive an unsigned DSN recipient!
+
+Only use this when you have implemented an SRS signing scheme in your MTA,
+which will sign ALL outgoing envelope-from addresses. Unfortunately,
+spf-milter cannot do that for you, as the Milter specs do not allow for a
+method to change the envelope-from address. You may want to have a peek at
+my SRS + sendmail integration project, at:
+
+ http://asarian-host.net/srs/sendmailsrs.htm
+
+
+B) How to use FAKE DSN DETECTION without SRS reversal in sendmail
+
+If your incoming mail server differs from your outgoing one, then there is
+way to use FAKE DSN DETECTION without setting up SRS reversal in the
+sendmail configuration for you incoming mail server.
+
+Since spf-milter handles your locally targeted SRS recipients, you would
+think that suffices. And it does. However, the Milter specification does not
+permit the changing of recipients at envrcpt_callback, and forces you to
+wait until eom_callback; thereby leaving an intermediate window, between
+callbacks, where sendmail itself will verify the recipients (upon return of
+envrcpt_callback), and conclude that your nice SRS0 bounce address does not
+exist on the system. The result? Sendmail will REJECT the recipient with a
+"User unknown" after all.
+
+The way to solve this, is to make use of sendmail's "plussed" user facility.
+Define two users (virtusertable), like so:
+
+ SRS0+*@yourdomain.com user
+ SRS1+*@yourdomain.com user
+
+(where "user" is the name of an existing user).
+
+This will provide the necessary "fallback" for the undefined in-between
+callback state. Mind you, these are 'dummy' addresses; they are never
+actually used for delivery; they are just there to prevent sendmail from
+bulking over your SRS addresses, in-between callbacks.
+
+Now that sendmail has these fallback wildcard addresses, spf-milter can
+proceed until eom_callback, where it will replace the SRS signed envelope
+recipient(s) with their reversed counterparts.
+
+For this to work, your SRS 'separator' character must be "+". Like so:
+
+ my $srs = new Mail::SRS (Secret => 'yaddayadda', Separator => '+');
+
+So that SRS0+, SRS1+ addresses are formed.
+
+
+C) Start-up considerations
+
+To use SRS on spf-milter, start it with the -S parameter; a minimum command
+line usage would be:
+
+ ./sendmail-milter-spf-1.40.pl -S milter
+
+This will place spf-milter in FAKE DSN DETECTION mode, running as user
+"milter".
+
+There has been some discussion on whether people should become SRS1
+forwarding hosts. To accomodate both parties, spf-milter can be started with
+an additional option, "-r". If set, spf-milter will relay non-locally
+resolving SRS0 addresses (reversed from SRS1 addresses). Per default,
+spf-milter only accepts locally resolving SRS0 addresses. If you want full
+SRS1 functionality, start spf-milter like so (minimal):
+
+ ./sendmail-milter-spf-1.40.pl -S -r milter
+
+Whether you start spf-milter with -S or not, when relaying, spf-milter is
+always SRS aware (that is, when your own mailer is sending TO foreign SRS0,
+SRS1 addresses). The "-r" option, outside -S, only has meaning when
+relaying.
+
+
+5. COMMON QUESTIONS ANSWERED
+----------------------------
+
+1) Why does spf-milter use the native threaded Milter model?
+
+Because Sendmail::Milter does.
+
+2) How does spf-milter stay stable using ithreads?
+
+Instead of using a multiplexor to split threads over individual child
+processes (like MIMEDefang), spf-milter 'locks' (thread-locks) its
+callbacks, thus effectively serializing the threads; so you get much of
+the effect of what the MIMEDefang multiplexor does (kinda). And since the
+'locked' attribute really prevents the threads from clobbering over one
+another, you can even use thread-unsafe package calls within those subs,
+like to DBI.
+
+3) By serializing all callbacks, do you not reduce performance?
+
+Without locking the subroutines, Sendmail::Milter is simply way too
+unstable, and effectively unusable. However, since there are 10 callbacks in
+total, each thread is only serialized for those occassions when two threads
+try and access the same sub at the same time. Otherwise they run parallel
+too: one thread may acces the eom_callback whilst another enters the
+helo_callback, for instance. In fact, as long as all threads are just
+slightly out of phase with one another (one callback difference minimum),
+they all run nicely parallel.
+
+4) Does spf-milter act prior to the DATA phase?
+
+Yes, spf-milter makes its SPF checks before the DATA phase; at
+envfrom_callback (at: "MAIL FROM: <address>"), or at envrcpt_callback (at:
+"RCPT TO: <recipient>"), when running in "mx" mode.
+
+5) Can spf-milter be used within the same sendmail configuration as
+MIMEDefang (and other Milters)?
+
+Yes. Quoting a bit from the libmilter documentation:
+
++----------------------------------------+
+| SPECIFYING FILTERS IN SENDMAIL CONFIGS |
++----------------------------------------+
+
+Filters are specified with a key letter ``X'' (for ``eXternal'').
+
+For example:
+
+ Xfilter1, S=local:/var/run/f1.sock, F=R
+ Xfilter2, S=inet6:999 at localhost, F=T, T=C:10m;S:1s;R:1s;E:5m
+ Xfilter3, S=inet:3333 at localhost
+
+specifies three filters. Filters can be specified in your .mc file using
+the following:
+
+ INPUT_MAIL_FILTER(`filter1', `S=local:/var/run/f1.sock, F=R')
+ INPUT_MAIL_FILTER(`filter2', `S=inet6:999 at localhost, F=T')
+ INPUT_MAIL_FILTER(`filter3', `S=inet:3333 at localhost')
+
+Which filters are invoked and their sequencing is handled by the
+InputMailFilters option:
+
+ O InputMailFilters=filter1, filter2, filter3
+
+This is is set automatically according to the order of the
+INPUT_MAIL_FILTER commands in your .mc file. Alternatively, you can
+reset its value by setting confINPUT_MAIL_FILTERS in your .mc file.
+This options causes the three filters to be called in the same order
+they were specified.
+
+- Mark
+
+ System Administrator Asarian-host.org
+
+-------
+To unsubscribe, change your address, or temporarily deactivate your subscription,
+please go to http://v2.listbox.com/member/?listname=srs-discuss@v2.listbox.com
Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/examples/sendmail-milter-INSTALL.txt
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ "Author Date Id Rev URL"
Name: svn:eol-style
+ native
Added: packages/libmail-spf-query-perl/branches/upstream/current/lib/Mail/SPF/Query.pm
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/lib/Mail/SPF/Query.pm 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/lib/Mail/SPF/Query.pm 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,1800 @@
+package Mail::SPF::Query;
+
+# ----------------------------------------------------------
+# Mail::SPF::Query
+# Test an IP / sender address pair for SPF authorization
+#
+# http://www.openspf.org
+# http://search.cpan.org/dist/Mail-SPF-Query
+#
+# Copyright (C) 2003-2005 Meng Weng Wong <mengwong+spf at pobox.com>
+# Contributions by various members of the SPF project <http://www.openspf.org>
+# License: like Perl, i.e. GPL-2 and Artistic License
+#
+# $Id$
+#
+# This version is compatible with spf-draft-20040209.
+#
+# The result of evaluating a SPF record associated with a domain is one of:
+#
+# pass Explicit pass -- message is not a forgery.
+# fail Explicit fail -- MTA may reject, MUA may discard.
+# softfail Explicit softfail -- please apply strict antispam checks.
+# neutral Domain explicitly wishes you to pretend it had no SPF record.
+# none The domain does not have an SPF record.
+# error Some type of temporary failure, usually DNS-related.
+# unknown A permanent error, such as missing SPF record during "include"
+# or "redirect", parse error, unknown mechanism, or record loop.
+#
+# TODO:
+# * Add ipv6 support.
+# * Add support for doing HELO tests before MAIL FROM tests.
+# * If the spf_source is not 'original-spf-record' (but e.g. a local policy
+# source), do not return the "why.html" default explanation, because
+# "why.html" will not be able to reproduce the local policy.
+# * If there are multiple unrecognized mechanisms, they all need to be
+# preserved in the 'unknown' Received-SPF header. Right now only the
+# first appears.
+# * Override and fallback keys need to be lc()ed at start.
+#
+# ----------------------------------------------------------
+
+use 5.006;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+our $VERSION = '1.998';
+$VERSION = eval($VERSION);
+
+use Sys::Hostname::Long;
+use Net::DNS qw(); # by default it exports mx, which we define.
+use Net::CIDR::Lite;
+use URI::Escape;
+
+# ----------------------------------------------------------
+# initialization
+# ----------------------------------------------------------
+
+my $GUESS_MECHS = "a/24 mx/24 ptr";
+my $TRUSTED_FORWARDER = "include:spf.trusted-forwarder.org";
+
+my $DEFAULT_EXPLANATION = "Please see http://www.openspf.org/why.html?sender=%{S}&ip=%{I}&receiver=%{R}";
+my @KNOWN_MECHANISMS = qw( a mx ptr include ip4 ip6 exists all );
+my $MAX_LOOKUP_COUNT = 10;
+
+my $Domains_Queried = {};
+
+our $CACHE_TIMEOUT = 120;
+our $DNS_RESOLVER_TIMEOUT = 15;
+
+# ----------------------------------------------------------
+# no user-serviceable parts below this line
+# ----------------------------------------------------------
+
+my $looks_like_ipv4 = qr/\d+\.\d+\.\d+\.\d+/;
+my $looks_like_email = qr/\S+\@\S+/;
+
+=head1 NAME
+
+Mail::SPF::Query - query Sender Policy Framework for an IP,email,helo
+
+=head1 VERSION
+
+1.998
+
+=head1 SYNOPSIS
+
+ my $query = new Mail::SPF::Query (ip => "127.0.0.1", sender=>'foo at example.com', helo=>"somehost.example.com", trusted=>0, guess=>0);
+ my ($result, # pass | fail | softfail | neutral | none | error | unknown [mechanism]
+ $smtp_comment, # "please see http://www.openspf.org/why.html?..." when rejecting, return this string to the SMTP client
+ $header_comment, # prepend_header("Received-SPF" => "$result ($header_comment)")
+ $spf_record, # "v=spf1 ..." original SPF record for the domain
+ ) = $query->result();
+
+ if ($result eq "pass") { "Domain is not forged. Apply RHSBL and content filters." }
+ elsif ($result eq "fail") { "Domain is forged. Reject or save to spambox." }
+
+=head1 ABSTRACT
+
+The SPF protocol relies on sender domains to describe their designated outbound
+mailers in DNS. Given an email address, Mail::SPF::Query determines the
+legitimacy of an SMTP client IP address.
+
+=head1 DESCRIPTION
+
+There are two ways to use Mail::SPF::Query. Your choice depends on whether the
+domains your server is an MX for have secondary MXes which your server doesn't
+know about.
+
+The first and more common style, calling ->result(), is suitable when all mail
+is received directly from the originator's MTA. If the domains you receive do
+not have secondary MX entries, this is appropriate. This style of use is
+outlined in the SYNOPSIS above. This is the common case.
+
+The second style is more complex, but works when your server receives mail from
+secondary MXes. This performs checks as each recipient is handled. If the
+message is coming from a valid MX secondary for a recipient, then the SPF check
+is not performed, and a "pass" response is returned right away. To do this,
+call C<result2()> and C<message_result2()> instead of C<result()>.
+
+If you do not know what a secondary MX is, you probably don't have one. Use
+the first style.
+
+You can try out Mail::SPF::Query on the command line with the following
+command:
+
+ perl -MMail::SPF::Query -le 'print for Mail::SPF::Query->new(helo=>shift, ipv4=>shift, sender=>shift)->result' helohost.example.com 1.2.3.4 user at example.com
+
+=head1 NON-STANDARD FEATURES
+
+Mail::SPF::Query tries to implement the SPF specification (see L</"SEE ALSO">)
+as close as reasonably possible given that M:S:Q has been the very first SPF
+implementation and has changed with the SPF specification over time.
+
+As such, M:S:Q does have some legacy features that are not parts of the
+official SPF specification, most notably I<best guess processing> and I<trusted
+forwarder accreditation checking>. Please be careful when using these
+I<non-standard> features or when reproducing them in your own SPF
+implementation, as they may cause unexpected results.
+
+=head1 METHODS
+
+=head2 C<< Mail::SPF::Query->new() >>
+
+ my $query = eval { new Mail::SPF::Query (
+ ip => '127.0.0.1',
+ sender => 'foo at example.com',
+ helo => 'host.example.com',
+
+ # optional parameters:
+ debug => 1, debuglog => sub { print STDERR "@_\n" },
+ local => 'extra mechanisms',
+ trusted => 1, # do trusted forwarder processing
+ guess => 1, # do best_guess if no SPF record
+ default_explanation => 'Please see http://spf.my.isp/spferror.html for details',
+ max_lookup_count => 10, # total number of SPF include/redirect queries
+ sanitize => 0, # do not sanitize all returned strings
+ myhostname => "foo.example.com", # prepended to header_comment
+ fallback => { "foo.com" => { record => "v=spf1 a mx -all", OPTION => VALUE },
+ "*.foo.com" => { record => "v=spf1 a mx -all", OPTION => VAULE }, },
+ override => { "bar.com" => { record => "v=spf1 a mx -all", OPTION => VALUE },
+ "*.bar.com" => { record => "v=spf1 a mx -all", OPTION => VAULE }, }
+ ) };
+
+ if ($@) { warn "bad input to Mail::SPF::Query: $@" }
+
+Set C<trusted=E<gt>1> to turned on C<trusted-forwarder.org> accreditation
+checking. The mechanism C<include:spf.trusted-forwarder.org> is used just
+before a C<-all> or C<?all>. The precise circumstances are somewhat more
+complicated, but it does get the case of C<v=spf1 -all> right -- i.e.
+C<trusted-forwarder.org> is not checked. B<This is a non-standard feature.>
+
+Set C<guess=E<gt>1> to turned on automatic best guess processing. This will
+use the best_guess SPF record when one cannot be found in the DNS. Note that
+this can only return C<pass> or C<neutral>. The C<trusted> and C<local> flags
+also operate when the best_guess is being used. B<This is a non-standard
+feature.>
+
+Set C<local=E<gt>'include:local.domain'> to include some extra processing just
+before a C<-all> or C<?all>. The local processing happens just before the
+trusted forwarder processing. B<This is a non-standard feature.>
+
+Set C<default_explanation> to a string to be used if the SPF record does not
+provide a specific explanation. The default value will direct the user to a
+page at www.openspf.org with the following message:
+
+ Please see http://www.openspf.org/why.html?sender=%{S}&ip=%{I}&receiver=%{R}
+
+Note that the string has macro substitution performed.
+
+Set C<sanitize> to 0 to get all the returned strings unsanitized.
+Alternatively, pass a function reference and this function will be used to
+sanitize the returned values. The function must take a single string argument
+and return a single string which contains the sanitized result.
+
+Set C<debug=E<gt>1> to watch the queries happen.
+
+Set C<fallback> to define "pretend" SPF records for domains that don't publish
+them yet. Wildcards are supported. B<This is a non-standard feature.>
+
+Set C<override> to define SPF records for domains that do publish but which you
+want to override anyway. Wildcards are supported. B<This is a non-standard
+feature.>
+
+Note: domain name arguments to fallback and override need to be in all
+lowercase.
+
+=cut
+
+# ----------------------------------------------------------
+sub new {
+# ----------------------------------------------------------
+ my $class = shift;
+ my $query = bless { @_ }, $class;
+
+ $query->{lookup_count} = 0;
+
+ $query->{ipv4} = delete $query->{ip} if $query->{ip} and $query->{ip} =~ $looks_like_ipv4;
+ $query->{helo} = delete $query->{ehlo} if $query->{ehlo};
+
+ $query->{local} .= ' ' . $TRUSTED_FORWARDER if ($query->{trusted});
+
+ $query->{trusted} = undef;
+
+ $query->{spf_error_explanation} ||= "SPF record error";
+
+ $query->{default_explanation} ||= $DEFAULT_EXPLANATION;
+
+ $query->{default_record} = $GUESS_MECHS if ($query->{guess});
+
+ if (($query->{sanitize} && !ref($query->{sanitize})) || !defined($query->{sanitize})) {
+ # Apply default sanitizer
+ $query->{sanitize} = \&strict_sanitize;
+ }
+
+ $query->{sender} =~ s/<(.*)>/$1/g;
+
+ if (not ($query->{ipv4} and length $query->{ipv4})) {
+ die "no IP address given";
+ }
+
+ for ($query->{sender}) { s/^\s+//; s/\s+$//; }
+
+ $query->{spf_source} = "domain of $query->{sender}";
+ $query->{spf_source_type} = "original-spf-record";
+
+ ($query->{domain}) = $query->{sender} =~ /([^@]+)$/; # given foo at bar@baz.com, the domain is baz.com, not bar at baz.com.
+
+ # the domain should not be an address literal --- [1.2.3.4]
+ if ($query->{domain} =~ /^\[\d+\.\d+\.\d+\.\d+\]$/) {
+ die "sender domain should be an FQDN, not an address literal";
+ }
+
+ if (not $query->{helo}) { require Carp; import Carp qw(cluck); cluck ("Mail::SPF::Query: ->new() requires a \"helo\" argument.\n");
+ $query->{helo} = $query->{domain};
+ }
+
+ $query->debuglog("new: ipv4=$query->{ipv4}, sender=$query->{sender}, helo=$query->{helo}");
+
+ ($query->{helo}) =~ s/.*\@//; # strip localpart from helo
+
+ if (not $query->{domain}) {
+ $query->debuglog("sender $query->{sender} has no domain, using HELO domain $query->{helo} instead.");
+ $query->{domain} = $query->{helo};
+ $query->{sender} = $query->{helo};
+ }
+
+ if (not length $query->{domain}) { die "unable to identify domain of sender $query->{sender}" }
+
+ $query->{orig_domain} = $query->{domain};
+
+ $query->{loop_report} = [$query->{domain}];
+
+ ($query->{localpart}) = $query->{sender} =~ /(.+)\@/;
+ $query->{localpart} = "postmaster" if not length $query->{localpart};
+
+ $query->debuglog("localpart is $query->{localpart}");
+
+ $query->{Reversed_IP} = ($query->{ipv4} ? reverse_in_addr($query->{ipv4}) :
+ $query->{ipv6} ? die "IPv6 not supported" : "");
+
+ if (not $query->{myhostname}) {
+ $query->{myhostname} = Sys::Hostname::Long::hostname_long();
+ }
+
+ $query->{myhostname} ||= "localhost";
+
+ $query->post_new(@_) if $class->can("post_new");
+
+ return $query;
+}
+
+=head2 C<< $query->result() >>
+
+ my ($result, $smtp_comment, $header_comment, $spf_record, $detail) = $query->result();
+
+C<$result> will be one of C<pass>, C<fail>, C<softfail>, C<neutral>, C<none>,
+C<error> or C<unknown [...]>:
+
+=over
+
+=item C<pass>
+
+The client IP address is an authorized mailer for the sender. The mail should
+be accepted subject to local policy regarding the sender.
+
+=item C<fail>
+
+The client IP address is not an authorized mailer, and the sender wants you to
+reject the transaction for fear of forgery.
+
+=item C<softfail>
+
+The client IP address is not an authorized mailer, but the sender prefers that
+you accept the transaction because it isn't absolutely sure all its users are
+mailing through approved servers. The C<softfail> status is often used during
+initial deployment of SPF records by a domain.
+
+=item C<neutral>
+
+The sender makes no assertion about the status of the client IP.
+
+=item C<none>
+
+There is no SPF record for this domain.
+
+=item C<error>
+
+The DNS lookup encountered a temporary error during processing.
+
+=item C<unknown [...]>
+
+The domain has a configuration error in the published data or defines a
+mechanism that this library does not understand. If the data contained an
+unrecognized mechanism, it will be presented following "unknown". You should
+test for unknown using a regexp C</^unknown/> rather than C<eq "unknown">.
+
+=back
+
+Results are cached internally for a default of 120 seconds. You can call
+C<-E<gt>result()> repeatedly; subsequent lookups won't hit your DNS.
+
+C<smtp_comment> should be displayed to the SMTP client.
+
+C<header_comment> goes into a C<Received-SPF> header, like so:
+
+ Received-SPF: $result ($header_comment)
+
+C<spf_record> shows the original SPF record fetched for the query. If there is
+no SPF record, it is blank. Otherwise, it will start with C<v=spf1> and
+contain the SPF mechanisms and such that describe the domain.
+
+Note that the strings returned by this method (and most of the other methods)
+are (at least partially) under the control of the sender's domain. This means
+that, if the sender is an attacker, the contents can be assumed to be hostile.
+The various methods that return these strings make sure that (by default) the
+strings returned contain only characters in the range 32 - 126. This behavior
+can be changed by setting C<sanitize> to 0 to turn off sanitization entirely.
+You can also set C<sanitize> to a function reference to perform custom
+sanitization. In particular, assume that C<smtp_comment> might contain a
+newline character.
+
+C<detail> is a hash of all the foregoing result elements, plus extra data
+returned by the SPF result.
+
+I<Why the weird duplication?> In the beginning, C<result()> returned only one
+value, the C<$result>. Then C<$smtp_comment> and C<$header_comment> came
+along. Then C<$spf_record>. Past a certain number of positional results, it
+makes more sense to have a hash. But we didn't want to break backwards
+compatibility, so we just declared that the fifth result would be a hash and
+future return value would go in there.
+
+The keys of the hash are:
+
+ result
+ smtp_comment
+ header_comment
+ header_pairs
+ spf_record
+ modifiers
+
+=cut
+
+# ----------------------------------------------------------
+# result
+# ----------------------------------------------------------
+
+sub result {
+ my $query = shift;
+ my %result_set;
+
+ my ($result, $smtp_explanation, $smtp_why, $orig_txt) = $query->spfquery(
+ $query->{best_guess} ? $query->{guess_mechs} : ()
+ );
+
+ $smtp_why = "" if $smtp_why eq "default";
+
+ my $smtp_comment = ($smtp_explanation && $smtp_why) ? "$smtp_explanation: $smtp_why" : ($smtp_explanation || $smtp_why);
+
+ $query->{smtp_comment} = $smtp_comment;
+
+ my $header_comment = "$query->{myhostname}: ". $query->header_comment($result);
+
+ # $result =~ s/\s.*$//; # this regex truncates "unknown some:mechanism" to just "unknown"
+
+ $query->{result} = $result;
+
+ my $hash = { result => $query->sanitize(lc $result),
+ smtp_comment => $query->sanitize($smtp_comment),
+ header_comment => $query->sanitize($header_comment),
+ spf_record => $query->sanitize($orig_txt),
+ modifiers => $query->{modifiers},
+ header_pairs => $query->sanitize(scalar $query->header_pairs()),
+ };
+
+ return ($hash->{result},
+ $hash->{smtp_comment},
+ $hash->{header_comment},
+ $hash->{spf_record},
+ $hash,
+ ) if wantarray;
+
+ return $query->sanitize(lc $result);
+}
+
+sub header_comment {
+ my $query = shift;
+ my $result = shift;
+ my $ip = $query->ip;
+ if ($result eq "pass" and $query->{smtp_comment} eq "localhost is always allowed.") { return $query->{smtp_comment} }
+
+ $query->debuglog("header_comment: spf_source = $query->{spf_source}");
+ $query->debuglog("header_comment: spf_source_type = $query->{spf_source_type}");
+
+ if ($query->{spf_source_type} eq "original-spf-record") {
+ return
+ ( $result eq "pass" ? "$query->{spf_source} designates $ip as permitted sender"
+ : $result eq "fail" ? "$query->{spf_source} does not designate $ip as permitted sender"
+ : $result eq "softfail" ? "transitioning $query->{spf_source} does not designate $ip as permitted sender"
+ : $result =~ /^unknown / ? "encountered unrecognized mechanism during SPF processing of $query->{spf_source}"
+ : $result eq "unknown" ? "error in processing during lookup of $query->{sender}"
+ : $result eq "neutral" ? "$ip is neither permitted nor denied by domain of $query->{sender}"
+ : $result eq "error" ? "encountered temporary error during SPF processing of $query->{spf_source}"
+ : $result eq "none" ? "$query->{spf_source} does not designate permitted sender hosts"
+ : "could not perform SPF query for $query->{spf_source}" );
+ }
+
+ return $query->{spf_source};
+
+}
+
+sub header_pairs {
+ my $query = shift;
+# from spf-draft-200404.txt
+# SPF clients may append zero or more of the following key-value-pairs
+# at their discretion:
+#
+# receiver the hostname of the SPF client
+# client-ip the IP address of the SMTP client
+# envelope-from the envelope sender address
+# helo the hostname given in the HELO or EHLO command
+# mechanism the mechanism that matched (if no mechanisms
+# matched, substitute the word "default".)
+# problem if an error was returned, details about the error
+#
+# Other key-value pairs may be defined by SPF clients. Until a new key
+# name becomes widely accepted, new key names should start with "x-".
+
+ my @pairs = (
+ "receiver" => $query->{myhostname},
+ "client-ip" => ($query->{ipv4} || $query->{ipv6} || ""),
+ "envelope-from" => $query->{sender},
+ "helo" => $query->{helo},
+ mechanism => ($query->{matched_mechanism} ? display_mechanism($query->{matched_mechanism}) : "default"),
+ ($query->{result} eq "error"
+ ? (problem => $query->{spf_error_explanation})
+ : ()),
+ ($query->{spf_source_type} ne "original-spf-record" ? ("x-spf-source" => $query->{spf_source}) : ()),
+ );
+
+ if (wantarray) { return @pairs; }
+ my @pair_text;
+ while (@pairs) {
+ my ($key, $val) = (shift(@pairs), shift (@pairs));
+ push @pair_text, "$key=$val;";
+ }
+ return join " ", @pair_text;
+}
+
+=head2 C<< $query->result2() >>
+
+ my ($result, $smtp_comment, $header_comment, $spf_record) = $query->result2('recipient at domain', 'recipient2 at domain');
+
+C<result2()> does everything that C<result()> does, but it first checks to see if
+the sending system is a recognized MX secondary for the recipient(s). If so,
+then it returns C<pass> and does not perform the SPF query. Note that the
+sending system may be a MX secondary for some (but not all) of the recipients
+for a multi-recipient message, which is why result2 takes an argument list.
+See also C<message_result2()>.
+
+B<This is a non-standard feature.> B<This feature is also deprecated, because
+exemption of trusted relays, such as secondary MXes, should really be performed
+by the software that uses this library before doing an SPF check.>
+
+C<$result> will be one of C<pass>, C<fail>, C<neutral [...]>, or C<unknown>.
+See C<result()> above for meanings.
+
+If you have secondary MXes and if you are unable to explicitly white-list them
+before SPF tests occur, you can use this method in place of C<result()>,
+calling it as many times as there are recipients, or just providing all the
+recipients at one time.
+
+C<smtp_comment> can be displayed to the SMTP client.
+
+For example:
+
+ my $query = new Mail::SPF::Query (ip => "127.0.0.1",
+ sender=>'foo at example.com',
+ helo=>"somehost.example.com");
+
+ ...
+
+ my ($result, $smtp_comment, $header_comment);
+
+ ($result, $smtp_comment, $header_comment) = $query->result2('recip1 at example.com');
+ # return suitable error code based on $result eq 'fail' or not
+
+ ($result, $smtp_comment, $header_comment) = $query->result2('recip2 at example.org');
+ # return suitable error code based on $result eq 'fail' or not
+
+ ($result, $smtp_comment, $header_comment) = $query->message_result2();
+ # return suitable error if $result eq 'fail'
+ # prefix message with "Received-SPF: $result ($header_comment)"
+
+=cut
+
+# ----------------------------------------------------------
+# result2
+# ----------------------------------------------------------
+
+sub result2 {
+ my $query = shift;
+ my @recipients = @_;
+
+ if (!$query->{result2}) {
+ my $all_mx_secondary = 'neutral';
+
+ foreach my $recip (@recipients) {
+ my ($rhost) = $recip =~ /([^@]+)$/;
+
+ $query->debuglog("result2: Checking status of recipient $recip (at host $rhost)");
+
+ my $cache_result = $query->{mx_cache}->{$rhost};
+ if (not defined($cache_result)) {
+ $cache_result = $query->{mx_cache}->{$rhost} = is_secondary_for($rhost, $query->{ipv4}) ? 'yes' : 'no';
+ $query->debuglog("result2: $query->{ipv4} is a MX for $rhost: $cache_result");
+ }
+
+ if ($cache_result eq 'yes') {
+ $query->{is_mx_good} = [$query->sanitize('pass'),
+ $query->sanitize('message from secondary MX'),
+ $query->sanitize("$query->{myhostname}: message received from $query->{ipv4} which is an MX secondary for $recip"),
+ undef];
+ $all_mx_secondary = 'yes';
+ } else {
+ $all_mx_secondary = 'no';
+ last;
+ }
+ }
+
+ if ($all_mx_secondary eq 'yes') {
+ return @{$query->{is_mx_good}} if wantarray;
+ return $query->{is_mx_good}->[0];
+ }
+
+ my @result = $query->result();
+
+ $query->{result2} = \@result;
+ }
+
+ return @{$query->{result2}} if wantarray;
+ return $query->{result2}->[0];
+}
+
+sub is_secondary_for {
+ my ($host, $addr) = @_;
+
+ my $resolver = Net::DNS::Resolver->new(
+ tcp_timeout => $DNS_RESOLVER_TIMEOUT,
+ udp_timeout => $DNS_RESOLVER_TIMEOUT,
+ )
+ ;
+ if ($resolver) {
+ my $mx = $resolver->send($host, 'MX');
+ if ($mx) {
+ my @mxlist = sort { $a->preference <=> $b->preference } (grep { $_->type eq 'MX' } $mx->answer);
+ # discard the first entry (top priority) - we shouldn't get mail from them
+ shift @mxlist;
+ foreach my $rr (@mxlist) {
+ my $a = $resolver->send($rr->exchange, 'A');
+ if ($a) {
+ foreach my $rra ($a->answer) {
+ if ($rra->type eq 'A') {
+ if ($rra->address eq $addr) {
+ return 1;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+
+ return undef;
+}
+
+=head2 C<< $query->message_result2() >>
+
+ my ($result, $smtp_comment, $header_comment, $spf_record) = $query->message_result2();
+
+C<message_result2()> returns an overall status for the message after zero or
+more calls to C<result2()>. It will always be the last status returned by
+C<result2()>, or the status returned by C<result()> if C<result2()> was never
+called.
+
+C<$result> will be one of C<pass>, C<fail>, C<neutral [...]>, or C<error>. See
+C<result()> above for meanings.
+
+=cut
+
+# ----------------------------------------------------------
+# message_result2
+# ----------------------------------------------------------
+
+sub message_result2 {
+ my $query = shift;
+
+ if (!$query->{result2}) {
+ if ($query->{is_mx_good}) {
+ return @{$query->{is_mx_good}} if wantarray;
+ return $query->{is_mx_good}->[0];
+ }
+
+ # we are very unlikely to get here -- unless result2 was not called.
+
+ my @result = $query->result();
+
+ $query->{result2} = \@result;
+ }
+
+ return @{$query->{result2}} if wantarray;
+ return $query->{result2}->[0];
+}
+
+=head2 C<< $query->best_guess() >>
+
+ my ($result, $smtp_comment, $header_comment) = $query->best_guess();
+
+When a domain does not publish an SPF record, this library can produce an
+educated guess anyway.
+
+It pretends the domain defined A, MX, and PTR mechanisms, plus a few others.
+The default set of directives is
+
+ a/24 mx/24 ptr
+
+That default set will return either "pass" or "neutral".
+
+If you want to experiment with a different default, you can pass it as an
+argument: C<< $query->best_guess("a mx ptr") >>
+
+B<This is a non-standard feature.> B<This method is also deprecated.> You
+should set C<guess=E<gt>1> on the C<new()> method instead.
+
+=head2 C<< $query->trusted_forwarder() >>
+
+ my ($result, $smtp_comment, $header_comment) = $query->best_guess();
+
+It is possible that the message is coming through a known-good relay like
+C<acm.org> or C<pobox.com>. During the transitional period, many legitimate
+services may appear to forge a sender address: for example, a news website may
+have a "send me this article in email" link.
+
+The C<trusted-forwarder.org> domain is a white-list of known-good hosts that
+either forward mail or perform benign envelope sender forgery:
+
+ include:spf.trusted-forwarder.org
+
+This will return either "pass" or "neutral".
+
+B<This is a non-standard feature.> B<This method is also deprecated.> You
+should set C<trusted=E<gt>1> on the C<new()> method instead.
+
+=cut
+
+sub clone {
+ my $query = shift;
+ my $class = ref $query;
+
+ my %guts = (%$query, @_, parent=>$query);
+
+ my $clone = bless \%guts, $class;
+
+ push @{$clone->{loop_report}}, delete $clone->{reason};
+
+ $query->debuglog(" clone: new object:");
+ for ($clone->show) { $clone->debuglog( "clone: $_" ) }
+
+ return $clone;
+}
+
+sub top {
+ my $query = shift;
+ if ($query->{parent}) { return $query->{parent}->top }
+ return $query;
+}
+
+sub set_temperror {
+ my $query = shift;
+ $query->{error} = shift;
+}
+
+sub show {
+ my $query = shift;
+
+ return map { sprintf ("%20s = %s", $_, $query->{$_}) } keys %$query;
+}
+
+sub best_guess {
+ my $query = shift;
+ my $guess_mechs = shift || $GUESS_MECHS;
+
+ # clone the query object with best_guess mode turned on.
+ my $guess_query = $query->clone( best_guess => 1,
+ guess_mechs => $guess_mechs,
+ reason => "has no data. best guess",
+ );
+
+ $guess_query->top->{lookup_count} = 0;
+
+ # if result is not defined, the domain has no SPF.
+ # perform fallback lookups.
+ # perform trusted-forwarder lookups.
+ # perform guess lookups.
+ #
+ # if result is defined, return it.
+
+ my ($result, $smtp_comment, $header_comment) = $guess_query->result();
+ if (defined $result and $result eq "pass") {
+ my $ip = $query->ip;
+ $header_comment = $query->sanitize("seems reasonable for $query->{sender} to mail through $ip");
+ return ($result, $smtp_comment, $header_comment) if wantarray;
+ return $result;
+ }
+
+ return $query->sanitize("neutral");
+}
+
+sub trusted_forwarder {
+ my $query = shift;
+ my $guess_mechs = shift || $TRUSTED_FORWARDER;
+ return $query->best_guess($guess_mechs);
+}
+
+# ----------------------------------------------------------
+
+=head2 C<< $query->sanitize('string') >>
+
+This applies the sanitization rules for the particular query object. These
+rules are controlled by the C<sanitize> parameter to the c<new()> method.
+
+=cut
+
+sub sanitize {
+ my $query = shift;
+ my $txt = shift;
+
+ if (ref($query->{sanitize})) {
+ $txt = $query->{sanitize}->($txt);
+ }
+
+ return $txt;
+}
+
+# ----------------------------------------------------------
+
+=head2 C<< strict_sanitize('string') >>
+
+This ensures that all the characters in the returned string are printable. All
+whitespace is converted into spaces, and all other non-printable characters are
+converted into question marks. This is probably over-aggressive for many
+applications.
+
+This function is used by default when the C<sanitize> option is passed to the
+C<new()> method.
+
+B<This function is not a class method.>
+
+=cut
+
+sub strict_sanitize {
+ my $txt = shift;
+
+ $txt =~ s/\s/ /g;
+ $txt =~ s/[^[:print:]]/?/g;
+
+ return $txt;
+}
+
+# ----------------------------------------------------------
+
+=head2 C<< $query->debuglog() >>
+
+Subclasses may override this with their own debug logger. C<Log::Dispatch> is
+recommended.
+
+Alternatively, pass the C<new()> constructor a C<< debuglog => sub { ... } >>
+callback, and we'll pass debugging lines to that.
+
+=cut
+
+sub debuglog {
+ my $query = shift;
+ return if ref $query and not $query->{debug};
+
+ my $toprint = join (" ", @_);
+ chomp $toprint;
+ $toprint = sprintf ("%-8s %s %s %s",
+ ("|" x ($query->top->{lookup_count}+1)),
+ $query->{localpart},
+ $query->{domain},
+ $toprint);
+
+ if (exists $query->{debuglog} and ref $query->{debuglog} eq "CODE") {
+ eval { $query->{debuglog}->($toprint) };
+ }
+ else {
+ printf STDERR "%s", "$toprint\n";
+ }
+}
+
+# ----------------------------------------------------------
+# spfquery
+# ----------------------------------------------------------
+
+sub spfquery {
+ #
+ # usage: my ($result, $explanation, $text, $time) = $query->spfquery( [ GUESS_MECHS ] )
+ #
+ # performs a full SPF resolution using the data in $query. to use different data, clone the object.
+ #
+ # if GUESS_MECHS is present, we are operating in "guess" mode so we will not actually query the domain for TXT; we will use the guess_mechs instead.
+ #
+ my $query = shift;
+ my $guess_mechs = shift;
+
+ if ($query->{ipv4} and
+ $query->{ipv4}=~ /^127\./) { return "pass", "localhost is always allowed." }
+
+ $query->top->{lookup_count}++;
+
+ if ($query->is_looping) { return "unknown", $query->{spf_error_explanation}, $query->is_looping }
+ if ($query->can_use_cached_result) { return $query->cached_result; }
+ else { $query->tell_cache_that_lookup_is_underway; }
+
+ my $directive_set = DirectiveSet->new($query->{domain}, $query, $guess_mechs, $query->{local}, $query->{default_record});
+
+ if (not defined $directive_set) {
+ $query->debuglog("no SPF record found for $query->{domain}");
+ $query->delete_cache_point;
+ if ($query->{domain} ne $query->{orig_domain}) {
+ if ($query->{error}) {
+ return "error", $query->{spf_error_explanation}, $query->{error};
+ }
+ return "unknown", $query->{spf_error_explanation}, "Missing SPF record at $query->{domain}";
+ }
+ if ($query->{last_dns_error} eq 'NXDOMAIN') {
+ my $explanation = $query->macro_substitute($query->{default_explanation});
+ return "unknown", $explanation, "domain of sender $query->{sender} does not exist";
+ }
+ return "none", "SPF", "domain of sender $query->{sender} does not designate mailers";
+ }
+
+ if ($directive_set->{hard_syntax_error}) {
+ $query->debuglog(" syntax error while parsing $directive_set->{txt}");
+ $query->delete_cache_point;
+ return "unknown", $query->{spf_error_explanation}, $directive_set->{hard_syntax_error};
+ }
+
+ $query->{directive_set} = $directive_set;
+
+ foreach my $mechanism ($directive_set->mechanisms) {
+ my ($result, $comment) = $query->evaluate_mechanism($mechanism);
+
+ if ($query->{error}) {
+ $query->debuglog(" returning temporary error: $query->{error}");
+ $query->delete_cache_point;
+ return "error", $query->{spf_error_explanation}, $query->{error};
+ }
+
+ if (defined $result) {
+ $query->debuglog(" saving result $result to cache point and returning.");
+ my $explanation = $query->interpolate_explanation(
+ ($result =~ /^unknown/)
+ ? $query->{spf_error_explanation} : $query->{default_explanation});
+ $query->save_result_to_cache($result,
+ $explanation,
+ $comment,
+ $query->{directive_set}->{orig_txt});
+ $query->{matched_mechanism} = $mechanism;
+ return $result, $explanation, $comment, $query->{directive_set}->{orig_txt};
+ }
+ }
+
+ # run the redirect modifier
+ if ($query->{directive_set}->redirect) {
+ my $new_domain = $query->macro_substitute($query->{directive_set}->redirect);
+
+ $query->debuglog(" executing redirect=$new_domain");
+
+ my $inner_query = $query->clone(domain => $new_domain,
+ reason => "redirects to $new_domain",
+ );
+
+ my @inner_result = $inner_query->spfquery();
+
+ $query->delete_cache_point;
+
+ $query->debuglog(" executed redirect=$new_domain, got result @inner_result");
+
+ $query->{spf_source} = $inner_query->{spf_source};
+ $query->{spf_source_type} = $inner_query->{spf_source_type};
+ $query->{matched_mechanism} = $inner_query->{matched_mechanism};
+
+ return @inner_result;
+ }
+
+ $query->debuglog(" no mechanisms matched; deleting cache point and using neutral");
+ $query->delete_cache_point;
+ return "neutral", $query->interpolate_explanation($query->{default_explanation}), $directive_set->{soft_syntax_error};
+}
+
+# ----------------------------------------------------------
+# we cache into $Domains_Queried.
+# ----------------------------------------------------------
+
+sub cache_point {
+ my $query = shift;
+ return my $cache_point = join "/", ($query->{best_guess} || 0,
+ $query->{guess_mechs} || "",
+ $query->{ipv4},
+ $query->{localpart},
+ $query->{domain},
+ $query->{default_record},
+ $query->{local});
+}
+
+sub is_looping {
+ my $query = shift;
+ my $cache_point = $query->cache_point;
+
+ return join(" ", "loop encountered:", @{$query->{loop_report}})
+ if exists $Domains_Queried->{$cache_point}
+ and not defined $Domains_Queried->{$cache_point}->[0];
+
+ return join(" ", "query caused more than" . $query->max_lookup_count . " lookups:", @{$query->{loop_report}})
+ if $query->max_lookup_count and $query->top->{lookup_count} > $query->max_lookup_count;
+
+ return 0;
+}
+
+sub max_lookup_count {
+ my $query = shift;
+ return $query->{max_lookup_count} || $MAX_LOOKUP_COUNT;
+}
+
+sub can_use_cached_result {
+ my $query = shift;
+ my $cache_point = $query->cache_point;
+
+ if ($Domains_Queried->{$cache_point}) {
+ $query->debuglog(" lookup: we have already processed $query->{domain} before with $query->{ipv4}.");
+ my @cached = @{ $Domains_Queried->{$cache_point} };
+ if (not defined $CACHE_TIMEOUT
+ or time - $cached[-1] > $CACHE_TIMEOUT) {
+ $query->debuglog(" lookup: but its cache entry is stale; deleting it.");
+ delete $Domains_Queried->{$cache_point};
+ return 0;
+ }
+
+ $query->debuglog(" lookup: the cache entry is fresh; returning it.");
+ return 1;
+ }
+ return 0;
+}
+
+sub tell_cache_that_lookup_is_underway {
+ my $query = shift;
+
+ # define an entry here so we don't loop endlessly in an Include loop.
+ $Domains_Queried->{$query->cache_point} = [undef, undef, undef, undef, time];
+}
+
+sub save_result_to_cache {
+ my $query = shift;
+ my ($result, $explanation, $comment, $orig_txt) = (shift, shift, shift, shift);
+
+ # define an entry here so we don't loop endlessly in an Include loop.
+ $Domains_Queried->{$query->cache_point} = [$result, $explanation, $comment, $orig_txt, time];
+}
+
+sub cached_result {
+ my $query = shift;
+ my $cache_point = $query->cache_point;
+
+ if ($Domains_Queried->{$cache_point}) {
+ return @{ $Domains_Queried->{$cache_point} };
+ }
+ return;
+}
+
+sub delete_cache_point {
+ my $query = shift;
+ delete $Domains_Queried->{$query->cache_point};
+}
+
+sub clear_cache {
+ $Domains_Queried = {};
+}
+
+sub get_ptr_domain {
+ my ($query) = shift;
+
+ return $query->{ptr_domain} if ($query->{ptr_domain});
+
+ foreach my $ptrdname ($query->myquery(reverse_in_addr($query->{ipv4}) . ".in-addr.arpa", "PTR", "ptrdname")) {
+ $query->debuglog(" get_ptr_domain: $query->{ipv4} is $ptrdname");
+
+ $query->debuglog(" get_ptr_domain: checking hostname $ptrdname for legitimacy.");
+
+ # check for legitimacy --- PTR -> hostname A -> PTR
+ foreach my $ptr_to_a ($query->myquery($ptrdname, "A", "address")) {
+
+ $query->debuglog(" get_ptr_domain: hostname $ptrdname -> $ptr_to_a");
+
+ if ($ptr_to_a eq $query->{ipv4}) {
+ return $query->{ptr_domain} = $ptrdname;
+ }
+ }
+ }
+
+ return undef;
+}
+
+sub macro_substitute_item {
+ my $query = shift;
+ my $arg = shift;
+
+ if ($arg eq "%") { return "%" }
+ if ($arg eq "_") { return " " }
+ if ($arg eq "-") { return "%20" }
+
+ $arg =~ s/^{(.*)}$/$1/;
+
+ my ($field, $num, $reverse, $delim) = $arg =~ /^(x?\w)(\d*)(r?)(.*)$/;
+
+ $delim = '.' if not length $delim;
+
+ my $newval = $arg;
+ my $timestamp = time;
+
+ $newval = $query->{localpart} if (lc $field eq 'u');
+ $newval = $query->{localpart} if (lc $field eq 'l');
+ $newval = $query->{domain} if (lc $field eq 'd');
+ $newval = $query->{sender} if (lc $field eq 's');
+ $newval = $query->{orig_domain} if (lc $field eq 'o');
+ $newval = $query->ip if (lc $field eq 'i');
+ $newval = $timestamp if (lc $field eq 't');
+ $newval = $query->{helo} if (lc $field eq 'h');
+ $newval = $query->get_ptr_domain if (lc $field eq 'p');
+ $newval = $query->{myhostname} if (lc $field eq 'r'); # only used in explanation
+ $newval = $query->{ipv4} ? 'in-addr' : 'ip6'
+ if (lc $field eq 'v');
+
+ # We need to escape a bunch of characters inside a character class
+ $delim =~ s/([\^\-\]\:\\])/\\$1/g;
+
+ if (length $delim) {
+ my @parts = split /[$delim]/, $newval;
+
+ @parts = reverse @parts if ($reverse);
+
+ if ($num) {
+ while (@parts > $num) { shift @parts }
+ }
+
+ $newval = join ".", @parts;
+ }
+
+ $newval = uri_escape($newval) if ($field ne lc $field);
+
+ $query->debuglog(" macro_substitute_item: $arg: field=$field, num=$num, reverse=$reverse, delim=$delim, newval=$newval");
+
+ return $newval;
+}
+
+sub macro_substitute {
+ my $query = shift;
+ my $arg = shift;
+ my $maxlen = shift;
+
+ my $original = $arg;
+
+# macro-char = ( '%{' alpha *digit [ 'r' ] *delim '}' )
+# / '%%'
+# / '%_'
+# / '%-'
+
+ $arg =~ s/%([%_-]|{(\w[^}]*)})/$query->macro_substitute_item($1)/ge;
+
+ if ($maxlen && length $arg > $maxlen) {
+ $arg = substr($arg, -$maxlen); # super.long.string -> er.long.string
+ $arg =~ s/[^.]*\.//; # er.long.string -> long.string
+ }
+ $query->debuglog(" macro_substitute: $original -> $arg") if ($original ne $arg);
+ return $arg;
+}
+
+# ----------------------------------------------------------
+# display_mechanism
+#
+# in human-readable form; used in header_pairs above.
+# ----------------------------------------------------------
+
+sub display_mechanism {
+ my ($modifier, $mechanism, $argument, $source) = @{shift()};
+
+ return "$modifier$mechanism" . (length($argument) ? ":$argument" : "");
+}
+
+# ----------------------------------------------------------
+# evaluate_mechanism
+# ----------------------------------------------------------
+
+sub evaluate_mechanism {
+ my $query = shift;
+ my ($modifier, $mechanism, $argument, $source) = @{shift()};
+
+ $modifier = "+" if not length $modifier;
+
+ $query->debuglog(" evaluate_mechanism: $modifier$mechanism($argument) for domain=$query->{domain}");
+
+ if ({ map { $_=>1 } @KNOWN_MECHANISMS }->{$mechanism}) {
+ my $mech_sub = "mech_$mechanism";
+ my ($hit, $text) = $query->$mech_sub($query->macro_substitute($argument, 255));
+ no warnings 'uninitialized';
+ $query->debuglog(" evaluate_mechanism: $modifier$mechanism($argument) returned $hit $text");
+
+ return if not $hit;
+
+ return ($hit, $text) if ($hit ne "hit");
+
+ if ($source) {
+ $query->{spf_source} = $source;
+ $query->{spf_source_type} = "from mechanism $mechanism";
+ }
+
+ return $query->shorthand2value($modifier), $text;
+ }
+ else {
+ my $unrecognized_mechanism = join ("",
+ ($modifier eq "+" ? "" : $modifier),
+ $mechanism,
+ ($argument ? ":" : ""),
+ $argument);
+ my $error_string = "unknown $unrecognized_mechanism";
+ $query->debuglog(" evaluate_mechanism: unrecognized mechanism $unrecognized_mechanism, returning $error_string");
+ return $error_string => "unrecognized mechanism $unrecognized_mechanism";
+ }
+
+ return ("neutral", "evaluate-mechanism: neutral");
+}
+
+# ----------------------------------------------------------
+# myquery wraps DNS resolver queries
+#
+# ----------------------------------------------------------
+
+sub myquery {
+ my $query = shift;
+ my $label = shift;
+ my $qtype = shift;
+ my $method = shift;
+ my $sortby = shift;
+
+ $query->debuglog(" myquery: doing $qtype query on $label");
+
+ for ($label) {
+ if (/\.\./ or /^\./) {
+ # convert .foo..com to foo.com, etc.
+ $query->debuglog(" myquery: fixing up invalid syntax in $label");
+ s/\.\.+/\./g;
+ s/^\.//;
+ $query->debuglog(" myquery: corrected label is $label");
+ }
+ }
+ my $resquery = $query->resolver->query($label, $qtype);
+
+ my $errorstring = $query->resolver->errorstring;
+ if (not $resquery and $errorstring eq "NOERROR") {
+ return;
+ }
+
+ $query->{last_dns_error} = $errorstring;
+
+ if (not $resquery) {
+ if ($errorstring eq "NXDOMAIN") {
+ $query->debuglog(" myquery: $label $qtype failed: NXDOMAIN.");
+ return;
+ }
+
+ $query->debuglog(" myquery: $label $qtype lookup error: $errorstring");
+ $query->debuglog(" myquery: will set error condition.");
+ $query->set_temperror("DNS error while looking up $label $qtype: $errorstring");
+ return;
+ }
+
+ my @answers = grep { lc $_->type eq lc $qtype } $resquery->answer;
+
+ # $query->debuglog(" myquery: found $qtype response: @answers");
+
+ my @toreturn;
+ if ($sortby) { @toreturn = map { rr_method($_,$method) } sort { $a->$sortby() <=> $b->$sortby() } @answers; }
+ else { @toreturn = map { rr_method($_,$method) } @answers; }
+
+ if (not @toreturn) {
+ $query->debuglog(" myquery: result had no data.");
+ return;
+ }
+
+ return @toreturn;
+}
+
+sub rr_method {
+ my ($answer, $method) = @_;
+ if ($method ne "char_str_list") { return $answer->$method() }
+
+ # long TXT records can't be had with txtdata; they need to be pulled out with char_str_list which returns a list of strings
+ # that need to be joined.
+
+ my @char_str_list = $answer->$method();
+ # print "rr_method returning join of @char_str_list\n";
+
+ return join "", @char_str_list;
+}
+
+#
+# Mechanisms return one of the following:
+#
+# undef mechanism did not match
+# "hit" mechanism matched
+# "unknown" some error happened during processing
+# "error" some temporary error
+#
+# ----------------------------------------------------------
+# all
+# ----------------------------------------------------------
+
+sub mech_all {
+ my $query = shift;
+ return "hit" => "default";
+}
+
+# ----------------------------------------------------------
+# include
+# ----------------------------------------------------------
+
+sub mech_include {
+ my $query = shift;
+ my $argument = shift;
+
+ if (not $argument) {
+ $query->debuglog(" mechanism include: no argument given.");
+ return "unknown", "include mechanism not given an argument";
+ }
+
+ $query->debuglog(" mechanism include: recursing into $argument");
+
+ my $inner_query = $query->clone(domain => $argument,
+ reason => "includes $argument",
+ local => undef,
+ trusted => undef,
+ guess => undef,
+ default_record => undef,
+ );
+
+ my ($result, $explanation, $text, $orig_txt, $time) = $inner_query->spfquery();
+
+ $query->debuglog(" mechanism include: got back result $result / $text / $time");
+
+ if ($result eq "pass") { return hit => $text, $time; }
+ if ($result eq "error") { return $result => $text, $time; }
+ if ($result eq "unknown") { return $result => $text, $time; }
+ if ($result eq "none") { return unknown => $text, $time; } # fail-safe mode. convert an included NONE into an UNKNOWN error.
+ if ($result eq "fail" ||
+ $result eq "neutral" ||
+ $result eq "softfail") { return undef, $text, $time; }
+
+ $query->debuglog(" mechanism include: reducing result $result to unknown");
+ return "unknown", $text, $time;
+}
+
+# ----------------------------------------------------------
+# a
+# ----------------------------------------------------------
+
+sub mech_a {
+ my $query = shift;
+ my $argument = shift;
+
+ my $ip4_cidr_length = ($argument =~ s/ \/(\d+)//x) ? $1 : 32;
+ my $ip6_cidr_length = ($argument =~ s/\/\/(\d+)//x) ? $1 : 128;
+
+ my $domain_to_use = $argument || $query->{domain};
+
+ # see code below in ip4 for more validation
+ if ($domain_to_use !~ / \. \p{IsAlpha} (?: [\p{IsAlnum}-]* \p{IsAlnum} ) $ /x) {
+ return ("unknown" => "bad argument to a: $domain_to_use not a valid FQDN");
+ }
+
+ foreach my $a ($query->myquery($domain_to_use, "A", "address")) {
+ $query->debuglog(" mechanism a: $a");
+ if ($a eq $query->{ipv4}) {
+ $query->debuglog(" mechanism a: match found: $domain_to_use A $a == $query->{ipv4}");
+ return "hit", "$domain_to_use A $query->{ipv4}";
+ }
+ elsif ($ip4_cidr_length < 32) {
+ my $cidr = Net::CIDR::Lite->new("$a/$ip4_cidr_length");
+
+ $query->debuglog(" mechanism a: looking for $query->{ipv4} in $a/$ip4_cidr_length");
+
+ return (hit => "$domain_to_use A $a /$ip4_cidr_length contains $query->{ipv4}")
+ if $cidr->find($query->{ipv4});
+ }
+ }
+ return;
+}
+
+# ----------------------------------------------------------
+# mx
+# ----------------------------------------------------------
+
+sub mech_mx {
+ my $query = shift;
+ my $argument = shift;
+
+ my $ip4_cidr_length = ($argument =~ s/ \/(\d+)//x) ? $1 : 32;
+ my $ip6_cidr_length = ($argument =~ s/\/\/(\d+)//x) ? $1 : 128;
+
+ my $domain_to_use = $argument || $query->{domain};
+
+ if ($domain_to_use !~ / \. \p{IsAlpha} (?: [\p{IsAlnum}-]* \p{IsAlnum} ) $ /x) {
+ return ("unknown" => "bad argument to mx: $domain_to_use not a valid FQDN");
+ }
+
+ my @mxes = $query->myquery($domain_to_use, "MX", "exchange", "preference");
+
+ foreach my $mx (@mxes) {
+ # $query->debuglog(" mechanism mx: $mx");
+
+ foreach my $a ($query->myquery($mx, "A", "address")) {
+ if ($a eq $query->{ipv4}) {
+ $query->debuglog(" mechanism mx: we have a match; $domain_to_use MX $mx A $a == $query->{ipv4}");
+ return "hit", "$domain_to_use MX $mx A $a";
+ }
+ elsif ($ip4_cidr_length < 32) {
+ my $cidr = Net::CIDR::Lite->new("$a/$ip4_cidr_length");
+
+ $query->debuglog(" mechanism mx: looking for $query->{ipv4} in $a/$ip4_cidr_length");
+
+ return (hit => "$domain_to_use MX $mx A $a /$ip4_cidr_length contains $query->{ipv4}")
+ if $cidr->find($query->{ipv4});
+
+ }
+ }
+ }
+ return;
+}
+
+# ----------------------------------------------------------
+# ptr
+# ----------------------------------------------------------
+
+sub mech_ptr {
+ my $query = shift;
+ my $argument = shift;
+
+ if ($query->{ipv6}) { return "neutral", "ipv6 not yet supported"; }
+
+ my $domain_to_use = $argument || $query->{domain};
+
+ foreach my $ptrdname ($query->myquery(reverse_in_addr($query->{ipv4}) . ".in-addr.arpa", "PTR", "ptrdname")) {
+ $query->debuglog(" mechanism ptr: $query->{ipv4} is $ptrdname");
+
+ $query->debuglog(" mechanism ptr: checking hostname $ptrdname for legitimacy.");
+
+ # check for legitimacy --- PTR -> hostname A -> PTR
+ foreach my $ptr_to_a ($query->myquery($ptrdname, "A", "address")) {
+
+ $query->debuglog(" mechanism ptr: hostname $ptrdname -> $ptr_to_a");
+
+ if ($ptr_to_a eq $query->{ipv4}) {
+ $query->debuglog(" mechanism ptr: we have a valid PTR: $query->{ipv4} PTR $ptrdname A $ptr_to_a");
+ $query->debuglog(" mechanism ptr: now we see if $ptrdname ends in $domain_to_use.");
+
+ if ($ptrdname =~ /(^|\.)\Q$domain_to_use\E$/i) {
+ $query->debuglog(" mechanism ptr: $query->{ipv4} PTR $ptrdname does end in $domain_to_use.");
+ return hit => "$query->{ipv4} PTR $ptrdname matches $domain_to_use";
+ }
+ else {
+ $query->debuglog(" mechanism ptr: $ptrdname does not end in $domain_to_use. no match.");
+ }
+ }
+ }
+ }
+ return;
+}
+
+# ----------------------------------------------------------
+# exists
+# ----------------------------------------------------------
+
+sub mech_exists {
+ my $query = shift;
+ my $argument = shift;
+
+ return if (!$argument);
+
+ my $domain_to_use = $argument;
+
+ $query->debuglog(" mechanism exists: looking up $domain_to_use");
+
+ foreach ($query->myquery($domain_to_use, "A", "address")) {
+ $query->debuglog(" mechanism exists: $_");
+ $query->debuglog(" mechanism exists: we have a match.");
+ my @txt = map { s/^"//; s/"$//; $_ } $query->myquery($domain_to_use, "TXT", "char_str_list");
+ if (@txt) {
+ return hit => join(" ", @txt);
+ }
+ return hit => "$domain_to_use found";
+ }
+ return;
+}
+
+# ----------------------------------------------------------
+# ip4
+# ----------------------------------------------------------
+
+sub mech_ip4 {
+ my $query = shift;
+ my $cidr_spec = shift;
+
+ if ($cidr_spec eq '') {
+ return ("unknown" => "no argument given to ip4");
+ }
+
+ my ($network, $cidr_length) = split (/\//, $cidr_spec, 2);
+
+ if ($network !~ /^\d+\.\d+\.\d+\.\d+$/) { return ("unknown" => "bad argument to ip4: $cidr_spec"); }
+
+ $cidr_length = "32" if not defined $cidr_length;
+
+ local $@;
+ my $cidr = eval { Net::CIDR::Lite->new("$network/$cidr_length") };
+ if ($@) { return ("unknown" => "unable to parse ip4:$cidr_spec"); }
+
+ $query->debuglog(" mechanism ip4: looking for $query->{ipv4} in $cidr_spec");
+
+ return (hit => "$cidr_spec contains $query->{ipv4}") if $cidr->find($query->{ipv4});
+
+ return;
+}
+
+# ----------------------------------------------------------
+# ip6
+# ----------------------------------------------------------
+
+sub mech_ip6 {
+ my $query = shift;
+
+ return;
+}
+
+# ----------------------------------------------------------
+# functions
+# ----------------------------------------------------------
+
+sub ip { # accessor
+ my $query = shift;
+ return $query->{ipv4} || $query->{ipv6};
+}
+
+sub reverse_in_addr {
+ return join (".", (reverse split /\./, shift));
+}
+
+sub resolver {
+ my $query = shift;
+ return $query->{res} ||= Net::DNS::Resolver->new(
+ tcp_timeout => $DNS_RESOLVER_TIMEOUT,
+ udp_timeout => $DNS_RESOLVER_TIMEOUT,
+ );
+}
+
+sub fallbacks {
+ my $query = shift;
+ return @{$query->{fallbacks}};
+}
+
+sub shorthand2value {
+ my $query = shift;
+ my $shorthand = shift;
+ return { "-" => "fail",
+ "+" => "pass",
+ "~" => "softfail",
+ "?" => "neutral" } -> {$shorthand} || $shorthand;
+}
+
+sub value2shorthand {
+ my $query = shift;
+ my $value = lc shift;
+ return { "fail" => "-",
+ "pass" => "+",
+ "softfail" => "~",
+ "deny" => "-",
+ "allow" => "+",
+ "softdeny" => "~",
+ "unknown" => "?",
+ "neutral" => "?" } -> {$value} || $value;
+}
+
+sub interpolate_explanation {
+ my $query = shift;
+ my $txt = shift;
+
+ if ($query->{directive_set}->explanation) {
+ my @txt = map { s/^"//; s/"$//; $_ } $query->myquery($query->macro_substitute($query->{directive_set}->explanation), "TXT", "char_str_list");
+ $txt = join " ", @txt;
+ }
+
+ return $query->macro_substitute($txt);
+}
+
+sub find_ancestor {
+ my $query = shift;
+ my $which_hash = shift;
+ my $current_domain = shift;
+
+ return if not exists $query->{$which_hash};
+
+ $current_domain =~ s/\.$//g;
+ my @current_domain = split /\./, $current_domain;
+
+ foreach my $ancestor_level (0 .. @current_domain) {
+ my @ancestor = @current_domain;
+ for (1 .. $ancestor_level) { shift @ancestor }
+ my $ancestor = join ".", @ancestor;
+
+ for my $match ($ancestor_level > 0 ? "*.$ancestor" : $ancestor) {
+ $query->debuglog(" DirectiveSet $which_hash: is $match in the $which_hash hash?");
+ if (my $found = $query->{$which_hash}->{lc $match}) {
+ $query->debuglog(" DirectiveSet $which_hash: yes, it is.");
+ return wantarray ? ($which_hash, $match, $found) : $found;
+ }
+ }
+ }
+ return;
+}
+
+sub found_record_for {
+ my $query = shift;
+ my ($which_hash, $matched_domain_glob, $found) = $query->find_ancestor(@_);
+ return if not $found;
+ my $txt = $found->{record};
+ $query->{spf_source} = "explicit $which_hash found: $matched_domain_glob defines $txt";
+ $query->{spf_source_type} = "full-explanation";
+ $txt = "v=spf1 $txt" if $txt !~ /^v=spf1\b/i;
+ return $txt;
+}
+
+sub try_override {
+ my $query = shift;
+ return $query->found_record_for("override", @_);
+}
+
+sub try_fallback {
+ my $query = shift;
+ return $query->found_record_for("fallback", @_);
+}
+
+# ----------------------------------------------------------
+# algo
+# ----------------------------------------------------------
+
+{
+ package DirectiveSet;
+
+ sub new {
+ my $class = shift;
+ my $current_domain = shift;
+ my $query = shift;
+ my $override_text = shift;
+ my $localpolicy = shift;
+ my $default_record = shift;
+
+ my $txt;
+
+ # overrides can come from two places:
+ # 1 - when operating in best_guess mode, spfquery may be called with a ($guess_mechs) argument, which comes in as $override_text.
+ # 2 - when operating with ->new(..., override => { ... }) we need to load the override dynamically.
+
+ if (not $override_text
+ and
+ exists $query->{override}
+ ) {
+ $txt = $query->try_override($current_domain);
+ }
+
+ if ($override_text) {
+ $txt = "v=spf1 $override_text ?all";
+ $query->{spf_source} = "local policy";
+ $query->{spf_source_type} = "full-explanation";
+ }
+ else {
+ my @txt;
+
+ $query->debuglog(" DirectiveSet->new(): doing TXT query on $current_domain");
+ @txt = $query->myquery($current_domain, "TXT", "char_str_list");
+ $query->debuglog(" DirectiveSet->new(): TXT query on $current_domain returned error=$query->{error}, last_dns_error=$query->{last_dns_error}");
+
+ if ($query->{error} || $query->{last_dns_error} eq 'NXDOMAIN' || ! @txt) {
+ # try the fallbacks.
+ $query->debuglog(" DirectiveSet->new(): will try fallbacks.");
+ if (exists $query->{fallback}
+ and
+ my $found_txt = $query->try_fallback($current_domain, "fallback")) {
+ @txt = $found_txt;
+ }
+ else {
+ $query->debuglog(" DirectiveSet->new(): fallback search failed.");
+ }
+ }
+
+ # Combine multiple TXT strings into a single string:
+ foreach (@txt) {
+ s/^"(.*)"$/$1/;
+ s/^\s+//;
+ s/\s+$//;
+
+ if (/^v=spf1(\s.*|)$/i) {
+ $txt .= $1;
+ }
+ }
+
+ if (!defined $txt && $default_record) {
+ $txt = "v=spf1 $default_record ?all";
+ $query->{spf_source} = "local policy";
+ $query->{spf_source_type} = "full-explanation";
+ }
+ }
+
+ $query->debuglog(" DirectiveSet->new(): SPF policy: $txt");
+
+ return if not defined $txt;
+
+ # TODO: the prepending of the v=spf1 is a massive hack; get it right by saving the actual raw orig_txt.
+ my $directive_set = bless { orig_txt => ($txt =~ /^v=spf1/ ? $txt : "v=spf1$txt"), txt => $txt } , $class;
+
+ TXT_RESPONSE:
+ for ($txt) {
+ $query->debuglog(" lookup: TXT $_");
+
+ # parse the policy record
+
+ while (/\S/) {
+ s/^\s*(\S+)\s*//;
+ my $word = $1;
+ # $query->debuglog(" lookup: word parsing word $word");
+ if ($word =~ /^v=(\S+)/i) {
+ my $version = $1;
+ $query->debuglog(" lookup: TXT version=$version");
+ $directive_set->{version} = $version;
+ next TXT_RESPONSE if ($version ne "spf1");
+ next;
+ }
+
+ # modifiers always have an = sign.
+ if (my ($lhs, $rhs) = $word =~ /^([^:\/]+)=(\S*)$/) {
+ # $query->debuglog(" lookup: TXT modifier found: $lhs = $rhs");
+
+ # if we ever come to support multiple of the same modifier, we need to make this a list.
+ $directive_set->{modifiers}->{lc $lhs} = $rhs;
+ next;
+ }
+
+ # RHS optional, defaults to domain.
+ # [:/] matches a:foo and a/24
+ if (my ($prefix, $lhs, $rhs) = $word =~ /^([-~+?]?)([\w_-]+)([\/:]\S*)?$/i) {
+ $rhs =~ s/^://;
+ $prefix ||= "+";
+ $query->debuglog(" lookup: TXT prefix=$prefix, lhs=$lhs, rhs=$rhs");
+ push @{$directive_set->{mechanisms}}, [$prefix => lc $lhs => $rhs];
+ next;
+ }
+
+ }
+ }
+
+ if (my $rhs = delete $directive_set->{modifiers}->{default}) {
+ push @{$directive_set->{mechanisms}}, [ $query->value2shorthand($rhs), all => undef ];
+ }
+
+ $directive_set->{mechanisms} = [] if not $directive_set->{mechanisms};
+ if ($localpolicy) {
+ my $mechanisms = $directive_set->{mechanisms};
+ my $lastmech = $mechanisms->[$#$mechanisms];
+ if (($lastmech->[0] eq '-' || $lastmech->[0] eq '?') &&
+ $lastmech->[1] eq 'all') {
+ my $index;
+
+ for ($index = $#$mechanisms - 1; $index >= 0; $index--) {
+ last if ($lastmech->[0] ne $mechanisms->[$index]->[0]);
+ }
+ if ($index >= 0) {
+ # We want to insert the localpolicy just *after* $index
+ $query->debuglog(" inserting local policy mechanisms into @{[$directive_set->show_mechanisms]} after position $index");
+ my $localset = DirectiveSet->new($current_domain, $query->clone, $localpolicy);
+
+ if ($localset) {
+ my @locallist = $localset->mechanisms;
+ # Get rid of the ?all at the end of the list
+ pop @locallist;
+ # $_->[3] goes into $query->{spf_source}.
+ map { $_->[3] = ($_->[1] eq 'include'
+ ? "local policy includes SPF record at " . $query->macro_substitute($_->[2])
+ : "local policy") }
+ @locallist;
+ splice(@$mechanisms, $index + 1, 0, @locallist);
+ }
+ }
+ }
+ }
+ $query->debuglog(" lookup: mec mechanisms=@{[$directive_set->show_mechanisms]}");
+ return $directive_set;
+ }
+
+ sub version { shift->{version} }
+ sub mechanisms { @{shift->{mechanisms}} }
+ sub explanation { shift->{modifiers}->{exp} }
+ sub redirect { shift->{modifiers}->{redirect} }
+ sub get_modifier { shift->{modifiers}->{shift()} }
+ sub syntax_error { shift->{syntax_error} }
+
+ sub show_mechanisms {
+ my $directive_set = shift;
+ my @toreturn = map { $_->[0] . $_->[1] . "(" . ($_->[2]||"") . ")" } $directive_set->mechanisms;
+ # print STDERR ("showing mechanisms @toreturn: " . Dumper($directive_set)); use Data::Dumper;
+ return @toreturn;
+ }
+}
+
+1;
+
+=head1 WARNINGS
+
+Mail::Query::SPF should only be used at the point where messages are received
+from the Internet. The underlying assumption is that the sender of the e-mail
+is sending the message directly to you or one of your secondary MXes. If your
+MTA does not have an exhaustive list of secondary MXes, then the C<result2()>
+and C<message_result2()> methods can be used. These methods take care to
+permit mail from secondary MXes.
+
+=head1 AUTHORS
+
+Meng Weng Wong <mengwong+spf at pobox.com>
+
+Philip Gladstone
+
+=head1 SEE ALSO
+
+About SPF: L<http://www.openspf.org>
+
+Mail::SPF::Query: L<http://search.cpan.org/dist/Mail-SPF-Query>
+
+The latest release of the SPF specification: L<http://www.openspf.org/spf-classic-current.txt>
+
+=cut
+
+# vim:et sts=4 sw=4
Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/lib/Mail/SPF/Query.pm
___________________________________________________________________
Name: svn:mime-type
+ text/x-perl
Name: svn:keywords
+ "Author Date Id Rev URL"
Name: svn:eol-style
+ native
Added: packages/libmail-spf-query-perl/branches/upstream/current/t/00_all.t
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/t/00_all.t 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/t/00_all.t 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,141 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl t/00all.t'.
+
+#########################
+
+use Test;
+use strict;
+use Getopt::Std;
+
+my %opts;
+
+getopts('d:',\%opts);
+
+my @test_table;
+
+BEGIN {
+ open TESTFILE, "t/test.dat";
+ @test_table = grep { /\S/ and not /^\s*#/ } <TESTFILE>;
+ chomp @test_table;
+ close TESTFILE;
+
+ plan tests => 1 + map(/\G,?(\d+)/g, @test_table);
+};
+
+use Mail::SPF::Query;
+
+# 1: did the library load okay?
+ok(1);
+
+if ($opts{d}) {
+ open(TEST, ">$opts{d}") || die "Cannot open $opts{d} for output";
+}
+
+my $testnum = 2;
+
+#########################
+
+foreach my $tuple (@test_table) {
+ my ($num, $domain, $ipv4, $expected_result, $expected_smtp_comment, $expected_header_comment) =
+ ($tuple =~ /\t/ ? split(/\t/, $tuple) : split(' ', $tuple));
+
+ my ($actual_result, $actual_smtp_comment, $actual_header_comment);
+
+ my ($sender, $localpolicy) = split(':', $domain, 2);
+ $sender =~ s/\\([0-7][0-7][0-7])/chr(oct($1))/ge;
+ $domain = $sender;
+ if ($domain =~ /\@/) { ($domain) = $domain =~ /\@(.+)/ }
+
+ my $testcnt = 3;
+
+ if ($expected_result =~ /=(pass|fail),/) {
+ for (my $debug = 0; $debug < 2; $debug++) {
+ Mail::SPF::Query->clear_cache;
+ my $query = eval { new Mail::SPF::Query (ipv4 => $ipv4,
+ sender => $sender,
+ helo => $domain,
+ debug => $debug,
+ local => $localpolicy,
+ ); };
+
+ my $ok = 1;
+ my $header_comment;
+
+ $actual_result = "";
+
+ foreach my $e_result (split(/,/, $expected_result)) {
+ if ($e_result !~ /=/) {
+ my ($msg_result, $smtp_comment);
+ ($msg_result, $smtp_comment, $header_comment) = eval { $query->message_result2 };
+
+ $actual_result .= $msg_result;
+
+ $ok = ok($msg_result, $e_result) if (!$debug);
+ if (!$ok) {
+ last;
+ }
+ } else {
+ my ($recip, $expected_recip_result) = split(/=/, $e_result, 2);
+ my ($recip_result, $smtp_comment) = eval { $query->result2(split(';',$recip)) };
+
+ $actual_result .= "$recip=$recip_result,";
+ $testcnt++;
+
+ $ok = ok($recip_result, $expected_recip_result) if (!$debug);
+ if (!$ok) {
+ last;
+ }
+ }
+ }
+
+ $header_comment =~ s/\S+: //; # strip the reporting hostname prefix
+
+ if ($expected_header_comment) {
+ $ok &= ok($header_comment, $expected_header_comment) if (!$debug);
+ }
+ $actual_header_comment = $header_comment;
+ $actual_smtp_comment = '.';
+ last if ($ok);
+ }
+ } else {
+ my ($result, $smtp_comment, $header_comment) = eval { new Mail::SPF::Query (ipv4 => $ipv4,
+ sender => $sender,
+ helo => $domain,
+ local => $localpolicy,
+ default_explanation => "explanation",
+ )->result; };
+ $header_comment =~ s/^\S+: //; # strip the reporting hostname prefix
+
+ my $ok = (! $expected_smtp_comment
+ ? ok($result, $expected_result)
+ : (ok($result, $expected_result) &&
+ ok($smtp_comment, $expected_smtp_comment) &&
+ ok($header_comment, $expected_header_comment)));
+
+ $actual_smtp_comment = $smtp_comment;
+ $actual_result = $result;
+ $actual_header_comment = $header_comment;
+
+ if (not $ok) {
+ Mail::SPF::Query->clear_cache;
+ my $result = eval { scalar(new Mail::SPF::Query (ipv4 => $ipv4,
+ sender => $sender,
+ helo => $domain,
+ debug => 1,
+ local => $localpolicy,
+ )->result) };
+ if ($@) {
+ print " trapped error: $@\n";
+ next;
+ }
+ }
+ }
+ if ($opts{d}) {
+ $num = join(",", $testnum .. $testnum + $testcnt - 1);
+ $testnum += $testcnt;
+ print TEST join("\t", $num, $sender . ($localpolicy ? ":$localpolicy": ""), $ipv4, $actual_result, $actual_smtp_comment, $actual_header_comment),
+ "\n";
+ }
+}
+
+# vim:syn=perl
Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/t/00_all.t
___________________________________________________________________
Name: svn:executable
+
Added: packages/libmail-spf-query-perl/branches/upstream/current/t/test.dat
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/t/test.dat 2006-01-01 18:08:42 UTC (rev 1819)
+++ packages/libmail-spf-query-perl/branches/upstream/current/t/test.dat 2006-01-01 18:09:38 UTC (rev 1820)
@@ -0,0 +1,404 @@
+# this file is read by test.pl
+#
+# it can be used as a common test configurator for all SPF client libraries.
+# meng will keep it up to date to match spf1-test.mailzone.com.
+#
+# tab-separated format:
+#
+# test_number i know this starts at 2; test 1 is for loading the test.txt itself
+# sender where no username@ is provided, substitute droid for the localpart, but postmaster for %{l}
+# client_ip the IP of the pretend client
+# result expected result
+# [smtp_comment] optional smtp comment
+# [header_comment] optional header comment (not counting the local "domain name: " prefix)
+#
+# The sender field can have a ':' in it. In this case the part of the field after the colon
+# contains a local policy to be used just before the terminating 'all'.
+#
+# most tests have no smtp_comment / header_comment.
+# to execute a test, feed the SPF client library the sender / client_ip input tuple,
+# and see if you get back the expected result.
+#
+# keep the numbers straight with perl -ple 'BEGIN { $num = 1 } s/(?:^|\G)(\d+)(,)?/++$num . "$2"/eg;'
+
+2 localhost.localdomain 127.0.0.1 pass
+
+# '01.spf1-test.mailzone.com:v=spf1 :60
+# '02.spf1-test.mailzone.com:v=spf1 -all :60
+# '03.spf1-test.mailzone.com:v=spf1 ~all:60
+# '04.spf1-test.mailzone.com:v=spf1 +all :60::poboxnet
+# '05.spf1-test.mailzone.com:v=spf1 default=deny :60
+# '06.spf1-test.mailzone.com:v=spf1 ?all :60
+# '07.spf1-test.mailzone.com:v=spf2 default=bogus :60
+
+3 01.spf1-test.mailzone.com 192.0.2.1 neutral
+4 02.spf1-test.mailzone.com 192.0.2.1 fail
+5 03.spf1-test.mailzone.com 192.0.2.1 softfail
+6 05.spf1-test.mailzone.com 192.0.2.1 fail
+7,8,9 06.spf1-test.mailzone.com 192.0.2.1 neutral /./ 192.0.2.1 is neither permitted nor denied by domain of 06.spf1-test.mailzone.com
+10 07.spf1-test.mailzone.com 192.0.2.1 none
+11 08.spf1-test.mailzone.com 192.0.2.1 fail
+
+# '08.spf1-test.mailzone.com:v=spf1 -all ?all :60
+# '09.spf1-test.mailzone.com:v=spf1 scope=header-from scope=envelope -all :60
+
+# '10.spf1-test.mailzone.com:v=spf1 mx -all:60
+12 10.spf1-test.mailzone.com 192.0.2.1 fail
+13 10.spf1-test.mailzone.com 192.0.2.10 pass
+14 10.spf1-test.mailzone.com 192.0.2.11 pass
+15 10.spf1-test.mailzone.com 192.0.2.12 pass
+16 10.spf1-test.mailzone.com 192.0.2.13 pass
+17 10.spf1-test.mailzone.com 192.0.2.20 pass
+18 10.spf1-test.mailzone.com 192.0.2.21 pass
+19 10.spf1-test.mailzone.com 192.0.2.22 pass
+20 10.spf1-test.mailzone.com 192.0.2.23 pass
+21 10.spf1-test.mailzone.com 192.0.2.30 pass
+22 10.spf1-test.mailzone.com 192.0.2.31 pass
+23 10.spf1-test.mailzone.com 192.0.2.32 pass
+24 10.spf1-test.mailzone.com 192.0.2.33 pass
+25 10.spf1-test.mailzone.com 192.0.2.34 fail
+
+# @10.spf1-test.mailzone.com::mx01.spf1-test.mailzone.com:10:60
+# @10.spf1-test.mailzone.com::mx02.spf1-test.mailzone.com:10:60
+# @10.spf1-test.mailzone.com::mx03.spf1-test.mailzone.com:20:60
+#
+# @12.spf1-test.mailzone.com::mx01.spf1-test.mailzone.com:10:60
+# @12.spf1-test.mailzone.com::mx02.spf1-test.mailzone.com:10:60
+# @12.spf1-test.mailzone.com::mx03.spf1-test.mailzone.com:20:60
+#
+# @14.spf1-test.mailzone.com::mx01.spf1-test.mailzone.com:10:60
+# @14.spf1-test.mailzone.com::mx02.spf1-test.mailzone.com:10:60
+# @14.spf1-test.mailzone.com::mx03.spf1-test.mailzone.com:20:60
+
+# '11.spf1-test.mailzone.com:v=spf1 mx\072spf1-test.mailzone.com -all:60
+26 11.spf1-test.mailzone.com 192.0.2.1 fail
+27 11.spf1-test.mailzone.com 192.0.2.10 pass
+28 11.spf1-test.mailzone.com 192.0.2.33 pass
+
+# '12.spf1-test.mailzone.com:v=spf1 mx mx\072spf1-test.mailzone.com -all:60
+29 12.spf1-test.mailzone.com 192.0.2.1 fail
+30 12.spf1-test.mailzone.com 192.0.2.10 pass
+31 12.spf1-test.mailzone.com 192.0.2.33 pass
+32 12.spf1-test.mailzone.com 208.210.124.192 fail
+
+# '13.spf1-test.mailzone.com:v=spf1 mx\072spf1-test.mailzone.com mx\072fallback-relay.spf1-test.mailzone.com -all:60
+33 13.spf1-test.mailzone.com 192.0.2.1 fail
+34 13.spf1-test.mailzone.com 192.0.2.10 pass
+35 13.spf1-test.mailzone.com 192.0.2.33 pass
+36 13.spf1-test.mailzone.com 208.210.124.192 fail
+37 13.spf1-test.mailzone.com 192.0.2.40 pass
+
+# '14.spf1-test.mailzone.com:v=spf1 mx mx\072spf1-test.mailzone.com mx\072fallback-relay.spf1-test.mailzone.com -all:60
+38 14.spf1-test.mailzone.com 192.0.2.1 fail
+39 14.spf1-test.mailzone.com 192.0.2.10 pass
+40 14.spf1-test.mailzone.com 192.0.2.33 pass
+41 14.spf1-test.mailzone.com 208.210.124.192 fail
+42 14.spf1-test.mailzone.com 192.0.2.40 pass
+
+# # the spf1-test.mailzone.com domain has two A records and three MX records.
+# # the first A record has no PTR. the second does. it's real.
+# @spf1-test.mailzone.com::mx01.spf1-test.mailzone.com:10:60
+# @spf1-test.mailzone.com::mx02.spf1-test.mailzone.com:10:60
+# @spf1-test.mailzone.com::mx03.spf1-test.mailzone.com:20:60
+#
+# +spf1-test.mailzone.com:192.0.2.200:60
+# =spf1-test.mailzone.com:208.210.124.192:60
+#
+# @fallback-relay.spf1-test.mailzone.com::mx04.spf1-test.mailzone.com:10:60
+#
+# +mx01.spf1-test.mailzone.com:192.0.2.10:60
+# +mx01.spf1-test.mailzone.com:192.0.2.11:60
+# +mx01.spf1-test.mailzone.com:192.0.2.12:60
+# +mx01.spf1-test.mailzone.com:192.0.2.13:60
+#
+# +mx02.spf1-test.mailzone.com:192.0.2.20:60
+# +mx02.spf1-test.mailzone.com:192.0.2.21:60
+# +mx02.spf1-test.mailzone.com:192.0.2.22:60
+# +mx02.spf1-test.mailzone.com:192.0.2.23:60
+#
+# +mx03.spf1-test.mailzone.com:192.0.2.30:60
+# +mx03.spf1-test.mailzone.com:192.0.2.31:60
+# +mx03.spf1-test.mailzone.com:192.0.2.32:60
+# +mx03.spf1-test.mailzone.com:192.0.2.33:60
+#
+# +mx04.spf1-test.mailzone.com:192.0.2.40:60
+# +mx04.spf1-test.mailzone.com:192.0.2.41:60
+# +mx04.spf1-test.mailzone.com:192.0.2.42:60
+# +mx04.spf1-test.mailzone.com:192.0.2.43:60
+#
+
+# '20.spf1-test.mailzone.com:v=spf1 a -all:60
+43 20.spf1-test.mailzone.com 192.0.2.1 fail
+44 20.spf1-test.mailzone.com 192.0.2.120 pass
+
+# '21.spf1-test.mailzone.com:v=spf1 a\072spf1-test.mailzone.com -all:60
+45 21.spf1-test.mailzone.com 192.0.2.1 fail
+46 21.spf1-test.mailzone.com 192.0.2.121 fail
+47 21.spf1-test.mailzone.com 192.0.2.200 pass
+
+# '22.spf1-test.mailzone.com:v=spf1 a a\072spf1-test.mailzone.com -all:60
+48 22.spf1-test.mailzone.com 192.0.2.1 fail
+49 22.spf1-test.mailzone.com 192.0.2.122 pass
+50 22.spf1-test.mailzone.com 192.0.2.200 pass
+
+#
+# +20.spf1-test.mailzone.com:192.0.2.120:60
+# +21.spf1-test.mailzone.com:192.0.2.121:60
+# +22.spf1-test.mailzone.com:192.0.2.122:60
+#
+
+# '30.spf1-test.mailzone.com:v=spf1 ptr -all:60
+# '30.spf1-test.mailzone.com:v=spf1 ptr default=softdeny:60
+51 30.spf1-test.mailzone.com 64.236.24.4 fail
+52 30.spf1-test.mailzone.com 208.210.124.130 pass
+
+# '31.spf1-test.mailzone.com:v=spf1 ptr\072spf1-test.mailzone.com -all:60
+53 31.spf1-test.mailzone.com 64.236.24.4 fail
+54 31.spf1-test.mailzone.com 208.210.124.130 pass
+55 31.spf1-test.mailzone.com 208.210.124.192 pass
+
+# '32.spf1-test.mailzone.com:v=spf1 ptr ptr\072spf1-test.mailzone.com -all:60
+56 32.spf1-test.mailzone.com 64.236.24.4 fail
+57 32.spf1-test.mailzone.com 208.210.124.130 pass
+58 32.spf1-test.mailzone.com 208.210.124.131 pass
+59 32.spf1-test.mailzone.com 208.210.124.192 pass
+
+# =30.spf1-test.mailzone.com:208.210.124.130:60
+# =31.spf1-test.mailzone.com:208.210.124.131:60
+# =32.spf1-test.mailzone.com:208.210.124.132:60
+
+# '40.spf1-test.mailzone.com:v=spf1 exists\072%{ir}.%{v}._spf.%{d} -all:60
+60 40.spf1-test.mailzone.com 192.0.2.100 pass
+61 40.spf1-test.mailzone.com 192.0.2.101 pass
+62 40.spf1-test.mailzone.com 192.0.2.102 fail
+
+# '41.spf1-test.mailzone.com:v=spf1 exists\072%{ir}.%{v}._spf.spf1-test.mailzone.com -all:60
+63 41.spf1-test.mailzone.com 192.0.2.100 fail
+64 41.spf1-test.mailzone.com 192.0.2.110 pass
+65 41.spf1-test.mailzone.com 192.0.2.111 pass
+
+# '42.spf1-test.mailzone.com:v=spf1 exists\072%{ir}.%{v}._spf.%{d} exists\072%{ir}.%{v}._spf.%{d3} -all:60
+66 42.spf1-test.mailzone.com 192.0.2.100 fail
+67 42.spf1-test.mailzone.com 192.0.2.110 pass
+68 42.spf1-test.mailzone.com 192.0.2.130 pass
+69 42.spf1-test.mailzone.com 192.0.2.131 pass
+
+
+#
+# +100.2.0.192.in-addr._spf.40.spf1-test.mailzone.com:127.0.0.2:60
+# +101.2.0.192.in-addr._spf.40.spf1-test.mailzone.com:127.0.0.2:60
+#
+# +110.2.0.192.in-addr._spf.spf1-test.mailzone.com:127.0.0.2:60
+# +111.2.0.192.in-addr._spf.spf1-test.mailzone.com:127.0.0.2:60
+#
+# +120.2.0.192.spf1-test.mailzone.com:127.0.0.2:60
+# +121.2.0.192.spf1-test.mailzone.com:127.0.0.2:60
+#
+# +130.2.0.192.in-addr._spf.42.spf1-test.mailzone.com:127.0.0.2:60
+# +131.2.0.192.in-addr._spf.42.spf1-test.mailzone.com:127.0.0.2:60
+#
+
+# '45.spf1-test.mailzone.com:v=spf1 -a a\072spf1-test.mailzone.com -all:60
+70 45.spf1-test.mailzone.com 192.0.2.140 fail
+71 45.spf1-test.mailzone.com 192.0.2.145 fail
+72 45.spf1-test.mailzone.com 192.0.2.146 fail
+73 45.spf1-test.mailzone.com 192.0.2.147 fail
+74 45.spf1-test.mailzone.com 192.0.2.148 fail
+75 45.spf1-test.mailzone.com 208.210.124.192 pass
+76 45.spf1-test.mailzone.com 192.0.2.200 pass
+
+#
+# +45.spf1-test.mailzone.com:192.0.2.145:60
+# +45.spf1-test.mailzone.com:192.0.2.146:60
+# +45.spf1-test.mailzone.com:192.0.2.147:60
+#
+
+# '50.spf1-test.mailzone.com:v=spf1 include -all:60
+77 50.spf1-test.mailzone.com 192.0.2.200 unknown
+
+# '51.spf1-test.mailzone.com:v=spf1 include\07242.spf1-test.mailzone.com -all:60
+78 51.spf1-test.mailzone.com 192.0.2.200 fail
+79 51.spf1-test.mailzone.com 192.0.2.130 pass
+
+# '52.spf1-test.mailzone.com:v=spf1 include\07253.spf1-test.mailzone.com -all:60
+# C53.spf1-test.mailzone.com:54.spf1-test.mailzone.com
+# '54.spf1-test.mailzone.com:v=spf1 include\07242.spf1-test.mailzone.com -all:60
+80 52.spf1-test.mailzone.com 192.0.2.200 fail
+81 52.spf1-test.mailzone.com 192.0.2.130 pass
+
+# '55.spf1-test.mailzone.com:v=spf1 include\07256.spf1-test.mailzone.com -all:60
+82 55.spf1-test.mailzone.com 192.0.2.200 unknown
+83 55.spf1-test.mailzone.com 192.0.2.130 unknown
+
+# SPF1_TEST(56) deliberately left blank
+84 56.spf1-test.mailzone.com 192.0.2.200 unknown
+
+# TODO: none and fail are both acceptable. we need a way to indicate that multiple result codes are OK.
+
+# include something that doesn't have SPF records
+# '57.spf1-test.mailzone.com:v=spf1 include\072spf1-test.mailzone.com -all:60
+85 57.spf1-test.mailzone.com 192.0.2.200 unknown
+86 57.spf1-test.mailzone.com 192.0.2.130 unknown
+
+# loop detection
+# '58.spf1-test.mailzone.com:v=spf1 include\07259.spf1-test.mailzone.com -all:60
+# '59.spf1-test.mailzone.com:v=spf1 include\07258.spf1-test.mailzone.com -all:60
+87 58.spf1-test.mailzone.com 192.0.2.200 unknown
+88 59.spf1-test.mailzone.com 192.0.2.130 unknown
+
+# '70.spf1-test.mailzone.com:v=spf1 exists\072%{lr+=}.lp._spf.spf1-test.mailzone.com -all:60
+#
+# +*.bob.lp._spf.spf1-test.mailzone.com:127.0.0.2:60
+# +bob.lp._spf.spf1-test.mailzone.com:127.0.0.2:60
+#
+# # no entries for joe.
+
+# 'SPF1_TEST(70):v=spf1 exists\072%{lr+=}.lp._spf.spf1-test.mailzone.com -all:60
+89 droid at 70.spf1-test.mailzone.com 192.0.2.103 fail
+
+90 bob+1 at 70.spf1-test.mailzone.com 192.0.2.103 pass
+91 bob+2 at 70.spf1-test.mailzone.com 192.0.2.103 pass
+92 bob at 70.spf1-test.mailzone.com 192.0.2.103 pass
+93 joe+1 at 70.spf1-test.mailzone.com 192.0.2.103 fail
+94 joe-2 at 70.spf1-test.mailzone.com 192.0.2.103 fail
+95 moe-1 at 70.spf1-test.mailzone.com 192.0.2.103 fail
+
+# client should substitute postmaster when no localpart.
+96 70.spf1-test.mailzone.com 192.0.2.103 pass
+
+# '80.spf1-test.mailzone.com:v=spf1 a mx exists\072%{ir}.%{v}._spf.80.spf1-test.mailzone.com ptr -all:60
+# =80.spf1-test.mailzone.com:208.210.124.180:60
+# +80.2.0.192.in-addr._spf.80.spf1-test.mailzone.com:127.0.0.2:60
+97 80.spf1-test.mailzone.com 64.236.24.4 fail
+98 80.spf1-test.mailzone.com 208.210.124.180 pass
+99 80.spf1-test.mailzone.com 192.0.2.80 pass
+
+# '90.spf1-test.mailzone.com:v=spf1 ip4\072192.0.2.128/25 -all:60
+100 90.spf1-test.mailzone.com 192.0.2.1 fail
+101 90.spf1-test.mailzone.com 192.0.2.127 fail
+102 90.spf1-test.mailzone.com 192.0.2.129 pass
+
+# '91.spf1-test.mailzone.com:v=spf1 -ip4\072192.0.2.128/25 ip4\072192.0.2.0/24 -all:60
+103 91.spf1-test.mailzone.com 192.168.1.1 fail
+104 91.spf1-test.mailzone.com 192.0.2.127 pass
+105 91.spf1-test.mailzone.com 192.0.2.129 fail
+
+# '92.spf1-test.mailzone.com:v=spf1 ?ip4\072192.0.2.192/26 ip4\072192.0.2.128/25 -ip4\072192.0.2.0/24 -all:60
+106 92.spf1-test.mailzone.com 192.168.2.1 fail
+107 92.spf1-test.mailzone.com 192.0.2.1 fail
+108 92.spf1-test.mailzone.com 192.0.2.129 pass
+109 92.spf1-test.mailzone.com 192.0.2.193 neutral
+
+# '95.spf1-test.mailzone.com:v=spf1 exists\072%{p}.whitelist.spf1-test.mailzone.com -all:60
+# '96.spf1-test.mailzone.com:v=spf1 -exists\072%{d}.blacklist.spf1-test.mailzone.com -all:60
+# '97.spf1-test.mailzone.com:v=spf1 exists\072%{p}.whitelist.spf1-test.mailzone.com -exists\072%{d}.blacklist.spf1-test.mailzone.com -all:60
+110 95.spf1-test.mailzone.com 208.210.124.180 pass
+111 95.spf1-test.mailzone.com 208.210.124.1 fail
+112 96.spf1-test.mailzone.com 192.0.2.193 fail
+113 97.spf1-test.mailzone.com 208.210.124.180 pass
+
+# +*.spf1-test.mailzone.com.blacklist.spf1-test.mailzone.com:127.0.0.2:60
+# +*.spf1-test.mailzone.com.whitelist.spf1-test.mailzone.com:127.0.0.2:60
+
+# '98.spf1-test.mailzone.com:v=spf1 a/26 mx/26 -all:60
+# +98.spf1-test.mailzone.com:192.0.2.98:60
+# @98.spf1-test.mailzone.com::80.spf1-test.mailzone.com:10:60
+114 98.spf1-test.mailzone.com 192.0.2.1 fail
+115 98.spf1-test.mailzone.com 192.0.2.98 pass
+116 98.spf1-test.mailzone.com 192.0.2.99 pass
+117 98.spf1-test.mailzone.com 208.210.124.180 pass
+118 98.spf1-test.mailzone.com 208.210.124.1 fail
+119 98.spf1-test.mailzone.com 208.210.124.181 pass
+
+# 'SPF1_TEST(08):v=spf2 default=softdeny default=deny :60
+# 'SPF1_TEST(09):v=spf2 scope=header-from scope=envelope default=deny :60
+120 08.spf1-test.mailzone.com 192.0.2.1 fail
+121 09.spf1-test.mailzone.com 192.0.2.1 fail
+
+# '99.spf1-test.mailzone.com:v=spf1 -all exp=99txt.spf1-test.mailzone.com moo:60
+# '99txt.spf1-test.mailzone.com:%u %s %d %t %h %i %% %U %S %D %T %H %I %% moo:60
+122 99.spf1-test.mailzone.com 192.0.2.1 fail
+
+# testing redirection
+# '100.spf1-test.mailzone.com:v=spf1 redirect=98.spf1-test.mailzone.com:60
+123 100.spf1-test.mailzone.com 192.0.2.1 fail
+124 100.spf1-test.mailzone.com 192.0.2.98 pass
+
+# '101.spf1-test.mailzone.com:v=spf1 -all redirect=98.spf1-test.mailzone.com:60
+125 101.spf1-test.mailzone.com 192.0.2.98 fail
+
+# '102.spf1-test.mailzone.com:v=spf1 ?all redirect=98.spf1-test.mailzone.com:60
+126 102.spf1-test.mailzone.com 192.0.2.98 neutral
+
+# '103.spf1-test.mailzone.com:v=spf1 redirect=98.%{d3}:60
+127 103.spf1-test.mailzone.com 192.0.2.98 pass
+
+# '104.spf1-test.mailzone.com:v=spf1 redirect=105.%{d3}:60
+# '105.spf1-test.mailzone.com:v=spf1 redirect=106.%{d3}:60
+# '106.spf1-test.mailzone.com:v=spf1 redirect=107.%{d3}:60
+# '107.spf1-test.mailzone.com:v=spf1 include\072104.%{d3}:60
+128,129,130 droid at 104.spf1-test.mailzone.com 192.0.2.98 unknown SPF record error: loop encountered: 104.spf1-test.mailzone.com redirects to 105.spf1-test.mailzone.com redirects to 106.spf1-test.mailzone.com redirects to 107.spf1-test.mailzone.com includes 104.spf1-test.mailzone.com error in processing during lookup of droid at 104.spf1-test.mailzone.com
+
+131,132,133 droid at 110.spf1-test.mailzone.com 192.0.2.98 unknown some:unrecognized=mechanism SPF record error: unrecognized mechanism some:unrecognized=mechanism encountered unrecognized mechanism during SPF processing of domain of droid at 110.spf1-test.mailzone.com
+
+# the following tests are for Mail::SPF::Query's result2 and message_result2 methods only.
+
+134,135,136 20.spf1-test.mailzone.com 192.0.2.33 foo at bar.com=fail,foo at spf1-test.mailzone.com=fail,fail
+137,138,139,140 20.spf1-test.mailzone.com 192.0.2.33 foo at spf1-test.mailzone.com=pass,foo at bar.com=fail,fail . domain of 20.spf1-test.mailzone.com does not designate 192.0.2.33 as permitted sender
+141,142,143 20.spf1-test.mailzone.com 192.0.2.33 foo at spf1-test.mailzone.com=pass,pass . message received from 192.0.2.33 which is an MX secondary for foo at spf1-test.mailzone.com
+144,145 20.spf1-test.mailzone.com 192.0.2.33 foo at bar.com=fail,fail
+146,147,148 20.spf1-test.mailzone.com 192.0.2.34 foo at spf1-test.mailzone.com=fail,foo at bar.com=fail,fail
+149,150,151 20.spf1-test.mailzone.com 192.0.2.120 dog at cat.com=pass,foo at bar.com=pass,pass
+152,153 20.spf1-test.mailzone.com 192.0.2.120 dog at cat.com;foo at bar.com=pass,pass
+154,155,156 20.spf1-test.mailzone.com 192.0.2.33 foo at spf1-test.mailzone.com;foo at bar.com=fail,fail . domain of 20.spf1-test.mailzone.com does not designate 192.0.2.33 as permitted sender
+157,158,159 20.spf1-test.mailzone.com 192.0.2.33 foo at bar.com;foo at spf1-test.mailzone.com=fail,fail . domain of 20.spf1-test.mailzone.com does not designate 192.0.2.33 as permitted sender
+
+# tests for localpolicy overrides
+
+160 103.spf1-test.mailzone.com:-all 192.0.2.98 pass
+
+161,162,163 20.spf1-test.mailzone.com:+all 192.0.2.1 pass /./ local policy
+164,165,166 20.spf1-test.mailzone.com:+ip4:192.0.2.1 192.0.2.1 pass /./ local policy
+167 20.spf1-test.mailzone.com:+ip4:192.0.2.2 192.0.2.1 fail
+
+# '91.spf1-test.mailzone.com:v=spf1 -ip4\072192.0.2.128/25 ip4\072192.0.2.0/24 -all:60
+168 91.spf1-test.mailzone.com:ip4:192.168.1.0/24 192.168.1.1 pass
+169 91.spf1-test.mailzone.com:-ip4:192.0.0.0/8 192.0.2.127 pass
+170 91.spf1-test.mailzone.com:ip4:192.0.0.0/8 192.0.2.129 fail
+
+# '92.spf1-test.mailzone.com:v=spf1 ?ip4\072192.0.2.192/26 ip4\072192.0.2.128/25 -ip4\072192.0.2.0/24 -all:60
+171 92.spf1-test.mailzone.com:+all 192.168.2.1 pass
+172 92.spf1-test.mailzone.com:+all 192.0.2.1 pass
+173 92.spf1-test.mailzone.com:-all 192.0.2.129 pass
+174 92.spf1-test.mailzone.com:-all 192.0.2.193 neutral
+
+# '100.spf1-test.mailzone.com:v=spf1 redirect=98.spf1-test.mailzone.com:60
+175 100.spf1-test.mailzone.com:+all 192.0.2.1 pass
+176 100.spf1-test.mailzone.com:-all 192.0.2.98 pass
+
+# '101.spf1-test.mailzone.com:v=spf1 -all redirect=98.spf1-test.mailzone.com:60
+177 101.spf1-test.mailzone.com:+all 192.0.2.98 fail
+
+# '102.spf1-test.mailzone.com:v=spf1 ?all redirect=98.spf1-test.mailzone.com:60
+178 102.spf1-test.mailzone.com:+all 192.0.2.98 neutral
+
+# '51.spf1-test.mailzone.com:v=spf1 include\07242.spf1-test.mailzone.com -all:60
+# '10.spf1-test.mailzone.com:v=spf1 mx -all:60
+179,180,181 10.spf1-test.mailzone.com:include:42.%{d3} 192.0.2.200 fail explanation domain of 10.spf1-test.mailzone.com does not designate 192.0.2.200 as permitted sender
+182,183,184 10.spf1-test.mailzone.com:include:42.%{d3} +all 192.0.2.200 pass /./ local policy
+185,186,187 10.spf1-test.mailzone.com:include:42.%{d3} +all 192.0.2.110 pass /./ local policy includes SPF record at 42.spf1-test.mailzone.com
+
+188,189,190 42-27 at 10.spf1-test.mailzone.com:include:%{l1r-}.%{d3} +all 192.0.2.110 pass /./ local policy includes SPF record at 42.spf1-test.mailzone.com
+191,192,193 42-27 at 10.spf1-test.mailzone.com:include:%{l1r0-9}.%{d3} +all 192.0.2.110 pass /./ local policy includes SPF record at 42.spf1-test.mailzone.com
+194,195,196 42-27 at 10.spf1-test.mailzone.com:include:%{l1r^-}.%{d3} +all 192.0.2.110 pass /./ local policy includes SPF record at 42.spf1-test.mailzone.com
+197,198,199 42di27 at 10.spf1-test.mailzone.com:include:%{l1r:digit:}.%{d3} +all 192.0.2.110 pass /./ local policy includes SPF record at 42.spf1-test.mailzone.com
+200,201,202 42\07227 at 10.spf1-test.mailzone.com:include:%{l1r:digit:}.%{d3} +all 192.0.2.110 pass /./ local policy includes SPF record at 42.spf1-test.mailzone.com
+203,204,205 42\07227 at 10.spf1-test.mailzone.com:include:%{l1r$foo:}.%{d3} +all 192.0.2.110 pass /./ local policy includes SPF record at 42.spf1-test.mailzone.com
+206,207,208 42\27 at 10.spf1-test.mailzone.com:include:%{l1r$fo\o:}.%{d3} +all 192.0.2.110 pass /./ local policy includes SPF record at 42.spf1-test.mailzone.com
+209,210,211 42-27 at 10.spf1-test.mailzone.com:include:%{l1r-[]}.%{d3} +all 192.0.2.110 pass /./ local policy includes SPF record at 42.spf1-test.mailzone.com
+212,213,214 42327 at 10.spf1-test.mailzone.com:include:%{l1r-[]3}.%{d3} +all 192.0.2.110 pass /./ local policy includes SPF record at 42.spf1-test.mailzone.com
+215,216,217 10.spf1-test.mailzone.com:include:01.%{d3} include:02.%{d3} include:06.%{d3} +all 192.0.2.110 pass /./ local policy
+
+218,219,220 10.spf1-test.mailzone.com:include:servfail.%{d3} 192.0.2.200 error explanation: DNS error while looking up servfail.spf1-test.mailzone.com TXT: SERVFAIL encountered temporary error during SPF processing of domain of 10.spf1-test.mailzone.com
+
+221,222,223 10.spf1-test.mailzone.com:~all 192.0.2.200 softfail explanation local policy
More information about the Pkg-perl-cvs-commits
mailing list