From 3e1c346d72f10c154eb7a1c8bf87b04f74331e67 Mon Sep 17 00:00:00 2001 From: Packit Date: Sep 30 2020 10:35:22 +0000 Subject: Mail-SPF-v2.9.0 base --- diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..7acf66b --- /dev/null +++ b/Build.PL @@ -0,0 +1,85 @@ +# +# Module::Build build script for Mail::SPF +# +# (C) 2005-2012 Julian Mehnle +# $Id: Build.PL 61 2013-07-22 03:45:15Z julian $ +# +############################################################################## + +use Module::Build 0.26; +use version; + +my $class = Module::Build->subclass( code => <<'EOF' ); + + sub process_extra_files { + my ($self, $dir) = @_; + $dir ||= $element; + File::Find::find( + { + wanted => sub { + $File::Find::prune = 1 if -d and /\.svn$/; # Exclude .svn/ dirs. + return if not -f; # Handle files only. + + my $destination = $self->copy_if_modified( + from => $File::Find::name, + to => File::Spec->catfile($self->blib, $File::Find::name) + ); + return if not defined($destination); # Already up to date? + + chmod((stat($File::Find::name))[2], $destination) + or warn("Cannot set permissions on $destination: $!"); + }, + no_chdir => 1 + }, + $dir + ); + } + + sub process_sbin_files { shift->process_extra_files('sbin') } + +EOF + +my $build = $class->new( + module_name => 'Mail::SPF', + dist_author => [ + 'Julian Mehnle ', + 'Shevek ' + ], + license => 'bsd', + requires => { + # Core requirements: + perl => '5.006', + version => 0, + Error => 0, + NetAddr::IP => '4', + Net::DNS => '0.62', + URI => '1.13' + }, + recommends => { + NetAddr::IP => '4.007' # has all $& and $` removed for better performance + }, + configure_requires => { + # Configuration requirements: + Module::Build => '0.2805' + }, + build_requires => { + # Build requirements: + Module::Build => '0.2805', + Test::More => 0, + Net::DNS::Resolver::Programmable + => '0.003', + }, + script_files => [ + 'bin/spfquery' + ], + install_path => { + 'sbin' => '/usr/sbin' + }, + create_makefile_pl => 'passthrough', + sign => 1 +); + +$build->add_build_element($_) + foreach qw(sbin); + +$build->create_build_script(); diff --git a/CHANGES b/CHANGES new file mode 100644 index 0000000..fcb5406 --- /dev/null +++ b/CHANGES @@ -0,0 +1,212 @@ +# Legend: +# --- = A new release +# + = Added a feature (in a backwards compatible way) +# ! = Changed something significant, or removed a feature +# * = Fixed a bug, or made a minor improvement + +--- 2.009 (2013-07-21 03:30) + + Mail::SPF: + * Default to querying only TXT type RRs (query_rr_types = Mail::SPF::Server-> + query_rr_type_txt). Experience has shown that querying SPF type RRs is + impractical. + +--- 2.008 (2012-01-30 08:15) + + Mail::SPF: + * Sanitize result local_explanation (as well as result object string + representation) by replacing all non-printable or non-ascii characters + with their hex-escaped representation (e.g., "\x00"). + (Addresses: bugs.launchpad.net #806926) + + Miscellaneous: + * Change openspf.org URLs to openspf.net because openspf.org is unreachable + indefinitely. + * Change URLs + to . + * META.yml: configure_requires: Module::Build 0.2805 + * META.yml: requires: Net::DNS 0.62 (was: 0.52) (Closes: rt.cpan.org #28545) + * META.yml: Revert to flat version numbers for perl and Net::DNS::Resolver:: + Programmable build requirements to avoid Module::Build::Compat/Makefile.PL + incompatibilities. (Closes: rt.cpan.org #53231) + * Attempt to prevent a cascading failure in t/00.03-class-result.t that seems + to happen under rare, unknown circumstances. (Closes: rt.cpan.org #39099) + + Debian: + * Declare Debian source package format as 3.0. + * Standards-Version: 3.9.2 (was: 3.8.3) + * Bump debhelper compatibility level to 7 (was: 5) and simplify debian/rules + using debhelper 7 features. + * debian/control: Simplify depdendencies under the assumption that package + will be installed on Debian Lenny (oldstable at the time of writing) or + later (or the Ubuntu equivalent). + * debian/watch: Use dist-based URL. + +--- 2.007 (2009-10-31 21:00) + + Mail::SPF: + * Macro expansion: + * Distinguish between split and join delimiters; they are not necessarily + the same. + * Support multiple split delimiters rather than at most one. + + Miscellaneous: + * We ship and pass the 2009.10 release of the official RFC 4408 test suite. + * Give advice in INSTALL on how to install without root privileges. + + Debian: + * Standards-Version: 3.8.3 (was: 3.8.0) + * Build-Depends-Indep: perl-modules (>= 5.10.0) | libmodule-build-perl (>= 0.26) + (was: libmodule-build-perl (>= 0.26)) + +--- 2.006 (2008-08-17 22:00) + + Mail::SPF: + + Added result object factory facility to Mail::SPF::Server in order to + support the sub-classing of Mail::SPF::Server and Mail::SPF::Result. + See README for details. + Any code throwing Mail::SPF::Result(::*) objects directly should stop doing + so and use Mail::SPF::Server::throw_result() instead. + + Added a "query_rr_types" option to Mail::SPF::Server's constructor as a + way to disable the retrieval of either "SPF" or "TXT" type RRs. + I wouldn't make use of it if I was you! + ! Changed the "max_void_dns_lookups" option's default value from undef (i.e., + no limit) to a limit of 2. This should not cause any problems in practice, + however see the "max_void_dns_lookups" option's description for specifics + on what this entails. + * Match patterns greedily by reversing the order of the + regexp alternatives from RFC 4408. Thus TLDs with dashes (e.g., + ".xn--wgv71a") are now correctly matched. + * In macro strings, expand '%-' to '%20' rather than '-'. + Thanks to Frank Ellermann for providing a test case for the RFC 4408 test + suite that inadvertently exposed this bug. + > Mail::SPF::Result: + + Added new received_spf_header_name() constant specifying the "Received- + SPF" header field name, which may (and usually should) be overridden by + custom result sub-classes; see the documentation. + * Generate "identity=mailfrom" rather than "identity=mfrom" in + "Received-SPF" header field. + * name() now returns a symbolic result name instead of the trailing part of + the result class name. This should have no impact on 3rd-party code. + * Added new isa_by_name() method as an equivalent to the built-in isa(), + taking a result name instead of a class name. Provides a superset of the + is_code() method's functionality. + * Substituted ";"s for "&" parameter separators in the openspf.org "Why?" + page URL in the default authority explanation string. This change is + purely cosmetic. + * Minor documentation fixes and improvements. + + Miscellaneous: + * We ship and pass the 2008.08 release of the official RFC 4408 test suite. + * While officially declaring a build-requirement of Module::Build >= 0.2805 + (which, if not satisfied, Module::Build itself will warn about, but not + abort), do not strictly require it. If the META.yml file generated during + package building is irrelevant, e.g., if we are being built by a package + management/build system such as Debian's, then 0.26 is sufficient. + * Recommend NetAddr::IP >= 4.007, as it has all $& and $` removed for better + performance; + see . + +--- 2.005 (2007-05-30 23:00) + + Mail::SPF: + + Added a "max_void_dns_lookups" option to Mail::SPF::Server's constructor, + allowing the number of potentially abusive lookups induced by DoS attacks + to be limited. See the documentation of the Mail::SPF::Server class. + + Added a "precedence" class property to Mail::SPF::GlobalMod and sub-classes + that defines the order in which global modifiers are to be processed + (0: first, 1: last). See Mail::SPF::Mod. + Mail::SPF::Mod::Exp has precedence 0.2, Mail::SPF::Mod::Redirect has 0.8. + Also, Mail::SPF::Record::global_mods() now returns modifiers ordered by + precedence. + + Added support for a non-standard %{_scope} pseudo macro that expands to the + request's identity scope. Note: Do NOT use any such non-standard macros in + explanation strings published in DNS! + ! Mail::SPF::Util::valid_domain_for_ip_address() now requires a Mail::SPF:: + Request object to be passed as a new second argument. This is actually + consistent with many of Mail::SPF's methods. Please excuse the late API + change (but who uses Mail::SPF::Util directly anyway?). + * Updated default authority explanation string to include identity scope in + the openspf.org "Why?" page URL in order to avoid misleading result + explanations. + * Truncate labels resulting from macro expansions to 63 bytes. This is not + strictly required by RFC 4408, 8.1/27, but is merely meant as a precaution. + * Minor documentation fixes and improvements. + + Miscellaneous: + * We ship and pass the 2007.05 release of the official RFC 4408 test suite + (no changes were required). + ! Build-require Module::Build >= 0.2805 (was: >= 0.26), hopefully fixing a + version.pm/CPAN.pm compatibility issue (closes: rt.cpan.org #26784). + (Debian packaging is not affected because it does not rely on META.yml.) + + Debian: + * Conflicts: spfquery (<< 1.2.5.dfsg-1) (was unversioned) + +--- 2.004 (2007-01-20 02:00) + + Mail::SPF: + * Correctly fall back to default authority explanation if the authority + domain does specify an explanation string but it cannot be expanded (e.g. + due to syntax errors). + * In Mail::SPF::Result::received_spf_header(), gracefully fall back to a + hostname of "unknown" if a fully qualified hostname can not be determined. + Some (misconfigured) systems simply will not reveal one. + * Minor documentation improvements and fixes. + + Miscellaneous: + * Note in the README file that we pass the 2006.11 release of the official + RFC 4408 test-suite. + + Tests: + * Do not test Mail::SPF::Util::hostname(), as some (misconfigured) systems + simply will not reveal a fully qualified hostname (see CPANTS tests for + 2.003). + * Minor code clean-up. + +--- 2.003 (2007-01-10 00:00) + + Mail::SPF: + * Fixed two Perl 5.6 incompatibilities: + * Added `use utf8` statements in several modules to keep Perl 5.6 from + whining about /[\p{}]/. + * Do not use the `use constant { a=>1, b=>2 }` multiple-constants idiom, + as it was introduced only in constant 1.03 (Perl 5.7.2). + * Fixed a very minor bug where a "TempError" result would incorrectly be + returned in the very rare case when the SPF-type look-up succeeded but + returned 0 records, and the following TXT-type look-up errored or timed + out. Now a "None" result is correctly returned in that case as demanded + by RFC 4408. + + spfquery: + * Minor documentation fixes. + +--- 2.002 (2006-12-14 00:00) + + Mail::SPF: + * Updated default authority explanation string to the SPF website's new + "Why?" page URL parameters scheme: + + + spfquery: + * Updated the '--help' text and man-page with regard to the black magic + options (which require the yet unreleased Mail::SPF::BlackMagic module). + +--- 2.001 (gold release) (2006-12-09 20:00) + + Gold Release! + + Major overhaul: + ! Major code refactoring, achieving full RFC 4408/4406 compliance, and + breaking API compatibility with 2.000. + ! Switched from ExtUtils::MakeMaker to Module::Build. + + Added complete rewrites of spfquery (2.500) and spfd (2.000). + + Added complete documentation. + + Added unit tests and the RFC 4408 test-suite. + + Added Debian package control files. + + And more... (closes: rt.cpan.org #20821, #20822, #21922, #21925) + +--- 2.000 (initial release) (2005-06-23 00:00) + +# $Id: CHANGES 61 2013-07-22 03:45:15Z julian $ +# vim:syn= tw=79 sts=2 sw=2 diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..ad2e506 --- /dev/null +++ b/INSTALL @@ -0,0 +1,46 @@ +System Requirements +------------------- + +The following Perl version and packages are required for... + +...building Mail::SPF: + + Perl 5.6 + Module-Build 0.2805 + Test-More + Net-DNS-Resolver-Programmable 0.003 + (plus all the run-time requirements) + +...running Mail::SPF: + + Perl 5.6 + version + Error + NetAddr-IP 4 + Net-DNS 0.62 + URI 1.13 + +Building and Installing +----------------------- + +You can build and install Mail::SPF automatically using the CPAN shell, or +manually with the following commands: + + perl Build.PL + ./Build + ./Build test + ./Build install + +If you want to install Mail::SPF without root privileges, then the hard-coded +installation of the "spfd" executable to /usr/sbin poses a problem (cf. +rt.cpan.org #34768). This path had to be hard-coded because Perl's built-in +Config.pm does not specify an "sbin" path that Module::Build could use as a +suitable "sbin" install path. + +You can, however, work around this limitation by using the "--install_path" +option during installation: + + ./Build install --install_path sbin=/desired/sbin/path + +# $Id: INSTALL 61 2013-07-22 03:45:15Z julian $ +# vim:tw=79 diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..6b63c63 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +(C) 2005-2012 Julian Mehnle + 2005 Shevek +All rights reserved. + +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. +3. The names of the authors may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..7fe3193 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,62 @@ +bin/spfquery +Build.PL +CHANGES +debian/changelog +debian/compat +debian/control +debian/copyright +debian/libmail-spf-perl.install +debian/rules +debian/source/format +debian/spf-tools-perl.install +debian/spf-tools-perl.postinst +debian/spf-tools-perl.prerm +debian/watch +INSTALL +lib/Mail/SPF.pm +lib/Mail/SPF/Base.pm +lib/Mail/SPF/Exception.pm +lib/Mail/SPF/MacroString.pm +lib/Mail/SPF/Mech.pm +lib/Mail/SPF/Mech/A.pm +lib/Mail/SPF/Mech/All.pm +lib/Mail/SPF/Mech/Exists.pm +lib/Mail/SPF/Mech/Include.pm +lib/Mail/SPF/Mech/IP4.pm +lib/Mail/SPF/Mech/IP6.pm +lib/Mail/SPF/Mech/MX.pm +lib/Mail/SPF/Mech/PTR.pm +lib/Mail/SPF/Mod.pm +lib/Mail/SPF/Mod/Exp.pm +lib/Mail/SPF/Mod/Redirect.pm +lib/Mail/SPF/Record.pm +lib/Mail/SPF/Request.pm +lib/Mail/SPF/Result.pm +lib/Mail/SPF/SenderIPAddrMech.pm +lib/Mail/SPF/Server.pm +lib/Mail/SPF/Term.pm +lib/Mail/SPF/Util.pm +lib/Mail/SPF/v1/Record.pm +lib/Mail/SPF/v2/Record.pm +LICENSE +Makefile.PL +MANIFEST This list of files +MANIFEST.SKIP +META.yml +README +sbin/spfd +t/00.00-class-misc.t +t/00.01-class-util.t +t/00.02-class-request.t +t/00.03-class-result.t +t/00.04-class-server.t +t/00.05-class-macrostring.t +t/00.99-class-misc.t +t/10.00-rfc4408.t +t/10.01-rfc4406.t +t/90-author-pod-validation.t +t/Mail-SPF-Test-lib.pm +t/rfc4406-tests.yml +t/rfc4408-tests.yml +TODO +SIGNATURE Added here by Module::Build diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..ae217c6 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,17 @@ +^_build/ +^Build$ +^blib/ +^debian/libmail-spf-perl/ +^debian/spf-tools-perl/ +^debian/tmp/ +^MANIFEST\.bak$ +^Makefile$ +^tmp/ +^\. +/\. +\.bak$ +\.old$ +\.swp$ +\.tar\.gz$ +~$ +^MYMETA.yml$ diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..b2865bb --- /dev/null +++ b/META.yml @@ -0,0 +1,171 @@ +--- +abstract: 'An object-oriented implementation of Sender Policy Framework' +author: + - 'Julian Mehnle ' + - 'Shevek ' +build_requires: + Module::Build: 0.2805 + Net::DNS::Resolver::Programmable: 0.003 + Test::More: 0 +configure_requires: + Module::Build: 0.2805 +generated_by: 'Module::Build version 0.3607' +license: bsd +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: Mail-SPF +provides: + Mail::SPF: + file: lib/Mail/SPF.pm + version: v2.9.0 + Mail::SPF::Base: + file: lib/Mail/SPF/Base.pm + Mail::SPF::EAbstractClass: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EClassMethod: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EDNSError: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EDNSTimeout: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EDuplicateGlobalMod: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EInstanceMethod: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EInvalidMacro: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EInvalidMacroString: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EInvalidMech: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EInvalidMechQualifier: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EInvalidMod: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EInvalidOptionValue: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EInvalidRecordVersion: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EInvalidScope: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EInvalidTerm: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EJunkInRecord: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EJunkInTerm: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EMacroExpansionCtxRequired: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::ENoAcceptableRecord: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::ENoUnparsedText: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::ENothingToParse: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EOptionRequired: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EProcessingLimitExceeded: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EReadOnlyValue: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::ERecordSelectionError: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::ERedundantAcceptableRecords: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::ESyntaxError: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::ETermDomainSpecExpected: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::ETermIPv4AddressExpected: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::ETermIPv4PrefixLengthExpected: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::ETermIPv6AddressExpected: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::ETermIPv6PrefixLengthExpected: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::EUnexpectedTermObject: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::Exception: + file: lib/Mail/SPF/Exception.pm + Mail::SPF::GlobalMod: + file: lib/Mail/SPF/Mod.pm + Mail::SPF::MacroString: + file: lib/Mail/SPF/MacroString.pm + Mail::SPF::Mech: + file: lib/Mail/SPF/Mech.pm + Mail::SPF::Mech::A: + file: lib/Mail/SPF/Mech/A.pm + Mail::SPF::Mech::All: + file: lib/Mail/SPF/Mech/All.pm + Mail::SPF::Mech::Exists: + file: lib/Mail/SPF/Mech/Exists.pm + Mail::SPF::Mech::IP4: + file: lib/Mail/SPF/Mech/IP4.pm + Mail::SPF::Mech::IP6: + file: lib/Mail/SPF/Mech/IP6.pm + Mail::SPF::Mech::Include: + file: lib/Mail/SPF/Mech/Include.pm + Mail::SPF::Mech::MX: + file: lib/Mail/SPF/Mech/MX.pm + Mail::SPF::Mech::PTR: + file: lib/Mail/SPF/Mech/PTR.pm + Mail::SPF::Mod: + file: lib/Mail/SPF/Mod.pm + Mail::SPF::Mod::Exp: + file: lib/Mail/SPF/Mod/Exp.pm + Mail::SPF::Mod::Redirect: + file: lib/Mail/SPF/Mod/Redirect.pm + Mail::SPF::PositionalMod: + file: lib/Mail/SPF/Mod.pm + Mail::SPF::Record: + file: lib/Mail/SPF/Record.pm + Mail::SPF::Request: + file: lib/Mail/SPF/Request.pm + Mail::SPF::Result: + file: lib/Mail/SPF/Result.pm + Mail::SPF::Result::Error: + file: lib/Mail/SPF/Result.pm + Mail::SPF::Result::Fail: + file: lib/Mail/SPF/Result.pm + Mail::SPF::Result::Neutral: + file: lib/Mail/SPF/Result.pm + Mail::SPF::Result::NeutralByDefault: + file: lib/Mail/SPF/Result.pm + Mail::SPF::Result::None: + file: lib/Mail/SPF/Result.pm + Mail::SPF::Result::Pass: + file: lib/Mail/SPF/Result.pm + Mail::SPF::Result::PermError: + file: lib/Mail/SPF/Result.pm + Mail::SPF::Result::SoftFail: + file: lib/Mail/SPF/Result.pm + Mail::SPF::Result::TempError: + file: lib/Mail/SPF/Result.pm + Mail::SPF::SenderIPAddrMech: + file: lib/Mail/SPF/SenderIPAddrMech.pm + Mail::SPF::Server: + file: lib/Mail/SPF/Server.pm + Mail::SPF::Term: + file: lib/Mail/SPF/Term.pm + Mail::SPF::UnknownMod: + file: lib/Mail/SPF/Mod.pm + Mail::SPF::Util: + file: lib/Mail/SPF/Util.pm + Mail::SPF::v1::Record: + file: lib/Mail/SPF/v1/Record.pm + Mail::SPF::v2::Record: + file: lib/Mail/SPF/v2/Record.pm +recommends: + NetAddr::IP: 4.007 +requires: + Error: 0 + Net::DNS: 0.62 + NetAddr::IP: 4 + URI: 1.13 + perl: 5.006 + version: 0 +resources: + license: http://opensource.org/licenses/bsd-license.php +version: v2.9.0 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..008138d --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,35 @@ +# Note: this file was auto-generated by Module::Build::Compat version 0.3607 +require 5.006; + + unless (eval "use Module::Build::Compat 0.02; 1" ) { + print "This module requires Module::Build to install itself.\n"; + + require ExtUtils::MakeMaker; + my $yn = ExtUtils::MakeMaker::prompt + (' Install Module::Build now from CPAN?', 'y'); + + unless ($yn =~ /^y/i) { + die " *** Cannot install without Module::Build. Exiting ...\n"; + } + + require Cwd; + require File::Spec; + require CPAN; + + # Save this 'cause CPAN will chdir all over the place. + my $cwd = Cwd::cwd(); + + CPAN::Shell->install('Module::Build::Compat'); + CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate + or die "Couldn't install Module::Build, giving up.\n"; + + chdir $cwd or die "Cannot chdir() back to $cwd: $!"; + } + eval "use Module::Build::Compat 0.02; 1" or die $@; + use lib '_build/lib'; + Module::Build::Compat->run_build_pl(args => \@ARGV); + my $build_script = 'Build'; + $build_script .= '.com' if $^O eq 'VMS'; + exit(0) unless(-e $build_script); # cpantesters convention + require MyModuleBuilder; + Module::Build::Compat->write_makefile(build_class => 'MyModuleBuilder'); diff --git a/README b/README new file mode 100644 index 0000000..834279d --- /dev/null +++ b/README @@ -0,0 +1,70 @@ +Mail::SPF 2.009 -- A Perl implementation of the Sender Policy Framework +(C) 2005-2013 Julian Mehnle + 2005 Shevek + +============================================================================== + +Mail::SPF is an object-oriented Perl implementation of the Sender Policy +Framework (SPF) e-mail sender authentication system. + +See for more information about SPF. + +This release of Mail::SPF fully conforms to RFC 4408 and passes the 2009.10 +release of the official test-suite . + +The Mail::SPF source package includes the following additional tools: + + * spfquery: A command-line tool for performing SPF checks. + * spfd: A daemon for services that perform SPF checks frequently. + +Mail::SPF is not your mother! +----------------------------- + +Unlike other SPF implementations, Mail::SPF will not do your homework for you. + +In particular, in evaluating SPF policies it will not make any exceptions for +your localhost or loopback addresses (127.0.0.*, ::1, etc.). There is no way +for Mail::SPF to know exactly which sending IP addresses you would like to +treat as trusted relays and which not. If you don't want messages from certain +addresses to be subject to SPF processing, then don't invoke Mail::SPF on such +messages -- it's that simple. Other libraries have chosen to be more +accommodating, but that has usually led to consumers getting spoiled and +implementations becoming fraught with feature creep. + +Also, parameter parsing is generally very strict. For example, no whitespace +or '<>' characters will be removed from e-mail address or IP address parameters +passed to Mail::SPF. If you pass in unsanitized values and it doesn't work, +don't be surprised. + +You may call me a purist. + +Sub-Classing +------------ + +You can easily sub-class Mail::SPF::Server and the Mail::SPF::Result class +collection in order to extend or modify their behavior. The hypothetical +Mail::SPF::BlackMagic package was once supposed to make use of this. + +In your Mail::SPF::Server sub-class simply override the result_base_class() +constant, specifying your custom Mail::SPF::Result base sub-class. Then have +your result base class specify its associated concrete sub-classes by +overriding Mail::SPF::Result's result_classes() constant. + +For this to work, any code throwing Mail::SPF::Result(::*) objects directly +needs to stop doing so as of Mail::SPF 2.006 and use Mail::SPF::Server:: +throw_result() instead. + +Reporting Bugs +-------------- + +Please report bugs in Mail::SPF and its documentation to the CPAN bug tracker: + + +License +------- + +Mail::SPF is free software. You may use, modify, and distribute it under the +terms of the BSD license. See LICENSE for the BSD license text. + +# $Id: README 61 2013-07-22 03:45:15Z julian $ +# vim:tw=79 diff --git a/SIGNATURE b/SIGNATURE new file mode 100644 index 0000000..0b538ff --- /dev/null +++ b/SIGNATURE @@ -0,0 +1,84 @@ +This file contains message digests of all files listed in MANIFEST, +signed via the Module::Signature module, version 0.55. + +To verify the content in this distribution, first make sure you have +Module::Signature installed, then type: + + % cpansign -v + +It will check each file's integrity, as well as the signature's +validity. If "==> Signature verified OK! <==" is not displayed, +the distribution may already have been compromised, and you should +not run its Makefile.PL or Build.PL. + +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA1 + +SHA1 b4056260a563ccf3d4e9a73d75e9667831d74c53 Build.PL +SHA1 6955847e9665153109ae92dd2a64d0a2dc1d8206 CHANGES +SHA1 44305138c55a84a3bb7f645e722bd066e54ead94 INSTALL +SHA1 d029ebcfd97e29709130f9f1ef101cdfbe3af5a2 LICENSE +SHA1 1698ff9ee090b7194324746019044513be9d80ed MANIFEST +SHA1 e650cdf127dfe2f2ffe6ee604d41f0c4066a7761 MANIFEST.SKIP +SHA1 cef1a05ad47a57f65e18eb4818606bc4b4b9ca72 META.yml +SHA1 0f1b3b6269550b5135e10b3cae1b6b41d274b276 Makefile.PL +SHA1 cf1a06e5832a6739d9587b0e72fa10a876847bd0 README +SHA1 19fcf1103168a8322d97948313c24741309b8312 TODO +SHA1 2cfe8f5d5e7aec159c5cd86cff31dd52e2a33a03 bin/spfquery +SHA1 4b41230d9827687b3097fc3d0e2c37bded3d3485 debian/changelog +SHA1 d3964f9dad9f60363c81b688324d95b4ec7c8038 debian/compat +SHA1 eeb2c6383ce08617a7b741365359fdd3b709e6cb debian/control +SHA1 89e3894e90964f8311ca70f6324c5b0e49b944a3 debian/copyright +SHA1 82e3b9428f66ec70a7479f83e4407ee557c2c006 debian/libmail-spf-perl.install +SHA1 8908ed30c5155d5956841ba7a35962abef954c3d debian/rules +SHA1 f8738a6566306ae25f93456a019426af51ccc827 debian/source/format +SHA1 23d8dc8e413e5fd67a56333f239fdb66e1d4c683 debian/spf-tools-perl.install +SHA1 dce445e7d92fccafd0fe9990354fa7a7b45aeb8f debian/spf-tools-perl.postinst +SHA1 ae33667b74f9bc1316f24d282a8d7dd66e95b854 debian/spf-tools-perl.prerm +SHA1 6eb40d86a8ae9f8be21125107bac7a8c24fb1c7d debian/watch +SHA1 7753b6c140c036d616ce19a523fcad01fc55dc49 lib/Mail/SPF.pm +SHA1 45240500a95d53d8b230249a8976015e9cf76597 lib/Mail/SPF/Base.pm +SHA1 438ad18b54c989d4c51d18c08989f002167e2e86 lib/Mail/SPF/Exception.pm +SHA1 f3edcc62b9ecd12fb8b46c75b3c904193d9e7b75 lib/Mail/SPF/MacroString.pm +SHA1 ddf7398759c02b7925041561a2905c98824da1ab lib/Mail/SPF/Mech.pm +SHA1 5bbccc51b186ce9c4be837dd35b38cd9f47840b0 lib/Mail/SPF/Mech/A.pm +SHA1 fe7cbbbe986d698402ac28fff25ea02b2d2aea9f lib/Mail/SPF/Mech/All.pm +SHA1 ca312b0babd7d35a819b84d7bd8b54447585a912 lib/Mail/SPF/Mech/Exists.pm +SHA1 9bd19e41b002f1bf6866535c1be29784bb797a76 lib/Mail/SPF/Mech/IP4.pm +SHA1 4521940a937cd2654e786c74c81d0b9abade234f lib/Mail/SPF/Mech/IP6.pm +SHA1 be0f109e8059eb9d6a991b115040e08b9cce48fa lib/Mail/SPF/Mech/Include.pm +SHA1 7c66414043297433f385167803eae1b2542f3aa6 lib/Mail/SPF/Mech/MX.pm +SHA1 b99888f766a6c11e1fdb2d24d7ddf758db86d245 lib/Mail/SPF/Mech/PTR.pm +SHA1 3864764b867e0ae3911866ef2b3f68428a103882 lib/Mail/SPF/Mod.pm +SHA1 1ca4386346d4fbff4c8f1257649f90cbc531a6e9 lib/Mail/SPF/Mod/Exp.pm +SHA1 3a4ad549c3f718ed8fd47772b4ebf069bdd640f8 lib/Mail/SPF/Mod/Redirect.pm +SHA1 20f6a69d8e1ffa97e672fbe45fce71cc1b842651 lib/Mail/SPF/Record.pm +SHA1 d18aab930a4ed4dc33e0abd039a4897810656aa5 lib/Mail/SPF/Request.pm +SHA1 4969a65683c4e583a071fdd1f7348abfac94f366 lib/Mail/SPF/Result.pm +SHA1 9a9b4e3ac80919ff93fac10daacd2af9806b9301 lib/Mail/SPF/SenderIPAddrMech.pm +SHA1 80ac6edddbe7cce95d4c66d311b08b72299481f0 lib/Mail/SPF/Server.pm +SHA1 bd9cd17be606faea2f8d23757326c6917e0bafaa lib/Mail/SPF/Term.pm +SHA1 8931b7feb968a99798c4d1222f64d1acf4262383 lib/Mail/SPF/Util.pm +SHA1 f417485715bf0f0b9839966ec444222d28606d1b lib/Mail/SPF/v1/Record.pm +SHA1 3a96854a8573b9275713c7a5df8bb408e7354c81 lib/Mail/SPF/v2/Record.pm +SHA1 1b53532eb660f943667730be95121cc7fd5a8f54 sbin/spfd +SHA1 cf2bcbc82699a16c94dd4dd1ea8995ae3f6ebb0a t/00.00-class-misc.t +SHA1 d69a90912ad71024803c1693d205f769a7c9b41c t/00.01-class-util.t +SHA1 f6dcf8f58ee1f8a2ca96f07785e098ae0510bb90 t/00.02-class-request.t +SHA1 00be4ddf4308799bffa9d02f4ff12ff24afa941f t/00.03-class-result.t +SHA1 c94732b64e189559ed20d9b1776d404022295f63 t/00.04-class-server.t +SHA1 704351986985b2ab199792ae5c6f99a1eaf64bd8 t/00.05-class-macrostring.t +SHA1 d8ccceaaada706cf54c22f9a522c8627107858ef t/00.99-class-misc.t +SHA1 44391e35442da7041b5664614e896bf7fe8dbd8c t/10.00-rfc4408.t +SHA1 a5f83a01fb49fde0462898bb67a4ce017e9d0208 t/10.01-rfc4406.t +SHA1 8276d90bce6d5287b3b64b2f3dafec964175adce t/90-author-pod-validation.t +SHA1 fd03b7df709556fe981806d4b71a4cd3dbfc8921 t/Mail-SPF-Test-lib.pm +SHA1 5612b3598a72d076b84d184d9660522097845a31 t/rfc4406-tests.yml +SHA1 a84a2411e470757c1d55d574a573079a53187565 t/rfc4408-tests.yml +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.10 (GNU/Linux) + +iEYEARECAAYFAlHsrIAACgkQwL7PKlBZWjv/CQCfXfKrLFVqYXF2Gr2Zy5Mnnah1 +aQgAoPa/0Lt6HkFnR+yjjQ4h1QNX+txx +=OBmj +-----END PGP SIGNATURE----- diff --git a/TODO b/TODO new file mode 100644 index 0000000..8aaf1b5 --- /dev/null +++ b/TODO @@ -0,0 +1,28 @@ +# Legend: +# --- = A new release +# + = Add a feature (in a backwards compatible way) +# ! = Change something significant, or remove a feature +# * = Fix a bug, or make a minor improvement + +--- ? + + Mail::SPF: + + Implement "policy source" concept in mechanisms. Make the policy source + accessible from Mail::SPF::Result. + * Implement DNS cache? If so, revert changes to the Mail::SPF::Server's + "DESCRIPTION" POD section in r36. + * Remove or conditionalize debug output generation. Add more debug code? + ! Resolve remaining XXXs, FIXMEs, and TODOs: + grep -rn 'XXX\|TODO\|FIXME' lib | grep -v '\.svn' | less + + spfquery: + + Enable/implement 'debug' option. + + Implement black magic options. + + spfd: + + Implement black magic options. + + Please DO report documentation bugs! + +# $Id: TODO 57 2012-01-30 08:15:31Z julian $ +# vim:tw=79 sts=2 sw=2 diff --git a/bin/spfquery b/bin/spfquery new file mode 100755 index 0000000..0188ab9 --- /dev/null +++ b/bin/spfquery @@ -0,0 +1,731 @@ +#!/usr/bin/perl + +# +# spfquery: Command-line tool for performing SPF queries +# +# (C) 2005-2012 Julian Mehnle +# 2004 Wayne Schlitt +# $Id: spfquery 138 2006-01-22 18:00:34Z julian $ +# +############################################################################## + +=head1 NAME + +spfquery - (Mail::SPF) - Checks if a given set of e-mail parameters matches a +domain's SPF policy + +=head1 VERSION + +2.501 + +=head1 SYNOPSIS + +=over + +=item B + +B [B<--versions>|B<-v> B<1>|B<2>|B<1,2>] [B<--scope>|B<-s> B|B|B] +B<--identity>|B<--id> I B<--ip-address>|B<--ip> I +[B<--helo-identity>|B<--helo-id> I] [I] + +B [B<--versions>|B<-v> B<1>|B<2>|B<1,2>] [B<--scope>|B<-s> B|B|B] +B<--file>|B<-f> I|B<-> [I] + +=item B + +B B<--helo> I B<--ip-address>|B<--ip> I [I] + +B B<--mfrom> I B<--ip-address>|B<--ip> I +[B<--helo> I] [I] + +B B<--pra> I B<--ip-address>|B<--ip> I [I] + +=item B + +B B<--version>|B<-V> + +B B<--help> + +=back + +=head1 DESCRIPTION + +B checks if a given set of e-mail parameters (e.g., the SMTP sender's +IP address) matches the responsible domain's Sender Policy Framework (SPF) +policy. For more information on SPF see L. + +=head2 Preferred Usage + +The following usage forms are preferred over the L +used by older B versions: + +The B<--identity> form checks if the given I is an authorized SMTP +sender for the given C hostname, C envelope sender e-mail address, +or C (so-called purported resonsible address) e-mail address, depending +on the value of the B<--scope> option (which defaults to B if omitted). + +The B<--file> form reads "I I [I]" tuples +from the file with the specified I, or from standard input if +I is B<->, and checks them against the specified scope (B by +default). + +Both forms support an optional B<--versions> option, which specifies a +comma-separated list of the SPF version numbers of SPF records that may be +used. B<1> means that C records should be used. B<2> means that +C records should be used. Defaults to B<1,2>, i.e., uses any SPF +records that are available. Records of a higher version are preferred. + +=head2 Legacy Usage + +B versions before 2.500 featured the following usage forms, which are +discouraged but still supported for L: + +The B<--helo> form checks if the given I is an authorized SMTP +sender for the C hostname given as the I (so-called C +check). + +The B<--mfrom> form checks if the given I is an authorized SMTP +sender for the envelope sender email-address (or domain) given as the +I (so-called C check). If a domain is given instead of an +e-mail address, C will be substituted for the localpart. + +The B<--pra> form checks if the given I is an authorized SMTP +sender for the PRA (Purported Responsible Address) e-mail address given as the +identity. + +=head2 Other Usage + +The B<--version> form prints version information of spfquery. The B<--help> +form prints usage information for spfquery. + +=head1 OPTIONS + +=head2 Standard Options + +The preferred and legacy forms optionally take any of the following +I: + +=over + +=item B<--default-explanation> I + +=item B<--def-exp> I + +Use the specified I as the default explanation if the authority domain +does not specify an explanation string of its own. + +=item B<--hostname> I + +Use I as the host name of the local system instead of auto-detecting +it. + +=item B<--keep-comments> + +=item B<--no-keep-comments> + +Do (not) print any comments found when reading from a file or from standard +input. + +=item B<--sanitize> (currently ignored) + +=item B<--no-sanitize> (currently ignored) + +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<--debug> (currently ignored) + +Print out debug information. + +=back + +=head2 Black Magic Options + +Several options that were supported by earlier versions of B are +considered black magic (i.e. potentially dangerous for the innocent user) and +are thus disabled by default. If the L> Perl module +is installed, they may be enabled by specifying B<--enable-black-magic>. + +=over + +=item B<--max-dns-interactive-terms> I + +Evaluate a maximum of I DNS-interactive mechanisms and modifiers per SPF +check. Defaults to B<10>. Do I override the default unless you know what +you are doing! + +=item B<--max-name-lookups-per-term> I + +Perform a maximum of I DNS name look-ups per mechanism or modifier. +Defaults to B<10>. Do I override the default unless you know what you are +doing! + +=item B<--authorize-mxes-for> I|IB<,>... + +Consider all the MXes of the comma-separated list of Ies and +Is as inherently authorized. + +=item B<--tfwl> + +Perform C accreditation checking. + +=item B<--guess> I + +Use I as a default record if no SPF record is found. + +=item B<--local> I + +Process I as local policy before resorting to a default result +(the implicit or explicit C mechanism at the end of the domain's SPF +record). For example, this could be used for white-listing one's secondary +MXes: C. + +=item B<--override> IB<=>I + +=item B<--fallback> IB<=>I + +Set overrides and fallbacks. Each option can be specified multiple times. For +example: + + --override example.org='v=spf1 -all' + --override '*.example.net'='v=spf1 a mx -all' + --fallback example.com='v=spf1 -all' + +=back + +=head1 RESULT CODES + +=over 12 + +=item B + +The specified IP address is an authorized SMTP sender for the identity. + +=item B + +The specified IP address is not an authorized SMTP sender for the identity. + +=item B + +The specified IP address is not an authorized SMTP sender for the identity, +however the authority domain is still testing out its SPF policy. + +=item B + +The identity's authority domain makes no assertion about the status of the IP +address. + +=item B + +A permanent error occurred while evaluating the authority domain's policy +(e.g., a syntax error in the SPF record). Manual intervention is required +from the authority domain. + +=item B + +A temporary error occurred while evaluating the authority domain's policy +(e.g., a DNS error). Try again later. + +=item B + +There is no applicable SPF policy for the identity domain. + +=back + +=head1 EXIT CODES + + Result | Exit code + -----------+----------- + pass | 0 + fail | 1 + softfail | 2 + neutral | 3 + permerror | 4 + temperror | 5 + none | 6 + +=head1 EXAMPLES + + spfquery --scope mfrom --id user@example.com --ip 1.2.3.4 + spfquery --file test_data + echo "127.0.0.1 user@example.com helohost.example.com" | spfquery -f - + +=head1 COMPATIBILITY + +B has undergone the following interface changes compared to earlier +versions: + +=over + +=item B<2.500> + +=over + +=item * + +A new preferred usage style for performing individual SPF checks has been +introduced. The new style accepts a unified B<--identity> option and an +optional B<--scope> option that specifies the type (scope) of the identity. In +contrast, the legacy usage style requires a separate usage form for every +supported scope. See L and L for details. + +=item * + +The former C and C result codes have been renamed to C +and C, respectively, in order to comply with RFC 4408 terminology. + +=item * + +SPF checks with an empty identity are no longer supported. In the case of an +empty C SMTP transaction parameter, perform a check with the C +scope directly. + +=item * + +The B<--debug> and B<--(no-)sanitize> options are currently ignored by this +version of B. They will again be supported in the future. + +=item * + +Several features that were supported by earlier versions of B are +considered black magic and thus are now disabled by default. See L. + +=item * + +Several option names have been deprecated. This is a list of them and their +preferred synonyms: + + Deprecated options | Preferred options + ---------------------+----------------------------- + --sender, -s | --mfrom + --ipv4, -i | --ip-address, --ip + --name | --hostname + --max-lookup-count, | --max-dns-interactive-terms + --max-lookup | + --rcpt-to, -r | --authorize-mxes-for + --trusted | --tfwl + +=back + +=back + +=head1 SEE ALSO + +L, L + +L + +=head1 AUTHORS + +This version of B is a complete rewrite by Julian Mehnle +, based on an earlier version written by Meng Weng Wong + and Wayne Schlitt . + +=cut + +our $VERSION = '2.501'; + +use warnings; +use strict; + +use IO::File; +use Getopt::Long qw(:config gnu_compat no_ignore_case); +use Error ':try'; +use Mail::SPF; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant exit_codes_by_result_code => { + pass => 0, + fail => 1, + softfail => 2, + neutral => 3, + permerror => 4, + temperror => 5, + none => 6 +}; + +# Helper Functions +############################################################################## + +sub usage { + STDERR->printf(<<'EOT'); +Preferred Usage: + spfquery [--versions|-v 1|2|1,2] [--scope|-s helo|mfrom|pra] + --identity|--id --ip-address|--ip + [--helo-identity|--helo-id ] [OPTIONS] + spfquery [--versions|-v 1|2|1,2] [--scope|-s helo|mfrom|pra] + --file|-f |- [OPTIONS] + +Legacy Usage: + spfquery --helo --ip-address|--ip [OPTIONS] + spfquery --mfrom --ip-address|--ip + [--helo ] [OPTIONS] + spfquery --pra --ip-address|--ip [OPTIONS] + +Other Usage: + spfquery --version|-V + +See `spfquery --help` for more information. +EOT + return; +} + +sub help { + print(<<'EOT'); +Preferred Usage: + spfquery [--versions|-v 1|2|1,2] [--scope|-s helo|mfrom|pra] + --identity|--id --ip-address|--ip + [--helo-identity|--helo-id ] [OPTIONS] + spfquery [--versions|-v 1|2|1,2] [--scope|-s helo|mfrom|pra] + --file|-f |- [OPTIONS] + +Legacy Usage: + spfquery --helo --ip-address|--ip [OPTIONS] + spfquery --mfrom --ip-address|--ip + [--helo ] [OPTIONS] + spfquery --pra --ip-address|--ip [OPTIONS] + +Other Usage: + spfquery --version|-V + +spfquery performs SPF checks based on the command-line arguments or data given +in a file or on standard input. + +Only the preferred and other usage forms are explained here. See the +spfquery(1) man-page for an explanation of the legacy usage forms. + +The "--identity" form checks if the given is an authorized SMTP +sender for the given "helo" hostname, "mfrom" envelope sender e-mail address, +or "pra" (purported resonsible address) e-mail address, depending on the value +of the "--scope" option (which defaults to "mfrom" if omitted). + +The "--file" form reads " []" tuples from +the file with the specified , or from standard input if is +"-", and checks them against the specified scope ("mfrom" by default). + +The "--version" form prints version information of spfquery. + +Valid OPTIONS (and their defaults) are: + --default-explanation + Default explanation string to use (sensible default). + --hostname + The name of the system doing the SPF checking (local + system's configured hostname). + --keep-comments Print comments found when reading from a file. + --no-sanitize Do not clean up invalid characters in output. + --debug Output debugging information. + +Black-magic OPTIONS are: + --max-dns-interactive-terms + Maximum number of DNS-interactive mechanisms and + modifiers (10). + --max-name-lookups-per-term + Maximum number of DNS name look-ups per mechanism or + modifier (10). + --authorize-mxes-for |,... + A comma-separated list of e-mail addresses and domains + whose MXes will be considered inherently authorized. + --tfwl Check trusted-forwarder.org white-list. + --guess Default checks if no SPF record is found. + --local Local policy to process before default result. + --override = + --fallback = + Set override and fallback SPF records for domains. + +Examples: + spfquery --scope mfrom --id user@example.com --ip 1.2.3.4 + spfquery --file test_data + echo "127.0.0.1 user@example.com helohost.example.com" | spfquery -f - +EOT + return; +} + +sub deprecated_option { + my ($old_option, $new_option, $options) = @_; + return FALSE if not exists($options->{$old_option}); + STDERR->print( + "Warning: '$old_option' option is deprecated" . + ($new_option ? "; use '$new_option' instead" : '') . + ".\n" + ); + $options->{$new_option} = delete($options->{$old_option}); + return TRUE; +} + +sub unsupported_option { + my ($option_name, $options) = @_; + return FALSE if not exists($options->{$option_name}); + STDERR->print("Error: '$option_name' option is no longer supported.\n"); + return TRUE; +} + +sub black_magic_option { + my ($option_name, $options) = @_; + return FALSE if not exists($options->{$option_name}); + STDERR->print("Error: '$option_name' option is black magic! Do not use it!\n"); + return TRUE; +} + +# Command-line Option Handling +############################################################################## + +my $options = {}; +my $getopt_result = GetOptions( + $options, + + 'file|f=s', + + 'versions|v=s', + 'scope=s', + 's=s', # Special handling for ambiguous 's' option (formerly a synonym + # for 'sender', now preferredly a synonym for 'scope'). + 'identity|id=s', + 'ip-address|ip=s', + 'helo-identity|helo-id=s', + + # Legacy/shortcut options: + 'mfrom|mail-from|m=s', + 'helo|h=s', + + 'default-explanation|def-exp=s', + 'hostname=s', + + 'keep-comments!', + 'debug!', # TODO Implement! + 'sanitize!', # TODO Implement! + + # Black Magic options: + 'enable-black-magic!', + 'max-dns-interactive-terms=i', + 'max-name-lookups-per-term=i', + 'authorize-mxes-for=s', + # TODO implement! + 'tfwl!', # TODO Implement! + 'guess=s', # TODO Implement! + 'local=s', # TODO Implement! + 'override=s%', # TODO Implement! + 'fallback=s%', # TODO Implement! + + # Meta actions: + 'version|V!', + 'help!', + + # Deprecated options: + 'sender=s', # Now 'scope'/'identity' or 'mfrom' + 'ipv4=s', # Now 'ip-address' + 'i=s', # Now 'ip-address' + 'name=s', # Now 'hostname' + 'max-lookup-count=i', + 'max-lookup=i', # Now 'max-dns-interactive-terms' + 'rcpt-to=s', # Now 'authorize-mxes-for' + 'r=s', # Now 'authorize-mxes-for' + 'trusted!' # Now 'tfwl' +); + +if (not $getopt_result) { + usage(); + exit(255); +} + +if ($options->{help}) { + help(); + exit(0); +} + +if ($options->{version}) { + print("spfquery version $VERSION (using Mail::SPF)\n"); + exit(0); +} + +deprecated_option('sender', 'mfrom', $options); +deprecated_option('ipv4', 'ip-address', $options); +deprecated_option('i', 'ip-address', $options); +deprecated_option('name', 'hostname', $options); +deprecated_option('max-lookup-count', 'max-dns-interactive-terms', $options); +deprecated_option('max-lookup', 'max-dns-interactive-terms', $options); +deprecated_option('rcpt-to', 'authorize-mxes-for', $options); +deprecated_option('r', 'authorize-mxes-for', $options); +deprecated_option('trusted', 'tfwl', $options); + +if ($options->{'enable-black-magic'}) { + if (not defined(eval('require Mail::SPF::BlackMagic'))) { + STDERR->print("Error: Cannot enable black magic. Unable to load Mail::SPF::BlackMagic.\n"); + exit(255); + } + # else: Black magic enabled! +} +elsif ( + black_magic_option('max-dns-interactive-terms', $options) or + black_magic_option('max-name-lookups-per-term', $options) or + black_magic_option('rcpt-to', $options) or + black_magic_option('trusted', $options) or + black_magic_option('guess', $options) or + black_magic_option('local', $options) or + black_magic_option('override', $options) or + black_magic_option('fallback', $options) +) { + exit(255); +} + +my @versions = split(',', $options->{versions} || ''); +my $scope = $options->{scope}; +my $identity = $options->{identity}; +my $ip_address = $options->{'ip-address'}; +my $helo_identity = $options->{'helo-identity'}; + +# Heuristic for distinguishing between 's(cope)' and 's(ender)': +if (defined(my $s = $options->{s})) { + if ( + not defined($scope) and # No explicit 'scope' option has been specified, and + $s !~ /[@.]/ # 's' option contains neither an '@' nor a dot, + # so it cannot be an e-mail address or a domain. + ) { + # Thus it must be meant as the 'scope' option: + $scope = $s; + } + else { + # Else, it must be meant as the deprecated 'sender' option: + $options->{mfrom} = $s; + } +} + +# Heuristic for when explicit 'scope'/'s(cope)' option is absent: +if (not defined($scope)) { + if (defined($identity) or defined($options->{file})) { + # Identity has been specified, or input will be read from file: + # apply the 'scope' option default: + $scope = 'mfrom'; + } + elsif (defined($options->{helo})) { + $scope = 'helo'; + $identity = $options->{helo}; + } + elsif (defined($options->{mfrom})) { + $scope = 'mfrom'; + $identity = $options->{mfrom}; + $helo_identity ||= $options->{helo}; + } + elsif (defined($options->{pra})) { + $scope = 'pra'; + $identity = $options->{pra}; + } +} + +my $default_explanation = $options->{'default-explanation'}; +my $hostname = $options->{hostname}; + +if ( + not defined($scope) or + not (defined($identity) xor defined($options->{file})) +) { + usage(); + exit(255); +} + +if (defined($identity) and $identity eq '') { + STDERR->print("Error: Empty identities are not supported. See spfquery(1).\n"); + exit(255); +} + +# Process the SPF Request(s) +############################################################################## + +try { + my $spf_server = Mail::SPF::Server->new( + default_authority_explanation + => $default_explanation, + hostname => $hostname, + # debug => $options->{debug}, + # sanitize => $options->{sanitize}, + + # Black Magic: + ( + exists($options->{'max-dns-interactive-terms'}) ? + (max_dns_interactive_terms => $options->{'max-dns-interactive-terms'} || undef) + : () + ), + ( + exists($options->{'max-name-lookups-per-term'}) ? + (max_name_lookups_per_term => $options->{'max-name-lookups-per-term'} || undef) + : () + ) + # rcpt_to => $options->{'rcpt-to'}, + # trusted => $options->{trusted}, + # guess => $options->{guess}, + # local => $options->{local}, + # override => $options->{override}, + # fallback => $options->{fallback}, + ); + + my $exit_code; + + if (not defined($options->{file})) { + # Single request: + my $result_code = do_process( + $spf_server, + versions => @versions ? [@versions] : undef, + scope => $scope, + identity => $identity, + ip_address => $ip_address, + helo_identity => $helo_identity + ); + $exit_code = exit_codes_by_result_code->{$result_code}; + } + else { + # File request: + my $file = $options->{file} eq '-' ? \*STDIN : IO::File->new($options->{file}) + or die("Could not open: $options->{file}\n"); + while (<$file>) { + chomp; + s/^\s*//; + next if /^$/; + if (/^#/) { + print("$_\n") if $options->{'keep-comments'}; + next; + } + ($ip_address, $identity, $helo_identity) = split; + my $result_code = do_process( + $spf_server, + versions => @versions ? [@versions] : undef, + scope => $scope, + identity => $identity, + ip_address => $ip_address, + helo_identity => $helo_identity + ); + $exit_code ||= exit_codes_by_result_code->{$result_code}; + } + } + + exit($exit_code); +} +catch Mail::SPF::Exception with { + my ($e) = @_; + STDERR->printf("Error: %s.\n", $e->text); + exit(255); +}; + + +# Helper Function +############################################################################## + +sub do_process { + my ($spf_server, %request_options) = @_; + my $request = Mail::SPF::Request->new(%request_options); + my $result = $spf_server->process($request); + printf( + "%s\n%s\n%s\n%s\n", + $result->code, + ( + $result->can('authority_explanation') ? + $result->authority_explanation + : $result->local_explanation + ), + $result->local_explanation, + $result->received_spf_header + ); + return $result->code; +} diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..c2973df --- /dev/null +++ b/debian/changelog @@ -0,0 +1,218 @@ +mail-spf-perl (2.009) unstable; urgency=low + + Mail::SPF: + * Default to querying only TXT type RRs (query_rr_types = Mail::SPF::Server-> + query_rr_type_txt). Experience has shown that querying SPF type RRs is + impractical. + + -- Julian Mehnle Mon, 22 Jul 2013 03:33:14 +0000 + +mail-spf-perl (2.008) unstable; urgency=low + + Debian: + * Declare source package format as 3.0. + * Standards-Version: 3.9.2 (was: 3.8.3) + * Bump debhelper compatibility level to 7 (was: 5) and simplify debian/rules + using debhelper 7 features. + * debian/control: Simplify depdendencies under the assumption that package + will be installed on Debian Lenny (oldstable at the time of writing) or + later (or the Ubuntu equivalent). + * debian/watch: Use dist-based URL. + + Mail::SPF: + * Sanitize result local_explanation (as well as result object string + representation) by replacing all non-printable or non-ascii characters + with their hex-escaped representation (e.g., "\x00"). + (Addresses: bugs.launchpad.net #806926) + + Miscellaneous: + * Change openspf.org URLs to openspf.net because openspf.org is unreachable + indefinitely. + * Change URLs + to . + * Attempt to prevent a cascading failure in t/00.03-class-result.t that seems + to happen under rare, unknown circumstances. (Closes: rt.cpan.org #39099) + + -- Julian Mehnle Mon, 30 Jan 2012 08:31:42 +0000 + +mail-spf-perl (2.007) unstable; urgency=low + + Debian: + * Standards-Version: 3.8.3 (was: 3.8.0) + * Build-Depends-Indep: perl-modules (>= 5.10.0) | libmodule-build-perl (>= 0.26) + (was: libmodule-build-perl (>= 0.26)) + + Mail::SPF: + * Macro expansion: + * Distinguish between split and join delimiters; they are not necessarily + the same. + * Support multiple split delimiters rather than at most one. + + Miscellaneous: + * We ship and pass the 2009.10 release of the official RFC 4408 test suite. + + -- Julian Mehnle Sat, 31 Oct 2009 21:29:45 +0000 + +mail-spf-perl (2.006) unstable; urgency=low + + Debian: + * Recommends: libnetaddr-ip-perl (>= 4.007) (in addition to the Depends on + >= 4), as it has all $& and $` removed for better performance; + see . + * Homepage: http://search.cpan.org/dist/Mail-SPF/ + * Standards-Version: 3.8.0 (was: 3.7.2) + * Added watch file. + * Other minor improvements. + + Mail::SPF: + + Added result object factory facility to Mail::SPF::Server in order to + support the sub-classing of Mail::SPF::Server and Mail::SPF::Result. + See README for details. + Any code throwing Mail::SPF::Result(::*) objects directly should stop doing + so and use Mail::SPF::Server::throw_result() instead. + + Added a "query_rr_types" option to Mail::SPF::Server's constructor as a + way to disable the retrieval of either "SPF" or "TXT" type RRs. + I wouldn't make use of it if I was you! + ! Changed the "max_void_dns_lookups" option's default value from undef (i.e., + no limit) to a limit of 2. This should not cause any problems in practice, + however see the "max_void_dns_lookups" option's description for specifics + on what this entails. + * Match patterns greedily by reversing the order of the + regexp alternatives from RFC 4408. Thus TLDs with dashes (e.g., + ".xn--wgv71a") are now correctly matched. + * In macro strings, expand '%-' to '%20' rather than '-'. + Thanks to Frank Ellermann for providing a test case for the RFC 4408 test + suite that inadvertently exposed this bug. + > Mail::SPF::Result: + + Added new received_spf_header_name() constant specifying the "Received- + SPF" header field name, which may (and usually should) be overridden by + custom result sub-classes; see the documentation. + * Generate "identity=mailfrom" rather than "identity=mfrom" in + "Received-SPF" header field. + * name() now returns a symbolic result name instead of the trailing part of + the result class name. This should have no impact on 3rd-party code. + * Added new isa_by_name() method as an equivalent to the built-in isa(), + taking a result name instead of a class name. Provides a superset of the + is_code() method's functionality. + * Substituted ";"s for "&" parameter separators in the openspf.org "Why?" + page URL in the default authority explanation string. This change is + purely cosmetic. + * Minor documentation fixes and improvements. + + Miscellaneous: + * We ship and pass the 2008.08 release of the official RFC 4408 test suite. + * While officially declaring a build-requirement of Module::Build >= 0.2805 + (which, if not satisfied, Module::Build itself will warn about, but not + abort), do not strictly require it. If the META.yml file generated during + package building is irrelevant, e.g., if we are being built by a package + management/build system such as Debian's, then 0.26 is sufficient. + * Recommend NetAddr::IP >= 4.007; see above. + + -- Julian Mehnle Sun, 17 Aug 2008 21:18:33 +0000 + +mail-spf-perl (2.005) unstable; urgency=low + + Debian: + * Conflicts: spfquery (<< 1.2.5.dfsg-1) (was unversioned) + + Mail::SPF: + + Added a "max_void_dns_lookups" option to Mail::SPF::Server's constructor, + allowing the number of potentially abusive lookups induced by DoS attacks + to be limited. See the documentation of the Mail::SPF::Server class. + + Added a "precedence" class property to Mail::SPF::GlobalMod and sub-classes + that defines the order in which global modifiers are to be processed + (0: first, 1: last). See Mail::SPF::Mod. + Mail::SPF::Mod::Exp has precedence 0.2, Mail::SPF::Mod::Redirect has 0.8. + Also, Mail::SPF::Record::global_mods() now returns modifiers ordered by + precedence. + + Added support for a non-standard %{_scope} pseudo macro that expands to the + request's identity scope. Note: Do NOT use any such non-standard macros in + explanation strings published in DNS! + ! Mail::SPF::Util::valid_domain_for_ip_address() now requires a Mail::SPF:: + Request object to be passed as a new second argument. This is actually + consistent with many of Mail::SPF's methods. Please excuse the late API + change (but who uses Mail::SPF::Util directly anyway?). + * Updated default authority explanation string to include identity scope in + the openspf.org "Why?" page URL in order to avoid misleading result + explanations. + * Truncate labels resulting from macro expansions to 63 bytes. This is not + strictly required by RFC 4408, 8.1/27, but is merely meant as a precaution. + * Minor documentation fixes and improvements. + + Miscellaneous: + * We pass (and include) the 2007.05 release of the official RFC 4408 test + suite (no changes were required). + + -- Julian Mehnle Wed, 30 May 2007 23:00:00 +0000 + +mail-spf-perl (2.004) unstable; urgency=low + + Mail::SPF: + * Correctly fall back to default authority explanation if the authority + domain does specify an explanation string but it cannot be expanded (e.g. + due to syntax errors). + * In Mail::SPF::Result::received_spf_header(), gracefully fall back to a + hostname of "unknown" if a fully qualified hostname can not be determined. + Some (misconfigured) systems simply will not reveal one. + * Minor documentation improvements and fixes. + + Miscellaneous: + * Note in the README file that we pass the 2006.11 release of the official + RFC 4408 test-suite. + + Tests: + * Do not test Mail::SPF::Util::hostname(), as some (misconfigured) systems + simply will not reveal a fully qualified hostname (see CPANTS tests for + 2.003). + * Minor code clean-up. + + -- Julian Mehnle Sat, 20 Jan 2007 02:00:00 +0000 + +mail-spf-perl (2.003) unstable; urgency=low + + Mail::SPF: + * Fixed two Perl 5.6 incompatibilities: + * Added `use utf8` statements in several modules to keep Perl 5.6 from + whining about /[\p{}]/. + * Do not use the `use constant { a=>1, b=>2 }` multiple-constants idiom, + as it was introduced only in constant 1.03 (Perl 5.7.2). + * Fixed a very minor bug where a "TempError" result would incorrectly be + returned in the very rare case when the SPF-type look-up succeeded but + returned 0 records, and the following TXT-type look-up errored or timed + out. Now a "None" result is correctly returned in that case as demanded + by RFC 4408. + + spfquery: + * Minor documentation fixes. + + -- Julian Mehnle Wed, 10 Jan 2007 00:00:00 +0000 + +mail-spf-perl (2.002) unstable; urgency=low + + Mail::SPF: + * Updated default authority explanation string to the SPF website's new + "Why?" page URL parameters scheme: + + + spfquery: + * Updated the '--help' text and man-page with regard to the black magic + options (which require the yet unreleased Mail::SPF::BlackMagic module). + + -- Julian Mehnle Thu, 14 Dec 2006 00:00:00 +0000 + +mail-spf-perl (2.001) unstable; urgency=low + + Gold Release! + + Major overhaul: + ! Major code refactoring, achieving full RFC 4408/4406 compliance, and + breaking API compatibility with 2.000. + ! Switched from ExtUtils::MakeMaker to Module::Build. + + Added complete rewrites of spfquery (2.500) and spfd (2.000). + + Added complete documentation. + + Added unit tests and the RFC 4408 test-suite. + + Added Debian package control files. + + And more... (closes: rt.cpan.org #20821, #20822, #21922, #21925) + + -- Julian Mehnle Sat, 9 Dec 2006 20:00:00 +0000 + diff --git a/debian/compat b/debian/compat new file mode 100644 index 0000000..7f8f011 --- /dev/null +++ b/debian/compat @@ -0,0 +1 @@ +7 diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..af10295 --- /dev/null +++ b/debian/control @@ -0,0 +1,48 @@ +Source: mail-spf-perl +Homepage: http://search.cpan.org/dist/Mail-SPF/ +Section: mail +Priority: optional +Maintainer: Julian Mehnle +Build-Depends: debhelper (>= 7.0.50~) +Build-Depends-Indep: perl, + liberror-perl, + libnet-dns-perl, + libnet-dns-resolver-programmable-perl, + libnetaddr-ip-perl, + libtest-pod-perl, + liburi-perl +Standards-Version: 3.9.2 +Vcs-Svn: http://www.mehnle.net/svn/mail-spf-perl +Vcs-Browser: http://www.mehnle.net/source/mail-spf-perl + +Package: libmail-spf-perl +Section: perl +Architecture: all +Depends: ${misc:Depends}, ${perl:Depends}, + liberror-perl, + libnet-dns-perl, + libnetaddr-ip-perl, + liburi-perl +Description: Perl implementation of Sender Policy Framework and Sender ID + Mail::SPF is an object-oriented Perl implementation of the Sender Policy + Framework (SPF) e-mail sender authentication system . + . + It supports both the TXT and SPF RR types as well as both SPFv1 (v=spf1) and + Sender ID (spf2.0) records, and it is fully compliant to RFCs 4408 and 4406. + (It does not however implement the patented PRA address selection algorithm + described in RFC 4407.) + +Package: spf-tools-perl +Section: mail +Architecture: all +Depends: ${misc:Depends}, ${perl:Depends}, + libmail-spf-perl (>= ${source:Version}) +Breaks: spfquery (<< 1.2.5.dfsg-1), + libmail-spf-query-perl (<< 1:1.999.1-3) +Description: SPF tools (spfquery, spfd) based on the Mail::SPF Perl module + A collection of Sender Policy Framework (SPF) tools that are based on the + fully RFC-conforming Mail::SPF Perl module. The following tools are included + in this package: + . + * spfquery: A command-line tool for performing SPF checks. + * spfd: A daemon for services that perform SPF checks frequently. diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..0b5ea23 --- /dev/null +++ b/debian/copyright @@ -0,0 +1,32 @@ +This is the Debian package for Mail::SPF, which is available from +. + +This is free software; you may use, modify, and distribute it under the terms +of the BSD license: + +© 2005-2012 Julian Mehnle + 2005 Shevek + +All rights reserved. + +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. +3. The names of the authors may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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. diff --git a/debian/libmail-spf-perl.install b/debian/libmail-spf-perl.install new file mode 100644 index 0000000..67191d9 --- /dev/null +++ b/debian/libmail-spf-perl.install @@ -0,0 +1,2 @@ +usr/share/man/man3 +usr/share/perl5 diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..6d2eb05 --- /dev/null +++ b/debian/rules @@ -0,0 +1,52 @@ +#!/usr/bin/make -f + +SOURCE_PACKAGE = mail-spf-perl +PACKAGE = $(shell dh_listpackages) + +ifndef PERL + PERL = /usr/bin/perl +endif + +TMP = $(CURDIR)/debian/tmp + +BUILD = ./Build + +%: + dh $@ + +override_dh_auto_build: build-stamp +build-stamp: + dh_testdir + $(PERL) Build.PL installdirs=vendor + $(BUILD) + touch build-stamp + +override_dh_auto_clean: + dh_testdir + dh_testroot + [ ! -f $(BUILD) ] || $(BUILD) distclean + dh_clean + +override_dh_auto_install: install-stamp +install-stamp: + dh_testdir + dh_testroot + dh_prep + + $(BUILD) test + $(BUILD) install destdir=$(TMP) create_packlist=0 + + # Manually create man-pages for sbin/ executables: + mkdir -p $(TMP)/usr/share/man/man8 + pod2man -s8p $(TMP)/usr/sbin/spfd $(TMP)/usr/share/man/man8/spfd.8p + + # Rename the `spfquery` and `spfd` tools and their man-pages for the alternatives system: + mv $(TMP)/usr/bin/spfquery $(TMP)/usr/bin/spfquery.$(SOURCE_PACKAGE) + mv $(TMP)/usr/share/man/man1/spfquery.1p $(TMP)/usr/share/man/man1/spfquery.$(SOURCE_PACKAGE).1p + mv $(TMP)/usr/sbin/spfd $(TMP)/usr/sbin/spfd.$(SOURCE_PACKAGE) + mv $(TMP)/usr/share/man/man8/spfd.8p $(TMP)/usr/share/man/man8/spfd.$(SOURCE_PACKAGE).8p + + touch install-stamp + +override_dh_installdocs: + dh_installdocs -A README TODO diff --git a/debian/source/format b/debian/source/format new file mode 100644 index 0000000..89ae9db --- /dev/null +++ b/debian/source/format @@ -0,0 +1 @@ +3.0 (native) diff --git a/debian/spf-tools-perl.install b/debian/spf-tools-perl.install new file mode 100644 index 0000000..8525236 --- /dev/null +++ b/debian/spf-tools-perl.install @@ -0,0 +1,4 @@ +usr/sbin +usr/bin +usr/share/man/man1 +usr/share/man/man8 diff --git a/debian/spf-tools-perl.postinst b/debian/spf-tools-perl.postinst new file mode 100755 index 0000000..956ac21 --- /dev/null +++ b/debian/spf-tools-perl.postinst @@ -0,0 +1,20 @@ +#!/bin/sh + +set -e + +mode=$1 + +source_package=mail-spf-perl + +case "$mode" in + configure ) + prev_version=$2 + + update-alternatives --install /usr/bin/spfquery spfquery /usr/bin/spfquery.$source_package 100 \ + --slave /usr/share/man/man1/spfquery.1.gz spfquery.1.gz /usr/share/man/man1/spfquery.$source_package.1p.gz + update-alternatives --install /usr/sbin/spfd spfd /usr/sbin/spfd.$source_package 100 \ + --slave /usr/share/man/man8/spfd.8.gz spfd.8.gz /usr/share/man/man8/spfd.$source_package.8p.gz + ;; +esac + +#DEBHELPER# diff --git a/debian/spf-tools-perl.prerm b/debian/spf-tools-perl.prerm new file mode 100755 index 0000000..c0bea90 --- /dev/null +++ b/debian/spf-tools-perl.prerm @@ -0,0 +1,16 @@ +#!/bin/sh + +set -e + +mode=$1 + +source_package=mail-spf-perl + +case "$mode" in + remove ) + update-alternatives --remove spfquery /usr/bin/spfquery.$source_package + update-alternatives --remove spfd /usr/sbin/spfd.$source_package + ;; +esac + +#DEBHELPER# diff --git a/debian/watch b/debian/watch new file mode 100644 index 0000000..597e34e --- /dev/null +++ b/debian/watch @@ -0,0 +1,2 @@ +version=3 +http://search.cpan.org/dist/Mail-SPF/ .*/Mail-SPF-v?([\d.]+)\.tar\.gz diff --git a/lib/Mail/SPF.pm b/lib/Mail/SPF.pm new file mode 100644 index 0000000..cc23115 --- /dev/null +++ b/lib/Mail/SPF.pm @@ -0,0 +1,95 @@ +# +# Mail::SPF +# An object-oriented Perl implementation of Sender Policy Framework. +# +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: SPF.pm 63 2013-07-22 03:52:21Z julian $ +# +############################################################################## + +package Mail::SPF; + +=head1 NAME + +Mail::SPF - An object-oriented implementation of Sender Policy Framework + +=head1 VERSION + +2.009 + +=cut + +use version; our $VERSION = qv('2.009'); + +use warnings; +use strict; + +use Mail::SPF::Server; +use Mail::SPF::Request; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +=head1 SYNOPSIS + + use Mail::SPF; + + my $spf_server = Mail::SPF::Server->new(); + + my $request = Mail::SPF::Request->new( + versions => [1, 2], # optional + scope => 'mfrom', # or 'helo', 'pra' + identity => 'fred@example.com', + ip_address => '192.168.0.1', + helo_identity => 'mta.example.com' # optional, + # for %{h} macro expansion + ); + + my $result = $spf_server->process($request); + + print("$result\n"); + my $result_code = $result->code; # 'pass', 'fail', etc. + my $local_exp = $result->local_explanation; + my $authority_exp = $result->authority_explanation + if $result->is_code('fail'); + my $spf_header = $result->received_spf_header; + +=head1 DESCRIPTION + +B is an object-oriented implementation of Sender Policy Framework +(SPF). See L for more information about SPF. + +This class collection aims to fully conform to the SPF specification (RFC +4408) so as to serve both as a production quality SPF implementation and as a +reference for other developers of SPF implementations. + +=head1 SEE ALSO + +L, L, L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 REFERENCES + +=over + +=item The SPF project + +L + +=item The SPFv1 specification (RFC 4408) + +L, L + +=back + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Base.pm b/lib/Mail/SPF/Base.pm new file mode 100644 index 0000000..64203c2 --- /dev/null +++ b/lib/Mail/SPF/Base.pm @@ -0,0 +1,155 @@ +# +# Mail::SPF::Base +# Base class for Mail::SPF classes. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Base.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Base; + +=head1 NAME + +Mail::SPF::Base - Base class for Mail::SPF classes + +=cut + +use warnings; +use strict; + +use Error ':try'; + +use Mail::SPF::Exception; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +=head1 SYNOPSIS + + use base 'Mail::SPF::Base'; + + sub new { + my ($class, @options) = @_; + my $self = $class->SUPER::new(@options); + ... + return $self; + } + +=head1 DESCRIPTION + +B is a common base class for all B classes. + +=head2 Constructor + +The following constructor is provided: + +=over + +=item B: returns I + +Creates a new object of the class on which the constructor was invoked. The +provided options are stored as key/value pairs in the new object. + +The C constructor may also be called on an object, in which case the +object is cloned. Any options provided override those from the old object. + +There are no common options defined in B. + +=cut + +sub new { + my ($self, %options) = @_; + my $new = + ref($self) ? # Was new() invoked on a class or an object? + { %$self, %options } # Object: clone source object, override fields. + : \%options; # Class: create new object. + return bless($new, $self->class); +} + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: returns I + +Returns the class name of the class or object on which it is invoked. + +=cut + +sub class { + my ($self) = @_; + return ref($self) || $self; +} + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: returns I + +Creates an accessor method in the class on which it is invoked. The accessor +has the given name and accesses the object field of the same name. If +$readonly is B, the accessor is made read-only. + +=cut + +sub make_accessor { + my ($class, $name, $readonly) = @_; + throw Mail::SPF::EClassMethod if ref($class); + my $accessor_name = "${class}::${name}"; + my $accessor; + if ($readonly) { + $accessor = sub { + local *__ANON__ = $accessor_name; + my ($self, @value) = @_; + throw Mail::SPF::EInstanceMethod if not ref($self); + throw Mail::SPF::EReadOnlyValue("$accessor_name is read-only") if @value; + return $self->{$name}; + }; + } + else { + $accessor = sub { + local *__ANON__ = $accessor_name; + my ($self, @value) = @_; + throw Mail::SPF::EInstanceMethod if not ref($self); + $self->{$name} = $value[0] if @value; + return $self->{$name}; + }; + } + { + no strict 'refs'; + *{$accessor_name} = $accessor; + } + return $accessor; +} + +=back + +=head2 Instance methods + +There are no common instance methods defined in B. + +=head1 SEE ALSO + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Exception.pm b/lib/Mail/SPF/Exception.pm new file mode 100644 index 0000000..76fbe17 --- /dev/null +++ b/lib/Mail/SPF/Exception.pm @@ -0,0 +1,211 @@ +# +# Mail::SPF::Exception +# Mail::SPF exception classes. +# +# (C) 2006 Julian Mehnle +# $Id: Exception.pm 36 2006-12-09 19:01:46Z Julian Mehnle $ +# +############################################################################## + +package Mail::SPF::Exception; + +use warnings; +use strict; + +use base 'Error', 'Mail::SPF::Base'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +sub new { + my ($self, $text) = @_; + local $Error::Depth = $Error::Depth + 1; + return $self->SUPER::new( + defined($text) ? (-text => $text) : () + ); +} + +sub stringify { + my ($self) = @_; + my $text = $self->SUPER::stringify; + $text .= sprintf(" (%s) at %s line %d.\n", $self->name, $self->file, $self->line) + if $text !~ /\n$/s; + return $text; +} + +sub name { + my ($self) = @_; + my $class = ref($self) || $self; + return $class =~ /^Mail::SPF::(\w+)$/ ? $1 : $class; +} + + +# Generic Exceptions +############################################################################## + +# Tried to call a class method as an instance method: +package Mail::SPF::EClassMethod; +our @ISA = qw(Mail::SPF::Exception); + +sub new { + my ($self) = @_; + local $Error::Depth = $Error::Depth + 2; + return $self->SUPER::new( + sprintf('Pure class method %s called as an instance method', (caller($Error::Depth - 1))[3]) + ); +} + +# Tried to call an instance method as a class method: +package Mail::SPF::EInstanceMethod; +our @ISA = qw(Mail::SPF::Exception); + +sub new { + my ($self) = @_; + local $Error::Depth = $Error::Depth + 2; + return $self->SUPER::new( + sprintf('Pure instance method %s called as a class method', (caller($Error::Depth - 1))[3]) + ); +} + +# Abstract class cannot be instantiated: +package Mail::SPF::EAbstractClass; +our @ISA = qw(Mail::SPF::Exception); + +sub new { + my ($self) = @_; + local $Error::Depth = $Error::Depth + 2; + return $self->SUPER::new('Abstract class cannot be instantiated'); +} + +# Missing required method option: +package Mail::SPF::EOptionRequired; +our @ISA = qw(Mail::SPF::Exception); + +# Invalid value for method option: +package Mail::SPF::EInvalidOptionValue; +our @ISA = qw(Mail::SPF::Exception); + +# Read-only value: +package Mail::SPF::EReadOnlyValue; +our @ISA = qw(Mail::SPF::Exception); + + +# Miscellaneous Errors +############################################################################## + +# DNS error: +package Mail::SPF::EDNSError; +our @ISA = qw(Mail::SPF::Exception); + +# DNS timeout: +package Mail::SPF::EDNSTimeout; +our @ISA = qw(Mail::SPF::EDNSError); + +# Record selection error: +package Mail::SPF::ERecordSelectionError; +our @ISA = qw(Mail::SPF::Exception); + +# No acceptable record found: +package Mail::SPF::ENoAcceptableRecord; +our @ISA = qw(Mail::SPF::ERecordSelectionError); + +# Redundant acceptable records found: +package Mail::SPF::ERedundantAcceptableRecords; +our @ISA = qw(Mail::SPF::ERecordSelectionError); + +# No unparsed text available: +package Mail::SPF::ENoUnparsedText; +our @ISA = qw(Mail::SPF::Exception); + +# Unexpected term object encountered: +package Mail::SPF::EUnexpectedTermObject; +our @ISA = qw(Mail::SPF::Exception); + +# Processing limit exceeded: +package Mail::SPF::EProcessingLimitExceeded; +our @ISA = qw(Mail::SPF::Exception); + +# Missing required context for macro expansion: +package Mail::SPF::EMacroExpansionCtxRequired; +our @ISA = qw(Mail::SPF::EOptionRequired); + + +# Parser Errors +############################################################################## + +# Nothing to parse: +package Mail::SPF::ENothingToParse; +our @ISA = qw(Mail::SPF::Exception); + +# Generic syntax error: +package Mail::SPF::ESyntaxError; +our @ISA = qw(Mail::SPF::Exception); + +# Invalid record version: +package Mail::SPF::EInvalidRecordVersion; +our @ISA = qw(Mail::SPF::ESyntaxError); + +# Invalid scope: +package Mail::SPF::EInvalidScope; +our @ISA = qw(Mail::SPF::ESyntaxError); + +# Junk encountered in record: +package Mail::SPF::EJunkInRecord; +our @ISA = qw(Mail::SPF::ESyntaxError); + +# Invalid term: +package Mail::SPF::EInvalidTerm; +our @ISA = qw(Mail::SPF::ESyntaxError); + +# Junk encountered in term: +package Mail::SPF::EJunkInTerm; +our @ISA = qw(Mail::SPF::ESyntaxError); + +# Invalid modifier: +package Mail::SPF::EInvalidMod; +our @ISA = qw(Mail::SPF::EInvalidTerm); + +# Duplicate global modifier: +package Mail::SPF::EDuplicateGlobalMod; +our @ISA = qw(Mail::SPF::EInvalidMod); + +# Invalid mechanism: +package Mail::SPF::EInvalidMech; +our @ISA = qw(Mail::SPF::EInvalidTerm); + +# Invalid mechanism qualifier: +package Mail::SPF::EInvalidMechQualifier; +our @ISA = qw(Mail::SPF::EInvalidMech); + +# Missing required in term: +package Mail::SPF::ETermDomainSpecExpected; +our @ISA = qw(Mail::SPF::ESyntaxError); + +# Missing required in term: +package Mail::SPF::ETermIPv4AddressExpected; +our @ISA = qw(Mail::SPF::ESyntaxError); + +# Missing required in term: +package Mail::SPF::ETermIPv4PrefixLengthExpected; +our @ISA = qw(Mail::SPF::ESyntaxError); + +# Missing required in term: +package Mail::SPF::ETermIPv6AddressExpected; +our @ISA = qw(Mail::SPF::ESyntaxError); + +# Missing required in term: +package Mail::SPF::ETermIPv6PrefixLengthExpected; +our @ISA = qw(Mail::SPF::ESyntaxError); + +# Invalid macro string: +package Mail::SPF::EInvalidMacroString; +our @ISA = qw(Mail::SPF::ESyntaxError); + +# Invalid macro: +package Mail::SPF::EInvalidMacro; +our @ISA = qw(Mail::SPF::EInvalidMacroString); + + +package Mail::SPF::Exception; + +TRUE; diff --git a/lib/Mail/SPF/MacroString.pm b/lib/Mail/SPF/MacroString.pm new file mode 100644 index 0000000..ee23514 --- /dev/null +++ b/lib/Mail/SPF/MacroString.pm @@ -0,0 +1,425 @@ +# +# Mail::SPF::MacroString +# SPF record macro string class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: MacroString.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::MacroString; + +=head1 NAME + +Mail::SPF::MacroString - SPF record macro string class + +=cut + +use warnings; +use strict; + +use utf8; # Hack to keep Perl 5.6 from whining about /[\p{}]/. + +use base 'Mail::SPF::Base'; + +use overload + '""' => 'stringify', + fallback => 1; + +use Error ':try'; +use URI::Escape (); + +use Mail::SPF::Util; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant default_split_delimiters => '.'; +use constant default_join_delimiter => '.'; + +use constant uri_unreserved_chars => 'A-Za-z0-9\-._~'; + # "unreserved" characters according to RFC 3986 -- not the "uric" chars! + # This deliberately deviates from what RFC 4408 says. This is a bug in + # RFC 4408. + +use constant macos_epoch_offset => ((1970 - 1904) * 365 + 17) * 24 * 3600; + # This is a hack because the MacOS Classic epoch is relative to the local + # timezone. Get a real OS! + +# Interface: +############################################################################## + +=head1 SYNOPSIS + +=head2 Providing the expansion context early + + use Mail::SPF::MacroString; + + my $macrostring = Mail::SPF::MacroString->new( + text => '%{ir}.%{v}._spf.%{d2}', + server => $server, + request => $request + ); + + my $expanded = $macrostring->expand; + +=head2 Providing the expansion context late + + use Mail::SPF::MacroString; + + my $macrostring = Mail::SPF::MacroString->new( + text => '%{ir}.%{v}._spf.%{d2}' + ); + + my $expanded1 = $macrostring->expand($server, $request1); + + $macrostring->context($server, $request2); + my $expanded2 = $macrostring->expand; + +=cut + +# Implementation: +############################################################################## + +=head1 DESCRIPTION + +An object of class B represents a macro string that +can be expanded to a plain string in the context of an SPF request. + +=head2 Constructor + +The following constructor is provided: + +=over + +=item B: returns I + +Creates a new SPF record macro string object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +I. The unexpanded text of the new macro string. + +=item B + +The I object that is to be used when expanding the macro +string. A server object need not be attached statically to the macro string; +it can be specified dynamically when calling the C method. + +=item B + +The I object that is to be used when expanding the macro +string. A request object need not be attached statically to the macro string; +it can be specified dynamically when calling the C method. + +=item B + +A I denoting whether the macro string is an explanation string +obtained via an C modifier. If B, the C, C, and C macros +may appear in the macro string, otherwise they may not, and if they do, a +I exception will be thrown when the macro string is +expanded. Defaults to B. + +=back + +=cut + +sub new { + my ($self, %options) = @_; + $self = $self->SUPER::new(%options); + defined($self->{text}) + or throw Mail::SPF::EOptionRequired("Missing required 'text' option"); + return $self; +} + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=item B: returns I + +Returns the unexpanded text of the macro string. + +=cut + +# Read-only accessor: +__PACKAGE__->make_accessor('text', TRUE); + +=item B: throws I + +Attaches the given I and I objects as +the context for the macro string. + +=cut + +sub context { + my ($self, $server, $request) = @_; + $self->_is_valid_context(TRUE, $server, $request); + $self->{server} = $server; + $self->{request} = $request; + $self->{expanded} = undef; + return; +} + +=item B: returns I; +throws I, I, I + +=item B: returns I; +throws I, I, I + +Expands the text of the macro string using either the context specified through +an earlier call to the C method, or the given context, and returns +the resulting string. See RFC 4408, 8, for how macros are expanded. + +=cut + +sub expand { + my ($self, @context) = @_; + + return $self->{expanded} + if defined($self->{expanded}); + + my $text = $self->{text}; + return undef + if not defined($text); + + return $self->{expanded} = $text + if $text !~ /%/; # Short-circuit expansion if text has no '%' character. + + my ($server, $request) = @context ? @context : ($self->{server}, $self->{request}); + $self->_is_valid_context(TRUE, $server, $request); + + my $expanded = ''; + pos($text) = 0; + + while ($text =~ m/ \G (.*?) %(.) /cgx) { + $expanded .= $1; + my $key = $2; + my $pos = pos($text) - 2; + + if ($key eq '{') { + if ($text =~ m/ \G (\w|_\p{IsAlpha}+) ([0-9]+)? (r)? ([.\-+,\/_=]*)? } /cgx) { + my ($char, $rh_parts, $reverse, $delimiters) = ($1, $2, $3, $4); + + # Upper-case macro chars trigger URL-escaping AKA percent-encoding + # (RFC 4408, 8.1/26): + my $do_percent_encode = $char =~ tr/A-Z/a-z/; + + my $value; + + if ($char eq 's') { # RFC 4408, 8.1/19 + $value = $request->identity; + } + elsif ($char eq 'l') { # RFC 4408, 8.1/19 + $value = $request->localpart; + } + elsif ($char eq 'o') { # RFC 4408, 8.1/19 + $value = $request->domain; + } + elsif ($char eq 'd') { # RFC 4408, 8.1/6/4 + $value = $request->authority_domain; + } + elsif ($char eq 'i') { # RFC 4408, 8.1/20, 8.1/21 + my $ip_address = $request->ip_address; + $ip_address = Mail::SPF::Util->ipv6_address_to_ipv4($ip_address) + if Mail::SPF::Util->ipv6_address_is_ipv4_mapped($ip_address); + my $ip_address_version = $ip_address->version; + if ($ip_address_version == 4) { + $value = $ip_address->addr; + } + elsif ($ip_address_version == 6) { + $value = join(".", split(//, unpack("H32", $ip_address->aton))); + } + else { + # Unexpected IP address version. + $server->throw_result('permerror', $request, + "Unexpected IP address version '$ip_address_version' in request"); + } + } + elsif ($char eq 'p') { # RFC 4408, 8.1/22 + try { + $value = Mail::SPF::Util->valid_domain_for_ip_address( + $server, $request, $request->ip_address, $request->authority_domain, + TRUE, TRUE + ); + } + catch Mail::SPF::EDNSError with {}; + $value ||= 'unknown'; + } + elsif ($char eq 'v') { # RFC 4408, 8.1/6/7 + my $ip_address_version = $request->ip_address->version; + if ($ip_address_version == 4) { + $value = 'in-addr'; + } + elsif ($ip_address_version == 6) { + $value = 'ip6'; + } + else { + # Unexpected IP address version. + $server->throw_result('permerror', $request, + "Unexpected IP address version '$ip_address_version' in request"); + } + } + elsif ($char eq 'h') { # RFC 4408, 8.1/6/8 + $value = $request->helo_identity || 'unknown'; + } + elsif ($char eq 'c') { # RFC 4408, 8.1/20, 8.1/21 + $self->{is_explanation} + or throw Mail::SPF::EInvalidMacro( + "Illegal 'c' macro in non-explanation macro string '$text'"); + my $ip_address = $request->ip_address; + $ip_address = Mail::SPF::Util->ipv6_address_to_ipv4($ip_address) + if Mail::SPF::Util->ipv6_address_is_ipv4_mapped($ip_address); + $value = Mail::SPF::Util->ip_address_to_string($ip_address); + } + elsif ($char eq 'r') { # RFC 4408, 8.1/23 + $self->{is_explanation} + or throw Mail::SPF::EInvalidMacro( + "Illegal 'r' macro in non-explanation macro string '$text'"); + $value = $server->hostname || 'unknown'; + } + elsif ($char eq 't') { # RFC 4408, 8.1/24 + $self->{is_explanation} + or throw Mail::SPF::EInvalidMacro( + "Illegal 't' macro in non-explanation macro string '$text'"); + $value = $^O ne 'MacOS' ? time() : time() + $self->macos_epoch_offset; + } + elsif ($char eq '_scope') { + # Scope pseudo macro for internal use only! + $value = $request->scope; + } + else { + # Unknown macro character. + throw Mail::SPF::EInvalidMacro( + "Unknown macro character '$char' at pos $pos in macro string '$text'"); + } + + if (defined($rh_parts) or defined($reverse)) { + $delimiters ||= $self->default_split_delimiters; + my @list = split(/[\Q$delimiters\E]/, $value); + @list = reverse(@list) if defined($reverse); + + # Extract desired parts: + if (defined($rh_parts) and $rh_parts > 0) { + splice(@list, 0, @list >= $rh_parts ? @list - $rh_parts : 0); + } + if (defined($rh_parts) and $rh_parts == 0) { + throw Mail::SPF::EInvalidMacro( + "Illegal selection of 0 (zero) right-hand parts at pos $pos in macro string '$text'"); + } + + $value = join($self->default_join_delimiter, @list); + } + + $value = URI::Escape::uri_escape($value, '^' . $self->uri_unreserved_chars) + # Note the comment about the set of safe/unsafe characters at the + # definition of the "uri_unreserved_chars" constant above. + if $do_percent_encode; + + $expanded .= $value; + } + else { + # Invalid macro expression. + throw Mail::SPF::EInvalidMacro( + "Invalid macro expression at pos $pos in macro string '$text'"); + } + } + elsif ($key eq '-') { + $expanded .= '%20'; + } + elsif ($key eq '_') { + $expanded .= ' '; + } + elsif ($key eq '%') { + $expanded .= '%'; + } + else { + # Invalid macro expression. + throw Mail::SPF::EInvalidMacro( + "Invalid macro expression at pos $pos in macro string '$text'"); + } + } + + $expanded .= substr($text, pos($text)); # Append remaining unmatched characters. + + #print("DEBUG: Expand $text -> $expanded\n"); + #printf("DEBUG: Caller: %s() (line %d)\n", (caller(1))[3, 2]); + return @context ? $expanded : ($self->{expanded} = $expanded); +} + +=item B: returns I + +Returns B if the macro string is an explanation string obtained via an +C modifier. See the description of the L constructor's +C option. + +=cut + +# Make read-only accessor: +__PACKAGE__->make_accessor('is_explanation', TRUE); + +=item B: returns I + +Returns the expanded text of the macro string if a context is attached to the +object. Returns the unexpanded text otherwise. You can simply use a +Mail::SPF::MacroString object as a string for the same effect, see +L<"OVERLOADING">. + +=cut + +sub stringify { + my ($self) = @_; + return + $self->_is_valid_context(FALSE, $self->{server}, $self->{request}) ? + $self->expand # Context availabe, expand. + : $self->text; # Context unavailable, do not expand. +} + +=back + +=cut + +sub _is_valid_context { + my ($self, $require, $server, $request) = @_; + if (not UNIVERSAL::isa($server, 'Mail::SPF::Server')) { + throw Mail::SPF::EMacroExpansionCtxRequired('Mail::SPF server object required') if $require; + return FALSE; + } + if (not UNIVERSAL::isa($request, 'Mail::SPF::Request')) { + throw Mail::SPF::EMacroExpansionCtxRequired('Request object required') if $require; + return FALSE; + } + return TRUE; +} + +=head1 OVERLOADING + +If a Mail::SPF::MacroString object is used as a I, the C +method is used to convert the object into a string. + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Mech.pm b/lib/Mail/SPF/Mech.pm new file mode 100644 index 0000000..0b1c557 --- /dev/null +++ b/lib/Mail/SPF/Mech.pm @@ -0,0 +1,441 @@ +# +# Mail::SPF::Mech +# SPF record mechanism class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Mech.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Mech; + +=head1 NAME + +Mail::SPF::Mech - SPF record mechanism base class + +=cut + +use warnings; +use strict; + +use utf8; # Hack to keep Perl 5.6 from whining about /[\p{}]/. + +use base 'Mail::SPF::Term'; + +use Error ':try'; +use NetAddr::IP; + +use Mail::SPF::Record; +use Mail::SPF::MacroString; +use Mail::SPF::Util; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant default_qualifier => Mail::SPF::Record->default_qualifier; +use constant default_ipv4_prefix_length => 32; +use constant default_ipv6_prefix_length => 128; + +use constant qualifier_pattern => qr/[+\-~?]/; +use constant name_pattern => qr/ ${\__PACKAGE__->SUPER::name_pattern} (?= [:\/\x20] | $ ) /x; + +use constant explanation_templates_by_result_code => { + pass => "Sender is authorized to use '%{s}' in '%{_scope}' identity", + fail => "Sender is not authorized to use '%{s}' in '%{_scope}' identity", + softfail => "Sender is not authorized to use '%{s}' in '%{_scope}' identity, however domain is not currently prepared for false failures", + neutral => "Domain does not state whether sender is authorized to use '%{s}' in '%{_scope}' identity" +}; + +=head1 DESCRIPTION + +An object of class B represents a mechanism within an SPF +record. Mail::SPF::Mech cannot be instantiated directly. Create an instance +of a concrete sub-class instead. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +I. Creates a new SPF record mechanism object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +A I denoting the unparsed text of the mechanism. + +=item B + +A single-character I denoting the qualifier of the mechanism. Any of +the following may be specified: B<'+'> (C), B<'-'> (C), +B<'~'> (C), B<'?'> (C). See RFC 4408, 4.6.2 and 2.5, for +their meanings. Defaults to B<'+'>. + +=item B + +A I denoting the name of the mechanism. I if a generic +I object (as opposed to a specific sub-class) is being +constructed. + +=item B + +A I object denoting an optional IP address network parameter of +the mechanism. Can be either an IPv4 or an IPv6 address, with an optional +network prefix length. IPv4-mapped IPv6 addresses (e.g. '::ffff:192.168.0.1') +must I be specified directly, but as plain IPv4 addresses. + +=item B + +Either a plain I or a I object denoting an +optional C parameter of the mechanism. + +=item B + +=item B + +A I denoting an optional IPv4 or IPv6 network prefix length for the +C of the mechanism. Note that these options do not apply to the +C option, which already includes an optional network prefix +length. + +=back + +Other options may be specified by sub-classes of Mail::SPF::Mech. + +=cut + +sub new { + my ($self, %options) = @_; + $self->class ne __PACKAGE__ + or throw Mail::SPF::EAbstractClass; + $self = $self->SUPER::new(%options); + $self->{parse_text} = $self->{text} if not defined($self->{parse_text}); + $self->{domain_spec} = Mail::SPF::MacroString->new(text => $self->{domain_spec}) + if defined($self->{domain_spec}) + and not UNIVERSAL::isa($self->{domain_spec}, 'Mail::SPF::MacroString'); + return $self; +} + +=item B: returns I; +throws I, I + +I. Creates a new SPF record mechanism object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: returns I + +Returns the default qualifier, i.e. B<'+'>. + +=item B: returns I + +Returns the default IPv4 network prefix length, i.e. B<32>. + +=item B: returns I + +Returns the default IPv6 network prefix length, i.e. B<128>. + +=item B: returns I + +Returns a regular expression that matches any legal mechanism qualifier, i.e. B<'+'>, +B<'-'>, B<'~'>, or B<'?'>. + +=item B: returns I + +I. Returns the name of the mechanism. + +This method is abstract and must be implemented by sub-classes of +Mail::SPF::Mech. + +=item B: returns I + +Returns a regular expression that matches any legal mechanism name. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse { + my ($self) = @_; + defined($self->{parse_text}) + or throw Mail::SPF::ENothingToParse('Nothing to parse for mechanism'); + $self->parse_qualifier(); + $self->parse_name(); + $self->parse_params(); + $self->parse_end(); + return; +} + +sub parse_qualifier { + my ($self) = @_; + if ($self->{parse_text} =~ s/^(${\$self->qualifier_pattern})?//) { + $self->{qualifier} = $1 || $self->default_qualifier; + } + else { + throw Mail::SPF::EInvalidMechQualifier( + "Invalid qualifier encountered in '" . $self->text . "'"); + } + return; +} + +sub parse_name { + my ($self) = @_; + if ($self->{parse_text} =~ s/^ (${\$self->name_pattern}) (?: : (?=.) )? //x) { + $self->{name} = $1; + } + else { + throw Mail::SPF::EInvalidMech( + "Unexpected mechanism name encountered in '" . $self->text . "'"); + } + return; +} + +sub parse_params { + my ($self) = @_; + # Parse generic string of parameters text (should be overridden in sub-classes): + if ($self->{parse_text} =~ s/^(.*)//) { + $self->{params_text} = $1; + } + return; +} + +sub parse_end { + my ($self) = @_; + $self->{parse_text} eq '' + or throw Mail::SPF::EJunkInTerm("Junk encountered in mechanism '" . $self->text . "'"); + delete($self->{parse_text}); + return; +} + +=item B: returns I; throws I + +Returns the unparsed text of the mechanism. Throws a +I exception if the mechanism was created +synthetically instead of being parsed, and no text was provided. + +=item B: returns I + +Returns the qualifier of the mechanism. See the description of the C +constructor's C option. + +=cut + +sub qualifier { + my ($self) = @_; + # Read-only! + return $self->{qualifier} || $self->default_qualifier; +} + +=item B: returns I + +I. Returns the mechanism's parameters formatted as a string. + +A sub-class of Mail::SPF::Mech does not have to implement this method if it +supports no parameters. + +=item B: returns I + +Formats the mechanism's qualifier, name, and parameters as a string and returns +it. (A qualifier that matches the default of B<'+'> is omitted.) You can +simply use a Mail::SPF::Mech object as a string for the same effect, see +L<"OVERLOADING">. + +=cut + +sub stringify { + my ($self) = @_; + my $params = $self->can('params') ? $self->params : undef; + return sprintf( + '%s%s%s', + $self->qualifier eq $self->default_qualifier ? '' : $self->qualifier, + $self->name, + defined($params) ? $params : '' + ); +} + +=item B: returns I + +Returns the target domain of the mechanism. Depending on whether the mechanism +does have an explicit C parameter, this is either the +macro-expanded C parameter, or the request's authority domain +(see L) otherwise. Both a +I and a I object are required for +resolving the target domain. + +=cut + +sub domain { + my ($self, $server, $request) = @_; + defined($server) + or throw Mail::SPF::EOptionRequired('Mail::SPF server object required for target domain resolution'); + defined($request) + or throw Mail::SPF::EOptionRequired('Request object required for target domain resolution'); + return $self->{domain_spec}->new(server => $server, request => $request) + if defined($self->{domain_spec}); + return $request->authority_domain; +} + +=item B: returns I; throws I + +I. Checks whether the mechanism matches the parameters of the given +request (see L) and returns B if it does, or B +otherwise. In any case, takes both a I and a +I object. + +This method is abstract and must be implemented by sub-classes of +Mail::SPF::Mech. + +=item B: returns I; +throws I + +=item B: returns I; +throws I + +Checks whether the mechanism's target domain name (that is, any of its DNS C +or C records) matches the given request's IP address (see +L), and returns B if it does, or B +otherwise. If an explicit domain is specified, it is used instead of the +mechanism's target domain. The mechanism's IP network prefix lengths are +respected when matching DNS address records against the request's IP address. +See RFC 4408, 5, for the exact algorithm used. + +This method exists mainly for the convenience of sub-classes of +Mail::SPF::Mech. + +=cut + +sub match_in_domain { + my ($self, $server, $request, $domain) = @_; + + $domain = $self->domain($server, $request) + if not defined($domain); + + my $ipv4_prefix_length = $self->ipv4_prefix_length; + my $ipv6_prefix_length = $self->ipv6_prefix_length; + my $addr_rr_type = $request->ip_address->version == 4 ? 'A' : 'AAAA'; + + my $packet = $server->dns_lookup($domain, $addr_rr_type); + my @rrs = $packet->answer + or $server->count_void_dns_lookup($request); + + foreach my $rr (@rrs) { + if ($rr->type eq 'A') { + my $network = NetAddr::IP->new($rr->address, $ipv4_prefix_length); + return TRUE + if $network->contains($request->ip_address); + } + elsif ($rr->type eq 'AAAA') { + my $network = NetAddr::IP->new($rr->address, $ipv6_prefix_length); + return TRUE + if $network->contains($request->ip_address_v6); + } + elsif ($rr->type eq 'CNAME') { + # Ignore -- we should have gotten the A/AAAA records anyway. + } + else { + # Unexpected RR type. + # TODO Generate debug info or ignore silently. + } + } + return FALSE; +} + +=item B + +Locally generates an explanation for why the mechanism caused the given result, +and stores it in the given request object's state. + +There is no need to override this method in sub-classes. See the +L method. + +=cut + +sub explain { + my ($self, $server, $request, $result) = @_; + my $explanation_template = $self->explanation_template($server, $request, $result); + return + if not defined($explanation_template); + try { + my $explanation = Mail::SPF::MacroString->new( + text => $explanation_template, + server => $server, + request => $request, + is_explanation => TRUE + ); + $request->state('local_explanation', $explanation); + } + catch Mail::SPF::Exception with {} + catch Mail::SPF::Result with {}; + return; +} + +=item B: returns I + +Returns a macro string template for a locally generated explanation for why the +mechanism caused the given result object. + +Sub-classes should either define an C +hash constant with their own templates, or override this method. + +=cut + +sub explanation_template { + my ($self, $server, $request, $result) = @_; + return undef + if not $self->can('explanation_templates_by_result_code'); + return $self->explanation_templates_by_result_code->{$result->code}; +} + +=back + +=head1 OVERLOADING + +If a Mail::SPF::Mech object is used as a I, the C method is +used to convert the object into a string. + +=head1 SEE ALSO + +L, +L, +L, +L, +L, +L, +L, +L + +L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Mech/A.pm b/lib/Mail/SPF/Mech/A.pm new file mode 100644 index 0000000..f172b23 --- /dev/null +++ b/lib/Mail/SPF/Mech/A.pm @@ -0,0 +1,193 @@ +# +# Mail::SPF::Mech::A +# SPF record "a" mechanism class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: A.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Mech::A; + +=head1 NAME + +Mail::SPF::Mech::A - SPF record C mechanism class + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::SenderIPAddrMech'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant name => 'a'; +use constant name_pattern => qr/${\name}/i; + +=head1 DESCRIPTION + +An object of class B represents an SPF record mechanism of +type C. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPF record C mechanism object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +=item B + +=item B + +=item B + +See L. + +=back + +=item B: returns I; +throws I, I + +Creates a new SPF record C mechanism object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B + +=item B + +=item B + +=item B + +See L. + +=item B: returns I + +Returns B<'a'>. + +=item B: returns I + +Returns a regular expression that matches a mechanism name of B<'a'>. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse_params { + my ($self) = @_; + $self->parse_domain_spec(); + $self->parse_ipv4_ipv6_prefix_lengths(); + return; +} + +=item B + +=item B + +=item B + +=cut + +sub params { + my ($self) = @_; + my $params; + $params .= ':' . $self->{domain_spec} + if defined($self->{domain_spec}); + $params .= '/' . $self->{ipv4_prefix_length} + if defined($self->{ipv4_prefix_length}) + and $self->{ipv4_prefix_length} != $self->default_ipv4_prefix_length; + $params .= '//' . $self->{ipv6_prefix_length} + if defined($self->{ipv6_prefix_length}) + and $self->{ipv6_prefix_length} != $self->default_ipv6_prefix_length; + return $params; +} + +=item B + +=item B + +=item B + +See L. + +=item B: returns I + +Returns the C parameter of the mechanism. + +=item B: returns I + +Returns the IPv4 network prefix length of the mechanism. + +=item B: returns I + +Returns the IPv6 network prefix length of the mechanism. + +=cut + +# Make read-only accessors: +__PACKAGE__->make_accessor($_, TRUE) + foreach qw(domain_spec ipv4_prefix_length ipv6_prefix_length); + +=item B: returns I + +Checks whether the mechanism's target domain name (that is, any of its DNS C +or C host addresses) matches the given request's IP address (see +L), and returns B if it does, or B +otherwise. The mechanism's IP network prefix lengths are respected when +matching address records against the request's IP address. See RFC 4408, 5, +for the exact algorithm used. + +=cut + +sub match { + my ($self, $server, $request) = @_; + $server->count_dns_interactive_term($request); + return $self->match_in_domain($server, $request); +} + +=back + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Mech/All.pm b/lib/Mail/SPF/Mech/All.pm new file mode 100644 index 0000000..0842bad --- /dev/null +++ b/lib/Mail/SPF/Mech/All.pm @@ -0,0 +1,145 @@ +# +# Mail::SPF::Mech::All +# SPF record "all" mechanism class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: All.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Mech::All; + +=head1 NAME + +Mail::SPF::Mech::All - SPF record C mechanism class + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::Mech'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant name => 'all'; +use constant name_pattern => qr/${\name}/i; + +use constant explanation_templates_by_result_code => { + %{__PACKAGE__->SUPER::explanation_templates_by_result_code}, + pass => "Sender is authorized by default to use '%{s}' in '%{_scope}' identity", + fail => "Sender is not authorized by default to use '%{s}' in '%{_scope}' identity", + softfail => "Sender is not authorized by default to use '%{s}' in '%{_scope}' identity, however domain is not currently prepared for false failures", +}; + +=head1 DESCRIPTION + +An object of class B represents an SPF record mechanism +of type C. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPF record C mechanism object. + +%options is a list of key/value pairs representing any of the following options: + +=over + +=item B + +See L. + +=back + +=item B: returns I; +throws I, I + +Creates a new SPF record C mechanism object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B + +=item B + +See L. + +=item B: returns I + +Returns B<'all'>. + +=item B: returns I + +Returns a regular expression that matches a mechanism name of B<'all'>. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse_params { + my ($self) = @_; + # No parameters. + return; +} + +=item B + +=item B + +=item B + +=item B + +See L. + +=item B: returns I + +Returns B because the C mechanism always matches. See RFC 4408, +5.1, for details. + +=cut + +sub match { + my ($self, $server, $request) = @_; + return TRUE; +} + +=back + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Mech/Exists.pm b/lib/Mail/SPF/Mech/Exists.pm new file mode 100644 index 0000000..87a3207 --- /dev/null +++ b/lib/Mail/SPF/Mech/Exists.pm @@ -0,0 +1,170 @@ +# +# Mail::SPF::Mech::Exists +# SPF record "exists" mechanism class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Exists.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Mech::Exists; + +=head1 NAME + +Mail::SPF::Mech::Exists - SPF record C mechanism class + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::Mech'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant name => 'exists'; +use constant name_pattern => qr/${\name}/i; + +=head1 DESCRIPTION + +An object of class B represents an SPF record +mechanism of type C. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPF record C mechanism object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +=item B + +See L. + +=back + +=item B: returns I; +throws I, I + +Creates a new SPF record C mechanism object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B + +=item B + +See L. + +=item B: returns I + +Returns B<'exists'>. + +=item B: returns I + +Returns a regular expression that matches a mechanism name of B<'exists'>. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse_params { + my ($self) = @_; + $self->parse_domain_spec(TRUE); + return; +} + +=item B + +=item B + +=item B + +=cut + +sub params { + my ($self) = @_; + return defined($self->{domain_spec}) ? ':' . $self->{domain_spec} : undef; +} + +=item B + +See L. + +=item B: returns I + +Returns the C parameter of the mechanism. + +=cut + +# Make read-only accessor: +__PACKAGE__->make_accessor('domain_spec', TRUE); + +=item B: returns I + +Checks whether a DNS C record exists for the mechanism's target domain name, +and returns B if one does, or B otherwise. See RFC 4408, 5.7, for +details. + +=cut + +sub match { + my ($self, $server, $request) = @_; + + $server->count_dns_interactive_term($request); + + my $domain = $self->domain($server, $request); + my $packet = $server->dns_lookup($domain, 'A'); + my @rrs = $packet->answer + or $server->count_void_dns_lookup($request); + + foreach my $rr (@rrs) { + return TRUE + if $rr->type eq 'A'; + } + return FALSE; +} + +=back + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Mech/IP4.pm b/lib/Mail/SPF/Mech/IP4.pm new file mode 100644 index 0000000..fb83c6c --- /dev/null +++ b/lib/Mail/SPF/Mech/IP4.pm @@ -0,0 +1,169 @@ +# +# Mail::SPF::Mech::IP4 +# SPF record "ip4" mechanism class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: IP4.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Mech::IP4; + +=head1 NAME + +Mail::SPF::Mech::IP4 - SPF record C mechanism class + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::SenderIPAddrMech'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant name => 'ip4'; +use constant name_pattern => qr/${\name}/i; + +=head1 DESCRIPTION + +An object of class B represents an SPF record mechanism +of type C. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPF record C mechanism object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +=item B + +See L. + +=back + +=item B: returns I; +throws I, I + +Creates a new SPF record C mechanism object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B + +=item B + +=item B + +See L. + +=item B: returns I + +Returns B<'ip4'>. + +=item B: returns I + +Returns a regular expression that matches a mechanism name of B<'ip4'>. + +=back + +See L for other supported class methods. + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse_params { + my ($self) = @_; + $self->parse_ipv4_network(TRUE); + return; +} + +=item B + +=item B + +=item B + +=cut + +sub params { + my ($self) = @_; + my $params = ':' . $self->{ip_network}->addr; + $params .= '/' . $self->{ip_network}->masklen + if $self->{ip_network}->masklen != $self->default_ipv4_prefix_length; + return $params; +} + +=item B + +See L. + +=item B: returns I + +Returns the IP address network parameter of the mechanism. + +=cut + +# Make read-only accessors: +__PACKAGE__->make_accessor($_, TRUE) + foreach qw(ip_network ip_address ipv4_prefix_length); + +=item B: returns I + +Returns B if the mechanism's C equals or contains the given +request's IP address, or B otherwise. See RFC 4408, 5.6, for details. + +=cut + +sub match { + my ($self, $server, $request) = @_; + my $ip_network_v6 = + $self->ip_network->version == 4 ? + Mail::SPF::Util->ipv4_address_to_ipv6($self->ip_network) + : $self->ip_network; + return $ip_network_v6->contains($request->ip_address_v6); +} + +=back + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Mech/IP6.pm b/lib/Mail/SPF/Mech/IP6.pm new file mode 100644 index 0000000..074d6b5 --- /dev/null +++ b/lib/Mail/SPF/Mech/IP6.pm @@ -0,0 +1,163 @@ +# +# Mail::SPF::Mech::IP6 +# SPF record "ip6" mechanism class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: IP6.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Mech::IP6; + +=head1 NAME + +Mail::SPF::Mech::IP6 - SPF record C mechanism class + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::SenderIPAddrMech'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant name => 'ip6'; +use constant name_pattern => qr/${\name}/i; + +=head1 DESCRIPTION + +An object of class B represents an SPF record mechanism +of type C. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPF record C mechanism object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +=item B + +See L. + +=back + +=item B: returns I; +throws I, I + +Creates a new SPF record C mechanism object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B + +=item B + +=item B + +See L. + +=item B: returns I + +Returns B<'ip6'>. + +=item B: returns I + +Returns a regular expression that matches a mechanism name of B<'ip6'>. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse_params { + my ($self) = @_; + $self->parse_ipv6_network(TRUE); + return; +} + +=item B + +=item B + +=item B + +=cut + +sub params { + my ($self) = @_; + my $params = ':' . $self->{ip_network}->short; + $params .= '/' . $self->{ip_network}->masklen + if $self->{ip_network}->masklen != $self->default_ipv6_prefix_length; + return $params; +} + +=item B + +See L. + +=item B: returns I + +Returns the IP address network parameter of the mechanism. + +=cut + +# Make read-only accessors: +__PACKAGE__->make_accessor($_, TRUE) + foreach qw(ip_network ip_address ipv6_prefix_length); + +=item B: returns I + +Returns B if the mechanism's C equals or contains the given +request's IP address, or B otherwise. See RFC 4408, 5.6, for details. + +=cut + +sub match { + my ($self, $server, $request) = @_; + return $self->ip_network->contains($request->ip_address_v6); +} + +=back + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Mech/Include.pm b/lib/Mail/SPF/Mech/Include.pm new file mode 100644 index 0000000..486ad68 --- /dev/null +++ b/lib/Mail/SPF/Mech/Include.pm @@ -0,0 +1,195 @@ +# +# Mail::SPF::Mech::Include +# SPF record "include" mechanism class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Include.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Mech::Include; + +=head1 NAME + +Mail::SPF::Mech::Include - SPF record C mechanism class + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::Mech'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant name => 'include'; +use constant name_pattern => qr/${\name}/i; + +=head1 DESCRIPTION + +An object of class B represents an SPF record +mechanism of type C. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPF record C mechanism object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +=item B + +See L. + +=back + +=item B: returns I; +throws I, I + +Creates a new SPF record C mechanism object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B + +=item B + +See L. + +=item B: returns I + +Returns B<'include'>. + +=item B: returns I + +Returns a regular expression that matches a mechanism name of B<'include'>. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse_params { + my ($self) = @_; + $self->parse_domain_spec(TRUE); + return; +} + +=item B + +=item B + +=item B + +=cut + +sub params { + my ($self) = @_; + return defined($self->{domain_spec}) ? ':' . $self->{domain_spec} : undef; +} + +=item B + +See L. + +=item B: returns I + +Returns the C parameter of the mechanism. + +=cut + +# Make read-only accessor: +__PACKAGE__->make_accessor('domain_spec', TRUE); + +=item B: returns I + +Performs a recursive SPF check using the given SPF server and request objects +and substituting the mechanism's target domain name for the request's authority +domain. The result of the recursive SPF check is translated as follows: + + Recursive result | Effect + ------------------+----------------- + pass | return true + fail | return false + softfail | return false + neutral | return false + none | throw PermError + permerror | throw PermError + temperror | throw TempError + +See RFC 4408, 5.2, for the exact algorithm used. + +=cut + +sub match { + my ($self, $server, $request) = @_; + + $server->count_dns_interactive_term($request); + + # Create sub-request with mutated authority domain: + my $authority_domain = $self->domain($server, $request); + my $sub_request = $request->new_sub_request(authority_domain => $authority_domain); + + # Process sub-request: + my $result = $server->process($sub_request); + + # Translate result of sub-request (RFC 4408, 5/9): + + return TRUE + if $result->isa('Mail::SPF::Result::Pass'); + + return FALSE + if $result->isa('Mail::SPF::Result::Fail') + or $result->isa('Mail::SPF::Result::SoftFail') + or $result->isa('Mail::SPF::Result::Neutral'); + + $server->throw_result('permerror', $request, + "Included domain '$authority_domain' has no applicable sender policy") + if $result->isa('Mail::SPF::Result::None'); + + # Propagate any other results (including {Perm,Temp}Error) as-is: + $result->throw(); +} + +=back + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Mech/MX.pm b/lib/Mail/SPF/Mech/MX.pm new file mode 100644 index 0000000..66d3c07 --- /dev/null +++ b/lib/Mail/SPF/Mech/MX.pm @@ -0,0 +1,218 @@ +# +# Mail::SPF::Mech::MX +# SPF record "mx" mechanism class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: MX.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Mech::MX; + +=head1 NAME + +Mail::SPF::Mech::MX - SPF record C mechanism class + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::SenderIPAddrMech'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant name => 'mx'; +use constant name_pattern => qr/${\name}/i; + +=head1 DESCRIPTION + +An object of class B represents an SPF record mechanism of +type C. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPF record C mechanism object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +=item B + +=item B + +=item B + +See L. + +=back + +=item B: returns I; +throws I, I + +Creates a new SPF record C mechanism object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B + +=item B + +=item B + +=item B + +See L. + +=item B: returns I + +Returns B<'mx'>. + +=item B: returns I + +Returns a regular expression that matches a mechanism name of B<'mx'>. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse_params { + my ($self) = @_; + $self->parse_domain_spec(); + $self->parse_ipv4_ipv6_prefix_lengths(); + return; +} + +=item B + +=item B + +=item B + +=cut + +sub params { + my ($self) = @_; + my $params; + $params .= ':' . $self->{domain_spec} + if defined($self->{domain_spec}); + $params .= '/' . $self->{ipv4_prefix_length} + if defined($self->{ipv4_prefix_length}) + and $self->{ipv4_prefix_length} != $self->default_ipv4_prefix_length; + $params .= '//' . $self->{ipv6_prefix_length} + if defined($self->{ipv6_prefix_length}) + and $self->{ipv6_prefix_length} != $self->default_ipv6_prefix_length; + return $params; +} + +=item B + +=item B + +=item B + +See L. + +=item B: returns I + +Returns the C parameter of the mechanism. + +=item B: returns I + +Returns the IPv4 network prefix length of the mechanism. + +=item B: returns I + +Returns the IPv6 network prefix length of the mechanism. + +=cut + +# Make read-only accessors: +__PACKAGE__->make_accessor($_, TRUE) + foreach qw(domain_spec ipv4_prefix_length ipv6_prefix_length); + +=item B: returns I + +Checks whether any MX hosts of the mechanism's target domain name (that is, any +of the host addresses of its DNS C records) matches the given request's IP +address (see L), and returns B if it does, +or B otherwise. The mechanism's IP network prefix lengths are respected +when matching address records against the request's IP address. See RFC 4408, +5 and 5.4, for the exact algorithm used. + +=cut + +sub match { + my ($self, $server, $request) = @_; + + $server->count_dns_interactive_term($request); + + my $target_domain = $self->domain($server, $request); + my $mx_packet = $server->dns_lookup($target_domain, 'MX'); + my @mx_rrs = $mx_packet->answer + or $server->count_void_dns_lookup($request); + + # Respect the MX mechanism lookups limit (RFC 4408, 5.4/3/4): + @mx_rrs = splice(@mx_rrs, 0, $server->max_name_lookups_per_mx_mech) + if defined($server->max_name_lookups_per_mx_mech); + + # TODO Use A records from packet's "additional" section? Probably not. + + # Check MX records: + foreach my $rr (@mx_rrs) { + if ($rr->type eq 'MX') { + return TRUE + if $self->match_in_domain($server, $request, $rr->exchange); + } + else { + # Unexpected RR type. + # TODO Generate debug info or ignore silently. + } + } + + return FALSE; +} + +=back + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Mech/PTR.pm b/lib/Mail/SPF/Mech/PTR.pm new file mode 100644 index 0000000..b9c0fc1 --- /dev/null +++ b/lib/Mail/SPF/Mech/PTR.pm @@ -0,0 +1,167 @@ +# +# Mail::SPF::Mech::PTR +# SPF record "ptr" mechanism class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: PTR.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Mech::PTR; + +=head1 NAME + +Mail::SPF::Mech::PTR - SPF record C mechanism class + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::SenderIPAddrMech'; + +use Mail::SPF::Util; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant name => 'ptr'; +use constant name_pattern => qr/${\name}/i; + +=head1 DESCRIPTION + +An object of class B represents an SPF record mechanism +of type C. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPF record C mechanism object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +=item B + +See L. + +=back + +=item B: returns I; +throws I, I + +Creates a new SPF record C mechanism object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B + +=item B + +See L. + +=item B: returns I + +Returns B<'ptr'>. + +=item B: returns I + +Returns a regular expression that matches a mechanism name of B<'ptr'>. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse_params { + my ($self) = @_; + $self->parse_domain_spec(); + return; +} + +=item B + +=item B + +=item B + +=cut + +sub params { + my ($self) = @_; + return defined($self->{domain_spec}) ? ':' . $self->{domain_spec} : undef; +} + +=item B + +See L. + +=item B: returns I + +Returns the C parameter of the mechanism. + +=cut + +# Make read-only accessor: +__PACKAGE__->make_accessor('domain_spec', TRUE); + +=item B: returns I + +Checks whether the mechanism's target domain name, or a sub-domain thereof, is +a "valid" domain name for the given request's IP address (see +L), and returns B if it does, or B +otherwise. See L for how domains +are validated. See RFC 4408, 5.5, for the description of an equivalent +algorithm. + +=cut + +sub match { + my ($self, $server, $request) = @_; + $server->count_dns_interactive_term($request); + return + Mail::SPF::Util->valid_domain_for_ip_address( + $server, $request, $request->ip_address, $self->domain($server, $request)) + ? TRUE : FALSE; +} + +=back + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Mod.pm b/lib/Mail/SPF/Mod.pm new file mode 100644 index 0000000..7b3f8bb --- /dev/null +++ b/lib/Mail/SPF/Mod.pm @@ -0,0 +1,378 @@ +# +# Mail::SPF::Mod +# SPF record modifier class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Mod.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Mod; + +=head1 NAME + +Mail::SPF::Mod - SPF record modifier base class + +=cut + +use warnings; +use strict; + +use utf8; # Hack to keep Perl 5.6 from whining about /[\p{}]/. + +use base 'Mail::SPF::Term'; + +use Mail::SPF::MacroString; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant name_pattern => qr/ ${\__PACKAGE__->SUPER::name_pattern} (?= = ) /x; + +=head1 DESCRIPTION + +An object of class B represents a modifier within an SPF +record. Mail::SPF::Mod cannot be instantiated directly. Create an instance of +a concrete sub-class instead. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +I. Creates a new SPF record modifier object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +A I denoting the unparsed text of the modifier. + +=item B + +A I denoting the name of the modifier. I if a generic +I object (as opposed to a specific sub-class) is being +constructed. + +=item B + +Either a plain I or a I object denoting an +optional C parameter of the mechanism. + +=back + +=cut + +sub new { + my ($self, %options) = @_; + $self->class ne __PACKAGE__ + or throw Mail::SPF::EAbstractClass; + $self = $self->SUPER::new(%options); + $self->{parse_text} = $self->{text} if not defined($self->{parse_text}); + $self->{domain_spec} = Mail::SPF::MacroString->new(text => $self->{domain_spec}) + if defined($self->{domain_spec}) + and not UNIVERSAL::isa($self->{domain_spec}, 'Mail::SPF::MacroString'); + return $self; +} + +=item B: returns I; +throws I, I + +I. Creates a new SPF record modifier object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: returns I + +Returns a regular expression that matches any legal modifier name. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse { + my ($self) = @_; + defined($self->{parse_text}) + or throw Mail::SPF::ENothingToParse('Nothing to parse for modifier'); + $self->parse_name(); + $self->parse_params(TRUE); + $self->parse_end(); + return; +} + +sub parse_name { + my ($self) = @_; + if ($self->{parse_text} =~ s/^(${\$self->name_pattern})=//) { + $self->{name} = $1; + } + else { + throw Mail::SPF::EInvalidMod( + "Unexpected modifier name encountered in '" . $self->text . "'"); + } + return; +} + +sub parse_params { + my ($self, $required) = @_; + # Parse generic macro string of parameters text (should be overridden in sub-classes): + if ($self->{parse_text} =~ s/^(${\$self->macro_string_pattern})$//) { + $self->{params_text} = $1; + } + elsif ($required) { + throw Mail::SPF::EInvalidMacroString( + "Invalid macro string encountered in '" . $self->text . "'"); + } + return; +} + +sub parse_end { + my ($self) = @_; + $self->{parse_text} eq '' + or throw Mail::SPF::EJunkInTerm("Junk encountered in modifier '" . $self->text . "'"); + delete($self->{parse_text}); + return; +} + +=item B: returns I; throws I + +Returns the unparsed text of the modifier. Throws a +I exception if the modifier was created +synthetically instead of being parsed, and no text was provided. + +=item B: returns I + +Returns the name of the modifier. + +=cut + +# Read-only accessor: +__PACKAGE__->make_accessor('name', TRUE); + +=item B: returns I + +I. Returns the modifier's parameters formatted as a string. + +A sub-class of Mail::SPF::Mod does not have to implement this method if it +supports no parameters, although this is highly unlikely. + +=item B: returns I + +Formats the modifier's name and parameters as a string and returns it. You can +simply use a Mail::SPF::Mod object as a string for the same effect, see +L<"OVERLOADING">. + +=cut + +sub stringify { + my ($self) = @_; + my $params = $self->can('params') ? $self->params : undef; + return sprintf( + '%s=%s', + $self->name, + defined($params) ? $params : '' + ); +} + +=item B: throws I, I, +I + +I. Processes the modifier. What that means depends on the actual +implementation in sub-classes. See L below. + +This method is abstract and must be implemented by sub-classes of +Mail::SPF::Mod. + +=back + +=head1 MODIFIER TYPES + +There are different basic types of modifiers, which are described below. All +of them are provided by the B module. + +=head2 Global modifiers - B + +B (RFC 4408) only knows "global" modifiers. A global modifier may +appear anywhere in an SPF record, but only once. During evaluation of the +record, global modifiers are processed after the last mechanism has been +evaluated and an SPF result has been determined. + +=cut + +package Mail::SPF::GlobalMod; +our @ISA = 'Mail::SPF::Mod'; + +sub new { + my ($self, %options) = @_; + $self->class ne __PACKAGE__ + or throw Mail::SPF::EAbstractClass; + return $self->SUPER::new(%options); +} + +=pod + +The following additional class method is provided by B: + +=over + +=item B: returns I + +I. Returns a I number between B<0> and B<1> denoting the +precedence of the type of the global modifier. Global modifiers present in an +SPF record are processed in the order of their precedence values, B<0> meaning +"first". + +This method is abstract and must be implemented by sub-classes of +Mail::SPF::GlobalMod. + +=back + +The following specific instance method is provided by B: + +=over + +=item B: throws I + +I. Processes the modifier. What that means depends on the actual +implementation in sub-classes. Takes both a I and a +I object. As global modifiers are generally processed +I an SPF result has already been determined, takes also the current +I. If the modifier wishes to modify the SPF result, it may +throw a different I object. + +This method is abstract and must be implemented by sub-classes of +Mail::SPF::GlobalMod. + +=back + +=head2 Positional modifiers - B + +B (RFC 4406) introduces the concept of "positional" modifiers. +According to RFC 4406, a positional modifier must follow a mechanism and +applies to that, and only that, mechanism. However, because this definition is +not very useful, and because no positional modifiers have been defined based on +it as of yet, B deviates from RFC 4406 as follows: + +A positional modifier may appear anywhere in an SPF record, and it is stateful, +i.e. it applies to all mechanisms and modifiers that follow it. Positional +modifiers are generally multiple, i.e. they may appear any number of times +throughout the record. During evaluation of the record, positional modifiers +are processed at exactly the time when they are encountered by the evaluator. +Consequently, all positional modifiers are processed before an SPF result is +determined. + +=cut + +package Mail::SPF::PositionalMod; +our @ISA = 'Mail::SPF::Mod'; + +sub new { + my ($self, %options) = @_; + $self->class ne __PACKAGE__ + or throw Mail::SPF::EAbstractClass; + return $self->SUPER::new(%options); +} + +=pod + +The following specific instance method is provided by +B: + +=over + +=item B: throws I, I + +I. Processes the modifier. What that means depends on the actual +implementation in sub-classes. Takes both a I and a +I object. As global modifiers are generally processed +I an SPF result has been determined, no result object is available to +the modifier. The modifier can (at least at this time) not directly modify the +final SPF result, however it may throw an exception to signal an error +condition. + +This method is abstract and must be implemented by sub-classes of +Mail::SPF::PositionalMod. + +=back + +=head2 Unknown modifiers - B + +Both B and B allow unknown modifiers to appear in SPF records +in order to allow new modifiers to be introduced without breaking existing +implementations. Obviously, unknown modifiers are neither global nor +positional, but they may appear any number of times throughout the record and +are simply ignored during evaluation of the record. + +=cut + +package Mail::SPF::UnknownMod; +our @ISA = 'Mail::SPF::Mod'; + +=pod + +Also obviously, B does not support a C method. + +The following specific instance method is provided by +B: + +=over + +=item B: returns I + +Returns the modifier's unparsed value as a string. + +=cut + +sub params { + my ($self) = @_; + return $self->{params_text}; +} + +=back + +=cut + +package Mail::SPF::Mod; + +=head1 OVERLOADING + +If a Mail::SPF::Mod object is used as a I, the C method is +used to convert the object into a string. + +=head1 SEE ALSO + +L, L + +L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Mod/Exp.pm b/lib/Mail/SPF/Mod/Exp.pm new file mode 100644 index 0000000..50ca729 --- /dev/null +++ b/lib/Mail/SPF/Mod/Exp.pm @@ -0,0 +1,182 @@ +# +# Mail::SPF::Mod::Exp +# SPF record "exp" modifier class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Exp.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Mod::Exp; + +=head1 NAME + +Mail::SPF::Mod::Exp - SPF record C modifier class + +=cut + +use warnings; +use strict; + +use Mail::SPF::Mod; +use base 'Mail::SPF::GlobalMod'; + +use Error ':try'; + +use Mail::SPF::MacroString; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant name => 'exp'; +use constant name_pattern => qr/${\name}/i; + +use constant precedence => 0.2; + +=head1 DESCRIPTION + +An object of class B represents an SPF record modifier of +type C. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPF record C modifier object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +See L. + +=back + +=item B: returns I; +throws I, I + +Creates a new SPF record C modifier object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: returns I + +Returns B<'exp'>. + +=item B: returns I + +Returns a regular expression that matches a modifier name of B<'exp'>. + +=item B: returns I + +Returns a precedence value of B<0.2>. See L. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse_params { + my ($self) = @_; + $self->parse_domain_spec(TRUE); + return; +} + +=item B + +See L. + +=cut + +sub params { + my ($self) = @_; + return $self->{domain_spec}; +} + +=item B: returns I + +Returns the C parameter of the modifier. + +=cut + +# Make read-only accessor: +__PACKAGE__->make_accessor('domain_spec', TRUE); + +=item B + +If the given SPF result is a C result, retrieves the authority domain's +explanation string from the modifier's target domain and attaches it to the SPF +result. If an error occurs during the retrieval of the explanation string, +does nothing, as if the modifier was not present. See RFC 4408, 6.2, for +details. + +=cut + +sub process { + my ($self, $server, $request, $result) = @_; + + try { + my $exp_domain = $self->{domain_spec}->new(server => $server, request => $request); + my $txt_packet = $server->dns_lookup($exp_domain, 'TXT'); + my @txt_rrs = grep($_->type eq 'TXT', $txt_packet->answer); + @txt_rrs > 0 + or $server->throw_result('permerror', $request, + "No authority explanation string available at domain '$exp_domain'"); # RFC 4408, 6.2/4 + @txt_rrs == 1 + or $server->throw_result('permerror', $request, + "Redundant authority explanation strings found at domain '$exp_domain'"); # RFC 4408, 6.2/4 + my $explanation = Mail::SPF::MacroString->new( + text => join('', $txt_rrs[0]->char_str_list), + server => $server, + request => $request, + is_explanation => TRUE + ); + $request->state('authority_explanation', $explanation); + } + # Ignore DNS and other errors: + catch Mail::SPF::EDNSError with {} + catch Mail::SPF::Result::Error with {}; + + return; +} + +=back + +See L for other supported instance methods. + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Mod/Redirect.pm b/lib/Mail/SPF/Mod/Redirect.pm new file mode 100644 index 0000000..af84903 --- /dev/null +++ b/lib/Mail/SPF/Mod/Redirect.pm @@ -0,0 +1,177 @@ +# +# Mail::SPF::Mod::Redirect +# SPF record "redirect" modifier class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Redirect.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Mod::Redirect; + +=head1 NAME + +Mail::SPF::Mod::Redirect - SPF record C modifier class + +=cut + +use warnings; +use strict; + +use Mail::SPF::Mod; +use base 'Mail::SPF::GlobalMod'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant name => 'redirect'; +use constant name_pattern => qr/${\name}/i; + +use constant precedence => 0.8; + +=head1 DESCRIPTION + +An object of class B represents an SPF record +modifier of type C. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPF record C modifier object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +See L. + +=back + +=item B: returns I; +throws I, I + +Creates a new SPF record C modifier object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: returns I + +Returns B<'redirect'>. + +=item B: returns I + +Returns a regular expression that matches a modifier name of B<'redirect'>. + +=item B: returns I + +Returns a precedence value of B<0.8>. See L. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse_params { + my ($self) = @_; + $self->parse_domain_spec(TRUE); + return; +} + +=item B + +See L. + +=cut + +sub params { + my ($self) = @_; + return $self->{domain_spec}; +} + +=item B: returns I + +Returns the C parameter of the modifier. + +=cut + +# Make read-only accessor: +__PACKAGE__->make_accessor('domain_spec', TRUE); + +=item B: throws I + +If no mechanism matched during the evaluation of the current SPF record, +performs a recursive SPF check using the given SPF server and request objects +and substituting the modifier's target domain name for the request's authority +domain. The result of the recursive SPF check is then thrown as the result of +the current record's evaluation. However, if the target domain has no +acceptable SPF record, a C result is thrown. See RFC 4408, 6.1, for +details. + +=cut + +sub process { + my ($self, $server, $request, $result) = @_; + + $server->count_dns_interactive_term($request); + + # Only perform redirection if no mechanism matched (RFC 4408, 6.1/1): + $result->isa('Mail::SPF::Result::NeutralByDefault') + or return; + + # Create sub-request with mutated authority domain: + my $authority_domain = $self->{domain_spec}->new(server => $server, request => $request); + my $sub_request = $request->new_sub_request(authority_domain => $authority_domain); + + # Process sub-request: + $result = $server->process($sub_request); + + # Translate result of sub-request (RFC 4408, 6.1/4): + $server->throw_result('permerror', $request, + "Redirect domain '$authority_domain' has no applicable sender policy") + if $result->isa('Mail::SPF::Result::None'); + + # Propagate any other results as-is: + $result->throw(); +} + +=back + +See L for other supported instance methods. + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Record.pm b/lib/Mail/SPF/Record.pm new file mode 100644 index 0000000..9205171 --- /dev/null +++ b/lib/Mail/SPF/Record.pm @@ -0,0 +1,449 @@ +# +# Mail::SPF::Record +# Abstract base class for SPF records. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Record.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Record; + +=head1 NAME + +Mail::SPF::Record - Abstract base class for SPF records + +=cut + +use warnings; +use strict; + +use utf8; # Hack to keep Perl 5.6 from whining about /[\p{}]/. + +use base 'Mail::SPF::Base'; + +use overload + '""' => 'stringify', + fallback => 1; + +use Error ':try'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant default_qualifier => '+'; + +use constant results_by_qualifier => { + '' => 'pass', + '+' => 'pass', + '-' => 'fail', + '~' => 'softfail', + '?' => 'neutral' +}; + +# Interface: +############################################################################## + +=head1 SYNOPSIS + +=head2 Creating a record from a string + + use Mail::SPF::v1::Record; + + my $record = Mail::SPF::v1::Record->new_from_string("v=spf1 a mx -all"); + +=head2 Creating a record synthetically + + use Mail::SPF::v2::Record; + + my $record = Mail::SPF::v2::Record->new( + scopes => ['mfrom', 'pra'], + terms => [ + Mail::SPF::Mech::A->new(), + Mail::SPF::Mech::MX->new(), + Mail::SPF::Mech::All->new(qualifier => '-') + ], + global_mods => [ + Mail::SPF::Mod::Exp->new(domain_spec => 'spf-exp.example.com') + ] + ); + +=cut + +# Implementation: +############################################################################## + +=head1 DESCRIPTION + +B is an abstract base class for SPF records. It cannot be +instantiated directly. Create an instance of a concrete sub-class instead. + +=head2 Constructor + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPF record object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +A I denoting the unparsed text of the record. + +=item B + +A reference to an I of Is denoting the scopes that are covered +by the record (see the description of the C option of +L constructor|Mail::SPF::Request/new>). + +=item B + +A reference to an I of I (i.e. I or +I) objects that make up the record. I +objects must not be included here, but should be specified using the +C option instead. + +=item B + +A reference to an I of I objects that are global +modifiers of the record. + +=back + +=cut + +sub new { + my ($self, %options) = @_; + $self->class ne __PACKAGE__ + or throw Mail::SPF::EAbstractClass; + $self = $self->SUPER::new(%options); + $self->{parse_text} = $self->{text} if not defined($self->{parse_text}); + $self->{terms} ||= []; + $self->{global_mods} ||= {}; + return $self; +} + +=item B: returns I; +throws I, I, +I + +Creates a new SPF record object by parsing the string and any options given. + +=cut + +sub new_from_string { + my ($self, $text, %options) = @_; + $self = $self->new(%options, text => $text); + $self->parse(); + return $self; +} + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: returns I + +I. Returns a regular expression that matches a legal version tag. + +This method is abstract and must be implemented by sub-classes of +Mail::SPF::Record. + +=item B: returns I + +Returns the default qualifier, i.e. B<'+'>. + +=item B: returns I of I + +Returns a reference to a hash that maps qualifiers to result codes as follows: + + Qualifier | Result code + -----------+------------- + + | pass + - | fail + ~ | softfail + ? | neutral + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse { + my ($self) = @_; + defined($self->{parse_text}) + or throw Mail::SPF::ENothingToParse('Nothing to parse for record'); + $self->parse_version_tag(); + $self->parse_term() while length($self->{parse_text}); + $self->parse_end(); + return; +} + +sub parse_version_tag { + my ($self) = @_; + if (not $self->{parse_text} =~ s/^${\$self->version_tag_pattern}(?:\x20+|$)//) { + throw Mail::SPF::EInvalidRecordVersion( + "Not a '" . $self->version_tag . "' record: '" . $self->text . "'"); + } +} + +sub parse_term { + my ($self) = @_; + if ( + $self->{parse_text} =~ s/ + ^ + ( + ${\Mail::SPF::Mech->qualifier_pattern}? + (${\Mail::SPF::Mech->name_pattern}) + [^\x20]* + ) + (?: \x20+ | $ ) + //x + ) { + # Looks like a mechanism: + my ($mech_text, $mech_name) = ($1, lc($2)); + my $mech_class = $self->mech_classes->{$mech_name}; + throw Mail::SPF::EInvalidMech("Unknown mechanism type '$mech_name' in '" . $self->version_tag . "' record") + if not defined($mech_class); + my $mech = $mech_class->new_from_string($mech_text); + push(@{$self->{terms}}, $mech); + } + elsif ( + $self->{parse_text} =~ s/ + ^ + ( + (${\Mail::SPF::Mod->name_pattern}) = + [^\x20]* + ) + (?: \x20+ | $ ) + //x + ) { + # Looks like a modifier: + my ($mod_text, $mod_name) = ($1, lc($2)); + my $mod_class = $self->mod_classes->{$mod_name}; + if (defined($mod_class)) { + # Known modifier. + my $mod = $mod_class->new_from_string($mod_text); + if ($mod->isa('Mail::SPF::GlobalMod')) { + # Global modifier. + not defined($self->{global_mods}->{$mod_name}) or + throw Mail::SPF::EDuplicateGlobalMod("Duplicate global modifier '$mod_name' encountered"); + $self->{global_mods}->{$mod_name} = $mod; + } + elsif ($mod->isa('Mail::SPF::PositionalMod')) { + # Positional modifier, queue normally: + push(@{$self->{terms}}, $mod); + } + else { + # Huh? This should not happen. + } + } + else { + # Unknown modifier. + my $mod = Mail::SPF::UnknownMod->new_from_string($mod_text); + push(@{$self->{terms}}, $mod); + } + } + else { + throw Mail::SPF::EJunkInRecord("Junk encountered in record '" . $self->text . "'"); + } + return; +} + +sub parse_end { + my ($self) = @_; + throw Mail::SPF::EJunkInRecord("Junk encountered in record '" . $self->text . "'") + if $self->{parse_text} ne ''; + delete($self->{parse_text}); + return; +} + +=item B: returns I; throws I + +Returns the unparsed text of the record. Throws a I +exception if the record was created synthetically instead of being parsed, and +no text was provided. + +=cut + +sub text { + my ($self) = @_; + defined($self->{text}) + or throw Mail::SPF::ENoUnparsedText; + return $self->{text}; +} + +=item B: returns I + +I. Returns the version tag of the record. + +This method is abstract and must be implemented by sub-classes of +Mail::SPF::Record. + +=item B: returns I of I + +Returns a list of the scopes that are covered by the record. See the +description of the L constructor's C option. + +=cut + +sub scopes { + my ($self) = @_; + return @{$self->{scopes}}; +} + +=item B: returns I of I + +Returns a list of the terms that make up the record, excluding any global +modifiers, which are returned by the C method. See the +description of the L constructor's C option. + +=cut + +sub terms { + my ($self) = @_; + return @{$self->{terms}}; +} + +=item B: returns I of I + +Returns a list of the global modifiers of the record, ordered ascending by +modifier precedence. See the description of the L constructor's +C option. + +=cut + +sub global_mods { + my ($self) = @_; + return sort { $a->precedence <=> $b->precedence } values(%{$self->{global_mods}}); +} + +=item B: returns I + +Returns the global modifier of the given name if it is present in the record. +Returns B otherwise. Use this method if you wish to retrieve a specific +global modifier as opposed to getting all of them. + +=cut + +sub global_mod { + my ($self, $mod_name) = @_; + return $self->{global_mods}->{$mod_name}; +} + +=item B: returns I + +Returns the record's version tag and terms (including the global modifiers) +formatted as a string. You can simply use a Mail::SPF::Record object as a +string for the same effect, see L<"OVERLOADING">. + +=cut + +sub stringify { + my ($self) = @_; + return join(' ', $self->version_tag, $self->terms, $self->global_mods); +} + +=item B: throws I + +Evaluates the SPF record in the context of the request parameters represented +by the given I object. The given I +object is used for performing DNS look-ups. Throws a I +object matching the outcome of the evaluation; see L. See +RFC 4408, 4.6 and 4.7, for the exact algorithm used. + +=cut + +sub eval { + my ($self, $server, $request) = @_; + + defined($server) + or throw Mail::SPF::EOptionRequired('Mail::SPF server object required for record evaluation'); + defined($request) + or throw Mail::SPF::EOptionRequired('Request object required for record evaluation'); + + try { + foreach my $term ($self->terms) { + if ($term->isa('Mail::SPF::Mech')) { + # Term is a mechanism. + my $mech = $term; + if ($mech->match($server, $request)) { + my $result_name = $self->results_by_qualifier->{$mech->qualifier}; + my $result_class = $server->result_class($result_name); + my $result = $result_class->new($server, $request, "Mechanism '$term' matched"); + $mech->explain($server, $request, $result); + $result->throw(); + } + } + elsif ($term->isa('Mail::SPF::PositionalMod')) { + # Term is a positional modifier. + my $mod = $term; + $mod->process($server, $request); + } + elsif ($term->isa('Mail::SPF::UnknownMod')) { + # Term is an unknown modifier. Ignore it (RFC 4408, 6/3). + } + else { + # Invalid term object encountered: + throw Mail::SPF::EUnexpectedTermObject( + "Unexpected term object '$term' encountered"); + } + } + + # Default result when "falling off" the end of the record (RFC 4408, 4.7/1): + $server->throw_result('neutral-by-default', $request, + 'Default neutral result due to no mechanism matches'); + } + catch Mail::SPF::Result with { + my ($result) = @_; + + # Process global modifiers in ascending order of precedence: + foreach my $global_mod ($self->global_mods) { + $global_mod->process($server, $request, $result); + } + + $result->throw(); + }; +} + +=back + +=head1 OVERLOADING + +If a Mail::SPF::Record object is used as a I, the C method +is used to convert the object into a string. + +=head1 SEE ALSO + +L, L, L, +L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Request.pm b/lib/Mail/SPF/Request.pm new file mode 100644 index 0000000..1ff95c9 --- /dev/null +++ b/lib/Mail/SPF/Request.pm @@ -0,0 +1,484 @@ +# +# Mail::SPF::Request +# SPF request class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Request.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Request; + +=head1 NAME + +Mail::SPF::Request - SPF request class + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::Base'; + +use NetAddr::IP; + +use Mail::SPF::Util; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant versions_for_scope => { + helo => [1 ], + mfrom => [1, 2], + pra => [ 2] +}; + +use constant scopes_by_version => { + 1 => ['helo', 'mfrom' ], + 2 => [ 'mfrom', 'pra'] +}; + +use constant default_localpart => 'postmaster'; + +# Interface: +############################################################################## + +=head1 SYNOPSIS + + use Mail::SPF; + + my $request = Mail::SPF::Request->new( + versions => [1, 2], # optional + scope => 'mfrom', # or 'helo', 'pra' + identity => 'fred@example.com', + ip_address => '192.168.0.1', + helo_identity # optional, + => 'mta.example.com' # for %{h} macro expansion + ); + + my @versions = $request->versions; + my $scope = $request->scope; + my $authority_domain + = $request->authority_domain; + my $identity = $request->identity; # 'localpart@domain' or 'domain' + my $domain = $request->domain; + my $localpart = $request->localpart; + my $ip_address = $request->ip_address; # IPv4 or IPv6 address + my $ip_address_v6 # native IPv6 address or + = $request->ip_address_v6; # IPv4-mapped IPv6 address + my $helo_identity # additional HELO identity + = $request->helo_identity; # for non-HELO scopes + + my $record = $request->record; + # the record selected during processing of the request, may be undef + + $request->state(field => 'value'); + my $value = $request->state('field'); + +=cut + +# Implementation: +############################################################################## + +=head1 DESCRIPTION + +An object of class B represents an SPF request. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPF request object. The request is considered the +I for any subsequent sub-requests (see the L +constructor). + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +A reference to an I of Is listing the versions of SPF records +that may be used for the SPF check. Only those record versions that cover the +desired scope will actually be used. At least one applicable version must be +specified. For a single record version, a simple scalar may be specified +instead of an array-ref. Defaults to all versions that cover the desired scope +(see below); defaults to B<[1, 2]> for the default scope of B<'mfrom'>. + +The following versions are supported: + +=over + +=item B<1> + +Use C records. + +=item B<2> + +Use C records. + +=back + +I: A value of B<1> (or B<[1]>) means that only C records +should be used for the SPF check. If at the same time a scope of B<'pra'> is +specified, a I exception will be thrown as C +records do not cover the PRA scope. + +=item B + +A string denoting the authorization scope of the identity that should be +checked. Defaults to B<'mfrom'>. The following scope values are supported: + +=over + +=item B<'helo'> + +The given identity is the C parameter of an SMTP transaction (RFC 2821) +and should be checked against SPF records that cover the C scope +(C). See the SPFv1 specification (RFC 4408) for the formal definition +of the C scope. + +=item B<'mfrom'> + +The given identity is the C parameter of an SMTP transaction (RFC +2821), and should be checked against SPF records that cover the C scope +(C and C). See the SPFv1 specification (RFC 4408) for +the formal definition of the C scope. + +I: In the case of an empty C SMTP transaction parameter (C<< +MAIL FROM:<> >>), you should perform a check with the C scope instead. + +=item B<'pra'> + +The given identity is the "Purported Responsible Address" of an internet +message (RFC 2822) and should be checked against SPF records that cover the +C scope (C). See the PRA specification (RFC 4407) for the +formal definition of the PRA scope. + +=back + +=item B + +A string denoting the domain name that should be queried for sender policy +records. Defaults to the domain of the C option. There is usually +no need to specify the C option. + +=item B + +I. A string denoting the sender identity whose authorization should +be checked. This is a domain name for the C scope, and an e-mail address +for the C and C scopes. + +I: An empty identity must not be passed. In the case of an empty C SMTP transaction parameter, you should perform a check with the C +scope instead. + +=item B + +I for checks with the C, C, and C scopes. Either a +string or a I object denoting the IP address of the host claiming +the identity that is being checked. Can be either an IPv4 or an IPv6 address. +An IPv4-mapped IPv6 address (e.g. '::ffff:192.168.0.1') is treated as an IPv4 +address. + +=item B + +A string denoting the C SMTP transaction parameter in the case that the +main identity is of a scope other than C. This identity is then used +merely for the expansion of C<%{h}> macros during the policy evaluation of the +main identity. Defaults to B, which will be expanded to B<'unknown'>. +If the main identity is of the C scope, this option is unused. + +=back + +=cut + +sub new { + my ($self, %options) = @_; + + # Create new object: + $self = $self->SUPER::new(%options); + # If the request object already has a state hash, clone its contents: + $self->{state} = { %{$self->{state}} } + if ref($self->{state}) eq 'HASH'; + + # Scope: + $self->{scope} ||= 'mfrom'; + my $versions_for_scope = $self->versions_for_scope->{$self->{scope}} + or throw Mail::SPF::EInvalidScope("Invalid scope '$self->{scope}'"); + + # Versions: + if (not defined($self->{versions})) { + # No versions specified, use all versions relevant to scope: + $self->{versions} = $versions_for_scope; + } + else { + if (not ref($self->{versions})) { + # Single version specified as scalar: + $self->{versions} = [$self->{versions}]; + } + elsif (ref($self->{versions}) ne 'ARRAY') { + # Something other than scalar or array-ref specified: + throw Mail::SPF::EInvalidOptionValue( + "'versions' option must be string or array-ref"); + } + + # All requested record versions must be supported: + my @unsupported_versions = grep( + (not defined($self->scopes_by_version->{$_})), + @{$self->{versions}} + ); + not @unsupported_versions + or throw Mail::SPF::EInvalidOptionValue( + 'Unsupported record version(s) ' . + join(', ', map("'$_'", @unsupported_versions))); + + # Use only those record versions that are relevant to the requested scope: + my %versions_for_scope; + @versions_for_scope{@$versions_for_scope} = (); + my @versions = grep(exists($versions_for_scope{$_}), @{$self->{versions}}); + + # Require at least one relevant record version that covers the scope: + @versions + or throw Mail::SPF::EInvalidScope( + "Invalid scope '$self->{scope}' for record version(s) " . + join(', ', @{$self->{versions}})); + + $self->{versions} = \@versions; + } + + # Identity: + defined($self->{identity}) + or throw Mail::SPF::EOptionRequired("Missing required 'identity' option"); + length($self->{identity}) + or throw Mail::SPF::EInvalidOptionValue("'identity' option must not be empty"); + + # Extract domain and localpart from identity: + if ( + ($self->{scope} eq 'mfrom' or $self->{scope} eq 'pra') and + $self->{identity} =~ /^(.*)@(.*?)$/ + ) { + $self->{domain} = $2; + $self->{localpart} = $1; + } + else { + $self->{domain} = $self->{identity}; + } + $self->{domain} =~ s/^(.*?)\.?$/\L$1/; + # Lower-case domain and remove eventual trailing dot. + $self->{localpart} = $self->default_localpart + if not defined($self->{localpart}) or not length($self->{localpart}); + + # HELO identity: + if ($self->{scope} eq 'helo') { + $self->{helo_identity} ||= $self->{identity}; + } + + # IP address: + throw Mail::SPF::EOptionRequired("Missing required 'ip_address' option") + if grep($self->{scope} eq $_, qw(helo mfrom pra)) + and not defined($self->{ip_address}); + + # Ensure ip_address is a NetAddr::IP object: + if (not UNIVERSAL::isa($self->{ip_address}, 'NetAddr::IP')) { + my $ip_address = NetAddr::IP->new($self->{ip_address}) + or throw Mail::SPF::EInvalidOptionValue("Invalid IP address '$self->{ip_address}'"); + $self->{ip_address} = $ip_address; + } + + # Convert IPv4 address to IPv4-mapped IPv6 address: + if (Mail::SPF::Util->ipv6_address_is_ipv4_mapped($self->{ip_address})) { + $self->{ip_address_v6} = $self->{ip_address}; # Accept as IPv6 address as-is. + $self->{ip_address} = Mail::SPF::Util->ipv6_address_to_ipv4($self->{ip_address}); + } + elsif ($self->{ip_address}->version == 4) { + $self->{ip_address_v6} = Mail::SPF::Util->ipv4_address_to_ipv6($self->{ip_address}); + } + elsif ($self->{ip_address}->version == 6) { + $self->{ip_address_v6} = $self->{ip_address}; + } + else { + throw Mail::SPF::EInvalidOptionValue( + "Unexpected IP address version '" . $self->{ip_address}->version . "'"); + } + + return $self; +} + +=item B: returns I + +Must be invoked on an existing request object. Creates a new sub-request +object by cloning the invoked request, which is then considered the new +request's I. Any specified options (see the L +constructor) override the parameters of the super-request. There is usually no +need to specify any options I the C option. + +=cut + +sub new_sub_request { + my ($super_request, %options) = @_; + UNIVERSAL::isa($super_request, __PACKAGE__) + or throw Mail::SPF::EInstanceMethod; + my $self = $super_request->new(%options); + $self->{super_request} = $super_request; + $self->{root_request} = $super_request->root_request; + return $self; +} + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=item B: returns I + +Returns the root of the request's chain of super-requests. Specifically, +returns the request itself if it has no super-requests. + +=cut + +sub root_request { + my ($self) = @_; + # Read-only! + return $self->{root_request} || $self; +} + +=item B: returns I + +Returns the super-request of the request, or B if there is none. + +=cut + +# Make read-only accessor: +__PACKAGE__->make_accessor('super_request', TRUE); + +=item B: returns I of I + +Returns a list of the SPF record versions that are used for request. See the +description of the L constructor's C option. + +=cut + +sub versions { + my ($self) = @_; + # Read-only! + return @{$self->{versions}}; +} + +=item B: returns I + +Returns the scope of the request. See the description of the L +constructor's C option. + +=item B: returns I + +Returns the authority domain of the request. See the description of the +L constructor's C option. + +=cut + +sub authority_domain { + my ($self) = @_; + return $self->{authority_domain} || $self->{domain}; +} + +=item B: returns I + +Returns the identity of the request. See the description of the L +constructor's C option. + +=item B: returns I + +Returns the identity domain of the request. See the description of the +L constructor's C option. + +=item B: returns I + +Returns the identity localpart of the request. See the description of the +L constructor's C option. + +=item B: returns I + +Returns the IP address of the request as a I object. See the +description of the L constructor's C option. + +=item B: returns I + +Like the C method, however, an IPv4 address is returned as an +IPv4-mapped IPv6 address (e.g. '::ffff:192.168.0.1') to facilitate uniform +processing. + +=item B: returns I + +Returns the C SMTP transaction parameter of the request. See the +description of the L constructor's C option. + +=cut + +# Make read-only accessors: +__PACKAGE__->make_accessor($_, TRUE) + foreach qw( + scope identity domain localpart + ip_address ip_address_v6 helo_identity + ); + +=item B: returns I + +Returns the SPF record selected during the processing of the request, or +B if there is none. + +=cut + +# Make read/write accessor: +__PACKAGE__->make_accessor('record', FALSE); + +=item B: returns anything + +=item B: returns anything + +Provides an interface for storing temporary state information with the request +object. This is primarily meant to be used internally by I +and other Mail::SPF classes. + +If C<$value> is specified, stores it in a state field named C<$field>. Returns +the current (new) value of the state field named C<$field>. This method may be +used as an lvalue. + +=cut + +sub state :lvalue { + my ($self, $field, @value) = @_; + defined($field) + or throw Mail::SPF::EOptionRequired('Field name required'); + $self->{state}->{$field} = $value[0] + if @value; + $self->{state}->{$field}; +} + +=back + +=head1 SEE ALSO + +L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Result.pm b/lib/Mail/SPF/Result.pm new file mode 100644 index 0000000..f247943 --- /dev/null +++ b/lib/Mail/SPF/Result.pm @@ -0,0 +1,617 @@ +# +# Mail::SPF::Result +# SPF result class. +# +# (C) 2005-2012 Julian Mehnle +# $Id: Result.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Result; + +=head1 NAME + +Mail::SPF::Result - SPF result class + +=cut + +use warnings; +use strict; + +use utf8; # Hack to keep Perl 5.6 from whining about /[\p{}]/. + +use base 'Error', 'Mail::SPF::Base'; + # An SPF result is not really a code exception in ideology, but in form. + # The Error base class fits our purpose, anyway. + +use Mail::SPF::Util; + +use Error ':try'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant result_classes => { + pass => 'Mail::SPF::Result::Pass', + fail => 'Mail::SPF::Result::Fail', + softfail => 'Mail::SPF::Result::SoftFail', + neutral => 'Mail::SPF::Result::Neutral', + 'neutral-by-default' + => 'Mail::SPF::Result::NeutralByDefault', + none => 'Mail::SPF::Result::None', + error => 'Mail::SPF::Result::Error', + permerror => 'Mail::SPF::Result::PermError', + temperror => 'Mail::SPF::Result::TempError' +}; + +use constant received_spf_header_name => 'Received-SPF'; + +use constant received_spf_header_scope_names_by_scope => { + helo => 'helo', + mfrom => 'mailfrom', + pra => 'pra' +}; + +use constant received_spf_header_identity_key_names_by_scope => { + helo => 'helo', + mfrom => 'envelope-from', + pra => 'pra' +}; + +use constant atext_pattern => qr/[\p{IsAlnum}!#\$%&'*+\-\/=?^_`{|}~]/; + +use constant dot_atom_pattern => qr/ + (${\atext_pattern})+ ( \. (${\atext_pattern})+ )* +/x; + +# Interface: +############################################################################## + +=head1 SYNOPSIS + +For the general usage of I objects in code that calls +Mail::SPF, see L. For the detailed interface of I +and its derivatives, see below. + +=head2 Throwing results + + package Mail::SPF::Foo; + use Error ':try'; + use Mail::SPF::Result; + + sub foo { + if (...) { + $server->throw_result('pass', $request) + } + else { + $server->throw_result('permerror', $request, 'Invalid foo'); + } + } + +=head2 Catching results + + package Mail::SPF::Bar; + use Error ':try'; + use Mail::SPF::Foo; + + try { + Mail::SPF::Foo->foo(); + } + catch Mail::SPF::Result with { + my ($result) = @_; + ... + }; + +=head2 Using results + + my $result_name = $result->name; + my $result_code = $result->code; + my $request = $result->request; + my $local_exp = $result->local_explanation; + my $authority_exp = $result->authority_explanation + if $result->can('authority_explanation'); + my $spf_header = $result->received_spf_header; + +=cut + +# Implementation: +############################################################################## + +=head1 DESCRIPTION + +An object of class B represents the result of an SPF +request. + +There is usually no need to construct an SPF result object directly using the +C constructor. Instead, use the C class method to signal to the +calling code that a definite SPF result has been determined. In other words, +use Mail::SPF::Result and its derivatives just like exceptions. See L +or L for how to handle exceptions in Perl. + +=head2 Constructor + +The following constructor is provided: + +=over + +=item B: returns I + +=item B: returns I + +Creates a new SPF result object and associates the given I +and I objects with it. An optional result text may be +specified. + +=cut + +sub new { + my ($self, @args) = @_; + + local $Error::Depth = $Error::Depth + 1; + + $self = + ref($self) ? # Was new() invoked on a class or an object? + bless({ %$self }, ref($self)) # Object: clone source result object. + : $self->SUPER::new(); # Class: create new result object. + + # Set/override fields: + $self->{server} = shift(@args) if @args; + defined($self->{server}) + or throw Mail::SPF::EOptionRequired('Mail::SPF server object required'); + $self->{request} = shift(@args) if @args; + defined($self->{request}) + or throw Mail::SPF::EOptionRequired('Request object required'); + $self->{'-text'} = shift(@args) if @args; + + return $self; +} + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: throws I + +=item B: throws I + +Throws a new SPF result object, associating the given I and +I objects with it. An optional result text may be +specified. + +I: Do not write code invoking C on I result class names +as this would ignore any derivative result classes provided by B +extension modules. Invoke the L|Mail::SPF::Server/throw_result> +method on a I object instead. + +=cut + +sub throw { + my ($self, @args) = @_; + local $Error::Depth = $Error::Depth + 1; + $self = $self->new(@args); + # Always create/clone a new result object, not just when throwing for the first time! + die($Error::THROWN = $self); +} + +=item B: returns I + +I. Returns the result name of the result class (or object). For +classes of the I hierarchy, this roughly corresponds to +the trailing part of the class name. For example, returns C +if invoked on I. Also see the L +method. This method may also be used as an instance method. + +This method must be implemented by sub-classes of Mail::SPF::Result for which +the result I differs from the result I. + +=cut + +# This method being implemented here does not make it any less abstract, +# because the code() method it uses is still abstract. +sub name { + my ($self) = @_; + return $self->code; +} + +=item B: returns I + +=item B: returns I + +Maps the given result name to the corresponding I class, +or returns the result base class (the class on which it is invoked) if no +result name is given. If an unknown result name is specified, returns +B. + +=cut + +sub class { + my ($self, $name) = @_; + return defined($name) ? $self->result_classes->{lc($name)} : (ref($self) || $self); +} + +=item B: returns I + +If the class (or object) on which this method is invoked represents the given +result name (or a derivative name), returns B. Returns B +otherwise. This method may also be used as an instance method. + +For example, C<< Mail::SPF::Result::NeutralByDefault->isa_by_name('neutral') >> +returns B. + +=cut + +sub isa_by_name { + my ($self, $name) = @_; + my $suspect_class = $self->class($name); + return FALSE if not defined($suspect_class); + return $self->isa($suspect_class); +} + +=item B: returns I + +I. Returns the basic SPF result code (C<"pass">, C<"fail">, +C<"softfail">, C<"neutral">, C<"none">, C<"error">, C<"permerror">, +C<"temperror">) of the result class on which it is invoked. All valid result +codes are valid result names as well, the reverse however does not apply. This +method may also be used as an instance method. + +This method is abstract and must be implemented by sub-classes of +Mail::SPF::Result. + +=item B: returns I + +If the class (or object) on which this method is invoked represents the given +result code, returns B. Returns B otherwise. This method may +also be used as an instance method. + +I: The L method provides a superset of this method's +functionality. + +=cut + +sub is_code { + my ($self, $code) = @_; + return $self->isa_by_name($code); +} + +=item B: returns I + +Returns B<'Received-SPF'> as the field name for C header fields. +This method should be overridden by B extension modules that provide +non-standard features (such as local policy) with the capacity to dilute the +purity of SPF results, in order not to deceive users of the header field into +mistaking it as an indication of a natural SPF result. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=item B: throws I + +=item B: throws I + +=item B: throws I + +Re-throws an existing SPF result object. If I and +I objects are specified, associates them with the result +object, replacing the prior server and request objects. If a result text is +specified as well, overrides the prior result text. + +=item B: returns I + +Returns the Mail::SPF server object that produced the result at hand. + +=item B: returns I + +Returns the SPF request that led to the result at hand. + +=cut + +# Read-only accessors: +__PACKAGE__->make_accessor($_, TRUE) + foreach qw(server request); + +=item B: returns I + +Returns the text message of the result object. + +=item B: returns I + +Returns the result's name and text message formatted as a string. You can +simply use a Mail::SPF::Result object as a string for the same effect, see +L. + +=cut + +sub stringify { + my ($self) = @_; + return sprintf( + "%s (%s)", + $self->name, + Mail::SPF::Util->sanitize_string($self->SUPER::stringify) + ); +} + +=item B: returns I; throws I, +I + +Returns a locally generated explanation for the result. + +The local explanation is prefixed with the authority domain whose sender policy +is responsible for the result. If the responsible sender policy referred to +another domain's policy (using the C mechanism or the C +modifier), that other domain which is I responsible for the result is +also included in the local explanation's head. For example: + + example.com: + +The authority domain C's sender policy is directly responsible for +the result. + + example.com ... other.example.org: + +The authority domain C (directly or indirectly) referred to the +domain C, whose sender policy then led to the result. + +=cut + +sub local_explanation { + my ($self) = @_; + my $local_explanation = $self->{local_explanation}; + + return $local_explanation + if defined($local_explanation); + + # Prepare local explanation: + my $request = $self->{request}; + $local_explanation = $request->state('local_explanation'); + if (defined($local_explanation)) { + $local_explanation = sprintf("%s (%s)", $local_explanation->expand, lcfirst($self->text)); + } + else { + $local_explanation = $self->text; + } + + # Resolve authority domains of root-request and bottom sub-request: + my $root_request = $request->root_request; + $local_explanation = + $request == $root_request ? + sprintf("%s: %s", $request->authority_domain, $local_explanation) + : sprintf("%s ... %s: %s", + $root_request->authority_domain, $request->authority_domain, $local_explanation); + + return $self->{local_explanation} = Mail::SPF::Util->sanitize_string($local_explanation); +} + +=item B: returns I + +Returns a string containing an appropriate C header field for the +result object. The header field is not line-wrapped and contains no trailing +newline character. + +=cut + +sub received_spf_header { + my ($self) = @_; + return $self->{received_spf_header} + if defined($self->{received_spf_header}); + my $scope_name = + $self->received_spf_header_scope_names_by_scope->{$self->{request}->scope}; + my $identity_key_name = + $self->received_spf_header_identity_key_names_by_scope->{$self->{request}->scope}; + my @info_pairs = ( + receiver => $self->{server}->hostname || 'unknown', + identity => $scope_name, + $identity_key_name => $self->{request}->identity, + ( + ($self->{request}->scope ne 'helo' and defined($self->{request}->helo_identity)) ? + (helo => $self->{request}->helo_identity) + : () + ), + 'client-ip' => Mail::SPF::Util->ip_address_to_string($self->{request}->ip_address) + ); + my $info_string; + while (@info_pairs) { + my $key = shift(@info_pairs); + my $value = shift(@info_pairs); + $info_string .= '; ' if defined($info_string); + if ($value !~ /^${\dot_atom_pattern}$/o) { + $value =~ s/(["\\])/\\$1/g; # Escape '\' and '"' characters. + $value = '"' . $value . '"'; # Double-quote value. + } + $info_string .= "$key=$value"; + } + return $self->{received_spf_header} = sprintf( + "%s: %s (%s) %s", + $self->received_spf_header_name, + $self->code, + $self->local_explanation, + $info_string + ); +} + +=back + +=head1 OVERLOADING + +If a Mail::SPF::Result object is used as a I, the L method +is used to convert the object into a string. + +=head1 RESULT CLASSES + +The following result classes are provided: + +=over + +=item * + +I + +=item * + +I + +=item * + +I + +=item * + +I + +=over + +=item * + +I + +This is a special case of the C result that is thrown as a default +when "falling off" the end of the record during evaluation. See RFC 4408, +4.7. + +=back + +=item * + +I + +=item * + +I + +=over + +=item * + +I + +=item * + +I + +=back + +=back + +The following result classes have additional functionality: + +=over + +=item I + +The following additional instance method is provided: + +=over + +=item B: returns I; throws I, +I + +Returns the authority domain's explanation for the result. Be aware that the +authority domain may be a malicious party and thus the authority explanation +should not be trusted blindly. See RFC 4408, 10.5, for a detailed discussion +of this issue. + +=back + +=back + +=cut + +package Mail::SPF::Result::Pass; +our @ISA = 'Mail::SPF::Result'; +use constant code => 'pass'; + +package Mail::SPF::Result::Fail; +our @ISA = 'Mail::SPF::Result'; +use Error ':try'; +use Mail::SPF::Exception; +use constant code => 'fail'; + +sub authority_explanation { + my ($self) = @_; + my $authority_explanation = $self->{authority_explanation}; + + return $authority_explanation + if defined($authority_explanation); + + my $server = $self->{server}; + my $request = $self->{request}; + + my $authority_explanation_macrostring = $request->state('authority_explanation'); + + # If an explicit explanation was specified by the authority domain... + if (defined($authority_explanation_macrostring)) { + try { + # ... then try to expand it: + $authority_explanation = $authority_explanation_macrostring->expand; + } + catch Mail::SPF::EInvalidMacroString with {}; + # Ignore expansion errors and leave authority explanation undefined. + } + + # If no authority explanation could be determined so far... + if (not defined($authority_explanation)) { + # ... then use the server's default authority explanation: + $authority_explanation = + $server->default_authority_explanation->new(request => $request)->expand; + } + + return $self->{authority_explanation} = $authority_explanation; +} + +package Mail::SPF::Result::SoftFail; +our @ISA = 'Mail::SPF::Result'; +use constant code => 'softfail'; + +package Mail::SPF::Result::Neutral; +our @ISA = 'Mail::SPF::Result'; +use constant code => 'neutral'; + +package Mail::SPF::Result::NeutralByDefault; +our @ISA = 'Mail::SPF::Result::Neutral'; +use constant name => 'neutral-by-default'; + # This is a special-case of the Neutral result that is thrown as a default + # when "falling off" the end of the record. See Mail::SPF::Record::eval(). + +package Mail::SPF::Result::None; +our @ISA = 'Mail::SPF::Result'; +use constant code => 'none'; + +package Mail::SPF::Result::Error; +our @ISA = 'Mail::SPF::Result'; +use constant code => 'error'; + +package Mail::SPF::Result::PermError; +our @ISA = 'Mail::SPF::Result::Error'; +use constant code => 'permerror'; + +package Mail::SPF::Result::TempError; +our @ISA = 'Mail::SPF::Result::Error'; +use constant code => 'temperror'; + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle + +=cut + +package Mail::SPF::Result; + +TRUE; diff --git a/lib/Mail/SPF/SenderIPAddrMech.pm b/lib/Mail/SPF/SenderIPAddrMech.pm new file mode 100644 index 0000000..f37f765 --- /dev/null +++ b/lib/Mail/SPF/SenderIPAddrMech.pm @@ -0,0 +1,75 @@ +# +# Mail::SPF::SenderIPAddrMech +# Abstract base class for SPF record mechanisms that operate on the SMTP +# sender's IP address. +# +# (C) 2005-2012 Julian Mehnle +# $Id: SenderIPAddrMech.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::SenderIPAddrMech; + +=head1 NAME + +Mail::SPF::SenderIPAddrMech - Abstract base class for SPF record mechanisms +that operate on the SMTP sender's IP address + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::Mech'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant explanation_templates_by_result_code => { + %{__PACKAGE__->SUPER::explanation_templates_by_result_code}, + pass => "%{c} is authorized to use '%{s}' in '%{_scope}' identity", + fail => "%{c} is not authorized to use '%{s}' in '%{_scope}' identity", + softfail => "%{c} is not authorized to use '%{s}' in '%{_scope}' identity, however domain is not currently prepared for false failures", + neutral => "Domain does not state whether %{c} is authorized to use '%{s}' in '%{_scope}' identity" +}; + +=head1 DESCRIPTION + +B is an abstract base class for SPF record +mechanisms that operate on the SMTP sender's IP address. It cannot be +instantiated directly. Create an instance of a concrete sub-class instead. + +=head2 Constructors + +See L. + +=head2 Class methods + +See L. + +=head2 Instance methods + +See L. + +=head1 SEE ALSO + +L, L, L + +L, +L, +L, +L, +L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Server.pm b/lib/Mail/SPF/Server.pm new file mode 100644 index 0000000..8c360a5 --- /dev/null +++ b/lib/Mail/SPF/Server.pm @@ -0,0 +1,713 @@ +# +# Mail::SPF::Server +# Server class for processing SPF requests. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Server.pm 61 2013-07-22 03:45:15Z julian $ +# +############################################################################## + +package Mail::SPF::Server; + +=head1 NAME + +Mail::SPF::Server - Server class for processing SPF requests + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::Base'; + +use Error ':try'; +use Net::DNS::Resolver; + +use Mail::SPF::MacroString; +use Mail::SPF::Record; +use Mail::SPF::Result; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant record_classes_by_version => { + 1 => 'Mail::SPF::v1::Record', + 2 => 'Mail::SPF::v2::Record' +}; + +use constant result_base_class => 'Mail::SPF::Result'; + +use constant query_rr_type_all => 0; +use constant query_rr_type_txt => 1; +use constant query_rr_type_spf => 2; + +use constant default_default_authority_explanation => + 'Please see http://www.openspf.org/Why?s=%{_scope};id=%{S};ip=%{C};r=%{R}'; + +sub default_query_rr_types { shift->query_rr_type_txt }; + +use constant default_max_dns_interactive_terms => 10; # RFC 4408, 10.1/6 +use constant default_max_name_lookups_per_term => 10; # RFC 4408, 10.1/7 +sub default_max_name_lookups_per_mx_mech { shift->max_name_lookups_per_term }; +sub default_max_name_lookups_per_ptr_mech { shift->max_name_lookups_per_term }; + +use constant default_max_void_dns_lookups => 2; + +# Interface: +############################################################################## + +=head1 SYNOPSIS + + use Mail::SPF; + + my $spf_server = Mail::SPF::Server->new( + # Optional custom default for authority explanation: + default_authority_explanation => + 'See http://www.%{d}/why/id=%{S};ip=%{I};r=%{R}' + ); + + my $result = $spf_server->process($request); + +=cut + +# Implementation: +############################################################################## + +=head1 DESCRIPTION + +B is a server class for processing SPF requests. Each +server instance can be configured with specific processing parameters. Also, +the default I DNS resolver used for making DNS look-ups can +be overridden with a custom resolver object. + +=head2 Constructor + +The following constructor is provided: + +=over + +=item B: returns I + +Creates a new server object for processing SPF requests. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +A I denoting the default (not macro-expanded) authority explanation +string to use if the authority domain does not specify an explanation string of +its own. Defaults to: + + 'Please see http://www.openspf.org/Why?s=%{_scope};id=%{S};ip=%{C};r=%{R}' + +As can be seen from the default, a non-standard C<_scope> pseudo macro is +supported that expands to the name of the identity's scope. (Note: Do I +use any non-standard macros in explanation strings published in DNS.) + +=item B + +A I denoting the local system's fully qualified host name that should +be used for expanding the C macro in explanation strings. Defaults to the +system's configured host name. + +=item B + +An optional DNS resolver object. If none is specified, a new I +object is used. The resolver object may be of a different class, but it must +provide an interface similar to I -- at least the C +and C methods must be supported, and the C method must +return either an object of class I, or, in the case of an +error, B. + +=item B + +For which RR types to query when looking up and selecting SPF records. The +following values are supported: + +=over + +=item B<< Mail::SPF::Server->query_rr_type_all >> + +Both C and C type RRs. + +=item B<< Mail::SPF::Server->query_rr_type_txt >> (default) + +C type RRs only. + +=item B<< Mail::SPF::Server->query_rr_type_spf >> + +C type RRs only. + +=back + +For years B has defaulted to looking up both C and C type +RRs as recommended by RFC 4408. Experience has shown, however, that a +significant portion of name servers suffer from serious brain damage with +regard to the handling of queries for RR types that are unknown to them, such +as the C RR type. Consequently B now defaults to looking up +only C type RRs. This may be overridden by setting the B +option. + +See RFC 4408, 3.1.1, for a discussion of the topic, as well as the description +of the L method. + +=item B + +An I denoting the maximum number of terms (mechanisms and modifiers) +per SPF check that perform DNS look-ups, as defined in RFC 4408, 10.1, +paragraph 6. If B is specified, there is no limit on the number of such +terms. Defaults to B<10>, which is the value defined in RFC 4408. + +A value above the default is I for security reasons. A +value below the default has implications with regard to the predictability of +SPF results. Only deviate from the default if you know what you are doing! + +=item B + +An I denoting the maximum number of DNS name look-ups per term +(mechanism or modifier), as defined in RFC 4408, 10.1, paragraph 7. If +B is specified, there is no limit on the number of look-ups performed. +Defaults to B<10>, which is the value defined in RFC 4408. + +A value above the default is I for security reasons. A +value below the default has implications with regard to the predictability of +SPF results. Only deviate from the default if you know what you are doing! + +=item B + +=item B + +An I denoting the maximum number of DNS name look-ups per B or B +mechanism, respectively. Defaults to the value of the C +option. See there for additional information and security notes. + +=item B + +An I denoting the maximum number of "void" DNS look-ups per SPF check, +i.e. the number of DNS look-ups that were caused by DNS-interactive terms and +macros (as defined in RFC 4408, 10.1, paragraphs 6 and 7) and that are allowed +to return an empty answer with RCODE 0 or RCODE 3 (C) before +processing is aborted with a C result. If B is specified, +there is no stricter limit on the number of void DNS look-ups beyond the usual +processing limits. Defaults to B<2>. + +Specifically, the DNS look-ups that are subject to this limit are those caused +by the C, C, C, and C mechanisms and the C

