Mail-SPF-v2.9.0000755001754000144 012173126204 13024 5ustar00julianusers000000000000Mail-SPF-v2.9.0/MANIFEST000444001754000144 242712173126200 14313 0ustar00julianusers000000000000bin/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 Mail-SPF-v2.9.0/TODO000444001754000144 153712173126177 13670 0ustar00julianusers000000000000# 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 Mail-SPF-v2.9.0/CHANGES000444001754000144 2262512173126177 14214 0ustar00julianusers000000000000# 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 Mail-SPF-v2.9.0/META.yml000444001754000144 1201712173126177 14464 0ustar00julianusers000000000000--- 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 Mail-SPF-v2.9.0/MANIFEST.SKIP000444001754000144 26012173126200 15031 0ustar00julianusers000000000000^_build/ ^Build$ ^blib/ ^debian/libmail-spf-perl/ ^debian/spf-tools-perl/ ^debian/tmp/ ^MANIFEST\.bak$ ^Makefile$ ^tmp/ ^\. /\. \.bak$ \.old$ \.swp$ \.tar\.gz$ ~$ ^MYMETA.yml$ Mail-SPF-v2.9.0/INSTALL000444001754000144 214312173126200 14206 0ustar00julianusers000000000000System 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 Mail-SPF-v2.9.0/README000444001754000144 556112173126200 14044 0ustar00julianusers000000000000Mail::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 Mail-SPF-v2.9.0/Makefile.PL000444001754000144 233312173126200 15130 0ustar00julianusers000000000000# 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'); Mail-SPF-v2.9.0/LICENSE000444001754000144 265312173126200 14170 0ustar00julianusers000000000000(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. Mail-SPF-v2.9.0/Build.PL000444001754000144 500512173126200 14451 0ustar00julianusers000000000000# # 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(); Mail-SPF-v2.9.0/SIGNATURE000644001754000144 1125312173126204 14471 0ustar00julianusers000000000000This 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----- Mail-SPF-v2.9.0/lib000755001754000144 012173126177 13603 5ustar00julianusers000000000000Mail-SPF-v2.9.0/lib/Mail000755001754000144 012173126200 14450 5ustar00julianusers000000000000Mail-SPF-v2.9.0/lib/Mail/SPF.pm000444001754000144 450112173126200 15573 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF000755001754000144 012173126200 15100 5ustar00julianusers000000000000Mail-SPF-v2.9.0/lib/Mail/SPF/Server.pm000444001754000144 6066512173126177 17113 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Util.pm000444001754000144 3006312173126177 16547 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Mod.pm000444001754000144 2370012173126177 16351 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Result.pm000444001754000144 4205512173126177 17114 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Request.pm000444001754000144 3510412173126177 17263 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/MacroString.pm000444001754000144 3353712173126177 20073 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/SenderIPAddrMech.pm000444001754000144 370012173126177 20651 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Exception.pm000444001754000144 1255212173126177 17573 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Base.pm000444001754000144 654012173126177 16467 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Term.pm000444001754000144 2155012173126200 16525 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Mech.pm000444001754000144 3152112173126200 16471 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Record.pm000444001754000144 3012512173126200 17032 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/v1000755001754000144 012173126177 15443 5ustar00julianusers000000000000Mail-SPF-v2.9.0/lib/Mail/SPF/v1/Record.pm000444001754000144 732612173126177 17364 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Mod000755001754000144 012173126177 15634 5ustar00julianusers000000000000Mail-SPF-v2.9.0/lib/Mail/SPF/Mod/Redirect.pm000444001754000144 776112173126177 20103 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Mod/Exp.pm000444001754000144 1003312173126177 17100 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Mech000755001754000144 012173126200 15754 5ustar00julianusers000000000000Mail-SPF-v2.9.0/lib/Mail/SPF/Mech/PTR.pm000444001754000144 641012173126177 17132 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Mech/A.pm000444001754000144 775312173126177 16660 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Mech/All.pm000444001754000144 553612173126177 17205 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Mech/IP6.pm000444001754000144 606612173126177 17072 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Mech/MX.pm000444001754000144 1145212173126200 17016 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Mech/Include.pm000444001754000144 1030312173126200 20047 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Mech/Exists.pm000444001754000144 627312173126200 17736 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/Mech/IP4.pm000444001754000144 642312173126200 17050 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/lib/Mail/SPF/v2000755001754000144 012173126177 15444 5ustar00julianusers000000000000Mail-SPF-v2.9.0/lib/Mail/SPF/v2/Record.pm000444001754000144 1163712173126177 17405 0ustar00julianusers000000000000# # 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; Mail-SPF-v2.9.0/debian000755001754000144 012173126200 14242 5ustar00julianusers000000000000Mail-SPF-v2.9.0/debian/libmail-spf-perl.install000444001754000144 4312173126177 21100 0ustar00julianusers000000000000usr/share/man/man3 usr/share/perl5 Mail-SPF-v2.9.0/debian/spf-tools-perl.postinst000555001754000144 110012173126177 21102 0ustar00julianusers000000000000#!/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# Mail-SPF-v2.9.0/debian/rules000555001754000144 240412173126177 15474 0ustar00julianusers000000000000#!/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 Mail-SPF-v2.9.0/debian/compat000444001754000144 212173126177 15532 0ustar00julianusers0000000000007 Mail-SPF-v2.9.0/debian/changelog000444001754000144 2271412173126177 16314 0ustar00julianusers000000000000mail-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 Mail-SPF-v2.9.0/debian/watch000444001754000144 12012173126177 15416 0ustar00julianusers000000000000version=3 http://search.cpan.org/dist/Mail-SPF/ .*/Mail-SPF-v?([\d.]+)\.tar\.gz Mail-SPF-v2.9.0/debian/spf-tools-perl.prerm000555001754000144 40312173126177 20331 0ustar00julianusers000000000000#!/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# Mail-SPF-v2.9.0/debian/copyright000444001754000144 316712173126177 16356 0ustar00julianusers000000000000This 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. Mail-SPF-v2.9.0/debian/spf-tools-perl.install000444001754000144 6712173126177 20635 0ustar00julianusers000000000000usr/sbin usr/bin usr/share/man/man1 usr/share/man/man8 Mail-SPF-v2.9.0/debian/control000444001754000144 330612173126200 16004 0ustar00julianusers000000000000Source: 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. Mail-SPF-v2.9.0/debian/source000755001754000144 012173126177 15557 5ustar00julianusers000000000000Mail-SPF-v2.9.0/debian/source/format000444001754000144 1512173126177 17063 0ustar00julianusers0000000000003.0 (native) Mail-SPF-v2.9.0/bin000755001754000144 012173126177 13605 5ustar00julianusers000000000000Mail-SPF-v2.9.0/bin/spfquery000555001754000144 5471712173126177 15604 0ustar00julianusers000000000000#!/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; } Mail-SPF-v2.9.0/t000755001754000144 012173126200 13263 5ustar00julianusers000000000000Mail-SPF-v2.9.0/t/Mail-SPF-Test-lib.pm000444001754000144 777212173126177 17001 0ustar00julianusers000000000000use 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; Mail-SPF-v2.9.0/t/90-author-pod-validation.t000444001754000144 25012173126177 20237 0ustar00julianusers000000000000use 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(); Mail-SPF-v2.9.0/t/00.01-class-util.t000444001754000144 664712173126177 16353 0ustar00julianusers000000000000use 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 Mail-SPF-v2.9.0/t/10.00-rfc4408.t000444001754000144 40312173126177 15325 0ustar00julianusers000000000000use 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'); Mail-SPF-v2.9.0/t/rfc4408-tests.yml000444001754000144 17766512173126177 16500 0ustar00julianusers000000000000# 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 Mail-SPF-v2.9.0/t/10.01-rfc4406.t000444001754000144 40312173126177 15324 0ustar00julianusers000000000000use 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'); Mail-SPF-v2.9.0/t/00.04-class-server.t000444001754000144 1066712173126177 16724 0ustar00julianusers000000000000use 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. Mail-SPF-v2.9.0/t/00.05-class-macrostring.t000444001754000144 541412173126177 17721 0ustar00julianusers000000000000use 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)'); } Mail-SPF-v2.9.0/t/00.00-class-misc.t000444001754000144 25312173126177 16273 0ustar00julianusers000000000000use strict; use warnings; use blib; use Test::More tests => 2; #### Class Compilation #### BEGIN { use_ok('Mail::SPF::Base'); use_ok('Mail::SPF::Exception'); } Mail-SPF-v2.9.0/t/00.02-class-request.t000444001754000144 1647112173126177 17103 0ustar00julianusers000000000000use 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'); } Mail-SPF-v2.9.0/t/rfc4406-tests.yml000444001754000144 152312173126200 16374 0ustar00julianusers000000000000# 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 Mail-SPF-v2.9.0/t/00.99-class-misc.t000444001754000144 127012173126200 16320 0ustar00julianusers000000000000use 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'); } Mail-SPF-v2.9.0/t/00.03-class-result.t000444001754000144 535212173126200 16671 0ustar00julianusers000000000000use 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")'); } Mail-SPF-v2.9.0/sbin000755001754000144 012173126200 13753 5ustar00julianusers000000000000Mail-SPF-v2.9.0/sbin/spfd000555001754000144 4373012173126200 15021 0ustar00julianusers000000000000#!/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; }