macro. + +A value of B<2> is likely to prevent effective DoS attacks against third-party +victim domains. However, a definite limit may cause C results even +with certain (overly complex) innocent sender policies where useful results +would normally be returned. + +=back + +=cut + +sub new { + my ($self, %options) = @_; + $self = $self->SUPER::new(%options); + + $self->{default_authority_explanation} = $self->default_default_authority_explanation + if not defined($self->{default_authority_explanation}); + $self->{default_authority_explanation} = Mail::SPF::MacroString->new( + text => $self->{default_authority_explanation}, + server => $self, + is_explanation => TRUE + ) + if not UNIVERSAL::isa($self->{default_authority_explanation}, 'Mail::SPF::MacroString'); + + $self->{hostname} ||= Mail::SPF::Util->hostname; + + $self->{dns_resolver} ||= Net::DNS::Resolver->new(); + + $self->{query_rr_types} = $self->default_query_rr_types + if not defined($self->{query_rr_types}); + + $self->{max_dns_interactive_terms} = $self->default_max_dns_interactive_terms + if not exists($self->{max_dns_interactive_terms}); + $self->{max_name_lookups_per_term} = $self->default_max_name_lookups_per_term + if not exists($self->{max_name_lookups_per_term}); + $self->{max_name_lookups_per_mx_mech} = $self->default_max_name_lookups_per_mx_mech + if not exists($self->{max_name_lookups_per_mx_mech}); + $self->{max_name_lookups_per_ptr_mech} = $self->default_max_name_lookups_per_ptr_mech + if not exists($self->{max_name_lookups_per_ptr_mech}); + + $self->{max_void_dns_lookups} = $self->default_max_void_dns_lookups + if not exists($self->{max_void_dns_lookups}); + + return $self; +} + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: returns I + +=item B: returns I + +Returns a I descendent class determined from the given +result name via the server's inherent result base class, or returns the +server's inherent result base class if no result name is given. This method +may also be used as an instance method. + +I: Do not write code invoking class methods on I result class +names as this would ignore any derivative result classes provided by +B extension modules. + +=cut + +sub result_class { + my ($self, $name) = @_; + return + defined($name) ? + $self->result_base_class->result_classes->{$name} + : $self->result_base_class; +} + +=item B: throws I + +=item B: throws I + +Throws a I descendant determined from the given result name +via the server's inherent result base class, passing an optional result text +and associating the given I object with the result object. +This method may also be used as an instance method. + +I: Do not write code invoking C on I result class names +as this would ignore any derivative result classes provided by B +extension modules. + +=cut + +sub throw_result { + my ($self, $name, $request, @text) = @_; + $self->result_class($name)->throw($self, $request, @text); +} + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=item B: returns I + +Processes the given I object, queries the authoritative +domain for an SPF sender policy (see the description of the L +method), evaluates the policy with regard to the given identity and other +request parameters, and returns a I object denoting the +result of the policy evaluation. See RFC 4408, 4, and RFC 4406, 4, for +details. + +=cut + +sub process { + my ($self, $request) = @_; + + $request->state('authority_explanation', undef); + $request->state('dns_interactive_terms_count', 0); + $request->state('void_dns_lookups_count', 0); + + my $result; + try { + my $record = $self->select_record($request); + $request->record($record); + $record->eval($self, $request); + } + catch Mail::SPF::Result with { + $result = shift; + } + catch Mail::SPF::EDNSError with { + $result = $self->result_class('temperror')->new($self, $request, shift->text); + } + catch Mail::SPF::ENoAcceptableRecord with { + $result = $self->result_class('none' )->new($self, $request, shift->text); + } + catch Mail::SPF::ERedundantAcceptableRecords with { + $result = $self->result_class('permerror')->new($self, $request, shift->text); + } + catch Mail::SPF::ESyntaxError with { + $result = $self->result_class('permerror')->new($self, $request, shift->text); + } + catch Mail::SPF::EProcessingLimitExceeded with { + $result = $self->result_class('permerror')->new($self, $request, shift->text); + }; + # Propagate other, unknown errors. + # This should not happen, but if it does, it helps exposing the bug! + + return $result; +} + +=item B: returns I; +throws I, +I, I, +I + +Queries the authority domain of the given I object for SPF +sender policy records and, if multiple records are available, selects the +record of the highest acceptable record version that covers the requested +scope. + +More precisely, the following algorithm is performed (assuming that both C +and C RR types are being queried): + +=over + +=item 1. + +Determine the authority domain, the set of acceptable SPF record versions, and +the identity scope from the given request object. + +=item 2. + +Query the authority domain for SPF records of the C DNS RR type, +discarding any records that are of an inacceptable version or do not cover the +desired scope. + +If this yields no SPF records, query the authority domain for SPF records of +the C DNS RR type, discarding any records that are of an inacceptable +version or do not cover the desired scope. + +If still no acceptable SPF records could be found, throw a +I exception. + +=item 3. + +Discard all records but those of the highest acceptable version found. + +If exactly one record remains, return it. Otherwise, throw a +I exception. + +=back + +If the querying of either RR type has been disabled via the L +constructor's C option, the respective part in step 2 will +be skipped. + +I exceptions due to DNS look-ups and +I exceptions due to invalid acceptable records may +also be thrown. + +=cut + +sub select_record { + my ($self, $request) = @_; + + my $domain = $request->authority_domain; + my @versions = $request->versions; + my $scope = $request->scope; + + # Employ identical behavior for 'v=spf1' and 'spf2.0' records, both of + # which support SPF (code 99) and TXT type records (this may be different + # in future revisions of SPF): + # Query for SPF type records first, then fall back to TXT type records. + + my @records; + my $query_count = 0; + my @dns_errors; + + # Query for SPF-type RRs first: + if ( + $self->query_rr_types == $self->query_rr_type_all or + $self->query_rr_types & $self->query_rr_type_spf + ) { + try { + $query_count++; + my $packet = $self->dns_lookup($domain, 'SPF'); + push( + @records, + $self->get_acceptable_records_from_packet( + $packet, 'SPF', \@versions, $scope, $domain) + ); + } + catch Mail::SPF::EDNSError with { + push(@dns_errors, shift); + }; + #catch Mail::SPF::EDNSTimeout with { + # # FIXME Ignore DNS time-outs on SPF type lookups? + # # Apparrently some brain-dead DNS servers time out on SPF-type queries. + #}; + } + + # If no usable SPF-type RRs, try TXT-type RRs: + if ( + not @records and + ( + $self->query_rr_types == $self->query_rr_type_all or + $self->query_rr_types & $self->query_rr_type_txt + ) + ) { + # NOTE: + # This deliberately violates RFC 4406 (Sender ID), 4.4/3 (4.4.1): + # TXT-type RRs are still tried if there _are_ SPF-type RRs but all of + # them are inapplicable (i.e. "Hi!", or even "spf2.0/pra" for an + # 'mfrom' scope request). This conforms to the spirit of the more + # sensible algorithm in RFC 4408 (SPF), 4.5. + # Implication: Sender ID processing may make use of existing TXT- + # type records where a result of "None" would normally be returned + # under a strict interpretation of RFC 4406. + + try { + $query_count++; + my $packet = $self->dns_lookup($domain, 'TXT'); + push( + @records, + $self->get_acceptable_records_from_packet( + $packet, 'TXT', \@versions, $scope, $domain) + ); + } + catch Mail::SPF::EDNSError with { + push(@dns_errors, shift); + }; + } + + @dns_errors < $query_count + or $dns_errors[0]->throw; + # Unless at least one query succeeded, re-throw the first DNS error that occurred. + + @records + or throw Mail::SPF::ENoAcceptableRecord( + "No applicable sender policy available"); # RFC 4408, 4.5/7 + + # Discard all records but the highest acceptable version: + my $preferred_record_class = $records[0]->class; + @records = grep($_->isa($preferred_record_class), @records); + + @records == 1 + or throw Mail::SPF::ERedundantAcceptableRecords( + "Redundant applicable '" . $preferred_record_class->version_tag . "' " . + "sender policies found"); # RFC 4408, 4.5/6 + + return $records[0]; +} + +=item B: +returns I of I + +Filters from the given I object all resource records of the +given RR type and for the given domain name, discarding any records that are +not SPF records at all, that are of an inacceptable SPF record version, or that +do not cover the given scope. Returns a list of acceptable records. + +=cut + +sub get_acceptable_records_from_packet { + my ($self, $packet, $rr_type, $versions, $scope, $domain) = @_; + + my @versions = sort { $b <=> $a } @$versions; + # Try higher record versions first. + # (This may be too simplistic for future revisions of SPF.) + + my @records; + foreach my $rr ($packet->answer) { + next if $rr->type ne $rr_type; # Ignore RRs of unexpected type. + + my $text = join('', $rr->char_str_list); + my $record; + + # Try to parse RR as each of the requested record versions, + # starting from the highest version: + VERSION: + foreach my $version (@versions) { + my $class = $self->record_classes_by_version->{$version}; + eval("require $class"); + try { + $record = $class->new_from_string($text); + } + catch Mail::SPF::EInvalidRecordVersion with {}; + # Ignore non-SPF and unknown-version records. + # Propagate other errors (including syntax errors), though. + last VERSION if defined($record); + } + + push(@records, $record) + if defined($record) + and grep($scope eq $_, $record->scopes); # record covers requested scope? + } + return @records; +} + +=item B: returns I; +throws I, I + +Queries the DNS using the configured resolver for resource records of the +desired type at the specified domain and returns a I object +if an answer packet was received. Throws a I exception +if a DNS time-out occurred. Throws a I exception if an +error (other than RCODE 3 AKA C) occurred. + +=cut + +sub dns_lookup { + my ($self, $domain, $rr_type) = @_; + + if (UNIVERSAL::isa($domain, 'Mail::SPF::MacroString')) { + $domain = $domain->expand; + # Truncate overlong labels at 63 bytes (RFC 4408, 8.1/27): + $domain =~ s/([^.]{63})[^.]+/$1/g; + # Drop labels from the head of domain if longer than 253 bytes (RFC 4408, 8.1/25): + $domain =~ s/^[^.]+\.(.*)$/$1/ + while length($domain) > 253; + } + + $domain =~ s/^(.*?)\.?$/\L$1/; # Normalize domain. + + my $packet = $self->dns_resolver->send($domain, $rr_type); + + # Throw DNS exception unless an answer packet with RCODE 0 or 3 (NXDOMAIN) + # was received (thereby treating NXDOMAIN as an acceptable but empty answer packet): + $self->dns_resolver->errorstring !~ /^(timeout|query timed out)$/ + or throw Mail::SPF::EDNSTimeout( + "Time-out on DNS '$rr_type' lookup of '$domain'"); + defined($packet) + or throw Mail::SPF::EDNSError( + "Unknown error on DNS '$rr_type' lookup of '$domain'"); + $packet->header->rcode =~ /^(NOERROR|NXDOMAIN)$/ + or throw Mail::SPF::EDNSError( + "'" . $packet->header->rcode . "' error on DNS '$rr_type' lookup of '$domain'"); + + return $packet; +} + +=item B: throws I + +Increments by one the count of DNS-interactive mechanisms and modifiers that +have been processed so far during the evaluation of the given +I object. If this exceeds the configured limit (see the +L constructor's C option), throws a +I exception. + +This method is supposed to be called by the C and C methods of +I and I sub-classes before (and only if) they +do any DNS look-ups. + +=cut + +sub count_dns_interactive_term { + my ($self, $request) = @_; + my $dns_interactive_terms_count = ++$request->root_request->state('dns_interactive_terms_count'); + my $max_dns_interactive_terms = $self->max_dns_interactive_terms; + if ( + defined($max_dns_interactive_terms) and + $dns_interactive_terms_count > $max_dns_interactive_terms + ) { + throw Mail::SPF::EProcessingLimitExceeded( + "Maximum DNS-interactive terms limit ($max_dns_interactive_terms) exceeded"); + } + return; +} + +=item B: throws I + +Increments by one the count of "void" DNS look-ups that have occurred so far +during the evaluation of the given I object. If this +exceeds the configured limit (see the L constructor's C +option), throws a I exception. + +This method is supposed to be called by any code after any calls to the +L method whenever (i) no answer records were returned, and (ii) +this fact is a possible indication of a DoS attack against a third-party victim +domain, and (iii) the number of "void" look-ups is not already constrained +otherwise (as for example is the case with the C mechanism and the +C modifier). Specifically, this applies to look-ups performed by the +C, C, C, and C mechanisms and the C

macro. + +=cut + +sub count_void_dns_lookup { + my ($self, $request) = @_; + my $void_dns_lookups_count = ++$request->root_request->state('void_dns_lookups_count'); + my $max_void_dns_lookups = $self->max_void_dns_lookups; + if ( + defined($max_void_dns_lookups) and + $void_dns_lookups_count > $max_void_dns_lookups + ) { + throw Mail::SPF::EProcessingLimitExceeded( + "Maximum void DNS look-ups limit ($max_void_dns_lookups) exceeded"); + } + return; +} + +=item B: returns I + +Returns the default authority explanation as a I object. See the +description of the L constructor's C +option. + +=item B: returns I + +Returns the local system's host name. See the description of the L +constructor's C option. + +=item B: returns I or compatible object + +Returns the DNS resolver object of the server object. See the description of +the L constructor's C option. + +=item B: returns I + +Returns a value denoting the RR types for which to query when looking up and +selecting SPF records. See the description of the L constructor's +C option. + +=item B: returns I + +=item B: returns I + +=item B: returns I + +=item B: returns I + +=item B: returns I + +Return the limit values of the server object. See the description of the +L constructor's corresponding options. + +=cut + +# Make read-only accessors: +__PACKAGE__->make_accessor($_, TRUE) + foreach qw( + default_authority_explanation + hostname + + dns_resolver + query_rr_types + + max_dns_interactive_terms + max_name_lookups_per_term + max_name_lookups_per_mx_mech + max_name_lookups_per_ptr_mech + + max_void_dns_lookups + ); + +=back + +=head1 SEE ALSO + +L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Term.pm b/lib/Mail/SPF/Term.pm new file mode 100644 index 0000000..d1c32ad --- /dev/null +++ b/lib/Mail/SPF/Term.pm @@ -0,0 +1,296 @@ +# +# Mail::SPF::Term +# SPF record term class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Term.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Term; + +=head1 NAME + +Mail::SPF::Term - SPF record term class + +=cut + +use warnings; +use strict; + +use utf8; # Hack to keep Perl 5.6 from whining about /[\p{}]/. + +use base 'Mail::SPF::Base'; + +use overload + '""' => 'stringify', + fallback => 1; + +use NetAddr::IP; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant name_pattern => qr/ \p{IsAlpha} [\p{IsAlnum}\-_.]* /x; + +use constant macro_literal_pattern => qr/[!-\$&-~]/; +use constant macro_delimiter => qr/[.\-+,\/_=]/; +use constant macro_transformers_pattern => qr/\d*r?/; +use constant macro_expand_pattern => qr/ + \% + (?: + { \p{IsAlpha} ${\macro_transformers_pattern} ${\macro_delimiter}* } | + [%_-] + ) +/x; + +use constant macro_string_pattern => qr/ + (?: + ${\macro_expand_pattern} | + ${\macro_literal_pattern} + )* +/x; + +use constant toplabel_pattern => qr/ + \p{IsAlnum}+ - [\p{IsAlnum}-]* \p{IsAlnum} | + \p{IsAlnum}* \p{IsAlpha} \p{IsAlnum}* +/x; + +use constant domain_end_pattern => qr/ + \. ${\toplabel_pattern} \.? | + ${\macro_expand_pattern} +/x; + +use constant domain_spec_pattern => qr/ ${\macro_string_pattern} ${\domain_end_pattern} /x; + +use constant qnum_pattern => qr/ 25[0-5] | 2[0-4]\d | 1\d\d | [1-9]\d | \d /x; +use constant ipv4_address_pattern => qr/ ${\qnum_pattern} (?: \. ${\qnum_pattern} ){3} /x; + +use constant hexword_pattern => qr/\p{IsXDigit}{1,4}/; +use constant two_hexwords_or_ipv4_address_pattern => qr/ + ${\hexword_pattern} : ${\hexword_pattern} | ${\ipv4_address_pattern} +/x; +use constant ipv6_address_pattern => qr/ + # x:x:x:x:x:x:x:x | x:x:x:x:x:x:n.n.n.n + (?: ${\hexword_pattern} : ){6} ${\two_hexwords_or_ipv4_address_pattern} | + # x::x:x:x:x:x:x | x::x:x:x:x:n.n.n.n + (?: ${\hexword_pattern} : ){1} : (?: ${\hexword_pattern} : ){4} ${\two_hexwords_or_ipv4_address_pattern} | + # x[:x]::x:x:x:x:x | x[:x]::x:x:x:n.n.n.n + (?: ${\hexword_pattern} : ){1,2} : (?: ${\hexword_pattern} : ){3} ${\two_hexwords_or_ipv4_address_pattern} | + # x[:...]::x:x:x:x | x[:...]::x:x:n.n.n.n + (?: ${\hexword_pattern} : ){1,3} : (?: ${\hexword_pattern} : ){2} ${\two_hexwords_or_ipv4_address_pattern} | + # x[:...]::x:x:x | x[:...]::x:n.n.n.n + (?: ${\hexword_pattern} : ){1,4} : (?: ${\hexword_pattern} : ){1} ${\two_hexwords_or_ipv4_address_pattern} | + # x[:...]::x:x | x[:...]::n.n.n.n + (?: ${\hexword_pattern} : ){1,5} : ${\two_hexwords_or_ipv4_address_pattern} | + # x[:...]::x | - + (?: ${\hexword_pattern} : ){1,6} : ${\hexword_pattern} | + # x[:...]:: | - + (?: ${\hexword_pattern} : ){1,7} : | + # ::[...:]x | - + :: (?: ${\hexword_pattern} : ){0,6} ${\hexword_pattern} | + # - | ::[...:]n.n.n.n + :: (?: ${\hexword_pattern} : ){0,5} ${\two_hexwords_or_ipv4_address_pattern} | + # :: | - + :: +/x; + +=head1 DESCRIPTION + +An object of class B represents a term within an SPF record. +Mail::SPF::Term cannot be instantiated directly. Create an instance of a +concrete sub-class instead. + +=head2 Constructor + +The following constructor is provided: + +=over + +=item B: returns I + +I. Creates a new SPF record term object. + +%options is a list of key/value pairs, however Mail::SPF::Term itself specifies +no constructor options. + +=item B: returns I; +throws I, I + +I. Creates a new SPF record term object by parsing the string and +any options given. + +=cut + +sub new_from_string { + my ($self, $text, %options) = @_; + $self = $self->new(%options, text => $text); + $self->parse(); + return $self; +} + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: returns I + +Returns a regular expression that matches any legal name for an SPF record +term. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse_domain_spec { + my ($self, $required) = @_; + if ($self->{parse_text} =~ s/^(${\$self->domain_spec_pattern})//) { + my $domain_spec = $1; + $domain_spec =~ s/^(.*?)\.?$/\L$1/; + $self->{domain_spec} = Mail::SPF::MacroString->new(text => $domain_spec); + } + elsif ($required) { + throw Mail::SPF::ETermDomainSpecExpected( + "Missing required domain-spec in '" . $self->text . "'"); + } + return; +} + +sub parse_ipv4_address { + my ($self, $required) = @_; + if ($self->{parse_text} =~ s/^(${\$self->ipv4_address_pattern})//) { + $self->{ip_address} = $1; + } + elsif ($required) { + throw Mail::SPF::ETermIPv4AddressExpected( + "Missing required IPv4 address in '" . $self->text . "'"); + } + return; +} + +sub parse_ipv4_prefix_length { + my ($self, $required) = @_; + if ($self->{parse_text} =~ s#^/(\d+)##) { + $1 >= 0 and $1 <= 32 and $1 !~ /^0./ + or throw Mail::SPF::ETermIPv4PrefixLengthExpected( + "Invalid IPv4 prefix length encountered in '" . $self->text . "'"); + $self->{ipv4_prefix_length} = $1; + } + elsif (not $required) { + $self->{ipv4_prefix_length} = $self->default_ipv4_prefix_length; + } + else { + throw Mail::SPF::ETermIPv4PrefixLengthExpected( + "Missing required IPv4 prefix length in '" . $self->text . "'"); + } + return; +} + +sub parse_ipv4_network { + my ($self, $required) = @_; + $self->parse_ipv4_address($required); + $self->parse_ipv4_prefix_length(); + $self->{ip_network} = NetAddr::IP->new($self->{ip_address}, $self->{ipv4_prefix_length}); + return; +} + +sub parse_ipv6_address { + my ($self, $required) = @_; + if ($self->{parse_text} =~ s/^(${\$self->ipv6_address_pattern})(?=\/|$)//) { + $self->{ip_address} = $1; + } + elsif ($required) { + throw Mail::SPF::ETermIPv6AddressExpected( + "Missing required IPv6 address in '" . $self->text . "'"); + } + return; +} + +sub parse_ipv6_prefix_length { + my ($self, $required) = @_; + if ($self->{parse_text} =~ s#^/(\d+)##) { + $1 >= 0 and $1 <= 128 and $1 !~ /^0./ + or throw Mail::SPF::ETermIPv6PrefixLengthExpected( + "Invalid IPv6 prefix length encountered in '" . $self->text . "'"); + $self->{ipv6_prefix_length} = $1; + } + elsif (not $required) { + $self->{ipv6_prefix_length} = $self->default_ipv6_prefix_length; + } + else { + throw Mail::SPF::ETermIPv6PrefixLengthExpected( + "Missing required IPv6 prefix length in '" . $self->text . "'"); + } + return; +} + +sub parse_ipv6_network { + my ($self, $required) = @_; + $self->parse_ipv6_address($required); + $self->parse_ipv6_prefix_length(); + $self->{ip_network} = NetAddr::IP->new( + $self->{ip_address}, $self->{ipv6_prefix_length}); + return; +} + +sub parse_ipv4_ipv6_prefix_lengths { + my ($self) = @_; + $self->parse_ipv4_prefix_length(); + if ( + defined($self->{ipv4_prefix_length}) and # an IPv4 prefix length has been parsed, and + $self->{parse_text} =~ s#^/## # another slash is following + ) { + # Parse an IPv6 prefix length: + $self->parse_ipv6_prefix_length(TRUE); + } + return; +} + +=item B: returns I; throws I + +Returns the unparsed text of the term. Throws a I +exception if the term was created synthetically instead of being parsed, and no +text was provided. + +=cut + +sub text { + my ($self) = @_; + defined($self->{text}) + or throw Mail::SPF::ENoUnparsedText; + return $self->{text}; +} + +=item B: returns I + +I. Returns the name of the term. + +=back + +=head1 SEE ALSO + +L, L, L, L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/Util.pm b/lib/Mail/SPF/Util.pm new file mode 100644 index 0000000..b6318bc --- /dev/null +++ b/lib/Mail/SPF/Util.pm @@ -0,0 +1,362 @@ +# +# Mail::SPF::Util +# Mail::SPF utility class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Util.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::Util; + +=head1 NAME + +Mail::SPF::Util - Mail::SPF utility class + +=cut + +use warnings; +use strict; + +use utf8; # Hack to keep Perl 5.6 from whining about /[\p{}]/. + +use base 'Mail::SPF::Base'; + +use Mail::SPF::Exception; + +use Error ':try'; +use Sys::Hostname (); +use NetAddr::IP; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant ipv4_mapped_ipv6_address_pattern => + qr/^::ffff:(\p{IsXDigit}{1,4}):(\p{IsXDigit}{1,4})/i; + +# Interface: +############################################################################## + +=head1 SYNOPSIS + + use Mail::SPF::Util; + + $hostname = Mail::SPF::Util->hostname; + + $ipv6_address_v4mapped = + Mail::SPF::Util->ipv4_address_to_ipv6($ipv4_address); + + $ipv4_address = + Mail::SPF::Util->ipv6_address_to_ipv4($ipv6_address_v4mapped); + + $is_v4mapped = + Mail::SPF::Util->ipv6_address_is_ipv4_mapped($ipv6_address); + + $ip_address_string = Mail::SPF::Util->ip_address_to_string($ip_address); + $reverse_name = Mail::SPF::Util->ip_address_reverse($ip_address); + + $validated_domain = Mail::SPF::Util->valid_domain_for_ip_address( + $spf_server, $request, + $ip_address, $domain, + $find_best_match, # defaults to false + $accept_any_domain # defaults to false + ); + + $sanitized_string = Mail::SPF::Util->sanitize_string($string); + +=cut + +# Implementation: +############################################################################## + +=head1 DESCRIPTION + +B is Mail::SPF's utility class. + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: returns I + +Returns the fully qualified domain name (FQDN) of the local host. + +=cut + +my $hostname; + +sub hostname { + my ($self) = @_; + return $hostname ||= (gethostbyname(Sys::Hostname::hostname))[0]; + # Thanks to Sys::Hostname::FQDN for that trick! +} + +=item B: returns I; throws +I + +Converts the specified I IPv4 address into an IPv4-mapped IPv6 +address. Throws a I exception if the specified +IP address is not an IPv4 address. + +=cut + +sub ipv4_address_to_ipv6 { + my ($self, $ipv4_address) = @_; + UNIVERSAL::isa($ipv4_address, 'NetAddr::IP') and + $ipv4_address->version == 4 + or throw Mail::SPF::EInvalidOptionValue('NetAddr::IP IPv4 address expected'); + return NetAddr::IP->new( + '::ffff:' . $ipv4_address->addr, # address + $ipv4_address->masklen - 32 + 128 # netmask length + ); +} + +=item B: returns I; throws +I + +Converts the specified I IPv4-mapped IPv6 address into a proper +IPv4 address. Throws a I exception if the +specified IP address is not an IPv4-mapped IPv6 address. + +=cut + +sub ipv6_address_to_ipv4 { + my ($self, $ipv6_address) = @_; + UNIVERSAL::isa($ipv6_address, 'NetAddr::IP') and + $ipv6_address->version == 6 and + $ipv6_address->short =~ $self->ipv4_mapped_ipv6_address_pattern + or throw Mail::SPF::EInvalidOptionValue('NetAddr::IP IPv4-mapped IPv6 address expected'); + return NetAddr::IP->new( + join('.', unpack('C4', pack('H8', sprintf('%04s%04s', $1, $2)))), # address + $ipv6_address->masklen >= 128 - 32 ? $ipv6_address->masklen - 128 + 32 : 0 # netmask length + ); +} + +=item B: returns I + +Returns B if the specified I IPv6 address is an IPv4-mapped +address, B otherwise. + +=cut + +sub ipv6_address_is_ipv4_mapped { + my ($self, $ipv6_address) = @_; + return ( + UNIVERSAL::isa($ipv6_address, 'NetAddr::IP') and + $ipv6_address->version == 6 and + $ipv6_address->short =~ $self->ipv4_mapped_ipv6_address_pattern + ); +} + +=item B: returns I; +throws I + +Returns the given I IPv4 or IPv6 address compactly formatted as a +I. For IPv4 addresses, this is equivalent to calling L< NetAddr::IP's +C |NetAddr::IP/addr> method. For IPv6 addresses, this is equivalent to +calling L< NetAddr::IP's C |NedAddr::IP/short> method. Throws a +I exception if the specified object is not a +I IPv4 or IPv6 address object. + +=cut + +sub ip_address_to_string { + my ($self, $ip_address) = @_; + UNIVERSAL::isa($ip_address, 'NetAddr::IP') and + ($ip_address->version == 4 or $ip_address->version == 6) + or throw Mail::SPF::EInvalidOptionValue('NetAddr::IP IPv4 or IPv6 address expected'); + return $ip_address->version == 4 ? $ip_address->addr : lc($ip_address->short); +} + +=item B: returns I; +throws I + +Returns the C/C reverse notation of the given +I IPv4 or IPv6 address. Throws a I +exception if the specified object is not a I IPv4 or IPv6 address +object. + +=cut + +sub ip_address_reverse { + my ($self, $ip_address) = @_; + UNIVERSAL::isa($ip_address, 'NetAddr::IP') and + ($ip_address->version == 4 or $ip_address->version == 6) + or throw Mail::SPF::EInvalidOptionValue('NetAddr::IP IPv4 or IPv6 address expected'); + try { + # Treat IPv4-mapped IPv6 addresses as IPv4 addresses: + $ip_address = $self->ipv6_address_to_ipv4($ip_address); + } + catch Mail::SPF::EInvalidOptionValue with {}; + # ...deliberately ignoring conversion errors. + if ($ip_address->version == 4) { + my @octets = split(/\./, $ip_address->addr); + @octets = @octets[0 .. int($ip_address->masklen / 8) - 1]; + return join('.', reverse(@octets)) . '.in-addr.arpa.'; + } + elsif ($ip_address->version == 6) { + my @nibbles = split(//, unpack("H32", $ip_address->aton)); + @nibbles = @nibbles[0 .. int($ip_address->masklen / 4) - 1]; + return join('.', reverse(@nibbles)) . '.ip6.arpa.'; + } +} + +=item B: +returns I or B + +Finds a valid domain name for the given I IP address that matches +the given domain or a sub-domain thereof. A domain name is valid for the given +IP address if the IP address reverse-maps to that domain name in DNS, and the +domain name in turn forward-maps to the IP address. Uses the given +I and I objects to perform DNS look-ups. +Returns the validated domain name. + +If C<$find_best_match> is B, the one domain name is selected that best +matches the given domain name, preferring direct matches over sub-domain +matches. Defaults to B. + +If C<$accept_any_domain> is B, I domain names are considered +acceptable, even if they differ completely from the given domain name (which +is then effectively unused unless a best match is requested). Defaults to +B. + +=cut + +use constant valid_domain_match_none => 0; +use constant valid_domain_match_subdomain => 1; +use constant valid_domain_match_identical => 2; + +sub valid_domain_for_ip_address { + my ($self, $server, $request, $ip_address, $domain, $find_best_match, $accept_any_domain) = @_; + + my $addr_rr_type = $ip_address->version == 4 ? 'A' : 'AAAA'; + + my $reverse_ip_name = $self->ip_address_reverse($ip_address); + my $ptr_packet = $server->dns_lookup($reverse_ip_name, 'PTR'); + my @ptr_rrs = $ptr_packet->answer + or $server->count_void_dns_lookup($request); + + # Respect the PTR mechanism lookups limit (RFC 4408, 5.5/3/4): + @ptr_rrs = splice(@ptr_rrs, 0, $server->max_name_lookups_per_ptr_mech) + if defined($server->max_name_lookups_per_ptr_mech); + + my $best_match_type; + my $valid_domain; + + # Check PTR records: + foreach my $ptr_rr (@ptr_rrs) { + if ($ptr_rr->type eq 'PTR') { + my $ptr_domain = $ptr_rr->ptrdname; + + my $match_type; + if ($ptr_domain =~ /^\Q$domain\E$/i) { + $match_type = valid_domain_match_identical; + } + elsif ($ptr_domain =~ /\.\Q$domain\E$/i) { + $match_type = valid_domain_match_subdomain; + } + else { + $match_type = valid_domain_match_none; + } + + # If we're not accepting _any_ domain, and the PTR domain does not match + # the requested domain at all, ignore this PTR domain (RFC 4408, 5.5/5): + next if not $accept_any_domain and $match_type == valid_domain_match_none; + + my $is_valid_domain = FALSE; + + try { + my $addr_packet = $server->dns_lookup($ptr_domain, $addr_rr_type); + my @addr_rrs = $addr_packet->answer + or $server->count_void_dns_lookup($request); + foreach my $addr_rr (@addr_rrs) { + if ($addr_rr->type eq $addr_rr_type) { + $is_valid_domain = TRUE, last + if $ip_address == NetAddr::IP->new($addr_rr->address); + # IP address reverse and forward mapping match, + # PTR domain validated! + } + elsif ($addr_rr->type =~ /^(CNAME|A|AAAA)$/) { + # A CNAME (which has hopefully been resolved by the server + # for us already), or an address RR of an unrequested type. + # Silently ignore any of those. + # FIXME Silently ignoring address RRs of an "unrequested" + # FIXME type poses a disparity with how the "ip{4,6}", "a", + # FIXME and "mx" mechanisms tolerantly handle alien but + # FIXME convertible IP address types. + } + else { + # Unexpected RR type. + # TODO Generate debug info or ignore silently. + } + } + } + catch Mail::SPF::EDNSError with {}; + # Ignore DNS errors on doing A/AAAA RR lookups (RFC 4408, 5.5/5/5). + + if ($is_valid_domain) { + # If we're not looking for the _best_ match, any acceptable validated + # domain will do (RFC 4408, 5.5/5): + return $ptr_domain if not $find_best_match; + + # Otherwise, is this PTR domain the best possible match? + return $ptr_domain if $match_type == valid_domain_match_identical; + + # Lastly, record this match as the best one as of yet: + if ( + not defined($best_match_type) or + $match_type > $best_match_type + ) { + $valid_domain = $ptr_domain; + $best_match_type = $match_type; + } + } + } + else { + # Unexpected RR type. + # TODO Generate debug info or ignore silently. + } + } + + # Return best match, possibly none (undef): + return $valid_domain; +} + +=item B: returns I or B + +Replaces all non-printable or non-ascii characters in a string with their +hex-escaped representation (e.g., C<\x00>). + +=cut + +sub sanitize_string { + my ($self, $string) = @_; + + return undef if not defined($string); + + $string =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02x", ord($1))/gex; + $string =~ s/([\x{0100}-\x{ffff}]) /sprintf("\\x{%04x}", ord($1))/gex; + + return $string; +} + +=back + +=head1 SEE ALSO + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/v1/Record.pm b/lib/Mail/SPF/v1/Record.pm new file mode 100644 index 0000000..6a56721 --- /dev/null +++ b/lib/Mail/SPF/v1/Record.pm @@ -0,0 +1,182 @@ +# +# Mail::SPF::v1::Record +# SPFv1 record class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Record.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::v1::Record; + +=head1 NAME + +Mail::SPF::v1::Record - SPFv1 record class + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::Record'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant mech_classes => { + all => 'Mail::SPF::Mech::All', + ip4 => 'Mail::SPF::Mech::IP4', + ip6 => 'Mail::SPF::Mech::IP6', + a => 'Mail::SPF::Mech::A', + mx => 'Mail::SPF::Mech::MX', + ptr => 'Mail::SPF::Mech::PTR', + 'exists' => 'Mail::SPF::Mech::Exists', + include => 'Mail::SPF::Mech::Include' +}; + +use constant mod_classes => { + redirect => 'Mail::SPF::Mod::Redirect', + 'exp' => 'Mail::SPF::Mod::Exp' +}; + +eval("require $_") + foreach values(%{mech_classes()}), values(%{mod_classes()}); + +use constant version_tag => 'v=spf1'; +use constant version_tag_pattern => qr/ v=spf(1) (?= \x20 | $ ) /ix; + +use constant scopes => ('helo', 'mfrom'); + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +An object of class B represents an B (C) +record. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new SPFv1 record object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +=item B + +=item B + +See L. + +=item B + +See L. Since SPFv1 records always implicitly cover the +C and C scopes, this option must either be exactly B<['helo', +'mfrom']> (or B<['mfrom', 'helo']>) or be omitted. + +=back + +=cut + +sub new { + my ($self, %options) = @_; + $self = $self->SUPER::new(%options); + + if (defined(my $scopes = $self->{scopes})) { + @$scopes > 0 + or throw Mail::SPF::EInvalidScope('No scopes for v=spf1 record'); + @$scopes == 2 and + ( + $scopes->[0] eq 'help' and $scopes->[1] eq 'mfrom' or + $scopes->[0] eq 'mfrom' and $scopes->[1] eq 'help' + ) + or throw Mail::SPF::EInvalidScope( + "Invalid set of scopes " . join(', ', map("'$_'", @$scopes)) . " for v=spf1 record"); + } + + return $self; +} + +=item B: returns I; +throws I, I, +I + +Creates a new SPFv1 record object by parsing the string and any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: returns I + +Returns a regular expression that matches a version tag of B<'v=spf1'>. + +=item B + +=item B + +See L. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +See L. + +=item B: returns I + +Returns B<'v=spf1'>. + +=back + +=head1 SEE ALSO + +L, L, L, L, +L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/lib/Mail/SPF/v2/Record.pm b/lib/Mail/SPF/v2/Record.pm new file mode 100644 index 0000000..0e0776f --- /dev/null +++ b/lib/Mail/SPF/v2/Record.pm @@ -0,0 +1,223 @@ +# +# Mail::SPF::v2::Record +# Sender ID ("spf2.0") record class. +# +# (C) 2005-2012 Julian Mehnle +# 2005 Shevek +# $Id: Record.pm 57 2012-01-30 08:15:31Z julian $ +# +############################################################################## + +package Mail::SPF::v2::Record; + +=head1 NAME + +Mail::SPF::v2::Record - Sender ID ("spf2.0") record class + +=cut + +use warnings; +use strict; + +use base 'Mail::SPF::Record'; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant mech_classes => { + all => 'Mail::SPF::Mech::All', + ip4 => 'Mail::SPF::Mech::IP4', + ip6 => 'Mail::SPF::Mech::IP6', + a => 'Mail::SPF::Mech::A', + mx => 'Mail::SPF::Mech::MX', + ptr => 'Mail::SPF::Mech::PTR', + 'exists' => 'Mail::SPF::Mech::Exists', + include => 'Mail::SPF::Mech::Include' +}; + +use constant mod_classes => { + redirect => 'Mail::SPF::Mod::Redirect', + 'exp' => 'Mail::SPF::Mod::Exp' +}; + +eval("require $_") + foreach values(%{mech_classes()}), values(%{mod_classes()}); + +use constant valid_scope => qr/^(?: mfrom | pra )$/x; +use constant version_tag_pattern => qr{ + spf(2\.0) + / + ( (?: mfrom | pra ) (?: , (?: mfrom | pra ) )* ) + (?= \x20 | $ ) +}ix; + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +An object of class B represents a B +(C) record. + +=head2 Constructors + +The following constructors are provided: + +=over + +=item B: returns I + +Creates a new Sender ID ("spf2.0") record object. + +%options is a list of key/value pairs representing any of the following +options: + +=over + +=item B + +=item B + +=item B + +See L. + +=item B + +I. See L. The B<'mfrom'> and B<'pra'> scopes +are supported. There is no default. + +=back + +=cut + +sub new { + my ($self, %options) = @_; + $self = $self->SUPER::new(%options); + + if (not defined($self->{parse_text})) { + # No parsing is intended, so scopes should have been specified: + my $scopes = $self->{scopes} || []; + @$scopes > 0 + or throw Mail::SPF::EInvalidScope('No scopes for spf2.0 record'); + foreach my $scope (@$scopes) { + $scope =~ $self->valid_scope + or throw Mail::SPF::EInvalidScope("Invalid scope '$scope' for spf2.0 record"); + } + } + + return $self; +} + +=item B: returns I; +throws I, I, +I + +Creates a new Sender ID ("spf2.0") record object by parsing the string and +any options given. + +=back + +=head2 Class methods + +The following class methods are provided: + +=over + +=item B: returns I + +Returns a regular expression that matches a version tag of B<'spf2.0/'> plus a +comma-separated list of any of the B<'mfrom'> and B<'pra'> scopes. The +following are valid version tags: + + spf2.0/mfrom + spf2.0/pra + spf2.0/mfrom,pra + spf2.0/pra,mfrom + +=item B + +=item B + +See L. + +=back + +=head2 Instance methods + +The following instance methods are provided: + +=over + +=cut + +sub parse_version_tag { + my ($self) = @_; + if ($self->{parse_text} =~ s/^${\$self->version_tag_pattern}(?:\x20+|$)//) { + my $scopes = $self->{scopes} = [ split(/,/, $2) ]; + @$scopes > 0 + or throw Mail::SPF::EInvalidScope('No scopes for spf2.0 record'); + foreach my $scope (@$scopes) { + $scope =~ $self->valid_scope + or throw Mail::SPF::EInvalidScope("Invalid scope '$scope' for spf2.0 record"); + } + } + else { + throw Mail::SPF::EInvalidRecordVersion( + "Not a 'spf2.0' record: '" . $self->text . "'"); + } + return; +} + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +See L. + +=item B: returns I + +Returns B<'spf2.0/'> plus a comma-separated list of the scopes of the record. +See L for a list of possible return values. + +=cut + +sub version_tag { + my ($self) = @_; + return 'spf2.0' + if not ref($self) # called as class method + or not defined($self->{scopes}) # no scopes parsed + or not @{$self->{scopes}}; # no scopes specified in record + return 'spf2.0/' . join(',', @{$self->{scopes}}); +} + +=back + +=head1 SEE ALSO + +L, L, L, L, +L + +L + +For availability, support, and license information, see the README file +included with Mail::SPF. + +=head1 AUTHORS + +Julian Mehnle , Shevek + +=cut + +TRUE; diff --git a/sbin/spfd b/sbin/spfd new file mode 100755 index 0000000..620398a --- /dev/null +++ b/sbin/spfd @@ -0,0 +1,606 @@ +#!/usr/bin/perl + +# +# spfd: Simple forking SPF query service daemon +# +# (C) 2005-2012 Julian Mehnle +# 2003-2004 Meng Weng Wong +# $Id: spfd 148 2006-06-17 21:50:57Z Julian Mehnle $ +# +############################################################################## + +=head1 NAME + +spfd - (Mail::SPF) - Simple forking daemon to provide SPF query services + +=head1 VERSION + +2.000 + +=head1 SYNOPSIS + +B B<--port>|B<-p> I [B<--set-user>|B<-u> I|I] +[B<--set-group>|B<-g> I|I] [I] + +B B<--socket>|B<-s> I [B<--socket-user> I|I] +[B<--socket-group> I|I] [B<--socket-perms> I] +[B<--set-user>|B<-u> I|I] [B<--set-group>|B<-g> I|I] +[I] + +B B<--version|-V> + +B B<--help> + +=head1 DESCRIPTION + +B is a simple forking Sender Policy Framework (SPF) query server. spfd +receives and answers SPF requests on a TCP/IP or UNIX domain socket. For more +information on SPF see L. + +The B<--port> form listens on a TCP/IP socket on the specified I. The +default port is B<5970>. + +The B<--socket> form listens on a UNIX domain socket that is created with the +specified I. 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<--version> form prints version information of spfd. The B<--help> form +prints usage information for spfd. + +=head1 OPTIONS + +spfd takes any of the following I: + +=over + +=item B<--default-explanation> I + +=item B<--def-exp> I + +Use the specified I as the default explanation if the authority domain +does not specify an explanation string of its own. + +=item B<--hostname> I + +Use I as the host name of the local system instead of auto-detecting +it. + +=item B<--debug> + +Print out debug information about spfd's operation, incoming requests, and the +responses sent. + +=back + +=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

+ +The legacy request style is deprecated but still supported for backwards +compatibility. The legacy response values are still returned for backwards +compatibility in addition to the new response values, but may be removed in the +future. Adjust your code to use the new request and response styles. + +=item * + +The former C and C result codes have been renamed to C +and C, respectively, in order to comply with RFC 4408 terminology. + +=item * + +SPF checks with an empty identity are no longer supported. In the case of an +empty C SMTP transaction parameter, perform a check with the C +scope directly. + +=back + +=back + +=head1 SEE ALSO + +L, L + +L + +=head1 AUTHORS + +This version of B is a complete rewrite by Julian Mehnle , +based on an earlier version written by Meng Weng Wong . + +=cut + +our $VERSION = '2.000'; + +use warnings; +use strict; + +use Error ':try'; +use IO::Handle; +use Getopt::Long qw(:config gnu_compat); +use Socket; +use Mail::SPF; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +use constant default_port => 5970; + +use constant deprecated_request_keys => { + sender => 'identity', + ip => 'ip_address', + helo => 'helo_identity' +}; + +# Helper Functions +############################################################################## + +sub usage { + STDERR->print(<<'EOT'); +Usage: + spfd --port|-p + [--set-user|-u |] [--set-group|-g |] + spfd --socket|-s [--socket-user |] + [--socket-group |] [--socket-perms ] + [--set-user|-u |] [--set-group|-g |] +EOT + return; +} + +sub deprecated_option { + my ($old_option, $new_option, $options) = @_; + return FALSE if not exists($options->{$old_option}); + STDERR->print( + "Warning: '$old_option' option is deprecated" . + ($new_option ? "; use '$new_option' instead" : '') . + ".\n" + ); + $options->{$new_option} = delete($options->{$old_option}); + return TRUE; +} + +# Command-line Option Handling +############################################################################## + +my $options = {}; +my $getopt_result = GetOptions( + $options, + + 'port|p=i', + 'socket|s=s', + 'socket-user=s', + 'socket-group=s', + 'socket-perms=s', + 'set-user|u=s', + 'set-group=s', + + 'default-explanation|def-exp=s', + 'hostname=s', + + 'debug!', + + # Black Magic options: + 'enable-black-magic!', + + # Meta actions: + 'version|V!', + 'help!', + + # Deprecated options: + 'path=s', # Now 'socket' + 'pathuser=s', # Now 'socket-user' + 'pathgroup=s', # Now 'socket-group' + 'pathmode=s', # Now 'socket-perms' + 'setuser=s', # Now 'set-user' + 'setgroup=s' # Now 'set-group' +); + +if (not $getopt_result) { + usage(); + exit(255); +} + +if ($options->{help}) { + usage(); + exit(0); +} + +if ($options->{version}) { + print("spfd version $VERSION (using Mail::SPF)\n"); + exit(0); +} + +my $enable_black_magic = $options->{'enable-black-magic'}; + +if ( + $enable_black_magic and + not defined(eval('require Mail::SPF::BlackMagic')) +) { + STDERR->print("Error: Cannot enable black magic. Unable to load Mail::SPF::BlackMagic.\n"); + exit(255); +} +elsif ($enable_black_magic) { + STDERR->print("Black magic enabled.\n"); +} + +deprecated_option('path', 'socket', $options); +deprecated_option('pathuser', 'socket-user', $options); +deprecated_option('pathgroup', 'socket-group', $options); +deprecated_option('pathmode', 'socket-perms', $options); +deprecated_option('setuser', 'set-user', $options); +deprecated_option('setgroup', 'set-group', $options); + +my $port = $options->{port}; +my $socket_path = $options->{socket}; +my $socket_user = $options->{'socket-user'}; +my $socket_group = $options->{'socket-group'}; +my $socket_perms = $options->{'socket-perms'}; +my $set_user = $options->{'set-user'}; +my $set_group = $options->{'set-group'}; + +my $default_explanation = $options->{'default-explanation'}; +my $hostname = $options->{hostname}; + +my $debug = defined($options->{debug}) ? $options->{debug} : $ENV{DEBUG}; + +if (defined($port) and defined($socket_path)) { + usage(); + exit(255); +} + +if (not defined($port) and not defined($socket_path)) { + $port = default_port; + STDERR->print("Using default TCP/IP port ($port). Run `spfd --help` for supported options.\n"); +} + +# Main Program +############################################################################## + +STDOUT->autoflush(TRUE); + +my $listen_socket; + +if (defined($port)) { + require IO::Socket::INET; + $listen_socket = IO::Socket::INET->new( + Listen => TRUE, + LocalAddr => '127.0.0.1', + LocalPort => $port, + ReuseAddr => TRUE + ); + print("spfd (PID $$): Listening on TCP/IP port $port.\n"); + #$0 = "spfd listening on TCP port $port"; +} +elsif (defined($socket_path)) { + require IO::Socket::UNIX; + unlink $socket_path + if -S $socket_path; + $listen_socket = IO::Socket::UNIX->new( + Listen => TRUE, + Local => $socket_path + ); + print("spfd (PID $$): Listening on UNIX socket '$socket_path'.\n"); + #$0 = "spfd listening on UNIX socket $socket_path"; + + $socket_user = normalize_uid($socket_user); + $socket_group = normalize_gid($socket_group); + chown($socket_user, $socket_group, $socket_path) + or die("Unable to chown($socket_user, $socket_group) socket '$socket_path'") + if $socket_user != -1 or $socket_path != -1; + + chmod(oct($socket_perms), $socket_path) + or die("Unable to chmod($socket_perms) socket '$socket_path': $!") + if defined($socket_perms); +} + +if (defined($set_group)) { + $set_group = normalize_gid($set_group); + $( = $) = $set_group; + $( == $set_group and $) == $set_group + or die("Unable to setgid($set_group): $!"); +} + +if (defined($set_user)) { + $set_user = normalize_uid($set_user); + $< = $> = $set_user; + $< == $set_user and $> == $set_user + or die("Unable to setuid($set_user): $!"); +} + +my $spf_server = Mail::SPF::Server->new( + default_authority_explanation + => $default_explanation, + hostname => $hostname, + + # Black Magic: + # TODO + # max-dns-interactive-terms + # max-name-lookups-per-term + # more? +); + +# Handle Client Connections +############################################################################## + +while (my $socket = $listen_socket->accept()) { + if (fork) { + # Parent process. + close($socket); + wait; # Reap our immediate child (the grand-child will run on its own). + next; + } + elsif (fork) { + # Child process, parent of grand-child process. + # The child exits immediately in order to avoid zombies: + exit; + } + + # Grand-child process. + + my $time = gmtime; + if ($debug) { + my $peerinfo = + $listen_socket->isa('IO::Socket::INET') ? + sprintf(" from %s [%s]", scalar(gethostbyaddr($socket->peeraddr, AF_INET)), $socket->peerhost) + : ''; + print("\n"); + print("[$time] Incoming connection" . $peerinfo . "\n"); + } + + try { + $socket->autoflush(TRUE); + + my $request_values = {}; + while (<$socket>) { + s/\s+$//; + last if /^$/; + my ($key, $value) = split(/=/, $_, 2); + $key = lc($key); + $key = deprecated_request_keys->{$key} + if defined(deprecated_request_keys->{$key}); + $request_values->{$key} = $value; + + print("[$time] R: $key=$value\n") + if $debug; + } + + my @versions = split(',', $request_values->{versions} || ''); + + my $request = Mail::SPF::Request->new( + versions => @versions ? [@versions] : undef, + scope => $request_values->{scope}, + identity => $request_values->{identity}, + ip_address => $request_values->{ip_address}, + helo_identity => $request_values->{helo_identity} + ); + + my $result = $spf_server->process($request); + + my $response_values = {}; + $response_values->{result} = $result->code; + $response_values->{local_explanation} = $result->local_explanation; + $response_values->{authority_explanation} = $result->authority_explanation + if $result->can('authority_explanation'); + $response_values->{received_spf_header} = $result->received_spf_header; + $response_values->{spf_record} = $result->request->root_request->record + if defined($result->request->root_request->record); + + # Legacy response values: + $response_values->{smtp_comment} = + defined($response_values->{authority_explanation}) ? + $response_values->{authority_explanation} + : $response_values->{local_explanation}; + $response_values->{header_comment} = $response_values->{local_explanation}; + + foreach my $key (qw( + result local_explanation authority_explanation received_spf_header spf_record + smtp_comment header_comment + )) { + defined($response_values->{$key}) or next; + $socket->print("$key=$response_values->{$key}\n"); + print("[$time] W: $key=$response_values->{$key}\n") + if $debug; + } + } + catch Mail::SPF::Exception with { + my ($e) = @_; + printf("[$time] An error occurred: %s\n", $e->text); + }; + + $socket->close(); + + exit; +} + +# Helper Functions +############################################################################## + +sub normalize_uid { + my ($uid) = @_; + return -1 if not defined($uid); + return getpwnam($uid) + or die("Unknown user '$uid'") + if $uid =~ /\D/; + return $uid; +} + +sub normalize_gid { + my ($gid) = @_; + return -1 if not defined($gid); + return getgrnam($gid) + or die("Unknown group '$gid'") + if $gid =~ /\D/; + return $gid; +} diff --git a/t/00.00-class-misc.t b/t/00.00-class-misc.t new file mode 100644 index 0000000..bbbaf4d --- /dev/null +++ b/t/00.00-class-misc.t @@ -0,0 +1,12 @@ +use strict; +use warnings; +use blib; + +use Test::More tests => 2; + +#### Class Compilation #### + +BEGIN { + use_ok('Mail::SPF::Base'); + use_ok('Mail::SPF::Exception'); +} diff --git a/t/00.01-class-util.t b/t/00.01-class-util.t new file mode 100644 index 0000000..d5729a9 --- /dev/null +++ b/t/00.01-class-util.t @@ -0,0 +1,88 @@ +use strict; +use warnings; +use blib; + +use Test::More tests => 15; + +my $ipv4_address = NetAddr::IP->new('192.168.0.1'); +my $ipv6_address_v4mapped = NetAddr::IP->new('::ffff:192.168.0.1'); +my $ipv6_address = NetAddr::IP->new('2001:db8::1'); + + +#### Class Compilation #### + +BEGIN { use_ok('Mail::SPF::Util') } + + +#### hostname() #### + +# We cannot really test Mail::SPF::Util->hostname, as on some systems it simply cannot get +# a fully qualified hostname and thus returns undef. + + +#### ipv4_address_to_ipv6() #### + +{ + my $ip_address = eval { Mail::SPF::Util->ipv4_address_to_ipv6($ipv4_address) }; + isa_ok($ip_address, 'NetAddr::IP', 'Mail::SPF::Util->ipv4_address_to_ipv6() returns NetAddr::IP object'); + ok($ip_address == $ipv6_address_v4mapped, 'Mail::SPF::Util->ipv4_address_to_ipv6() yields correct IPv4-mapped IPv6 address'); + + eval { Mail::SPF::Util->ipv4_address_to_ipv6('192.168.0.1') }; + isa_ok($@, 'Mail::SPF::EInvalidOptionValue', 'Mail::SPF::Util->ipv4_address_to_ipv6($string) exception'); + + eval { Mail::SPF::Util->ipv4_address_to_ipv6($ipv6_address_v4mapped) }; + isa_ok($@, 'Mail::SPF::EInvalidOptionValue', 'Mail::SPF::Util->ipv4_address_to_ipv6($ipv6_address) exception'); +} + + +#### ipv6_address_to_ipv4() #### + +{ + my $ip_address = eval { Mail::SPF::Util->ipv6_address_to_ipv4($ipv6_address_v4mapped) }; + isa_ok($ip_address, 'NetAddr::IP', 'Mail::SPF::Util->ipv6_address_to_ipv4() returns NetAddr::IP object'); + ok($ip_address == $ipv4_address, 'Mail::SPF::Util->ipv6_address_to_ipv4() yields correct IPv4 address'); + + eval { Mail::SPF::Util->ipv6_address_to_ipv4('2001:db8::1') }; + isa_ok($@, 'Mail::SPF::EInvalidOptionValue', 'Mail::SPF::Util->ipv6_address_to_ipv4($string) exception'); + + eval { Mail::SPF::Util->ipv6_address_to_ipv4($ipv4_address) }; + isa_ok($@, 'Mail::SPF::EInvalidOptionValue', 'Mail::SPF::Util->ipv6_address_to_ipv4($ipv4_address) exception'); +} + + +#### ipv6_address_is_ipv4_mapped() #### + +{ + my $is_v4mapped; + + $is_v4mapped = Mail::SPF::Util->ipv6_address_is_ipv4_mapped($ipv6_address_v4mapped); + ok($is_v4mapped, 'Mail::SPF::Util->ipv6_address_is_ipv4_mapped($ipv6_address_v4mapped)'); + + $is_v4mapped = Mail::SPF::Util->ipv6_address_is_ipv4_mapped($ipv6_address); + ok((not $is_v4mapped), 'Mail::SPF::Util->ipv6_address_is_ipv4_mapped($ipv6_address)'); + + $is_v4mapped = Mail::SPF::Util->ipv6_address_is_ipv4_mapped($ipv4_address); + ok((not $is_v4mapped), 'Mail::SPF::Util->ipv6_address_is_ipv4_mapped($ipv4_address)'); +} + + +#### ip_address_reverse() #### + +{ + my $reverse_name; + + $reverse_name = Mail::SPF::Util->ip_address_reverse($ipv4_address); + is($reverse_name, '1.0.168.192.in-addr.arpa.', 'Mail::SPF::Util->ip_address_reverse($ipv4_address)'); + + $reverse_name = Mail::SPF::Util->ip_address_reverse($ipv6_address_v4mapped); + is($reverse_name, '1.0.168.192.in-addr.arpa.', 'Mail::SPF::Util->ip_address_reverse($ipv6_address_v4mapped)'); + + $reverse_name = Mail::SPF::Util->ip_address_reverse($ipv6_address); + is($reverse_name, '1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.b.d.0.1.0.0.2.ip6.arpa.', + 'Mail::SPF::Util->ip_address_reverse($ipv6_address)'); +} + + +#### valid_domain_for_ip_address() #### + +# TODO diff --git a/t/00.02-class-request.t b/t/00.02-class-request.t new file mode 100644 index 0000000..d3581ea --- /dev/null +++ b/t/00.02-class-request.t @@ -0,0 +1,212 @@ +use strict; +use warnings; +use blib; + +use Test::More tests => 43; + +use constant valid_mfrom_identity => ( identity => 'fred@example.com' ); +use constant valid_ip_address => ( ip_address => '192.168.0.1' ); + + +#### Class Compilation #### + +BEGIN { use_ok('Mail::SPF::Request') } + + +#### Basic Instantiation #### + +{ + my $request = eval { Mail::SPF::Request->new( + versions => [1, 2], + scope => 'mfrom', + identity => 'fred@example.com', + ip_address => '192.168.0.1', + helo_identity + => 'mta.example.com' + ) }; + + $@ eq '' and isa_ok($request, 'Mail::SPF::Request', 'Basic request object') + or BAIL_OUT("Basic request instantiation failed: $@"); + + # Have options been interpreted correctly? + is_deeply([$request->versions], [1, 2], 'Basic request versions()'); + is($request->scope, 'mfrom', 'Basic request scope()'); + is($request->authority_domain, 'example.com', 'Basic request authority_domain()'); + is($request->identity, 'fred@example.com', 'Basic request identity()'); + is($request->domain, 'example.com', 'Basic request domain()'); + is($request->localpart, 'fred', 'Basic request localpart()'); + my $ip_address = $request->ip_address; + isa_ok($ip_address, 'NetAddr::IP', 'Basic request ip_address()'); + is($ip_address, '192.168.0.1/32', 'Basic request ip_address()'); + is($ip_address->version, 4, 'Basic request ip_address() IP version'); + my $ip_address_v6 = $request->ip_address_v6; + isa_ok($ip_address_v6, 'NetAddr::IP', 'Basic request ip_address_v6()'); + is($ip_address_v6, NetAddr::IP->new('::ffff:192.168.0.1'), 'Basic request ip_address_v6()'); + is($ip_address_v6->version, 6, 'Basic request ip_address_v6() IP version'); + is($request->helo_identity, 'mta.example.com', 'Basic request helo_identity()'); + + # Request object cloning: + my $request_clone = eval { $request->new( ip_address => '192.168.0.254' ) }; + isa_ok($request_clone, 'Mail::SPF::Request', 'Clone request object'); + is($request_clone->identity, 'fred@example.com', 'Clone request inherited identity()'); + is($request_clone->ip_address, '192.168.0.254/32', 'Clone request override ip_address()'); +} + + +#### Minimally Parameterized MAIL FROM Request #### + +{ + my $request = eval { Mail::SPF::Request->new( + identity => 'fred@example.com', + ip_address => '192.168.0.1' + ) }; + + $@ eq '' and isa_ok($request, 'Mail::SPF::Request', 'Minimal MAIL FROM request object') + or BAIL_OUT("Minimal MAIL FROM request instantiation failed: $@"); + + # Have omitted options been deduced correctly? + is_deeply([$request->versions], [1, 2], 'Minimal MAIL FROM request versions()'); + is($request->scope, 'mfrom', 'Minimal MAIL FROM request scope()'); + is($request->authority_domain, 'example.com', 'Minimal MAIL FROM request authority_domain()'); + is($request->helo_identity, undef, 'Minimal MAIL FROM request helo_identity()'); +} + + +#### Minimally Parameterized HELO Request #### + +{ + my $request = eval { Mail::SPF::Request->new( + scope => 'helo', + identity => 'mta.example.com', + valid_ip_address + ) }; + + $@ eq '' and isa_ok($request, 'Mail::SPF::Request', 'Minimal HELO request object') + or BAIL_OUT("Minimal HELO request instantiation failed: $@"); + + # Have omitted options been deduced correctly? + is_deeply([$request->versions], [1], 'Minimal HELO request versions()'); + is($request->authority_domain, 'mta.example.com', 'Minimal HELO request authority_domain()'); + is($request->localpart, 'postmaster', 'Minimal HELO request default localpart()'); + is($request->helo_identity, 'mta.example.com', 'Minimal HELO request helo_identity()'); +} + + +#### Versions Validation #### + +{ + my $request; + + $request = Mail::SPF::Request->new( + versions => 1, + valid_mfrom_identity, + valid_ip_address + ); + is_deeply([$request->versions], [1], 'versions => $string supported'); + + eval { Mail::SPF::Request->new( + versions => {}, # Illegal versions option type! + valid_mfrom_identity, + valid_ip_address + ) }; + isa_ok($@, 'Mail::SPF::EInvalidOptionValue', 'versions => $non_string_or_array illegal'); + + eval { Mail::SPF::Request->new( + versions => [1, 666], # Illegal version number! + valid_mfrom_identity, + valid_ip_address + ) }; + isa_ok($@, 'Mail::SPF::EInvalidOptionValue', 'Detect illegal versions'); + + $request = Mail::SPF::Request->new( + versions => [1, 2], + scope => 'helo', + identity => 'mta.example.com', + valid_ip_address + ); + is_deeply([$request->versions], [1], 'Drop versions irrelevant for scope'); +} + + +#### Scope Validation #### + +{ + eval { Mail::SPF::Request->new( + scope => 'foo', + valid_mfrom_identity, + valid_ip_address + ) }; + isa_ok($@, 'Mail::SPF::EInvalidScope', 'Detect invalid scope'); + + eval { Mail::SPF::Request->new( + versions => 1, + scope => 'pra', + valid_mfrom_identity, + valid_ip_address + ) }; + isa_ok($@, 'Mail::SPF::EInvalidScope', 'Detect invalid scope for versions'); +} + + +#### Identity Validation #### + +{ + my $request; + + eval { Mail::SPF::Request->new( + valid_ip_address + ) }; + isa_ok($@, 'Mail::SPF::EOptionRequired', 'Detect missing identity option'); + + $request = Mail::SPF::Request->new( + scope => 'mfrom', + identity => 'mta.example.com', # Empty MAIL FROM, supply HELO domain. + valid_ip_address + ); + is($request->domain, 'mta.example.com', 'Extract domain from identity correctly'); + is($request->localpart, 'postmaster', 'Default "postmaster" localpart'); +} + + +#### IP Address Validation #### + +{ + my $request; + + eval { Mail::SPF::Request->new( + valid_mfrom_identity + ) }; + isa_ok($@, 'Mail::SPF::EOptionRequired', 'Detect missing ip_address option'); + + my $ip_address = NetAddr::IP->new('192.168.0.1'); + $request = Mail::SPF::Request->new( + valid_mfrom_identity, + ip_address => $ip_address + ); + is($request->ip_address, $ip_address, 'Accept NetAddr::IP object for ip_address'); + + $request = Mail::SPF::Request->new( + valid_mfrom_identity, + ip_address => '::ffff:192.168.0.1' + ); + is($request->ip_address, '192.168.0.1/32', 'Treat IPv4-mapped IPv6 address as IPv6 address'); +} + + +#### Custom Request State #### + +{ + my $request = Mail::SPF::Request->new( + valid_mfrom_identity, + valid_ip_address + ); + + is($request->state('uninitialized'), undef, 'Read uninitialized state field'); + + $request->state('foo', 'bar'); + is($request->state('foo'), 'bar', 'Write and read state field'); + + my $request_clone = $request->new(); # Clone request object. + $request_clone->state('foo', 'boo'); + is($request->state('foo'), 'bar', 'Original state unaffected when modifying clone state'); +} diff --git a/t/00.03-class-result.t b/t/00.03-class-result.t new file mode 100644 index 0000000..dec4ab5 --- /dev/null +++ b/t/00.03-class-result.t @@ -0,0 +1,83 @@ +use strict; +use warnings; +use blib; + +use Error ':try'; + +use Test::More tests => 20; + +use Mail::SPF::Request; + + +#### Class Compilation #### + +BEGIN { use_ok('Mail::SPF::Result') } + + +#### Basic Instantiation #### + +{ + my $result = eval { Mail::SPF::Result->new('dummy server', 'dummy request', 'result text') }; + + $@ eq '' and isa_ok($result, 'Mail::SPF::Result', 'Basic result object') + or BAIL_OUT("Basic result instantiation failed: $@"); + + # Have options been interpreted correctly? + is($result->server, 'dummy server', 'Basic result server()'); + is($result->request, 'dummy request', 'Basic result request()'); + is($result->text, 'result text', 'Basic result text()'); +} + + +#### Parameterized Result Rethrowing #### + +{ + eval { + eval { throw Mail::SPF::Result('server', 'request', 'result text') }; + $@->throw('other server', 'other request', 'other text'); + }; + my $result = $@; + + isa_ok($result, 'Mail::SPF::Result', 'Param-rethrown result object'); + is($result->server, 'other server', 'Param-rethrown result server()'); + is($result->request, 'other request', 'Param-rethrown result request()'); + is($result->text, 'other text', 'Param-rethrown result text()'); +} + + +#### class() #### + +{ + my $class; + + $class = Mail::SPF::Result->class; + is($class, 'Mail::SPF::Result', 'Result class()'); + + $class = Mail::SPF::Result->class('PaSs'); + is($class, 'Mail::SPF::Result::Pass', 'Result class($valid_name)'); + + $class = Mail::SPF::Result->class('foo'); + is($class, undef, 'Result class($invalid_name)'); +} + + +#### isa_by_name(), is_code() #### + +{ + my $result = Mail::SPF::Result::Pass->new('dummy server', 'dummy request'); + ok($result->isa_by_name('PaSs'), 'Result isa_by_name($valid_name)'); + ok((not $result->isa_by_name('foo')), 'Result isa_by_name($invalid_name)'); + ok($result->is_code('PaSs'), 'Result is_code($valid_code)'); + ok((not $result->is_code('foo')), 'Result is_code($invalid_code)'); +} + + +#### NeutralByDefault, code(), isa_by_name() #### + +{ + my $result = Mail::SPF::Result::NeutralByDefault->new('dummy server', 'dummy request'); + isa_ok($result, 'Mail::SPF::Result::Neutral', 'NeutralByDefault result object'); + is($result->code, 'neutral', 'NeutralByDefault result code()'); + ok($result->isa_by_name('neutral-by-default'), 'NeutralByDefault isa_by_name("neutral-by-default")'); + ok($result->isa_by_name('neutral'), 'NeutralByDefault isa_by_name("neutral")'); +} diff --git a/t/00.04-class-server.t b/t/00.04-class-server.t new file mode 100644 index 0000000..b2aa32a --- /dev/null +++ b/t/00.04-class-server.t @@ -0,0 +1,133 @@ +use strict; +use warnings; +use blib; + +use Error ':try'; +use Net::DNS::Resolver::Programmable; +use Net::DNS::RR; + +use Test::More tests => 23; + +my $test_resolver_empty = Net::DNS::Resolver::Programmable->new( + records => {} +); + +my $test_resolver_1 = Net::DNS::Resolver::Programmable->new( + records => { + 'example.com' => [ + Net::DNS::RR->new('example.com. A 192.168.0.1') + ] + } +); + +my $test_resolver_nxdomain = Net::DNS::Resolver::Programmable->new( + resolver_code => sub { return ('NXDOMAIN', undef) } +); + +my $test_resolver_servfail = Net::DNS::Resolver::Programmable->new( + resolver_code => sub { return ('SERVFAIL', undef) } +); + + +#### Class Compilation #### + +BEGIN { use_ok('Mail::SPF::Server') } + + +#### Basic Instantiation #### + +{ + my $server = eval { Mail::SPF::Server->new( + dns_resolver => $test_resolver_empty, + max_dns_interactive_terms => 1, + max_name_lookups_per_term => 2, + max_name_lookups_per_mx_mech => 3 + ) }; + + $@ eq '' and isa_ok($server, 'Mail::SPF::Server', 'Basic server object') + or BAIL_OUT("Basic server instantiation failed: $@"); + + # Have options been interpreted correctly? + isa_ok($server->dns_resolver, 'Net::DNS::Resolver::Programmable', 'Basic server dns_resolver()'); + is($server->max_dns_interactive_terms, 1, 'Basic server max_dns_interactive_terms()'); + is($server->max_name_lookups_per_term, 2, 'Basic server max_name_lookups_per_term()'); + is($server->max_name_lookups_per_mx_mech, 3, 'Basic server max_name_lookups_per_mx_mech()'); + is($server->max_name_lookups_per_ptr_mech, 2, 'Basic server fallback max_name_lookups_per_ptr_mech()'); +} + + +#### Minimally Parameterized Server #### + +{ + my $server = eval { Mail::SPF::Server->new() }; + + $@ eq '' and isa_ok($server, 'Mail::SPF::Server', 'Minimal server object') + or BAIL_OUT("Minimal server instantiation failed: $@"); + + # Have omitted options been defaulted correctly? + isa_ok($server->dns_resolver, 'Net::DNS::Resolver', 'Minimal server default dns_resolver()'); + is($server->max_dns_interactive_terms, 10, 'Minimal server default max_dns_interactive_terms()'); + is($server->max_name_lookups_per_term, 10, 'Minimal server default max_name_lookups_per_term()'); + is($server->max_name_lookups_per_mx_mech, 10, 'Minimal server default max_name_lookups_per_mx_mech()'); + is($server->max_name_lookups_per_ptr_mech, 10, 'Minimal server default max_name_lookups_per_ptr_mech()'); +} + + +#### dns_lookup() #### + +# No-records lookup: + +{ + my $server = Mail::SPF::Server->new( + dns_resolver => $test_resolver_empty + ); + + my $packet = $server->dns_lookup('example.com', 'A'); + isa_ok($packet, 'Net::DNS::Packet', 'Server no-records dns_lookup() packet object'); + is($packet->header->rcode, 'NOERROR', 'Server no-records dns_lookup() rcode'); + is($packet->answer, 0, 'Server no-records dns_lookup() answer RR count'); +} + +# 'A' record lookup: + +{ + my $server = Mail::SPF::Server->new( + dns_resolver => $test_resolver_1 + ); + + my $packet = $server->dns_lookup('example.com', 'A'); + isa_ok($packet, 'Net::DNS::Packet', 'Server "A" dns_lookup() packet object'); + + my @rrs = $packet->answer; + is($rrs[0]->name, 'example.com', 'Server "A" dns_lookup() answer domain name'); + is($rrs[0]->type, 'A', 'Server "A" dns_lookup() answer RR type'); +} + +# NXDOMAIN lookup: + +{ + my $server = Mail::SPF::Server->new( + dns_resolver => $test_resolver_nxdomain + ); + + my $packet = $server->dns_lookup('example.com', 'A'); + isa_ok($packet, 'Net::DNS::Packet', 'Server NXDOMAIN dns_lookup() packet object'); + is($packet->header->rcode, 'NXDOMAIN', 'Server NXDOMAIN dns_lookup() rcode'); + is($packet->answer, 0, 'Server NXDOMAIN dns_lookup() answer RR count'); +} + +# SERVFAIL lookup: + +{ + my $server = Mail::SPF::Server->new( + dns_resolver => $test_resolver_servfail + ); + + my $packet = eval { $server->dns_lookup('example.com', 'A') }; + isa_ok($@, 'Mail::SPF::EDNSError', 'Server SERVFAIL dns_lookup()'); +} + + +#### SPF Record Selection / select_record(), get_acceptable_records_from_packet() #### + +# This gets checked by the RFC 4408 test suite. diff --git a/t/00.05-class-macrostring.t b/t/00.05-class-macrostring.t new file mode 100644 index 0000000..6ce8d54 --- /dev/null +++ b/t/00.05-class-macrostring.t @@ -0,0 +1,84 @@ +use strict; +use warnings; +use blib; + +use Error ':try'; +use Net::DNS::Resolver::Programmable; +use Net::DNS::RR; + +use Mail::SPF::Server; +use Mail::SPF::Request; + +use Test::More tests => 12; + +use constant valid_macrostring_text => '%{ir}.%{v}._spf.%{d2}'; +use constant valid_macrostring_expanded + => '1.0.168.192.in-addr._spf.example.com'; + +my $test_resolver = Net::DNS::Resolver::Programmable->new( + records => {} +); + +my $server = Mail::SPF::Server->new( + dns_resolver => $test_resolver +); + +my $request = Mail::SPF::Request->new( + identity => 'foo.example.com', + ip_address => '192.168.0.1' +); + + +#### Class Compilation #### + +BEGIN { use_ok('Mail::SPF::MacroString') } + + +#### Early Context Instantiation #### + +{ + my $macrostring = eval { Mail::SPF::MacroString->new( + text => valid_macrostring_text, + server => $server, + request => $request + ) }; + + $@ eq '' and isa_ok($macrostring, 'Mail::SPF::MacroString', 'Early-context macro-string object') + or BAIL_OUT("Early-context macro-string instantiation failed: $@"); + + # Have options been interpreted correctly? + is($macrostring->text, valid_macrostring_text, 'Early-context macro-string text()'); + + # Expansion: + is($macrostring->expand, valid_macrostring_expanded, 'Early-context macro-string expand()'); + is($macrostring, valid_macrostring_expanded, 'Early-context macro-string stringify() (+overloading)'); +} + + +#### Late Context Instantiation #### + +{ + my $macrostring = eval { Mail::SPF::MacroString->new( + text => '%{ir}.%{v}._spf.%{d2}' + ) }; + + $@ eq '' and isa_ok($macrostring, 'Mail::SPF::MacroString', 'Late-context macro-string object') + or BAIL_OUT("Late-context macro-string instantiation failed: $@"); + + # Context-less stringify(): + is($macrostring, valid_macrostring_text, 'Late-context macro-string context-less stringify() (+overloading)'); + + # Context-less expand(): + eval { $macrostring->expand }; + isa_ok($@, 'Mail::SPF::EMacroExpansionCtxRequired', 'Late-context macro-string context-less expand() illegal'); + + # Expansion with on-the-fly context: + is($macrostring->expand($server, $request), + valid_macrostring_expanded, 'Late-context macro-string expand(context)'); + is($macrostring, valid_macrostring_text, 'Late-context macro-string context-less stringify() (+overloading) after expand(context)'); + + # Expansion with permanent context: + $macrostring->context($server, $request); + is($macrostring->expand, valid_macrostring_expanded, 'Late-context macro-string context-ful expand()'); + is($macrostring, valid_macrostring_expanded, 'Late-context macro-string context-ful stringify() (+overloading)'); +} diff --git a/t/00.99-class-misc.t b/t/00.99-class-misc.t new file mode 100644 index 0000000..1f76674 --- /dev/null +++ b/t/00.99-class-misc.t @@ -0,0 +1,27 @@ +use strict; +use warnings; +use blib; + +use Test::More tests => 17; + +#### Class Compilation #### + +BEGIN { + use_ok('Mail::SPF::Term'); + use_ok('Mail::SPF::Mech'); + use_ok('Mail::SPF::Mech::All'); + use_ok('Mail::SPF::Mech::IP4'); + use_ok('Mail::SPF::Mech::IP6'); + use_ok('Mail::SPF::Mech::A'); + use_ok('Mail::SPF::Mech::MX'); + use_ok('Mail::SPF::Mech::PTR'); + use_ok('Mail::SPF::Mech::Exists'); + use_ok('Mail::SPF::Mech::Include'); + use_ok('Mail::SPF::Mod'); + use_ok('Mail::SPF::Mod::Exp'); + use_ok('Mail::SPF::Mod::Redirect'); + use_ok('Mail::SPF::Record'); + use_ok('Mail::SPF::v1::Record'); + use_ok('Mail::SPF::v2::Record'); + use_ok('Mail::SPF'); +} diff --git a/t/10.00-rfc4408.t b/t/10.00-rfc4408.t new file mode 100644 index 0000000..955a780 --- /dev/null +++ b/t/10.00-rfc4408.t @@ -0,0 +1,12 @@ +use strict; +use warnings; +use blib; + +use Test::More; + +eval("use Mail::SPF::Test"); +plan(skip_all => "Mail::SPF::Test required for testing Mail::SPF's RFC compliance") if $@; + +require('t/Mail-SPF-Test-lib.pm'); + +run_spf_test_suite_file('t/rfc4408-tests.yml'); diff --git a/t/10.01-rfc4406.t b/t/10.01-rfc4406.t new file mode 100644 index 0000000..e733a99 --- /dev/null +++ b/t/10.01-rfc4406.t @@ -0,0 +1,12 @@ +use strict; +use warnings; +use blib; + +use Test::More; + +eval("use Mail::SPF::Test"); +plan(skip_all => "Mail::SPF::Test required for testing Mail::SPF's RFC compliance") if $@; + +require('t/Mail-SPF-Test-lib.pm'); + +run_spf_test_suite_file('t/rfc4406-tests.yml'); diff --git a/t/90-author-pod-validation.t b/t/90-author-pod-validation.t new file mode 100644 index 0000000..a305550 --- /dev/null +++ b/t/90-author-pod-validation.t @@ -0,0 +1,9 @@ +use strict; +use warnings; + +use Test::More; + +eval("use Test::Pod 1.00"); +plan skip_all => "Test::Pod 1.00 required for testing POD validity" if $@; + +all_pod_files_ok(); diff --git a/t/Mail-SPF-Test-lib.pm b/t/Mail-SPF-Test-lib.pm new file mode 100644 index 0000000..c37df01 --- /dev/null +++ b/t/Mail-SPF-Test-lib.pm @@ -0,0 +1,116 @@ +use Test::More; + +use Error ':try'; +use Mail::SPF; +use Net::DNS::Resolver::Programmable; + +use constant TRUE => (0 == 0); +use constant FALSE => not TRUE; + +$Error::Debug = TRUE; + +sub run_spf_test_suite_file { + my ($file_name, $test_case_overrides) = @_; + $test_case_overrides ||= {}; + + #### Load Test Suite Data and Plan Tests #### + + my $test_suite = Mail::SPF::Test->new_from_yaml_file($file_name); + + defined($test_suite) + or BAIL_OUT("Unable to load test-suite data from file '$file_name'"); + + my $total_test_cases_count = 0; + $total_test_cases_count += scalar($_->test_cases) foreach $test_suite->scenarios; + + plan(tests => $total_test_cases_count * 2); + + #### Perform Tests #### + + foreach my $scenario ($test_suite->scenarios) { + my $server = Mail::SPF::Server->new( + dns_resolver => Net::DNS::Resolver::Programmable->new( + resolver_code => sub { + my ($domain, $rr_type) = @_; + my $rcode = 'NOERROR'; + my @rrs; + push(@rrs, $scenario->records_for_domain($domain, $rr_type)); + push(@rrs, $scenario->records_for_domain($domain, 'CNAME')) + if not @rrs and $rr_type ne 'CNAME'; + if (@rrs == 0) { + $rcode = 'NXDOMAIN'; + } + elsif ($rrs[0] eq 'TIMEOUT') { + return 'query timed out'; + } + return ($rcode, undef, @rrs); + } + ), + default_authority_explanation + => 'DEFAULT', + max_void_dns_lookups => undef # Be RFC 4408 compliant during testing! + ); + + foreach my $test_case ($scenario->test_cases) { SKIP: { + my $test_base_name = sprintf("Test case '%s'", $test_case->name); + + if (defined(my $test_case_override = $test_case_overrides->{$test_case->name})) { + if ($test_case_override =~ /^SKIP(?:: (.*))/) { + skip( + "Skipping test '" . $test_case->name . "' due to override" . + (defined($1) ? " ($1)" : ""), + 2 + ); + } + } + + my $request = Mail::SPF::Request->new( + scope => $test_case->scope, + identity => $test_case->identity, + ip_address => $test_case->ip_address, + helo_identity => $test_case->helo_identity + ); + my $result; + try { + $result = $server->process($request); + } + catch Error with { + BAIL_OUT("Uncaught error: " . shift->stacktrace); + }; + + my $overall_ok = TRUE; + + # Test result code: + my $result_is_ok = $test_case->is_expected_result($result->code); + diag( + "$test_base_name result:\n" . + "Expected: " . join(' or ', map("'$_'", $test_case->expected_results)) . "\n" . + " Got: " . "'" . $result->code . "'" + ) + if not $result_is_ok; + $overall_ok &&= ok($result_is_ok, "$test_base_name result"); + + # Test explanation: + if (not $result->is_code('fail')) { + pass("$test_base_name explanation not applicable"); + } + elsif (not defined($test_case->expected_explanation)) { + pass("$test_base_name explanation not relevant"); + } + else { + $overall_ok &&= is( + lc($result->authority_explanation), + lc($test_case->expected_explanation), + "$test_base_name explanation" + ); + } + + diag("Test case description: " . $test_case->description) + if not $overall_ok and defined($test_case->description); + } } + } + + return; +} + +TRUE; diff --git a/t/rfc4406-tests.yml b/t/rfc4406-tests.yml new file mode 100644 index 0000000..39bfb4f --- /dev/null +++ b/t/rfc4406-tests.yml @@ -0,0 +1,33 @@ +# RFC 4406 test-suite (version 2006.11) +# +# (C) 2006 Julian Mehnle +# $Id: rfc4406-tests.yml 30 2006-11-27 19:55:10Z Julian Mehnle $ +# +# vim:sw=2 sts=2 +--- +description: Selecting records +tests: + v2-preferred-over-v1: + description: >- + "spf2.0" records ought to be preferred over "v=spf1" records. + spec: 4.4/6 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@v2+v1.example.com + result: fail + redundant-v2: + description: >- + Redundant "spf2.0" records must cause a PermError. + spec: 4.4/8 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@v2+v2+v1.example.com + result: permerror +zonedata: + v2+v1.example.com: + - SPF: spf2.0/mfrom -all + - SPF: v=spf1 +all + v2+v2+v1.example.com: + - SPF: spf2.0/mfrom -all + - SPF: spf2.0/mfrom,pra -all + - SPF: v=spf1 -all diff --git a/t/rfc4408-tests.yml b/t/rfc4408-tests.yml new file mode 100644 index 0000000..7f4954e --- /dev/null +++ b/t/rfc4408-tests.yml @@ -0,0 +1,2214 @@ +# This is the openspf.org test suite (release 2009.10) based on RFC 4408. +# http://www.openspf.org/Test_Suite +# +# $Id: rfc4408-tests.yml 108 2009-10-31 19:51:18Z Julian Mehnle $ +# vim:sw=2 sts=2 et +# +# See rfc4408-tests.CHANGES for a changelog. +# +# Contributors: +# Stuart D Gathman 90% of the tests +# Julian Mehnle some tests, proofread YAML syntax, formal schema +# Frank Ellermann +# Scott Kitterman +# Wayne Schlitt +# Craig Whitmore +# Norman Maurer +# Mark Shewmaker +# Philip Gladstone +# +--- +description: Initial processing +tests: + toolonglabel: + description: >- + DNS labels limited to 63 chars. + comment: >- + For initial processing, a long label results in None, not TempError + spec: 4.3/1 + helo: mail.example.net + host: 1.2.3.5 + mailfrom: lyme.eater@A123456789012345678901234567890123456789012345678901234567890123.example.com + result: none + longlabel: + description: >- + DNS labels limited to 63 chars. + spec: 4.3/1 + helo: mail.example.net + host: 1.2.3.5 + mailfrom: lyme.eater@A12345678901234567890123456789012345678901234567890123456789012.example.com + result: fail + emptylabel: + spec: 4.3/1 + helo: mail.example.net + host: 1.2.3.5 + mailfrom: lyme.eater@A...example.com + result: none + helo-not-fqdn: + spec: 4.3/1 + helo: A2345678 + host: 1.2.3.5 + mailfrom: "" + result: none + helo-domain-literal: + spec: 4.3/1 + helo: "[1.2.3.5]" + host: 1.2.3.5 + mailfrom: "" + result: none + nolocalpart: + spec: 4.3/2 + helo: mail.example.net + host: 1.2.3.4 + mailfrom: '@example.net' + result: fail + explanation: postmaster + domain-literal: + spec: 4.3/1 + helo: OEMCOMPUTER + host: 1.2.3.5 + mailfrom: "foo@[1.2.3.5]" + result: none +zonedata: + example.com: + - TIMEOUT + example.net: + - SPF: v=spf1 -all exp=exp.example.net + a.example.net: + - SPF: v=spf1 -all exp=exp.example.net + exp.example.net: + - TXT: '%{l}' + a12345678901234567890123456789012345678901234567890123456789012.example.com: + - SPF: v=spf1 -all +--- +description: Record lookup +tests: + both: + spec: 4.4/1 + helo: mail.example.net + host: 1.2.3.4 + mailfrom: foo@both.example.net + result: fail + txtonly: + description: Result is none if checking SPF records only. + spec: 4.4/1 + helo: mail.example.net + host: 1.2.3.4 + mailfrom: foo@txtonly.example.net + result: [fail, none] + spfonly: + description: Result is none if checking TXT records only. + spec: 4.4/1 + helo: mail.example.net + host: 1.2.3.4 + mailfrom: foo@spfonly.example.net + result: [fail, none] + spftimeout: + description: >- + TXT record present, but SPF lookup times out. + Result is temperror if checking SPF records only. + comment: >- + This actually happens for a popular braindead DNS server. + spec: 4.4/1 + helo: mail.example.net + host: 1.2.3.4 + mailfrom: foo@spftimeout.example.net + result: [fail, temperror] + txttimeout: + description: >- + SPF record present, but TXT lookup times out. + If only TXT records are checked, result is temperror. + spec: 4.4/1 + helo: mail.example.net + host: 1.2.3.4 + mailfrom: foo@txttimeout.example.net + result: [fail, temperror] + nospftxttimeout: + description: >- + No SPF record present, and TXT lookup times out. + If only TXT records are checked, result is temperror. + comment: >- + Because TXT records is where v=spf1 records will likely be, returning + temperror will try again later. A timeout due to a braindead server + is unlikely in the case of TXT, as opposed to the newer SPF RR. + spec: 4.4/1 + helo: mail.example.net + host: 1.2.3.4 + mailfrom: foo@nospftxttimeout.example.net + result: [temperror, none] + alltimeout: + description: Both TXT and SPF queries time out + spec: 4.4/2 + helo: mail.example.net + host: 1.2.3.4 + mailfrom: foo@alltimeout.example.net + result: temperror +zonedata: + both.example.net: + - TXT: v=spf1 -all + - SPF: v=spf1 -all + txtonly.example.net: + - TXT: v=spf1 -all + spfonly.example.net: + - SPF: v=spf1 -all + - TXT: NONE + spftimeout.example.net: + - TXT: v=spf1 -all + - TIMEOUT + txttimeout.example.net: + - SPF: v=spf1 -all + - TXT: NONE + - TIMEOUT + nospftxttimeout.example.net: + - SPF: "v=spf3 !a:yahoo.com -all" + - TXT: NONE + - TIMEOUT + alltimeout.example.net: + - TIMEOUT +--- +description: Selecting records +tests: + nospace1: + description: >- + Version must be terminated by space or end of record. TXT pieces + are joined without intervening spaces. + spec: 4.5/4 + helo: mail.example1.com + host: 1.2.3.4 + mailfrom: foo@example2.com + result: none + empty: + description: Empty SPF record. + spec: 4.5/4 + helo: mail1.example1.com + host: 1.2.3.4 + mailfrom: foo@example1.com + result: neutral + nospace2: + spec: 4.5/4 + helo: mail.example1.com + host: 1.2.3.4 + mailfrom: foo@example3.com + result: pass + spfoverride: + description: >- + SPF records override TXT records. Older implementation may + check TXT records only. + spec: 4.5/5 + helo: mail.example1.com + host: 1.2.3.4 + mailfrom: foo@example4.com + result: [pass, fail] + multitxt1: + description: >- + Older implementations will give permerror/unknown because of + the conflicting TXT records. However, RFC 4408 says the SPF + records overrides them. + spec: 4.5/5 + helo: mail.example1.com + host: 1.2.3.4 + mailfrom: foo@example5.com + result: [pass, permerror] + multitxt2: + description: >- + Multiple records is a permerror, v=spf1 is case insensitive + comment: >- + Implementations that query for only SPF-type RRs will acceptably yield + "none". + spec: 4.5/6 + helo: mail.example1.com + host: 1.2.3.4 + mailfrom: foo@example6.com + result: [permerror, none] + multispf1: + description: >- + Multiple records is a permerror, even when they are identical. + However, this situation cannot be reliably reproduced with live + DNS since cache and resolvers are allowed to combine identical + records. + spec: 4.5/6 + helo: mail.example1.com + host: 1.2.3.4 + mailfrom: foo@example7.com + result: [permerror, fail] + multispf2: + description: >- + Older implementations ignoring SPF-type records will give pass because + there is a (single) TXT record. But RFC 4408 requires permerror because + the SPF records override and there are more than one. + spec: 4.5/6 + helo: mail.example1.com + host: 1.2.3.4 + mailfrom: foo@example8.com + result: [permerror, pass] + nospf: + spec: 4.5/7 + helo: mail.example1.com + host: 1.2.3.4 + mailfrom: foo@mail.example1.com + result: none + case-insensitive: + description: >- + v=spf1 is case insensitive + spec: 4.5/6 + helo: mail.example1.com + host: 1.2.3.4 + mailfrom: foo@example9.com + result: softfail +zonedata: + example3.com: + - SPF: v=spf10 + - SPF: v=spf1 mx + - MX: [0, mail.example1.com] + example1.com: + - SPF: v=spf1 + example2.com: + - SPF: ['v=spf1', 'mx'] + mail.example1.com: + - A: 1.2.3.4 + example4.com: + - SPF: v=spf1 +all + - TXT: v=spf1 -all + example5.com: + - SPF: v=spf1 +all + - TXT: v=spf1 -all + - TXT: v=spf1 +all + example6.com: + - TXT: v=spf1 -all + - TXT: V=sPf1 +all + example7.com: + - SPF: v=spf1 -all + - SPF: v=spf1 -all + example8.com: + - SPF: V=spf1 -all + - SPF: v=spf1 -all + - TXT: v=spf1 +all + example9.com: + - SPF: v=SpF1 ~all +--- +description: Record evaluation +tests: + detect-errors-anywhere: + description: Any syntax errors anywhere in the record MUST be detected. + spec: 4.6 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@t1.example.com + result: permerror + modifier-charset-good: + description: name = ALPHA *( ALPHA / DIGIT / "-" / "_" / "." ) + spec: 4.6.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@t2.example.com + result: pass + modifier-charset-bad1: + description: >- + '=' character immediately after the name and before any ":" or "/" + spec: 4.6.1/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@t3.example.com + result: permerror + modifier-charset-bad2: + description: >- + '=' character immediately after the name and before any ":" or "/" + spec: 4.6.1/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@t4.example.com + result: permerror + redirect-after-mechanisms1: + description: >- + The "redirect" modifier has an effect after all the mechanisms. + comment: >- + The redirect in this example would violate processing limits, except + that it is never used because of the all mechanism. + spec: 4.6.3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@t5.example.com + result: softfail + redirect-after-mechanisms2: + description: >- + The "redirect" modifier has an effect after all the mechanisms. + spec: 4.6.3 + helo: mail.example.com + host: 1.2.3.5 + mailfrom: foo@t6.example.com + result: fail + default-result: + description: Default result is neutral. + spec: 4.7/1 + helo: mail.example.com + host: 1.2.3.5 + mailfrom: foo@t7.example.com + result: neutral + redirect-is-modifier: + description: |- + Invalid mechanism. Redirect is a modifier. + spec: 4.6.1/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@t8.example.com + result: permerror + invalid-domain: + description: >- + Domain-spec must end in macro-expand or valid toplabel. + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@t9.example.com + result: permerror + invalid-domain-empty-label: + description: >- + target-name that is a valid domain-spec per RFC 4408 but an invalid + domain name per RFC 1035 (empty label) must be treated as non-existent. + comment: >- + An empty domain label, i.e. two successive dots, in a mechanism + target-name is valid domain-spec syntax, even though a DNS query cannot + be composed from it. The spec being unclear about it, this could either + be considered a syntax error, or, by analogy to 4.3/1 and 5/10/3, the + mechanism chould be treated as a no-match. + spec: [4.3/1, 5/10/3] + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@t10.example.com + result: [permerror, fail] + invalid-domain-long: + description: >- + target-name that is a valid domain-spec per RFC 4408 but an invalid + domain name per RFC 1035 (long label) must be treated as non-existent. + comment: >- + A domain label longer than 63 characters in a mechanism target-name is + valid domain-spec syntax, even though a DNS query cannot be composed + from it. The spec being unclear about it, this could either be + considered a syntax error, or, by analogy to 4.3/1 and 5/10/3, the + mechanism chould be treated as a no-match. + spec: [4.3/1, 5/10/3] + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@t11.example.com + result: [permerror,fail] + invalid-domain-long-via-macro: + description: >- + target-name that is a valid domain-spec per RFC 4408 but an invalid + domain name per RFC 1035 (long label) must be treated as non-existent. + comment: >- + A domain label longer than 63 characters that results from macro + expansion in a mechanism target-name is valid domain-spec syntax (and is + not even subject to syntax checking after macro expansion), even though + a DNS query cannot be composed from it. The spec being unclear about + it, this could either be considered a syntax error, or, by analogy to + 4.3/1 and 5/10/3, the mechanism chould be treated as a no-match. + spec: [4.3/1, 5/10/3] + helo: "%%%%%%%%%%%%%%%%%%%%%%" + host: 1.2.3.4 + mailfrom: foo@t12.example.com + result: [permerror,fail] +zonedata: + mail.example.com: + - A: 1.2.3.4 + t1.example.com: + - SPF: v=spf1 ip4:1.2.3.4 -all moo + t2.example.com: + - SPF: v=spf1 moo.cow-far_out=man:dog/cat ip4:1.2.3.4 -all + t3.example.com: + - SPF: v=spf1 moo.cow/far_out=man:dog/cat ip4:1.2.3.4 -all + t4.example.com: + - SPF: v=spf1 moo.cow:far_out=man:dog/cat ip4:1.2.3.4 -all + t5.example.com: + - SPF: v=spf1 redirect=t5.example.com ~all + t6.example.com: + - SPF: v=spf1 ip4:1.2.3.4 redirect=t2.example.com + t7.example.com: + - SPF: v=spf1 ip4:1.2.3.4 + t8.example.com: + - SPF: v=spf1 ip4:1.2.3.4 redirect:t2.example.com + t9.example.com: + - SPF: v=spf1 a:foo-bar -all + t10.example.com: + - SPF: v=spf1 a:mail.example...com -all + t11.example.com: + - SPF: v=spf1 a:a123456789012345678901234567890123456789012345678901234567890123.example.com -all + t12.example.com: + - SPF: v=spf1 a:%{H}.bar -all +--- +description: ALL mechanism syntax +tests: + all-dot: + description: | + all = "all" + comment: |- + At least one implementation got this wrong + spec: 5.1/1 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e1.example.com + result: permerror + all-arg: + description: | + all = "all" + comment: |- + At least one implementation got this wrong + spec: 5.1/1 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e2.example.com + result: permerror + all-cidr: + description: | + all = "all" + spec: 5.1/1 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e3.example.com + result: permerror + all-neutral: + description: | + all = "all" + spec: 5.1/1 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e4.example.com + result: neutral + all-double: + description: | + all = "all" + spec: 5.1/1 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e5.example.com + result: pass +zonedata: + mail.example.com: + - A: 1.2.3.4 + e1.example.com: + - SPF: v=spf1 -all. + e2.example.com: + - SPF: v=spf1 -all:foobar + e3.example.com: + - SPF: v=spf1 -all/8 + e4.example.com: + - SPF: v=spf1 ?all + e5.example.com: + - SPF: v=spf1 all -all +--- +description: PTR mechanism syntax +tests: + ptr-cidr: + description: |- + PTR = "ptr" [ ":" domain-spec ] + spec: 5.5/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e1.example.com + result: permerror + ptr-match-target: + description: >- + Check all validated domain names to see if they end in the + domain. + spec: 5.5/5 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e2.example.com + result: pass + ptr-match-implicit: + description: >- + Check all validated domain names to see if they end in the + domain. + spec: 5.5/5 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e3.example.com + result: pass + ptr-nomatch-invalid: + description: >- + Check all validated domain names to see if they end in the + domain. + comment: >- + This PTR record does not validate + spec: 5.5/5 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e4.example.com + result: fail + ptr-match-ip6: + description: >- + Check all validated domain names to see if they end in the + domain. + spec: 5.5/5 + helo: mail.example.com + host: CAFE:BABE::1 + mailfrom: foo@e3.example.com + result: pass + ptr-empty-domain: + description: >- + domain-spec cannot be empty. + spec: 5.5/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e5.example.com + result: permerror +zonedata: + mail.example.com: + - A: 1.2.3.4 + e1.example.com: + - SPF: v=spf1 ptr/0 -all + e2.example.com: + - SPF: v=spf1 ptr:example.com -all + 4.3.2.1.in-addr.arpa: + - PTR: e3.example.com + - PTR: e4.example.com + - PTR: mail.example.com + 1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.E.B.A.B.E.F.A.C.ip6.arpa: + - PTR: e3.example.com + e3.example.com: + - SPF: v=spf1 ptr -all + - A: 1.2.3.4 + - AAAA: CAFE:BABE::1 + e4.example.com: + - SPF: v=spf1 ptr -all + e5.example.com: + - SPF: "v=spf1 ptr:" +--- +description: A mechanism syntax +tests: + a-cidr6: + description: | + A = "a" [ ":" domain-spec ] [ dual-cidr-length ] + dual-cidr-length = [ ip4-cidr-length ] [ "/" ip6-cidr-length ] + spec: 5.3/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e6.example.com + result: fail + a-bad-cidr4: + description: | + A = "a" [ ":" domain-spec ] [ dual-cidr-length ] + dual-cidr-length = [ ip4-cidr-length ] [ "/" ip6-cidr-length ] + spec: 5.3/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e6a.example.com + result: permerror + a-bad-cidr6: + description: | + A = "a" [ ":" domain-spec ] [ dual-cidr-length ] + dual-cidr-length = [ ip4-cidr-length ] [ "/" ip6-cidr-length ] + spec: 5.3/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e7.example.com + result: permerror + a-multi-ip1: + description: >- + A matches any returned IP. + spec: 5.3/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e10.example.com + result: pass + a-multi-ip2: + description: >- + A matches any returned IP. + spec: 5.3/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e10.example.com + result: pass + a-bad-domain: + description: >- + domain-spec must pass basic syntax checks; + a ':' may appear in domain-spec, but not in top-label + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e9.example.com + result: permerror + a-nxdomain: + description: >- + If no ips are returned, A mechanism does not match, even with /0. + spec: 5.3/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e1.example.com + result: fail + a-cidr4-0: + description: >- + Matches if any A records are present in DNS. + spec: 5.3/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e2.example.com + result: pass + a-cidr4-0-ip6: + description: >- + Matches if any A records are present in DNS. + spec: 5.3/3 + helo: mail.example.com + host: 1234::1 + mailfrom: foo@e2.example.com + result: fail + a-cidr6-0-ip4: + description: >- + Would match if any AAAA records are present in DNS, + but not for an IP4 connection. + spec: 5.3/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e2a.example.com + result: fail + a-cidr6-0-ip4mapped: + description: >- + Would match if any AAAA records are present in DNS, + but not for an IP4 connection. + spec: 5.3/3 + helo: mail.example.com + host: ::FFFF:1.2.3.4 + mailfrom: foo@e2a.example.com + result: fail + a-cidr6-0-ip6: + description: >- + Matches if any AAAA records are present in DNS. + spec: 5.3/3 + helo: mail.example.com + host: 1234::1 + mailfrom: foo@e2a.example.com + result: pass + a-cidr6-0-nxdomain: + description: >- + No match if no AAAA records are present in DNS. + spec: 5.3/3 + helo: mail.example.com + host: 1234::1 + mailfrom: foo@e2b.example.com + result: fail + a-null: + description: >- + Null octets not allowed in toplabel + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.5 + mailfrom: foo@e3.example.com + result: permerror + a-numeric: + description: >- + toplabel may not be all numeric + comment: >- + A common publishing mistake is using ip4 addresses with A mechanism. + This should receive special diagnostic attention in the permerror. + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e4.example.com + result: permerror + a-numeric-toplabel: + description: >- + toplabel may not be all numeric + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e5.example.com + result: permerror + a-dash-in-toplabel: + description: >- + toplabel may contain dashes + comment: >- + Going from the "toplabel" grammar definition, an implementation using + regular expressions in incrementally parsing SPF records might + erroneously try to match a TLD such as ".xn--zckzah" (cf. IDN TLDs!) to + '( *alphanum ALPHA *alphanum )' first before trying the alternative + '( 1*alphanum "-" *( alphanum / "-" ) alphanum )', essentially causing + a non-greedy, and thus, incomplete match. Make sure a greedy match is + performed! + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e14.example.com + result: pass + a-bad-toplabel: + description: >- + toplabel may not begin with a dash + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e12.example.com + result: permerror + a-only-toplabel: + description: >- + domain-spec may not consist of only a toplabel. + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e5a.example.com + result: permerror + a-only-toplabel-trailing-dot: + description: >- + domain-spec may not consist of only a toplabel. + comment: >- + "A trailing dot doesn't help." + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e5b.example.com + result: permerror + a-colon-domain: + description: >- + domain-spec may contain any visible char except % + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e11.example.com + result: pass + a-colon-domain-ip4mapped: + description: >- + domain-spec may contain any visible char except % + spec: 8.1/2 + helo: mail.example.com + host: ::FFFF:1.2.3.4 + mailfrom: foo@e11.example.com + result: pass + a-empty-domain: + description: >- + domain-spec cannot be empty. + spec: 5.3/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e13.example.com + result: permerror +zonedata: + mail.example.com: + - A: 1.2.3.4 + e1.example.com: + - SPF: v=spf1 a/0 -all + e2.example.com: + - A: 1.1.1.1 + - AAAA: 1234::2 + - SPF: v=spf1 a/0 -all + e2a.example.com: + - AAAA: 1234::1 + - SPF: v=spf1 a//0 -all + e2b.example.com: + - A: 1.1.1.1 + - SPF: v=spf1 a//0 -all + e3.example.com: + - SPF: "v=spf1 a:foo.example.com\0" + e4.example.com: + - SPF: v=spf1 a:111.222.33.44 + e5.example.com: + - SPF: v=spf1 a:abc.123 + e5a.example.com: + - SPF: v=spf1 a:museum + e5b.example.com: + - SPF: v=spf1 a:museum. + e6.example.com: + - SPF: v=spf1 a//33 -all + e6a.example.com: + - SPF: v=spf1 a/33 -all + e7.example.com: + - SPF: v=spf1 a//129 -all + e9.example.com: + - SPF: v=spf1 a:example.com:8080 + e10.example.com: + - SPF: v=spf1 a:foo.example.com/24 + foo.example.com: + - A: 1.1.1.1 + - A: 1.2.3.5 + e11.example.com: + - SPF: v=spf1 a:foo:bar/baz.example.com + foo:bar/baz.example.com: + - A: 1.2.3.4 + e12.example.com: + - SPF: v=spf1 a:example.-com + e13.example.com: + - SPF: "v=spf1 a:" + e14.example.com: + - SPF: "v=spf1 a:foo.example.xn--zckzah -all" + foo.example.xn--zckzah: + - A: 1.2.3.4 +--- +description: Include mechanism semantics and syntax +tests: + include-fail: + description: >- + recursive check_host() result of fail causes include to not match. + spec: 5.2/9 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e1.example.com + result: softfail + include-softfail: + description: >- + recursive check_host() result of softfail causes include to not match. + spec: 5.2/9 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e2.example.com + result: pass + include-neutral: + description: >- + recursive check_host() result of neutral causes include to not match. + spec: 5.2/9 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e3.example.com + result: fail + include-temperror: + description: >- + recursive check_host() result of temperror causes include to temperror + spec: 5.2/9 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e4.example.com + result: temperror + include-permerror: + description: >- + recursive check_host() result of permerror causes include to permerror + spec: 5.2/9 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e5.example.com + result: permerror + include-syntax-error: + description: >- + include = "include" ":" domain-spec + spec: 5.2/1 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e6.example.com + result: permerror + include-cidr: + description: >- + include = "include" ":" domain-spec + spec: 5.2/1 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e9.example.com + result: permerror + include-none: + description: >- + recursive check_host() result of none causes include to permerror + spec: 5.2/9 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e7.example.com + result: permerror + include-empty-domain: + description: >- + domain-spec cannot be empty. + spec: 5.2/1 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e8.example.com + result: permerror +zonedata: + mail.example.com: + - A: 1.2.3.4 + ip5.example.com: + - SPF: v=spf1 ip4:1.2.3.5 -all + ip6.example.com: + - SPF: v=spf1 ip4:1.2.3.6 ~all + ip7.example.com: + - SPF: v=spf1 ip4:1.2.3.7 ?all + ip8.example.com: + - TIMEOUT + erehwon.example.com: + - TXT: v=spfl am not an SPF record + e1.example.com: + - SPF: v=spf1 include:ip5.example.com ~all + e2.example.com: + - SPF: v=spf1 include:ip6.example.com all + e3.example.com: + - SPF: v=spf1 include:ip7.example.com -all + e4.example.com: + - SPF: v=spf1 include:ip8.example.com -all + e5.example.com: + - SPF: v=spf1 include:e6.example.com -all + e6.example.com: + - SPF: v=spf1 include +all + e7.example.com: + - SPF: v=spf1 include:erehwon.example.com -all + e8.example.com: + - SPF: "v=spf1 include: -all" + e9.example.com: + - SPF: "v=spf1 include:ip5.example.com/24 -all" +--- +description: MX mechanism syntax +tests: + mx-cidr6: + description: | + MX = "mx" [ ":" domain-spec ] [ dual-cidr-length ] + dual-cidr-length = [ ip4-cidr-length ] [ "/" ip6-cidr-length ] + spec: 5.4/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e6.example.com + result: fail + mx-bad-cidr4: + description: | + MX = "mx" [ ":" domain-spec ] [ dual-cidr-length ] + dual-cidr-length = [ ip4-cidr-length ] [ "/" ip6-cidr-length ] + spec: 5.4/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e6a.example.com + result: permerror + mx-bad-cidr6: + description: | + MX = "mx" [ ":" domain-spec ] [ dual-cidr-length ] + dual-cidr-length = [ ip4-cidr-length ] [ "/" ip6-cidr-length ] + spec: 5.4/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e7.example.com + result: permerror + mx-multi-ip1: + description: >- + MX matches any returned IP. + spec: 5.4/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e10.example.com + result: pass + mx-multi-ip2: + description: >- + MX matches any returned IP. + spec: 5.4/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e10.example.com + result: pass + mx-bad-domain: + description: >- + domain-spec must pass basic syntax checks + comment: >- + A ':' may appear in domain-spec, but not in top-label. + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e9.example.com + result: permerror + mx-nxdomain: + description: >- + If no ips are returned, MX mechanism does not match, even with /0. + spec: 5.4/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e1.example.com + result: fail + mx-cidr4-0: + description: >- + Matches if any A records for any MX records are present in DNS. + spec: 5.4/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e2.example.com + result: pass + mx-cidr4-0-ip6: + description: >- + Matches if any A records for any MX records are present in DNS. + spec: 5.4/3 + helo: mail.example.com + host: 1234::1 + mailfrom: foo@e2.example.com + result: fail + mx-cidr6-0-ip4: + description: >- + Would match if any AAAA records for MX records are present in DNS, + but not for an IP4 connection. + spec: 5.4/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e2a.example.com + result: fail + mx-cidr6-0-ip4mapped: + description: >- + Would match if any AAAA records for MX records are present in DNS, + but not for an IP4 connection. + spec: 5.4/3 + helo: mail.example.com + host: ::FFFF:1.2.3.4 + mailfrom: foo@e2a.example.com + result: fail + mx-cidr6-0-ip6: + description: >- + Matches if any AAAA records for any MX records are present in DNS. + spec: 5.3/3 + helo: mail.example.com + host: 1234::1 + mailfrom: foo@e2a.example.com + result: pass + mx-cidr6-0-nxdomain: + description: >- + No match if no AAAA records for any MX records are present in DNS. + spec: 5.4/3 + helo: mail.example.com + host: 1234::1 + mailfrom: foo@e2b.example.com + result: fail + mx-null: + description: >- + Null not allowed in top-label. + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.5 + mailfrom: foo@e3.example.com + result: permerror + mx-numeric-top-label: + description: >- + Top-label may not be all numeric + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e5.example.com + result: permerror + mx-colon-domain: + description: >- + Domain-spec may contain any visible char except % + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e11.example.com + result: pass + mx-colon-domain-ip4mapped: + description: >- + Domain-spec may contain any visible char except % + spec: 8.1/2 + helo: mail.example.com + host: ::FFFF:1.2.3.4 + mailfrom: foo@e11.example.com + result: pass + mx-bad-toplab: + description: >- + Toplabel may not begin with - + spec: 8.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e12.example.com + result: permerror + mx-empty: + description: >- + test null MX + comment: >- + Some implementations have had trouble with null MX + spec: 5.4/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: "" + result: neutral + mx-implicit: + description: >- + If the target name has no MX records, check_host() MUST NOT pretend the + target is its single MX, and MUST NOT default to an A lookup on the + target-name directly. + spec: 5.4/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e4.example.com + result: neutral + mx-empty-domain: + description: >- + domain-spec cannot be empty. + spec: 5.2/1 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e13.example.com + result: permerror +zonedata: + mail.example.com: + - A: 1.2.3.4 + - MX: [0, ""] + - SPF: v=spf1 mx + e1.example.com: + - SPF: v=spf1 mx/0 -all + - MX: [0, e1.example.com] + e2.example.com: + - A: 1.1.1.1 + - AAAA: 1234::2 + - MX: [0, e2.example.com] + - SPF: v=spf1 mx/0 -all + e2a.example.com: + - AAAA: 1234::1 + - MX: [0, e2a.example.com] + - SPF: v=spf1 mx//0 -all + e2b.example.com: + - A: 1.1.1.1 + - MX: [0, e2b.example.com] + - SPF: v=spf1 mx//0 -all + e3.example.com: + - SPF: "v=spf1 mx:foo.example.com\0" + e4.example.com: + - SPF: v=spf1 mx + - A: 1.2.3.4 + e5.example.com: + - SPF: v=spf1 mx:abc.123 + e6.example.com: + - SPF: v=spf1 mx//33 -all + e6a.example.com: + - SPF: v=spf1 mx/33 -all + e7.example.com: + - SPF: v=spf1 mx//129 -all + e9.example.com: + - SPF: v=spf1 mx:example.com:8080 + e10.example.com: + - SPF: v=spf1 mx:foo.example.com/24 + foo.example.com: + - MX: [0, foo1.example.com] + foo1.example.com: + - A: 1.1.1.1 + - A: 1.2.3.5 + e11.example.com: + - SPF: v=spf1 mx:foo:bar/baz.example.com + foo:bar/baz.example.com: + - MX: [0, "foo:bar/baz.example.com"] + - A: 1.2.3.4 + e12.example.com: + - SPF: v=spf1 mx:example.-com + e13.example.com: + - SPF: "v=spf1 mx: -all" +--- +description: EXISTS mechanism syntax +tests: + exists-empty-domain: + description: >- + domain-spec cannot be empty. + spec: 5.7/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e1.example.com + result: permerror + exists-implicit: + description: >- + exists = "exists" ":" domain-spec + spec: 5.7/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e2.example.com + result: permerror + exists-cidr: + description: >- + exists = "exists" ":" domain-spec + spec: 5.7/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e3.example.com + result: permerror +zonedata: + mail.example.com: + - A: 1.2.3.4 + e1.example.com: + - SPF: "v=spf1 exists:" + e2.example.com: + - SPF: "v=spf1 exists" + e3.example.com: + - SPF: "v=spf1 exists:mail.example.com/24" +--- +description: IP4 mechanism syntax +tests: + cidr4-0: + description: >- + ip4-cidr-length = "/" 1*DIGIT + spec: 5.6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e1.example.com + result: pass + cidr4-32: + description: >- + ip4-cidr-length = "/" 1*DIGIT + spec: 5.6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e2.example.com + result: pass + cidr4-33: + description: >- + Invalid CIDR should get permerror. + comment: >- + The RFC is silent on ip4 CIDR > 32 or ip6 CIDR > 128. However, + since there is no reasonable interpretation (except a noop), we have + read between the lines to see a prohibition on invalid CIDR. + spec: 5.6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e3.example.com + result: permerror + cidr4-032: + description: >- + Invalid CIDR should get permerror. + comment: >- + Leading zeros are not explicitly prohibited by the RFC. However, + since the RFC explicity prohibits leading zeros in ip4-network, + our interpretation is that CIDR should be also. + spec: 5.6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e4.example.com + result: permerror + bare-ip4: + description: >- + IP4 = "ip4" ":" ip4-network [ ip4-cidr-length ] + spec: 5.6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e5.example.com + result: permerror + bad-ip4-port: + description: >- + IP4 = "ip4" ":" ip4-network [ ip4-cidr-length ] + comment: >- + This has actually been published in SPF records. + spec: 5.6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e8.example.com + result: permerror + bad-ip4-short: + description: >- + It is not permitted to omit parts of the IP address instead of + using CIDR notations. + spec: 5.6/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e9.example.com + result: permerror + ip4-dual-cidr: + description: >- + dual-cidr-length not permitted on ip4 + spec: 5.6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e6.example.com + result: permerror + ip4-mapped-ip6: + description: >- + IP4 mapped IP6 connections MUST be treated as IP4 + spec: 5/9/2 + helo: mail.example.com + host: ::FFFF:1.2.3.4 + mailfrom: foo@e7.example.com + result: fail +zonedata: + mail.example.com: + - A: 1.2.3.4 + e1.example.com: + - SPF: v=spf1 ip4:1.1.1.1/0 -all + e2.example.com: + - SPF: v=spf1 ip4:1.2.3.4/32 -all + e3.example.com: + - SPF: v=spf1 ip4:1.2.3.4/33 -all + e4.example.com: + - SPF: v=spf1 ip4:1.2.3.4/032 -all + e5.example.com: + - SPF: v=spf1 ip4 + e6.example.com: + - SPF: v=spf1 ip4:1.2.3.4//32 + e7.example.com: + - SPF: v=spf1 -ip4:1.2.3.4 ip6:::FFFF:1.2.3.4 + e8.example.com: + - SPF: v=spf1 ip4:1.2.3.4:8080 + e9.example.com: + - SPF: v=spf1 ip4:1.2.3 +--- +description: IP6 mechanism syntax +comment: >- + IP4 only implementations may skip tests where host is not IP4 +tests: + bare-ip6: + description: >- + IP6 = "ip6" ":" ip6-network [ ip6-cidr-length ] + spec: 5.6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e1.example.com + result: permerror + cidr6-0-ip4: + description: >- + IP4 connections do not match ip6. + comment: >- + There is controversy over ip4 mapped connections. RFC4408 clearly + requires such connections to be considered as ip4. However, + some interpret the RFC to mean that such connections should *also* + match appropriate ip6 mechanisms (but not, inexplicably, A or MX + mechanisms). Until there is consensus, both + results are acceptable. + spec: 5/9/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e2.example.com + result: [neutral, pass] + cidr6-ip4: + description: >- + Even if the SMTP connection is via IPv6, an IPv4-mapped IPv6 IP address + (see RFC 3513, Section 2.5.5) MUST still be considered an IPv4 address. + comment: >- + There is controversy over ip4 mapped connections. RFC4408 clearly + requires such connections to be considered as ip4. However, + some interpret the RFC to mean that such connections should *also* + match appropriate ip6 mechanisms (but not, inexplicably, A or MX + mechanisms). Until there is consensus, both + results are acceptable. + spec: 5/9/2 + helo: mail.example.com + host: ::FFFF:1.2.3.4 + mailfrom: foo@e2.example.com + result: [neutral, pass] + cidr6-0: + description: >- + Match any IP6 + spec: 5/8 + helo: mail.example.com + host: DEAF:BABE::CAB:FEE + mailfrom: foo@e2.example.com + result: pass + cidr6-129: + description: >- + Invalid CIDR + comment: >- + IP4 only implementations MUST fully syntax check all mechanisms, + even if they otherwise ignore them. + spec: 5.6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e3.example.com + result: permerror + cidr6-bad: + description: >- + dual-cidr syntax not used for ip6 + comment: >- + IP4 only implementations MUST fully syntax check all mechanisms, + even if they otherwise ignore them. + spec: 5.6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e4.example.com + result: permerror + cidr6-33: + description: >- + make sure ip4 cidr restriction are not used for ip6 + spec: 5.6/2 + helo: mail.example.com + host: "CAFE:BABE:8000::" + mailfrom: foo@e5.example.com + result: pass + cidr6-33-ip4: + description: >- + make sure ip4 cidr restriction are not used for ip6 + spec: 5.6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e5.example.com + result: neutral + ip6-bad1: + description: >- + spec: 5.6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e6.example.com + result: permerror +zonedata: + mail.example.com: + - A: 1.2.3.4 + e1.example.com: + - SPF: v=spf1 -all ip6 + e2.example.com: + - SPF: v=spf1 ip6:::1.1.1.1/0 + e3.example.com: + - SPF: v=spf1 ip6:::1.1.1.1/129 + e4.example.com: + - SPF: v=spf1 ip6:::1.1.1.1//33 + e5.example.com: + - SPF: v=spf1 ip6:CAFE:BABE:8000::/33 + e6.example.com: + - SPF: v=spf1 ip6::CAFE::BABE +--- +description: Semantics of exp and other modifiers +comment: >- + Implementing exp= is optional. If not implemented, the test driver should + not check the explanation field. +tests: + redirect-none: + description: >- + If no SPF record is found, or if the target-name is malformed, the result + is a "PermError" rather than "None". + spec: 6.1/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e10.example.com + result: permerror + redirect-cancels-exp: + description: >- + when executing "redirect", exp= from the original domain MUST NOT be used. + spec: 6.2/13 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e1.example.com + result: fail + explanation: DEFAULT + redirect-syntax-error: + description: | + redirect = "redirect" "=" domain-spec + comment: >- + A literal application of the grammar causes modifier syntax + errors (except for macro syntax) to become unknown-modifier. + + modifier = explanation | redirect | unknown-modifier + + However, it is generally agreed, with precedent in other RFCs, + that unknown-modifier should not be "greedy", and should not + match known modifier names. There should have been explicit + prose to this effect, and some has been proposed as an erratum. + spec: 6.1/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e17.example.com + result: permerror + include-ignores-exp: + description: >- + when executing "include", exp= from the target domain MUST NOT be used. + spec: 6.2/13 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e7.example.com + result: fail + explanation: Correct! + redirect-cancels-prior-exp: + description: >- + when executing "redirect", exp= from the original domain MUST NOT be used. + spec: 6.2/13 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e3.example.com + result: fail + explanation: See me. + invalid-modifier: + description: | + unknown-modifier = name "=" macro-string + name = ALPHA *( ALPHA / DIGIT / "-" / "_" / "." ) + comment: >- + Unknown modifier name must begin with alpha. + spec: A/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e5.example.com + result: permerror + empty-modifier-name: + description: | + name = ALPHA *( ALPHA / DIGIT / "-" / "_" / "." ) + comment: >- + Unknown modifier name must not be empty. + spec: A/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e6.example.com + result: permerror + dorky-sentinel: + description: >- + An implementation that uses a legal expansion as a sentinel. We + cannot check them all, but we can check this one. + comment: >- + Spaces are allowed in local-part. + spec: 8.1/6 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: "Macro Error@e8.example.com" + result: fail + explanation: Macro Error in implementation + exp-multiple-txt: + description: | + Ignore exp if multiple TXT records. + comment: >- + If domain-spec is empty, or there are any DNS processing errors (any + RCODE other than 0), or if no records are returned, or if more than one + record is returned, or if there are syntax errors in the explanation + string, then proceed as if no exp modifier was given. + spec: 6.2/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e11.example.com + result: fail + explanation: DEFAULT + exp-no-txt: + description: | + Ignore exp if no TXT records. + comment: >- + If domain-spec is empty, or there are any DNS processing errors (any + RCODE other than 0), or if no records are returned, or if more than one + record is returned, or if there are syntax errors in the explanation + string, then proceed as if no exp modifier was given. + spec: 6.2/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e22.example.com + result: fail + explanation: DEFAULT + exp-dns-error: + description: | + Ignore exp if DNS error. + comment: >- + If domain-spec is empty, or there are any DNS processing errors (any + RCODE other than 0), or if no records are returned, or if more than one + record is returned, or if there are syntax errors in the explanation + string, then proceed as if no exp modifier was given. + spec: 6.2/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e21.example.com + result: fail + explanation: DEFAULT + exp-empty-domain: + description: | + PermError if exp= domain-spec is empty. + comment: >- + Section 6.2/4 says, "If domain-spec is empty, or there are any DNS + processing errors (any RCODE other than 0), or if no records are + returned, or if more than one record is returned, or if there are syntax + errors in the explanation string, then proceed as if no exp modifier was + given." However, "if domain-spec is empty" conflicts with the grammar + given for the exp modifier. This was reported as an erratum, and the + solution chosen was to report explicit "exp=" as PermError, but ignore + problems due to macro expansion, DNS, or invalid explanation string. + spec: 6.2/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e12.example.com + result: permerror + explanation-syntax-error: + description: | + Ignore exp if the explanation string has a syntax error. + comment: >- + If domain-spec is empty, or there are any DNS processing errors (any + RCODE other than 0), or if no records are returned, or if more than one + record is returned, or if there are syntax errors in the explanation + string, then proceed as if no exp modifier was given. + spec: 6.2/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e13.example.com + result: fail + explanation: DEFAULT + exp-syntax-error: + description: | + explanation = "exp" "=" domain-spec + comment: >- + A literal application of the grammar causes modifier syntax + errors (except for macro syntax) to become unknown-modifier. + + modifier = explanation | redirect | unknown-modifier + + However, it is generally agreed, with precedent in other RFCs, + that unknown-modifier should not be "greedy", and should not + match known modifier names. There should have been explicit + prose to this effect, and some has been proposed as an erratum. + spec: 6.2/1 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e16.example.com + result: permerror + exp-twice: + description: | + exp= appears twice. + comment: >- + These two modifiers (exp,redirect) MUST NOT appear in a record more than + once each. If they do, then check_host() exits with a result of + "PermError". + spec: 6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e14.example.com + result: permerror + redirect-empty-domain: + description: | + redirect = "redirect" "=" domain-spec + comment: >- + Unlike for exp, there is no instruction to override the permerror + for an empty domain-spec (which is invalid syntax). + spec: 6.2/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e18.example.com + result: permerror + redirect-twice: + description: | + redirect= appears twice. + comment: >- + These two modifiers (exp,redirect) MUST NOT appear in a record more than + once each. If they do, then check_host() exits with a result of + "PermError". + spec: 6/2 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e15.example.com + result: permerror + unknown-modifier-syntax: + description: | + unknown-modifier = name "=" macro-string + comment: >- + Unknown modifiers must have valid macro syntax. + spec: A/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e9.example.com + result: permerror + default-modifier-obsolete: + description: | + Unknown modifiers do not modify the RFC SPF result. + comment: >- + Some implementations may have a leftover default= modifier from + earlier drafts. + spec: 6/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e19.example.com + result: neutral + default-modifier-obsolete2: + description: | + Unknown modifiers do not modify the RFC SPF result. + comment: >- + Some implementations may have a leftover default= modifier from + earlier drafts. + spec: 6/3 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e20.example.com + result: neutral +zonedata: + mail.example.com: + - A: 1.2.3.4 + e1.example.com: + - SPF: v=spf1 exp=exp1.example.com redirect=e2.example.com + e2.example.com: + - SPF: v=spf1 -all + e3.example.com: + - SPF: v=spf1 exp=exp1.example.com redirect=e4.example.com + e4.example.com: + - SPF: v=spf1 -all exp=exp2.example.com + exp1.example.com: + - TXT: No-see-um + exp2.example.com: + - TXT: See me. + exp3.example.com: + - TXT: Correct! + exp4.example.com: + - TXT: "%{l} in implementation" + e5.example.com: + - SPF: v=spf1 1up=foo + e6.example.com: + - SPF: v=spf1 =all + e7.example.com: + - SPF: v=spf1 include:e3.example.com -all exp=exp3.example.com + e8.example.com: + - SPF: v=spf1 -all exp=exp4.example.com + e9.example.com: + - SPF: v=spf1 -all foo=%abc + e10.example.com: + - SPF: v=spf1 redirect=erehwon.example.com + e11.example.com: + - SPF: v=spf1 -all exp=e11msg.example.com + e11msg.example.com: + - TXT: Answer a fool according to his folly. + - TXT: Do not answer a fool according to his folly. + e12.example.com: + - SPF: v=spf1 exp= -all + e13.example.com: + - SPF: v=spf1 exp=e13msg.example.com -all + e13msg.example.com: + - TXT: The %{x}-files. + e14.example.com: + - SPF: v=spf1 exp=e13msg.example.com -all exp=e11msg.example.com + e15.example.com: + - SPF: v=spf1 redirect=e12.example.com -all redirect=e12.example.com + e16.example.com: + - SPF: v=spf1 exp=-all + e17.example.com: + - SPF: v=spf1 redirect=-all ?all + e18.example.com: + - SPF: v=spf1 ?all redirect= + e19.example.com: + - SPF: v=spf1 default=pass + e20.example.com: + - SPF: "v=spf1 default=+" + e21.example.com: + - SPF: v=spf1 exp=e21msg.example.com -all + e21msg.example.com: + - TIMEOUT + e22.example.com: + - SPF: v=spf1 exp=mail.example.com -all +--- +description: Macro expansion rules +tests: + trailing-dot-domain: + spec: 8.1/16 + description: >- + trailing dot is ignored for domains + helo: msgbas2x.cos.example.com + host: 192.168.218.40 + mailfrom: test@example.com + result: pass + trailing-dot-exp: + spec: 8.1 + description: >- + trailing dot is not removed from explanation + comment: >- + A simple way for an implementation to ignore trailing dots on + domains is to remove it when present. But be careful not to + remove it for explanation text. + helo: msgbas2x.cos.example.com + host: 192.168.218.40 + mailfrom: test@exp.example.com + result: fail + explanation: This is a test. + exp-only-macro-char: + spec: 8.1/8 + description: >- + The following macro letters are allowed only in "exp" text: c, r, t + helo: msgbas2x.cos.example.com + host: 192.168.218.40 + mailfrom: test@e2.example.com + result: permerror + invalid-macro-char: + spec: 8.1/9 + description: >- + A '%' character not followed by a '{', '%', '-', or '_' character + is a syntax error. + helo: msgbas2x.cos.example.com + host: 192.168.218.40 + mailfrom: test@e1.example.com + result: permerror + macro-mania-in-domain: + description: >- + macro-encoded percents (%%), spaces (%_), and URL-percent-encoded + spaces (%-) + spec: 8.1/3, 8.1/4 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: test@e1a.example.com + result: pass + exp-txt-macro-char: + spec: 8.1/20 + description: >- + For IPv4 addresses, both the "i" and "c" macros expand + to the standard dotted-quad format. + helo: msgbas2x.cos.example.com + host: 192.168.218.40 + mailfrom: test@e3.example.com + result: fail + explanation: Connections from 192.168.218.40 not authorized. + domain-name-truncation: + spec: 8.1/25 + description: >- + When the result of macro expansion is used in a domain name query, if the + expanded domain name exceeds 253 characters, the left side is truncated + to fit, by removing successive domain labels until the total length does + not exceed 253 characters. + helo: msgbas2x.cos.example.com + host: 192.168.218.40 + mailfrom: test@somewhat.long.exp.example.com + result: fail + explanation: Congratulations! That was tricky. + v-macro-ip4: + spec: 8.1/6 + description: |- + v = the string "in-addr" if is ipv4, or "ip6" if is ipv6 + helo: msgbas2x.cos.example.com + host: 192.168.218.40 + mailfrom: test@e4.example.com + result: fail + explanation: 192.168.218.40 is queried as 40.218.168.192.in-addr.arpa + v-macro-ip6: + spec: 8.1/6 + description: |- + v = the string "in-addr" if is ipv4, or "ip6" if is ipv6 + helo: msgbas2x.cos.example.com + host: CAFE:BABE::1 + mailfrom: test@e4.example.com + result: fail + explanation: cafe:babe::1 is queried as 1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.E.B.A.B.E.F.A.C.ip6.arpa + undef-macro: + spec: 8.1/6 + description: >- + Allowed macros chars are 'slodipvh' plus 'crt' in explanation. + helo: msgbas2x.cos.example.com + host: CAFE:BABE::192.168.218.40 + mailfrom: test@e5.example.com + result: permerror + p-macro-ip4-novalid: + spec: 8.1/22 + description: |- + p = the validated domain name of + comment: >- + The PTR in this example does not validate. + helo: msgbas2x.cos.example.com + host: 192.168.218.40 + mailfrom: test@e6.example.com + result: fail + explanation: connect from unknown + p-macro-ip4-valid: + spec: 8.1/22 + description: |- + p = the validated domain name of + comment: >- + If a subdomain of the is present, it SHOULD be used. + helo: msgbas2x.cos.example.com + host: 192.168.218.41 + mailfrom: test@e6.example.com + result: fail + explanation: connect from mx.example.com + p-macro-ip6-novalid: + spec: 8.1/22 + description: |- + p = the validated domain name of + comment: >- + The PTR in this example does not validate. + helo: msgbas2x.cos.example.com + host: CAFE:BABE::1 + mailfrom: test@e6.example.com + result: fail + explanation: connect from unknown + p-macro-ip6-valid: + spec: 8.1/22 + description: |- + p = the validated domain name of + comment: >- + If a subdomain of the is present, it SHOULD be used. + helo: msgbas2x.cos.example.com + host: CAFE:BABE::3 + mailfrom: test@e6.example.com + result: fail + explanation: connect from mx.example.com + p-macro-multiple: + spec: 8.1/22 + description: |- + p = the validated domain name of + comment: >- + If a subdomain of the is present, it SHOULD be used. + helo: msgbas2x.cos.example.com + host: 192.168.218.42 + mailfrom: test@e7.example.com + result: [pass, softfail] + upper-macro: + spec: 8.1/26 + description: >- + Uppercased macros expand exactly as their lowercased equivalents, + and are then URL escaped. + helo: msgbas2x.cos.example.com + host: 192.168.218.42 + mailfrom: jack&jill=up@e8.example.com + result: fail + explanation: http://example.com/why.html?l=jack%26jill%3Dup + hello-macro: + spec: 8.1/6 + description: |- + h = HELO/EHLO domain + helo: msgbas2x.cos.example.com + host: 192.168.218.40 + mailfrom: test@e9.example.com + result: pass + invalid-hello-macro: + spec: 8.1/2 + description: |- + h = HELO/EHLO domain, but HELO is invalid + comment: >- + Domain-spec must end in either a macro, or a valid toplabel. + It is not correct to check syntax after macro expansion. + helo: "JUMPIN' JUPITER" + host: 192.168.218.40 + mailfrom: test@e9.example.com + result: fail + hello-domain-literal: + spec: 8.1/2 + description: |- + h = HELO/EHLO domain, but HELO is a domain literal + comment: >- + Domain-spec must end in either a macro, or a valid toplabel. + It is not correct to check syntax after macro expansion. + helo: "[192.168.218.40]" + host: 192.168.218.40 + mailfrom: test@e9.example.com + result: fail + require-valid-helo: + spec: 8.1/6 + description: >- + Example of requiring valid helo in sender policy. This is a complex + policy testing several points at once. + helo: OEMCOMPUTER + host: 1.2.3.4 + mailfrom: test@e10.example.com + result: fail + macro-reverse-split-on-dash: + spec: [8.1/15, 8.1/16, 8.1/17, 8.1/18] + description: >- + Macro value transformation (splitting on arbitrary characters, reversal, + number of right-hand parts to use) + helo: mail.example.com + host: 1.2.3.4 + mailfrom: philip-gladstone-test@e11.example.com + result: pass + macro-multiple-delimiters: + spec: [8.1/15, 8.1/16] + description: |- + Multiple delimiters may be specified in a macro expression. + macro-expand = ( "%{" macro-letter transformers *delimiter "}" ) + / "%%" / "%_" / "%-" + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo-bar+zip+quux@e12.example.com + result: pass +zonedata: + example.com.d.spf.example.com: + - SPF: v=spf1 redirect=a.spf.example.com + a.spf.example.com: + - SPF: v=spf1 include:o.spf.example.com. ~all + o.spf.example.com: + - SPF: v=spf1 ip4:192.168.218.40 + msgbas2x.cos.example.com: + - A: 192.168.218.40 + example.com: + - A: 192.168.90.76 + - SPF: v=spf1 redirect=%{d}.d.spf.example.com. + exp.example.com: + - SPF: v=spf1 exp=msg.example.com. -all + msg.example.com: + - TXT: This is a test. + e1.example.com: + - SPF: v=spf1 -exists:%(ir).sbl.example.com ?all + e1a.example.com: + - SPF: "v=spf1 a:macro%%percent%_%_space%-url-space.example.com -all" + "macro%percent space%20url-space.example.com": + - A: 1.2.3.4 + e2.example.com: + - SPF: v=spf1 -all exp=%{r}.example.com + e3.example.com: + - SPF: v=spf1 -all exp=%{ir}.example.com + 40.218.168.192.example.com: + - TXT: Connections from %{c} not authorized. + somewhat.long.exp.example.com: + - SPF: v=spf1 -all exp=foobar.%{o}.%{o}.%{o}.%{o}.%{o}.%{o}.%{o}.%{o}.example.com + somewhat.long.exp.example.com.somewhat.long.exp.example.com.somewhat.long.exp.example.com.somewhat.long.exp.example.com.somewhat.long.exp.example.com.somewhat.long.exp.example.com.somewhat.long.exp.example.com.somewhat.long.exp.example.com.example.com: + - TXT: Congratulations! That was tricky. + e4.example.com: + - SPF: v=spf1 -all exp=e4msg.example.com + e4msg.example.com: + - TXT: "%{c} is queried as %{ir}.%{v}.arpa" + e5.example.com: + - SPF: v=spf1 a:%{a}.example.com -all + e6.example.com: + - SPF: v=spf1 -all exp=e6msg.example.com + e6msg.example.com: + - TXT: "connect from %{p}" + mx.example.com: + - A: 192.168.218.41 + - A: 192.168.218.42 + - AAAA: CAFE:BABE::2 + - AAAA: CAFE:BABE::3 + 40.218.168.192.in-addr.arpa: + - PTR: mx.example.com + 41.218.168.192.in-addr.arpa: + - PTR: mx.example.com + 42.218.168.192.in-addr.arpa: + - PTR: mx.example.com + - PTR: mx.e7.example.com + 1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.E.B.A.B.E.F.A.C.ip6.arpa: + - PTR: mx.example.com + 3.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.E.B.A.B.E.F.A.C.ip6.arpa: + - PTR: mx.example.com + mx.e7.example.com: + - A: 192.168.218.42 + mx.e7.example.com.should.example.com: + - A: 127.0.0.2 + mx.example.com.ok.example.com: + - A: 127.0.0.2 + e7.example.com: + - SPF: v=spf1 exists:%{p}.should.example.com ~exists:%{p}.ok.example.com + e8.example.com: + - SPF: v=spf1 -all exp=msg8.%{D2} + msg8.example.com: + - TXT: "http://example.com/why.html?l=%{L}" + e9.example.com: + - SPF: v=spf1 a:%{H} -all + e10.example.com: + - SPF: v=spf1 -include:_spfh.%{d2} ip4:1.2.3.0/24 -all + _spfh.example.com: + - SPF: v=spf1 -a:%{h} +all + e11.example.com: + - SPF: v=spf1 exists:%{i}.%{l2r-}.user.%{d2} + 1.2.3.4.gladstone.philip.user.example.com: + - A: 127.0.0.2 + e12.example.com: + - SPF: v=spf1 exists:%{l2r+-}.user.%{d2} + bar.foo.user.example.com: + - A: 127.0.0.2 +--- +description: Processing limits +tests: + redirect-loop: + description: >- + SPF implementations MUST limit the number of mechanisms and modifiers + that do DNS lookups to at most 10 per SPF check. + spec: 10.1/6 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e1.example.com + result: permerror + include-loop: + description: >- + SPF implementations MUST limit the number of mechanisms and modifiers + that do DNS lookups to at most 10 per SPF check. + spec: 10.1/6 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e2.example.com + result: permerror + mx-limit: + description: >- + there MUST be a limit of no more than 10 MX looked up and checked. + comment: >- + The required result for this test was the subject of much + controversy. Many felt that the RFC *should* have specified + permerror, but the consensus was that it failed to actually do so. + The preferred result reflects evaluating the 10 allowed MX records in the + order returned by the test data - or sorted via priority. + If testing with live DNS, the MX order may be random, and a pass + result would still be compliant. The SPF result is effectively + random. + spec: 10.1/7 + helo: mail.example.com + host: 1.2.3.5 + mailfrom: foo@e4.example.com + result: [neutral, pass] + ptr-limit: + description: >- + there MUST be a limit of no more than 10 PTR looked up and checked. + comment: >- + The result of this test cannot be permerror not only because the + RFC does not specify it, but because the sender has no control over + the PTR records of spammers. + The preferred result reflects evaluating the 10 allowed PTR records in + the order returned by the test data. + If testing with live DNS, the PTR order may be random, and a pass + result would still be compliant. The SPF result is effectively + randomized. + spec: 10.1/7 + helo: mail.example.com + host: 1.2.3.5 + mailfrom: foo@e5.example.com + result: [neutral, pass] + false-a-limit: + description: >- + unlike MX, PTR, there is no RR limit for A + comment: >- + There seems to be a tendency for developers to want to limit + A RRs in addition to MX and PTR. These are IPs, not usable for + 3rd party DoS attacks, and hence need no low limit. + spec: 10.1/7 + helo: mail.example.com + host: 1.2.3.12 + mailfrom: foo@e10.example.com + result: pass + mech-at-limit: + description: >- + SPF implementations MUST limit the number of mechanisms and modifiers + that do DNS lookups to at most 10 per SPF check. + spec: 10.1/6 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e6.example.com + result: pass + mech-over-limit: + description: >- + SPF implementations MUST limit the number of mechanisms and modifiers + that do DNS lookups to at most 10 per SPF check. + comment: >- + We do not check whether an implementation counts mechanisms before + or after evaluation. The RFC is not clear on this. + spec: 10.1/6 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e7.example.com + result: permerror + include-at-limit: + description: >- + SPF implementations MUST limit the number of mechanisms and modifiers + that do DNS lookups to at most 10 per SPF check. + comment: >- + The part of the RFC that talks about MAY parse the entire record first + (4.6) is specific to syntax errors. Processing limits is a different, + non-syntax issue. Processing limits (10.1) specifically talks about + limits during a check. + spec: 10.1/6 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e8.example.com + result: pass + include-over-limit: + description: >- + SPF implementations MUST limit the number of mechanisms and modifiers + that do DNS lookups to at most 10 per SPF check. + spec: 10.1/6 + helo: mail.example.com + host: 1.2.3.4 + mailfrom: foo@e9.example.com + result: permerror +zonedata: + mail.example.com: + - A: 1.2.3.4 + e1.example.com: + - SPF: v=spf1 ip4:1.1.1.1 redirect=e1.example.com + e2.example.com: + - SPF: v=spf1 include:e3.example.com + e3.example.com: + - SPF: v=spf1 include:e2.example.com + e4.example.com: + - SPF: v=spf1 mx + - MX: [0, mail.example.com] + - MX: [1, mail.example.com] + - MX: [2, mail.example.com] + - MX: [3, mail.example.com] + - MX: [4, mail.example.com] + - MX: [5, mail.example.com] + - MX: [6, mail.example.com] + - MX: [7, mail.example.com] + - MX: [8, mail.example.com] + - MX: [9, mail.example.com] + - MX: [10, e4.example.com] + - A: 1.2.3.5 + e5.example.com: + - SPF: v=spf1 ptr + - A: 1.2.3.5 + 5.3.2.1.in-addr.arpa: + - PTR: e1.example.com. + - PTR: e2.example.com. + - PTR: e3.example.com. + - PTR: e4.example.com. + - PTR: example.com. + - PTR: e6.example.com. + - PTR: e7.example.com. + - PTR: e8.example.com. + - PTR: e9.example.com. + - PTR: e10.example.com. + - PTR: e5.example.com. + e6.example.com: + - SPF: v=spf1 a mx a mx a mx a mx a ptr ip4:1.2.3.4 -all + e7.example.com: + - SPF: v=spf1 a mx a mx a mx a mx a ptr a ip4:1.2.3.4 -all + e8.example.com: + - SPF: v=spf1 a include:inc.example.com ip4:1.2.3.4 mx -all + inc.example.com: + - SPF: v=spf1 a a a a a a a a + e9.example.com: + - SPF: v=spf1 a include:inc.example.com a ip4:1.2.3.4 -all + e10.example.com: + - SPF: v=spf1 a -all + - A: 1.2.3.1 + - A: 1.2.3.2 + - A: 1.2.3.3 + - A: 1.2.3.4 + - A: 1.2.3.5 + - A: 1.2.3.6 + - A: 1.2.3.7 + - A: 1.2.3.8 + - A: 1.2.3.9 + - A: 1.2.3.10 + - A: 1.2.3.11 + - A: 1.2.3.12