"Fossies" - the Fresh Open Source Software Archive

Member "Mail-SPF-Query-1.999.1/lib/Mail/SPF/Query.pm" (26 Feb 2006, 62723 Bytes) of package /linux/privat/old/Mail-SPF-Query-1.999.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Query.pm" see the Fossies "Dox" file reference documentation.

    1 package Mail::SPF::Query;
    2 
    3 # ----------------------------------------------------------
    4 #                      Mail::SPF::Query
    5 #   Test an IP / sender address pair for SPF authorization
    6 #
    7 #                   http://www.openspf.org
    8 #         http://search.cpan.org/dist/Mail-SPF-Query
    9 #
   10 # Copyright (C) 2003-2005 Meng Weng Wong <mengwong+spf@pobox.com>
   11 # Contributions by various members of the SPF project <http://www.openspf.org>
   12 # License: like Perl, i.e. GPL-2 and Artistic License
   13 #
   14 # $Id: Query.pm 143 2006-02-26 17:41:10Z julian $
   15 # ----------------------------------------------------------
   16 
   17 use 5.006;
   18 
   19 use strict;
   20 use warnings;
   21 no warnings 'uninitialized';
   22 
   23 our $VERSION = '1.999.1';  # fake version for EU::MM and CPAN
   24 $VERSION = '1.999001';     # real numerical version
   25 
   26 use Sys::Hostname::Long;
   27 use Net::DNS qw();  # by default it exports mx, which we define.
   28 use Net::CIDR::Lite;
   29 use URI::Escape;
   30 
   31 # ----------------------------------------------------------
   32 #                      initialization
   33 # ----------------------------------------------------------
   34 
   35 my $GUESS_MECHS         = "a/24 mx/24 ptr";
   36 my $TRUSTED_FORWARDER   = "include:spf.trusted-forwarder.org";
   37 
   38 my $DEFAULT_EXPLANATION = "Please see http://www.openspf.org/why.html?sender=%{S}&ip=%{I}&receiver=%{R}";
   39 my @KNOWN_MECHANISMS    = qw( a mx ptr include ip4 ip6 exists all );
   40 my $MAX_LOOKUP_COUNT    = 10;
   41 
   42 my $Domains_Queried     = {};
   43 
   44 our $CACHE_TIMEOUT      = 120;
   45 our $DNS_RESOLVER_TIMEOUT = 15;
   46 
   47 # ----------------------------------------------------------
   48 #        no user-serviceable parts below this line
   49 # ----------------------------------------------------------
   50 
   51 my $looks_like_ipv4  = qr/\d+\.\d+\.\d+\.\d+/;
   52 my $looks_like_email = qr/\S+\@\S+/;
   53 
   54 =head1 NAME
   55 
   56 Mail::SPF::Query - query Sender Policy Framework for an IP,email,helo
   57 
   58 =head1 VERSION
   59 
   60 1.999.1
   61 
   62 =head1 SYNOPSIS
   63 
   64     my $query = new Mail::SPF::Query (ip => "127.0.0.1", sender=>'foo@example.com', helo=>"somehost.example.com", trusted=>0, guess=>0);
   65     my ($result,           # pass | fail | softfail | neutral | none | error | unknown [mechanism]
   66         $smtp_comment,     # "please see http://www.openspf.org/why.html?..."  when rejecting, return this string to the SMTP client
   67         $header_comment,   # prepend_header("Received-SPF" => "$result ($header_comment)")
   68         $spf_record,       # "v=spf1 ..." original SPF record for the domain
   69        ) = $query->result();
   70 
   71     if    ($result eq "pass") { "Domain is not forged. Apply RHSBL and content filters." }
   72     elsif ($result eq "fail") { "Domain is forged. Reject or save to spambox." }
   73 
   74 =head1 ABSTRACT
   75 
   76 The SPF protocol relies on sender domains to describe their designated outbound
   77 mailers in DNS.  Given an email address, Mail::SPF::Query determines the
   78 legitimacy of an SMTP client IP address.
   79 
   80 =head1 DESCRIPTION
   81 
   82 There are two ways to use Mail::SPF::Query.  Your choice depends on whether the
   83 domains your server is an MX for have secondary MXes which your server doesn't
   84 know about.
   85 
   86 The first and more common style, calling ->result(), is suitable when all mail
   87 is received directly from the originator's MTA.  If the domains you receive do
   88 not have secondary MX entries, this is appropriate.  This style of use is
   89 outlined in the SYNOPSIS above.  This is the common case.
   90 
   91 The second style is more complex, but works when your server receives mail from
   92 secondary MXes.  This performs checks as each recipient is handled.  If the
   93 message is coming from a valid MX secondary for a recipient, then the SPF check
   94 is not performed, and a "pass" response is returned right away.  To do this,
   95 call C<result2()> and C<message_result2()> instead of C<result()>.
   96 
   97 If you do not know what a secondary MX is, you probably don't have one.  Use
   98 the first style.
   99 
  100 You can try out Mail::SPF::Query on the command line with the following
  101 command:
  102 
  103     perl -MMail::SPF::Query -le 'print for Mail::SPF::Query->new(
  104         helo => shift, ipv4 => shift, sender => shift)->result' \
  105         helohost.example.com 1.2.3.4 user@example.com
  106 
  107 =head1 BUGS
  108 
  109 Mail::SPF::Query tries to implement the SPF specification (see L</"SEE ALSO">)
  110 as close as reasonably possible given that M:S:Q has been the very first SPF
  111 implementation and has changed with the SPF specification over time.  As a
  112 result, M:S:Q has various known deficiencies that cannot be corrected with
  113 reasonably little effort:
  114 
  115 =over
  116 
  117 =item *
  118 
  119 B<Unable to query HELO and MAIL FROM separately.>  M:S:Q is not designed to
  120 support the I<separate> querying of the HELO and MAIL FROM identities.  Passing
  121 the HELO identity as the C<sender> argument for a stand-alone HELO check might
  122 generally work but could yield unexpected results.
  123 
  124 =item *
  125 
  126 B<No IPv6 support.>  IPv6 is not supported.  C<ip6> mechanisms in SPF records
  127 and everywhere else are simply ignored.
  128 
  129 =item *
  130 
  131 B<Result explanation may be inappropriate for local policy results.>  If a
  132 query result was caused by anything other than a real SPF record (i.e. local
  133 policy, overrides, fallbacks, etc.), and no custom C<default_explanation> was
  134 specified, the domain's explanation or M:S:Q's hard-coded default explanation
  135 will still be returned.  Be aware that in this case the explanation may not
  136 correctly explain the reason for such an artificial result.
  137 
  138 =for comment
  139 INTERNAL NOTE:  If the spf_source is not 'original-spf-record' (but e.g. a
  140 local policy source), do not return the "why.html" default explanation, because
  141 "why.html" will not be able to reproduce the local policy.
  142 
  143 =back
  144 
  145 =head1 NON-STANDARD FEATURES
  146 
  147 Also due to its long history, M:S:Q does have some legacy features that are not
  148 parts of the official SPF specification, most notably I<best guess processing>
  149 and I<trusted forwarder accreditation checking>.  Please be careful when using
  150 these I<non-standard> features or when reproducing them in your own SPF
  151 implementation, as they may cause unexpected results.
  152 
  153 =head1 METHODS
  154 
  155 =head2 C<< Mail::SPF::Query->new() >>
  156 
  157     my $query = eval { new Mail::SPF::Query (
  158         ip          => '127.0.0.1',
  159         sender      => 'foo@example.com',
  160         helo        => 'host.example.com',
  161 
  162         # Optional parameters:
  163         debug       => 1, debuglog => sub { print STDERR "@_\n" },
  164         local       => 'extra mechanisms',
  165         trusted     => 1,                   # do trusted forwarder processing
  166         guess       => 1,                   # do best guess if no SPF record
  167         default_explanation => 'Please see http://spf.my.isp/spferror.html for details',
  168         max_lookup_count    => 10,          # total number of SPF includes/redirects
  169         sanitize    => 0,                   # do not sanitize all returned strings
  170         myhostname  => 'foo.example.com',   # prepended to header_comment
  171         override    => {   'example.net' => 'v=spf1 a mx -all',
  172                          '*.example.net' => 'v=spf1 a mx -all' },
  173         fallback    => {   'example.org' => 'v=spf1 a mx -all',
  174                          '*.example.org' => 'v=spf1 a mx -all' }
  175     ) };
  176 
  177     if ($@) { warn "bad input to Mail::SPF::Query: $@" }
  178 
  179 Set C<trusted=E<gt>1> to turned on C<trusted-forwarder.org> accreditation
  180 checking.  The mechanism C<include:spf.trusted-forwarder.org> is used just
  181 before a C<-all> or C<?all>.  The precise circumstances are somewhat more
  182 complicated, but it does get the case of C<v=spf1 -all> right -- i.e.
  183 C<trusted-forwarder.org> is not checked.  B<This is a non-standard feature.>
  184 
  185 Set C<guess=E<gt>1> to turned on automatic best guess processing.  This will
  186 use the best_guess SPF record when one cannot be found in the DNS.  Note that
  187 this can only return C<pass> or C<neutral>.  The C<trusted> and C<local> flags
  188 also operate when the best_guess is being used.  B<This is a non-standard
  189 feature.>
  190 
  191 Set C<local=E<gt>'include:local.domain'> to include some extra processing just
  192 before a C<-all> or C<?all>.  The local processing happens just before the
  193 trusted forwarder processing.  B<This is a non-standard feature.>
  194 
  195 Set C<default_explanation> to a string to be used if the SPF record does not
  196 provide a specific explanation. The default value will direct the user to a
  197 page at www.openspf.org with the following message:
  198 
  199     Please see http://www.openspf.org/why.html?sender=%{S}&ip=%{I}&receiver=%{R}
  200 
  201 Note that the string has macro substitution performed.
  202 
  203 Set C<sanitize> to 0 to get all the returned strings unsanitized.
  204 Alternatively, pass a function reference and this function will be used to
  205 sanitize the returned values.  The function must take a single string argument
  206 and return a single string which contains the sanitized result.
  207 
  208 Set C<debug=E<gt>1> to watch the queries happen.
  209 
  210 Set C<override> to define SPF records for domains that do publish but which you
  211 want to override anyway.  Wildcards are supported.  B<This is a non-standard
  212 feature.>
  213 
  214 Set C<fallback> to define "pretend" SPF records for domains that don't publish
  215 them yet.  Wildcards are supported.  B<This is a non-standard feature.>
  216 
  217 Note: domain name arguments to override and fallback need to be in all
  218 lowercase.
  219 
  220 =cut
  221 
  222 # ----------------------------------------------------------
  223 #                            new
  224 # ----------------------------------------------------------
  225 
  226 sub new {
  227   my $class = shift;
  228   my $query = bless { @_ }, $class;
  229 
  230   $query->{lookup_count} = 0;
  231 
  232   $query->{ipv4} = delete $query->{ip}
  233     if defined($query->{ip}) and $query->{ip} =~ $looks_like_ipv4;
  234   $query->{helo} = delete $query->{ehlo}
  235     if defined($query->{ehlo});
  236 
  237   $query->{local} .= ' ' . $TRUSTED_FORWARDER if ($query->{trusted});
  238 
  239   $query->{trusted} = undef;
  240 
  241   $query->{spf_error_explanation} ||= "SPF record error";
  242 
  243   $query->{default_explanation} ||= $DEFAULT_EXPLANATION;
  244 
  245   $query->{default_record} = $GUESS_MECHS if ($query->{guess});
  246 
  247   if (($query->{sanitize} && !ref($query->{sanitize})) || !defined($query->{sanitize})) {
  248       # Apply default sanitizer
  249       $query->{sanitize} = \&strict_sanitize;
  250   }
  251 
  252   $query->{sender} =~ s/<(.*)>/$1/g;
  253 
  254   if (not ($query->{ipv4} and length $query->{ipv4})) {
  255     die "no IP address given";
  256   }
  257 
  258   for ($query->{sender}) { s/^\s+//; s/\s+$//; }
  259 
  260   $query->{spf_source} = "domain of $query->{sender}";
  261   $query->{spf_source_type} = "original-spf-record";
  262 
  263   ($query->{domain}) = $query->{sender} =~ /([^@]+)$/; # given foo@bar@baz.com, the domain is baz.com, not bar@baz.com.
  264 
  265   # the domain should not be an address literal --- [1.2.3.4]
  266   if ($query->{domain} =~ /^\[\d+\.\d+\.\d+\.\d+\]$/) {
  267     die "sender domain should be an FQDN, not an address literal";
  268   }
  269 
  270   if (not $query->{helo}) { require Carp; import Carp qw(cluck); cluck ("Mail::SPF::Query: ->new() requires a \"helo\" argument.\n");
  271                             $query->{helo} = $query->{domain};
  272                           }
  273 
  274   $query->debuglog("new: ipv4=$query->{ipv4}, sender=$query->{sender}, helo=$query->{helo}");
  275 
  276   ($query->{helo}) =~ s/.*\@//; # strip localpart from helo
  277 
  278   if (not $query->{domain}) {
  279     $query->debuglog("sender $query->{sender} has no domain, using HELO domain $query->{helo} instead.");
  280     $query->{domain} = $query->{helo};
  281     $query->{sender} = $query->{helo};
  282   }
  283 
  284   if (not length $query->{domain}) { die "unable to identify domain of sender $query->{sender}" }
  285 
  286   $query->{orig_domain} = $query->{domain};
  287 
  288   $query->{loop_report} = [$query->{domain}];
  289 
  290   ($query->{localpart}) = $query->{sender} =~ /(.+)\@/;
  291   $query->{localpart} = "postmaster" if not length $query->{localpart};
  292 
  293   $query->debuglog("localpart is $query->{localpart}");
  294 
  295   $query->{Reversed_IP} = ($query->{ipv4} ? reverse_in_addr($query->{ipv4}) :
  296                            $query->{ipv6} ? die "IPv6 not supported" : "");
  297 
  298   if (not $query->{myhostname}) {
  299     $query->{myhostname} = Sys::Hostname::Long::hostname_long();
  300   }
  301   $query->{myhostname} ||= "localhost";
  302 
  303   # Unfold legacy { 'domain' => { record => '...' } } override and fallback
  304   # structures to just { 'domain' => '...' }:
  305   foreach ('override', 'fallback') {
  306     if (ref(my $domains_hash = $query->{$_}) eq 'HASH') {
  307       foreach my $domain (keys(%$domains_hash)) {
  308         $domains_hash->{$domain} = $domains_hash->{$domain}->{record}
  309           if ref($domains_hash->{$domain}) eq 'HASH';
  310       }
  311     }
  312   }
  313 
  314   $query->post_new(@_) if $class->can("post_new");
  315 
  316   return $query;
  317 }
  318 
  319 =head2 C<< $query->result() >>
  320 
  321     my ($result, $smtp_comment, $header_comment, $spf_record, $detail) = $query->result();
  322 
  323 C<$result> will be one of C<pass>, C<fail>, C<softfail>, C<neutral>, C<none>,
  324 C<error> or C<unknown [...]>:
  325 
  326 =over
  327 
  328 =item C<pass>
  329 
  330 The client IP address is an authorized mailer for the sender.  The mail should
  331 be accepted subject to local policy regarding the sender.
  332 
  333 =item C<fail>
  334 
  335 The client IP address is not an authorized mailer, and the sender wants you to
  336 reject the transaction for fear of forgery.
  337 
  338 =item C<softfail>
  339 
  340 The client IP address is not an authorized mailer, but the sender prefers that
  341 you accept the transaction because it isn't absolutely sure all its users are
  342 mailing through approved servers.  The C<softfail> status is often used during
  343 initial deployment of SPF records by a domain.
  344 
  345 =item C<neutral>
  346 
  347 The sender makes no assertion about the status of the client IP.
  348 
  349 =item C<none>
  350 
  351 There is no SPF record for this domain.
  352 
  353 =item C<error>
  354 
  355 The DNS lookup encountered a temporary error during processing.
  356 
  357 =item C<unknown [...]>
  358 
  359 The domain has a configuration error in the published data or defines a
  360 mechanism that this library does not understand.  If the data contained an
  361 unrecognized mechanism, it will be presented following "unknown".  You should
  362 test for unknown using a regexp C</^unknown/> rather than C<eq "unknown">.
  363 
  364 =back
  365 
  366 Results are cached internally for a default of 120 seconds.  You can call
  367 C<-E<gt>result()> repeatedly; subsequent lookups won't hit your DNS.
  368 
  369 C<smtp_comment> should be displayed to the SMTP client.
  370 
  371 C<header_comment> goes into a C<Received-SPF> header, like so:
  372 
  373     Received-SPF: $result ($header_comment)
  374 
  375 C<spf_record> shows the original SPF record fetched for the query.  If there is
  376 no SPF record, it is blank.  Otherwise, it will start with C<v=spf1> and
  377 contain the SPF mechanisms and such that describe the domain.
  378 
  379 Note that the strings returned by this method (and most of the other methods)
  380 are (at least partially) under the control of the sender's domain.  This means
  381 that, if the sender is an attacker, the contents can be assumed to be hostile.
  382 The various methods that return these strings make sure that (by default) the
  383 strings returned contain only characters in the range 32 - 126.  This behavior
  384 can be changed by setting C<sanitize> to 0 to turn off sanitization entirely.
  385 You can also set C<sanitize> to a function reference to perform custom
  386 sanitization.  In particular, assume that C<smtp_comment> might contain a
  387 newline character. 
  388 
  389 C<detail> is a hash of all the foregoing result elements, plus extra data
  390 returned by the SPF result.
  391 
  392 I<Why the weird duplication?>  In the beginning, C<result()> returned only one
  393 value, the C<$result>.  Then C<$smtp_comment> and C<$header_comment> came
  394 along.  Then C<$spf_record>.  Past a certain number of positional results, it
  395 makes more sense to have a hash.  But we didn't want to break backwards
  396 compatibility, so we just declared that the fifth result would be a hash and
  397 future return value would go in there.
  398 
  399 The keys of the hash are:
  400 
  401     result
  402     smtp_comment
  403     header_comment
  404     header_pairs
  405     spf_record
  406     modifiers
  407 
  408 =cut
  409 
  410 # ----------------------------------------------------------
  411 #                           result
  412 # ----------------------------------------------------------
  413 
  414 sub result {
  415   my $query = shift;
  416   my %result_set;
  417 
  418   my ($result, $smtp_explanation, $smtp_why, $orig_txt) = $query->spfquery(
  419     $query->{best_guess} ? $query->{guess_mechs} : ()
  420   );
  421 
  422   $smtp_why = "" if $smtp_why eq "default";
  423 
  424   my $smtp_comment = ($smtp_explanation && $smtp_why) ? "$smtp_explanation: $smtp_why" : ($smtp_explanation || $smtp_why);
  425 
  426   $query->{smtp_comment} = $smtp_comment;
  427 
  428   my $header_comment = "$query->{myhostname}: ". $query->header_comment($result);
  429 
  430   # $result =~ s/\s.*$//; # this regex truncates "unknown some:mechanism" to just "unknown"
  431 
  432   $query->{result} = $result;
  433 
  434   my $hash = { result         => $query->sanitize(lc $result),
  435                smtp_comment   => $query->sanitize($smtp_comment),
  436                header_comment => $query->sanitize($header_comment),
  437                spf_record     => $query->sanitize($orig_txt),
  438                modifiers      => $query->{modifiers},
  439                header_pairs   => $query->sanitize(scalar $query->header_pairs()),
  440              };        
  441 
  442   return ($hash->{result},
  443           $hash->{smtp_comment},
  444           $hash->{header_comment},
  445           $hash->{spf_record},
  446           $hash,
  447          ) if wantarray;
  448 
  449   return  $query->sanitize(lc $result);
  450 }
  451 
  452 sub header_comment {
  453   my $query = shift;
  454   my $result = shift;
  455   my $ip = $query->ip;
  456   if ($result eq "pass" and $query->{smtp_comment} eq "localhost is always allowed.") { return $query->{smtp_comment} }
  457 
  458   $query->debuglog("header_comment: spf_source = $query->{spf_source}");
  459   $query->debuglog("header_comment: spf_source_type = $query->{spf_source_type}");
  460 
  461   if ($query->{spf_source_type} eq "original-spf-record") {
  462   return
  463     (  $result eq "pass"      ? "$query->{spf_source} designates $ip as permitted sender"
  464      : $result eq "fail"      ? "$query->{spf_source} does not designate $ip as permitted sender"
  465      : $result eq "softfail"  ? "transitioning $query->{spf_source} does not designate $ip as permitted sender"
  466      : $result =~ /^unknown / ? "encountered unrecognized mechanism during SPF processing of $query->{spf_source}"
  467      : $result eq "unknown"   ? "error in processing during lookup of $query->{sender}"
  468      : $result eq "neutral"   ? "$ip is neither permitted nor denied by domain of $query->{sender}"
  469      : $result eq "error"     ? "encountered temporary error during SPF processing of $query->{spf_source}"
  470      : $result eq "none"      ? "$query->{spf_source} does not designate permitted sender hosts" 
  471      :                          "could not perform SPF query for $query->{spf_source}" );
  472   }
  473 
  474   return $query->{spf_source};
  475 
  476 }
  477 
  478 sub header_pairs {
  479   my $query = shift;
  480 # from spf-draft-200404.txt
  481 #    SPF clients may append zero or more of the following key-value-pairs
  482 #    at their discretion:
  483 # 
  484 #       receiver       the hostname of the SPF client
  485 #       client-ip      the IP address of the SMTP client
  486 #       envelope-from  the envelope sender address
  487 #       helo           the hostname given in the HELO or EHLO command
  488 #       mechanism      the mechanism that matched (if no mechanisms
  489 #                      matched, substitute the word "default".)
  490 #       problem        if an error was returned, details about the error
  491 # 
  492 #    Other key-value pairs may be defined by SPF clients.  Until a new key
  493 #    name becomes widely accepted, new key names should start with "x-".
  494 
  495   my @pairs = (
  496                "receiver"      => $query->{myhostname},
  497                "client-ip"     => ($query->{ipv4} || $query->{ipv6} || ""),
  498                "envelope-from" => $query->{sender},
  499                "helo"          => $query->{helo},
  500                mechanism       => ($query->{matched_mechanism} ? display_mechanism($query->{matched_mechanism}) : "default"),
  501                ($query->{result} eq "error"
  502                 ? (problem         => $query->{spf_error_explanation})
  503                 : ()),
  504                ($query->{spf_source_type} ne "original-spf-record" ? ("x-spf-source" => $query->{spf_source}) : ()),
  505               );
  506 
  507   if (wantarray) { return @pairs; }
  508   my @pair_text;
  509   while (@pairs) {
  510     my ($key, $val) = (shift(@pairs), shift (@pairs));
  511     push @pair_text, "$key=$val;";
  512   }
  513   return join " ", @pair_text;
  514 }
  515 
  516 =head2 C<< $query->result2() >>
  517 
  518     my ($result, $smtp_comment, $header_comment, $spf_record) = $query->result2('recipient@domain', 'recipient2@domain');
  519 
  520 C<result2()> does everything that C<result()> does, but it first checks to see if
  521 the sending system is a recognized MX secondary for the recipient(s).  If so,
  522 then it returns C<pass> and does not perform the SPF query.  Note that the
  523 sending system may be a MX secondary for some (but not all) of the recipients
  524 for a multi-recipient message, which is why result2 takes an argument list.
  525 See also C<message_result2()>.
  526 
  527 B<This is a non-standard feature.>  B<This feature is also deprecated, because
  528 exemption of trusted relays, such as secondary MXes, should really be performed
  529 by the software that uses this library before doing an SPF check.>
  530 
  531 C<$result> will be one of C<pass>, C<fail>, C<neutral [...]>, or C<unknown>.
  532 See C<result()> above for meanings.
  533 
  534 If you have secondary MXes and if you are unable to explicitly white-list them
  535 before SPF tests occur, you can use this method in place of C<result()>,
  536 calling it as many times as there are recipients, or just providing all the
  537 recipients at one time.
  538 
  539 C<smtp_comment> can be displayed to the SMTP client.
  540 
  541 For example:
  542 
  543     my $query = new Mail::SPF::Query (ip => "127.0.0.1",
  544                                       sender=>'foo@example.com',
  545                                       helo=>"somehost.example.com");
  546 
  547     ...
  548 
  549     my ($result, $smtp_comment, $header_comment);
  550 
  551     ($result, $smtp_comment, $header_comment) = $query->result2('recip1@example.com');
  552     # return suitable error code based on $result eq 'fail' or not
  553 
  554     ($result, $smtp_comment, $header_comment) = $query->result2('recip2@example.org');
  555     # return suitable error code based on $result eq 'fail' or not
  556 
  557     ($result, $smtp_comment, $header_comment) = $query->message_result2();
  558     # return suitable error if $result eq 'fail'
  559     # prefix message with "Received-SPF: $result ($header_comment)"
  560 
  561 =cut
  562 
  563 # ----------------------------------------------------------
  564 #                           result2
  565 # ----------------------------------------------------------
  566 
  567 sub result2 {
  568   my $query = shift;
  569   my @recipients = @_;
  570 
  571   if (!$query->{result2}) {
  572       my $all_mx_secondary = 'neutral';
  573 
  574       foreach my $recip (@recipients) {
  575           my ($rhost) = $recip =~ /([^@]+)$/;
  576 
  577           $query->debuglog("result2: Checking status of recipient $recip (at host $rhost)");
  578 
  579           my $cache_result = $query->{mx_cache}->{$rhost};
  580           if (not defined($cache_result)) {
  581               $cache_result = $query->{mx_cache}->{$rhost} = is_secondary_for($rhost, $query->{ipv4}) ? 'yes' : 'no';
  582               $query->debuglog("result2: $query->{ipv4} is a MX for $rhost: $cache_result");
  583           }
  584 
  585           if ($cache_result eq 'yes') {
  586               $query->{is_mx_good} = [$query->sanitize('pass'),
  587                                       $query->sanitize('message from secondary MX'),
  588                                       $query->sanitize("$query->{myhostname}: message received from $query->{ipv4} which is an MX secondary for $recip"),
  589                                       undef];
  590               $all_mx_secondary = 'yes';
  591           } else {
  592               $all_mx_secondary = 'no';
  593               last;
  594           }
  595       }
  596 
  597       if ($all_mx_secondary eq 'yes') {
  598           return @{$query->{is_mx_good}} if wantarray;
  599           return $query->{is_mx_good}->[0];
  600       }
  601 
  602       my @result = $query->result();
  603 
  604       $query->{result2} = \@result;
  605   }
  606 
  607   return @{$query->{result2}} if wantarray;
  608   return $query->{result2}->[0];
  609 }
  610 
  611 sub is_secondary_for {
  612     my ($host, $addr) = @_;
  613 
  614     my $resolver = Net::DNS::Resolver->new(
  615                                            tcp_timeout => $DNS_RESOLVER_TIMEOUT,
  616                                            udp_timeout => $DNS_RESOLVER_TIMEOUT,
  617                                            )
  618                                            ;
  619     if ($resolver) {
  620         my $mx = $resolver->send($host, 'MX');
  621         if ($mx) {
  622             my @mxlist = sort { $a->preference <=> $b->preference } (grep { $_->type eq 'MX' } $mx->answer);
  623             # discard the first entry (top priority) - we shouldn't get mail from them
  624             shift @mxlist;
  625             foreach my $rr (@mxlist) {
  626                 my $a = $resolver->send($rr->exchange, 'A');
  627                 if ($a) {
  628                     foreach my $rra ($a->answer) {
  629                         if ($rra->type eq 'A') {
  630                             if ($rra->address eq $addr) {
  631                                 return 1;
  632                             }
  633                         }
  634                     }
  635                 }
  636             }
  637         }
  638     }
  639 
  640     return undef;
  641 }
  642 
  643 =head2 C<< $query->message_result2() >>
  644 
  645     my ($result, $smtp_comment, $header_comment, $spf_record) = $query->message_result2();
  646 
  647 C<message_result2()> returns an overall status for the message after zero or
  648 more calls to C<result2()>.  It will always be the last status returned by
  649 C<result2()>, or the status returned by C<result()> if C<result2()> was never
  650 called.
  651 
  652 C<$result> will be one of C<pass>, C<fail>, C<neutral [...]>, or C<error>.  See
  653 C<result()> above for meanings.
  654 
  655 =cut
  656 
  657 # ----------------------------------------------------------
  658 #                           message_result2
  659 # ----------------------------------------------------------
  660 
  661 sub message_result2 {
  662   my $query = shift;
  663 
  664   if (!$query->{result2}) {
  665       if ($query->{is_mx_good}) {
  666           return @{$query->{is_mx_good}} if wantarray;
  667           return $query->{is_mx_good}->[0];
  668       }
  669 
  670       # we are very unlikely to get here -- unless result2 was not called.
  671 
  672       my @result = $query->result();
  673 
  674       $query->{result2} = \@result;
  675   }
  676 
  677   return @{$query->{result2}} if wantarray;
  678   return $query->{result2}->[0];
  679 }
  680 
  681 =head2 C<< $query->best_guess() >>
  682 
  683     my ($result, $smtp_comment, $header_comment) = $query->best_guess();
  684 
  685 When a domain does not publish an SPF record, this library can produce an
  686 educated guess anyway.
  687 
  688 It pretends the domain defined A, MX, and PTR mechanisms, plus a few others.
  689 The default set of directives is
  690 
  691     a/24 mx/24 ptr
  692 
  693 That default set will return either "pass" or "neutral".
  694 
  695 If you want to experiment with a different default, you can pass it as an
  696 argument: C<< $query->best_guess("a mx ptr") >>
  697 
  698 B<This is a non-standard feature.>  B<This method is also deprecated.>  You
  699 should set C<guess=E<gt>1> on the C<new()> method instead.
  700 
  701 =head2 C<< $query->trusted_forwarder() >>
  702 
  703     my ($result, $smtp_comment, $header_comment) = $query->best_guess();
  704 
  705 It is possible that the message is coming through a known-good relay like
  706 C<acm.org> or C<pobox.com>.  During the transitional period, many legitimate
  707 services may appear to forge a sender address: for example, a news website may
  708 have a "send me this article in email" link.
  709 
  710 The C<trusted-forwarder.org> domain is a white-list of known-good hosts that
  711 either forward mail or perform benign envelope sender forgery:
  712 
  713     include:spf.trusted-forwarder.org
  714 
  715 This will return either "pass" or "neutral".
  716 
  717 B<This is a non-standard feature.>  B<This method is also deprecated.>  You
  718 should set C<trusted=E<gt>1> on the C<new()> method instead.
  719 
  720 =cut
  721 
  722 sub clone {
  723   my $query = shift;
  724   my $class = ref $query;
  725 
  726   my %guts = (%$query, @_, parent=>$query);
  727 
  728   my $clone = bless \%guts, $class;
  729 
  730   push @{$clone->{loop_report}}, delete $clone->{reason};
  731 
  732   $query->debuglog("  clone: new object:");
  733   for ($clone->show) { $clone->debuglog( "clone: $_" ) }
  734 
  735   return $clone;
  736 }
  737 
  738 sub top {
  739   my $query = shift;
  740   if ($query->{parent}) { return $query->{parent}->top }
  741   return $query;
  742 }
  743 
  744 sub set_temperror {
  745   my $query = shift;
  746   $query->{error} = shift;
  747 }
  748 
  749 sub show {
  750   my $query = shift;
  751 
  752   return map { sprintf ("%20s = %s", $_, $query->{$_}) } keys %$query;
  753 }
  754 
  755 sub best_guess {
  756   my $query = shift;
  757   my $guess_mechs = shift || $GUESS_MECHS;
  758 
  759   # clone the query object with best_guess mode turned on.
  760   my $guess_query = $query->clone( best_guess => 1,
  761                                    guess_mechs => $guess_mechs,
  762                                    reason => "has no data.  best guess",
  763                                  );
  764 
  765   $guess_query->top->{lookup_count} = 0;
  766 
  767   # if result is not defined, the domain has no SPF.
  768   #    perform fallback lookups.
  769   #    perform trusted-forwarder lookups.
  770   #    perform guess lookups.
  771   #
  772   # if result is defined, return it.
  773 
  774   my ($result, $smtp_comment, $header_comment) = $guess_query->result();
  775   if (defined $result and $result eq "pass") {
  776     my $ip = $query->ip;
  777     $header_comment = $query->sanitize("seems reasonable for $query->{sender} to mail through $ip");
  778     return ($result, $smtp_comment, $header_comment) if wantarray;
  779     return $result;
  780   }
  781 
  782   return $query->sanitize("neutral");
  783 }
  784 
  785 sub trusted_forwarder {
  786   my $query = shift;
  787   my $guess_mechs = shift || $TRUSTED_FORWARDER;
  788   return $query->best_guess($guess_mechs);
  789 }
  790 
  791 # ----------------------------------------------------------
  792 
  793 =head2 C<< $query->sanitize('string') >>
  794 
  795 This applies the sanitization rules for the particular query object. These
  796 rules are controlled by the C<sanitize> parameter to the c<new()> method.
  797 
  798 =cut
  799 
  800 sub sanitize {
  801   my $query = shift;
  802   my $txt = shift;
  803 
  804   if (ref($query->{sanitize})) {
  805       $txt = $query->{sanitize}->($txt);
  806   }
  807 
  808   return $txt;
  809 }
  810 
  811 # ----------------------------------------------------------
  812 
  813 =head2 C<< strict_sanitize('string') >>
  814 
  815 This ensures that all the characters in the returned string are printable.  All
  816 whitespace is converted into spaces, and all other non-printable characters are
  817 converted into question marks.  This is probably over-aggressive for many
  818 applications.
  819 
  820 This function is used by default when the C<sanitize> option is passed to the
  821 C<new()> method.
  822 
  823 B<This function is not a class method.>
  824 
  825 =cut
  826 
  827 sub strict_sanitize {
  828   my $txt = shift;
  829 
  830   $txt =~ s/\s/ /g;
  831   $txt =~ s/[^[:print:]]/?/g;
  832 
  833   return $txt;
  834 }
  835 
  836 # ----------------------------------------------------------
  837 
  838 =head2 C<< $query->debuglog() >>
  839 
  840 Subclasses may override this with their own debug logger.  C<Log::Dispatch> is
  841 recommended.
  842 
  843 Alternatively, pass the C<new()> constructor a C<< debuglog => sub { ... } >>
  844 callback, and we'll pass debugging lines to that.
  845 
  846 =cut
  847 
  848 sub debuglog {
  849   my $query = shift;
  850   return if ref $query and not $query->{debug};
  851   
  852   my $toprint = join (" ", @_);
  853   chomp $toprint;
  854   $toprint = sprintf ("%-8s %s %s %s",
  855                       ("|" x ($query->top->{lookup_count}+1)),
  856                       $query->{localpart},
  857                       $query->{domain},
  858                       $toprint);
  859 
  860   if (exists $query->{debuglog} and ref $query->{debuglog} eq "CODE") {
  861     eval { $query->{debuglog}->($toprint) };
  862   }
  863   else {
  864     printf STDERR "%s", "$toprint\n";
  865   }
  866 }
  867 
  868 # ----------------------------------------------------------
  869 #                           spfquery
  870 # ----------------------------------------------------------
  871 
  872 sub spfquery {
  873   #
  874   # usage: my ($result, $explanation, $text, $time) = $query->spfquery( [ GUESS_MECHS ] )
  875   #
  876   #  performs a full SPF resolution using the data in $query.  to use different data, clone the object.
  877   #
  878   #  if GUESS_MECHS is present, we are operating in "guess" mode so we will not actually query the domain for TXT; we will use the guess_mechs instead.
  879   #
  880   my $query = shift;
  881   my $guess_mechs = shift;
  882 
  883   if ($query->{ipv4} and
  884       $query->{ipv4}=~ /^127\./) { return "pass", "localhost is always allowed." }
  885 
  886   $query->top->{lookup_count}++;
  887 
  888   if ($query->is_looping)            { return "unknown", $query->{spf_error_explanation}, $query->is_looping }
  889   if ($query->can_use_cached_result) { return $query->cached_result; }
  890   else                               { $query->tell_cache_that_lookup_is_underway; }
  891 
  892   my $directive_set = DirectiveSet->new($query->{domain}, $query, $guess_mechs, $query->{local}, $query->{default_record});
  893 
  894   if (not defined $directive_set) {
  895     $query->debuglog("no SPF record found for $query->{domain}");
  896     $query->delete_cache_point;
  897     if ($query->{domain} ne $query->{orig_domain}) {
  898         if ($query->{error}) {
  899             return "error", $query->{spf_error_explanation}, $query->{error};
  900         }
  901         return "unknown", $query->{spf_error_explanation}, "Missing SPF record at $query->{domain}";
  902     }
  903     if ($query->{last_dns_error} eq 'NXDOMAIN') {
  904         my $explanation = $query->macro_substitute($query->{default_explanation});
  905         return "unknown", $explanation, "domain of sender $query->{sender} does not exist";
  906     }
  907     return "none", "SPF", "domain of sender $query->{sender} does not designate mailers";
  908   }
  909 
  910   if ($directive_set->{hard_syntax_error}) {
  911     $query->debuglog("  syntax error while parsing $directive_set->{txt}");
  912     $query->delete_cache_point;
  913     return "unknown", $query->{spf_error_explanation}, $directive_set->{hard_syntax_error};
  914   }
  915 
  916   $query->{directive_set} = $directive_set;
  917 
  918   foreach my $mechanism ($directive_set->mechanisms) {
  919     my ($result, $comment) = $query->evaluate_mechanism($mechanism);
  920 
  921     if ($query->{error}) {
  922       $query->debuglog("  returning temporary error: $query->{error}");
  923       $query->delete_cache_point;
  924       return "error", $query->{spf_error_explanation}, $query->{error};
  925     }
  926 
  927     if (defined $result) {
  928       $query->debuglog("  saving result $result to cache point and returning.");
  929       my $explanation = $query->interpolate_explanation(
  930             ($result =~ /^unknown/)
  931             ? $query->{spf_error_explanation} : $query->{default_explanation});
  932       $query->save_result_to_cache($result,
  933                                    $explanation,
  934                                    $comment,
  935                                    $query->{directive_set}->{orig_txt});
  936       $query->{matched_mechanism} = $mechanism;
  937       return $result, $explanation, $comment, $query->{directive_set}->{orig_txt};
  938     }
  939   }
  940 
  941   # run the redirect modifier
  942   if ($query->{directive_set}->redirect) {
  943     my $new_domain = $query->macro_substitute($query->{directive_set}->redirect);
  944 
  945     $query->debuglog("  executing redirect=$new_domain");
  946 
  947     my $inner_query = $query->clone(domain => $new_domain,
  948                                     reason => "redirects to $new_domain",
  949                                    );
  950 
  951     my @inner_result = $inner_query->spfquery();
  952 
  953     $query->delete_cache_point;
  954 
  955     $query->debuglog("  executed redirect=$new_domain, got result @inner_result");
  956 
  957     $query->{spf_source} = $inner_query->{spf_source};
  958     $query->{spf_source_type} = $inner_query->{spf_source_type};
  959     $query->{matched_mechanism} = $inner_query->{matched_mechanism};
  960 
  961     return @inner_result;
  962   }
  963 
  964   $query->debuglog("  no mechanisms matched; deleting cache point and using neutral");
  965   $query->delete_cache_point;
  966   return "neutral", $query->interpolate_explanation($query->{default_explanation}), $directive_set->{soft_syntax_error};
  967 }
  968 
  969 # ----------------------------------------------------------
  970 #             we cache into $Domains_Queried.
  971 # ----------------------------------------------------------
  972 
  973 sub cache_point {
  974   my $query = shift;
  975   return my $cache_point = join "/", ($query->{best_guess}  || 0,
  976                                       $query->{guess_mechs} || "",
  977                                       $query->{ipv4},
  978                                       $query->{localpart},
  979                                       $query->{domain},
  980                                       $query->{default_record},
  981                                       $query->{local});
  982 }
  983 
  984 sub is_looping {
  985   my $query = shift;
  986   my $cache_point = $query->cache_point;
  987 
  988   return join(" ", "loop encountered:", @{$query->{loop_report}})
  989     if  exists $Domains_Queried->{$cache_point}
  990     and not defined $Domains_Queried->{$cache_point}->[0];
  991 
  992   return join(" ", "query caused more than" . $query->max_lookup_count . " lookups:", @{$query->{loop_report}})
  993     if $query->max_lookup_count and $query->top->{lookup_count} > $query->max_lookup_count;
  994 
  995   return 0;
  996 }
  997 
  998 sub max_lookup_count {
  999   my $query = shift;
 1000   return $query->{max_lookup_count} || $MAX_LOOKUP_COUNT;
 1001 }
 1002 
 1003 sub can_use_cached_result {
 1004   my $query = shift;
 1005   my $cache_point = $query->cache_point;
 1006 
 1007   if ($Domains_Queried->{$cache_point}) {
 1008     $query->debuglog("  lookup: we have already processed $query->{domain} before with $query->{ipv4}.");
 1009     my @cached = @{ $Domains_Queried->{$cache_point} };
 1010     if (not defined $CACHE_TIMEOUT
 1011         or time - $cached[-1] > $CACHE_TIMEOUT) {
 1012       $query->debuglog("  lookup: but its cache entry is stale; deleting it.");
 1013       delete $Domains_Queried->{$cache_point};
 1014       return 0;
 1015     }
 1016 
 1017     $query->debuglog("  lookup: the cache entry is fresh; returning it.");
 1018     return 1;
 1019   }
 1020   return 0;
 1021 }
 1022 
 1023 sub tell_cache_that_lookup_is_underway {
 1024   my $query = shift;
 1025 
 1026   # define an entry here so we don't loop endlessly in an Include loop.
 1027   $Domains_Queried->{$query->cache_point} = [undef, undef, undef, undef, time];
 1028 }
 1029 
 1030 sub save_result_to_cache {
 1031   my $query = shift;
 1032   my ($result, $explanation, $comment, $orig_txt) = (shift, shift, shift, shift);
 1033 
 1034   # define an entry here so we don't loop endlessly in an Include loop.
 1035   $Domains_Queried->{$query->cache_point} = [$result, $explanation, $comment, $orig_txt, time];
 1036 }
 1037 
 1038 sub cached_result {
 1039   my $query = shift;
 1040   my $cache_point = $query->cache_point;
 1041 
 1042   if ($Domains_Queried->{$cache_point}) {
 1043     return @{ $Domains_Queried->{$cache_point} };
 1044   }
 1045   return;
 1046 }
 1047 
 1048 sub delete_cache_point {
 1049   my $query = shift;
 1050   delete $Domains_Queried->{$query->cache_point};
 1051 }
 1052 
 1053 sub clear_cache {
 1054   $Domains_Queried = {};
 1055 }
 1056 
 1057 sub get_ptr_domain {
 1058     my ($query) = shift;
 1059 
 1060     return $query->{ptr_domain} if ($query->{ptr_domain});
 1061     
 1062     foreach my $ptrdname ($query->myquery(reverse_in_addr($query->{ipv4}) . ".in-addr.arpa", "PTR", "ptrdname")) {
 1063         $query->debuglog("  get_ptr_domain: $query->{ipv4} is $ptrdname");
 1064     
 1065         $query->debuglog("  get_ptr_domain: checking hostname $ptrdname for legitimacy.");
 1066     
 1067         # check for legitimacy --- PTR -> hostname A -> PTR
 1068         foreach my $ptr_to_a ($query->myquery($ptrdname, "A", "address")) {
 1069           
 1070             $query->debuglog("  get_ptr_domain: hostname $ptrdname -> $ptr_to_a");
 1071       
 1072             if ($ptr_to_a eq $query->{ipv4}) {
 1073                 return $query->{ptr_domain} = $ptrdname;
 1074             }
 1075         }
 1076     }
 1077 
 1078     return undef;
 1079 }
 1080 
 1081 sub macro_substitute_item {
 1082     my $query = shift;
 1083     my $arg = shift;
 1084 
 1085     if ($arg eq "%") { return "%" }
 1086     if ($arg eq "_") { return " " }
 1087     if ($arg eq "-") { return "%20" }
 1088 
 1089     $arg =~ s/^{(.*)}$/$1/;
 1090 
 1091     my ($field, $num, $reverse, $delim) = $arg =~ /^(x?\w)(\d*)(r?)(.*)$/;
 1092 
 1093     $delim = '.' if not length $delim;
 1094 
 1095     my $newval = $arg;
 1096     my $timestamp = time;
 1097 
 1098     $newval = $query->{localpart}       if (lc $field eq 'u');
 1099     $newval = $query->{localpart}       if (lc $field eq 'l');
 1100     $newval = $query->{domain}          if (lc $field eq 'd');
 1101     $newval = $query->{sender}          if (lc $field eq 's');
 1102     $newval = $query->{orig_domain}     if (lc $field eq 'o');
 1103     $newval = $query->ip                if (lc $field eq 'i');
 1104     $newval = $timestamp                if (lc $field eq 't');
 1105     $newval = $query->{helo}            if (lc $field eq 'h');
 1106     $newval = $query->get_ptr_domain    if (lc $field eq 'p');
 1107     $newval = $query->{myhostname}      if (lc $field eq 'r');  # only used in explanation
 1108     $newval = $query->{ipv4} ? 'in-addr' : 'ip6'
 1109                                         if (lc $field eq 'v');
 1110 
 1111     # We need to escape a bunch of characters inside a character class
 1112     $delim =~ s/([\^\-\]\:\\])/\\$1/g;
 1113 
 1114     if (length $delim) {
 1115         my @parts = split /[$delim]/, $newval;
 1116 
 1117         @parts = reverse @parts if ($reverse);
 1118 
 1119         if ($num) {
 1120             while (@parts > $num) { shift @parts }
 1121         }
 1122 
 1123         $newval = join ".", @parts;
 1124     }
 1125 
 1126     $newval = uri_escape($newval)       if ($field ne lc $field);
 1127 
 1128     $query->debuglog("  macro_substitute_item: $arg: field=$field, num=$num, reverse=$reverse, delim=$delim, newval=$newval");
 1129 
 1130     return $newval;
 1131 }
 1132 
 1133 sub macro_substitute {
 1134     my $query = shift;
 1135     my $arg = shift;
 1136     my $maxlen = shift;
 1137 
 1138     my $original = $arg;
 1139 
 1140     # macro-char   = ( '%{' alpha *digit [ 'r' ] *delim '}' )
 1141     #                / '%%'
 1142     #                / '%_'
 1143     #                / '%-'
 1144 
 1145     $arg =~ s/%([%_-]|{(\w[^}]*)})/$query->macro_substitute_item($1)/ge;
 1146 
 1147     if ($maxlen && length $arg > $maxlen) {
 1148       $arg = substr($arg, -$maxlen);  # super.long.string -> er.long.string
 1149       $arg =~ s/[^.]*\.//;            #    er.long.string ->    long.string
 1150     }
 1151     $query->debuglog("  macro_substitute: $original -> $arg") if ($original ne $arg);
 1152     return $arg;
 1153 }
 1154 
 1155 # ----------------------------------------------------------
 1156 #                    display_mechanism
 1157 # 
 1158 # in human-readable form; used in header_pairs above.
 1159 # ----------------------------------------------------------
 1160 
 1161 sub display_mechanism {
 1162   my ($modifier, $mechanism, $argument, $source) = @{shift()};
 1163 
 1164   return "$modifier$mechanism" . (length($argument) ? ":$argument" : "");
 1165 }
 1166 
 1167 # ----------------------------------------------------------
 1168 #                    evaluate_mechanism
 1169 # ----------------------------------------------------------
 1170 
 1171 sub evaluate_mechanism {
 1172   my $query = shift;
 1173   my ($modifier, $mechanism, $argument, $source) = @{shift()};
 1174 
 1175   $modifier = "+" if not length $modifier;
 1176 
 1177   $query->debuglog("  evaluate_mechanism: $modifier$mechanism($argument) for domain=$query->{domain}");
 1178 
 1179   if ({ map { $_=>1 } @KNOWN_MECHANISMS }->{$mechanism}) {
 1180     my $mech_sub = "mech_$mechanism";
 1181     my ($hit, $text) = $query->$mech_sub($query->macro_substitute($argument, 255));
 1182     no warnings 'uninitialized';
 1183     $query->debuglog("  evaluate_mechanism: $modifier$mechanism($argument) returned $hit $text");
 1184 
 1185     return if not $hit;
 1186 
 1187     return ($hit, $text) if ($hit ne "hit");
 1188     
 1189     if ($source) {
 1190       $query->{spf_source} = $source;
 1191       $query->{spf_source_type} = "from mechanism $mechanism";
 1192     }
 1193 
 1194     return $query->shorthand2value($modifier), $text;
 1195   }
 1196   else {
 1197     my $unrecognized_mechanism = join ("",
 1198                                        ($modifier eq "+" ? "" : $modifier),
 1199                                        $mechanism,
 1200                                        ($argument ? ":" : ""),
 1201                                        $argument);
 1202     my $error_string = "unknown $unrecognized_mechanism";
 1203     $query->debuglog("  evaluate_mechanism: unrecognized mechanism $unrecognized_mechanism, returning $error_string");
 1204     return $error_string => "unrecognized mechanism $unrecognized_mechanism";
 1205   }
 1206 
 1207   return ("neutral", "evaluate-mechanism: neutral");
 1208 }
 1209 
 1210 # ----------------------------------------------------------
 1211 #            myquery wraps DNS resolver queries
 1212 #
 1213 # ----------------------------------------------------------
 1214 
 1215 sub myquery {
 1216   my $query = shift;
 1217   my $label = shift;
 1218   my $qtype = shift;
 1219   my $method = shift;
 1220   my $sortby = shift;
 1221 
 1222   $query->debuglog("  myquery: doing $qtype query on $label");
 1223 
 1224   for ($label) {
 1225     if (/\.\./ or /^\./) {
 1226       # convert .foo..com to foo.com, etc.
 1227       $query->debuglog("  myquery: fixing up invalid syntax in $label");
 1228       s/\.\.+/\./g;
 1229       s/^\.//;
 1230       $query->debuglog("  myquery: corrected label is $label");
 1231     }
 1232   }
 1233   my $resquery = $query->resolver->query($label, $qtype);
 1234 
 1235   my $errorstring = $query->resolver->errorstring;
 1236   if (not $resquery and $errorstring eq "NOERROR") {
 1237     return;
 1238   }
 1239 
 1240   $query->{last_dns_error} = $errorstring;
 1241 
 1242   if (not $resquery) {
 1243     if ($errorstring eq "NXDOMAIN") {
 1244       $query->debuglog("  myquery: $label $qtype failed: NXDOMAIN.");
 1245       return;
 1246     }
 1247 
 1248     $query->debuglog("  myquery: $label $qtype lookup error: $errorstring");
 1249     $query->debuglog("  myquery: will set error condition.");
 1250     $query->set_temperror("DNS error while looking up $label $qtype: $errorstring");
 1251     return;
 1252   }
 1253 
 1254   my @answers = grep { lc $_->type eq lc $qtype } $resquery->answer;
 1255 
 1256   # $query->debuglog("  myquery: found $qtype response: @answers");
 1257 
 1258   my @toreturn;
 1259   if ($sortby) { @toreturn = map { rr_method($_,$method) } sort { $a->$sortby() <=> $b->$sortby() } @answers; }
 1260   else         { @toreturn = map { rr_method($_,$method) }                                          @answers; }
 1261 
 1262   if (not @toreturn) {
 1263     $query->debuglog("  myquery: result had no data.");
 1264     return;
 1265   }
 1266 
 1267   return @toreturn;
 1268 }
 1269 
 1270 sub rr_method {
 1271   my ($answer, $method) = @_;
 1272   if ($method ne "char_str_list") { return $answer->$method() }
 1273 
 1274   # long TXT records can't be had with txtdata; they need to be pulled out with char_str_list which returns a list of strings
 1275   # that need to be joined.
 1276 
 1277   my @char_str_list = $answer->$method();
 1278   # print "rr_method returning join of @char_str_list\n";
 1279 
 1280   return join "", @char_str_list;
 1281 }
 1282 
 1283 #
 1284 # Mechanisms return one of the following:
 1285 #
 1286 # undef     mechanism did not match
 1287 # "hit"     mechanism matched
 1288 # "unknown" some error happened during processing
 1289 # "error"   some temporary error
 1290 #
 1291 # ----------------------------------------------------------
 1292 #                           all
 1293 # ----------------------------------------------------------
 1294 
 1295 sub mech_all {
 1296   my $query = shift;
 1297   return "hit" => "default";
 1298 }
 1299 
 1300 # ----------------------------------------------------------
 1301 #                         include
 1302 # ----------------------------------------------------------
 1303 
 1304 sub mech_include {
 1305   my $query = shift;
 1306   my $argument = shift;
 1307 
 1308   if (not $argument) {
 1309     $query->debuglog("  mechanism include: no argument given.");
 1310     return "unknown", "include mechanism not given an argument";
 1311   }
 1312 
 1313   $query->debuglog("  mechanism include: recursing into $argument");
 1314 
 1315   my $inner_query = $query->clone(domain => $argument,
 1316                                   reason => "includes $argument",
 1317                                   local => undef,
 1318                                   trusted => undef,
 1319                                   guess => undef,
 1320                                   default_record => undef,
 1321                                  );
 1322 
 1323   my ($result, $explanation, $text, $orig_txt, $time) = $inner_query->spfquery();
 1324 
 1325   $query->debuglog("  mechanism include: got back result $result / $text / $time");
 1326 
 1327   if ($result eq "pass")            { return hit     => $text, $time; }
 1328   if ($result eq "error")           { return $result => $text, $time; }
 1329   if ($result eq "unknown")         { return $result => $text, $time; }
 1330   if ($result eq "none")            { return unknown => $text, $time; } # fail-safe mode.  convert an included NONE into an UNKNOWN error.
 1331   if ($result eq "fail" ||
 1332       $result eq "neutral" ||
 1333       $result eq "softfail")        { return undef,     $text, $time; }
 1334   
 1335   $query->debuglog("  mechanism include: reducing result $result to unknown");
 1336   return "unknown", $text, $time;
 1337 }
 1338 
 1339 # ----------------------------------------------------------
 1340 #                            a
 1341 # ----------------------------------------------------------
 1342 
 1343 sub mech_a {
 1344   my $query = shift;
 1345   my $argument = shift;
 1346   
 1347   my $ip4_cidr_length = ($argument =~ s/  \/(\d+)//x) ? $1 : 32;
 1348   my $ip6_cidr_length = ($argument =~ s/\/\/(\d+)//x) ? $1 : 128;
 1349 
 1350   my $domain_to_use = $argument || $query->{domain};
 1351 
 1352   # see code below in ip4 for more validation
 1353   if ($domain_to_use !~ / \. [a-z] (?: [a-z0-9-]* [a-z0-9] ) $ /ix) {
 1354     return ("unknown" => "bad argument to a: $domain_to_use not a valid FQDN");
 1355   }
 1356 
 1357   foreach my $a ($query->myquery($domain_to_use, "A", "address")) {
 1358     $query->debuglog("  mechanism a: $a");
 1359     if ($a eq $query->{ipv4}) {
 1360       $query->debuglog("  mechanism a: match found: $domain_to_use A $a == $query->{ipv4}");
 1361       return "hit", "$domain_to_use A $query->{ipv4}";
 1362     }
 1363     elsif ($ip4_cidr_length < 32) {
 1364       my $cidr = Net::CIDR::Lite->new("$a/$ip4_cidr_length");
 1365 
 1366       $query->debuglog("  mechanism a: looking for $query->{ipv4} in $a/$ip4_cidr_length");
 1367       
 1368       return (hit => "$domain_to_use A $a /$ip4_cidr_length contains $query->{ipv4}")
 1369         if $cidr->find($query->{ipv4});
 1370     }
 1371   }
 1372   return;
 1373 }
 1374 
 1375 # ----------------------------------------------------------
 1376 #                            mx
 1377 # ----------------------------------------------------------
 1378 
 1379 sub mech_mx {
 1380   my $query = shift;
 1381   my $argument = shift;
 1382 
 1383   my $ip4_cidr_length = ($argument =~ s/  \/(\d+)//x) ? $1 : 32;
 1384   my $ip6_cidr_length = ($argument =~ s/\/\/(\d+)//x) ? $1 : 128;
 1385 
 1386   my $domain_to_use = $argument || $query->{domain};
 1387 
 1388   if ($domain_to_use !~ / \. [a-z] (?: [a-z0-9-]* [a-z0-9] ) $ /ix) {
 1389     return ("unknown" => "bad argument to mx: $domain_to_use not a valid FQDN");
 1390   }
 1391 
 1392   my @mxes = $query->myquery($domain_to_use, "MX", "exchange", "preference");
 1393 
 1394   foreach my $mx (@mxes) {
 1395     # $query->debuglog("  mechanism mx: $mx");
 1396 
 1397     foreach my $a ($query->myquery($mx, "A", "address")) {
 1398       if ($a eq $query->{ipv4}) {
 1399         $query->debuglog("  mechanism mx: we have a match; $domain_to_use MX $mx A $a == $query->{ipv4}");
 1400         return "hit", "$domain_to_use MX $mx A $a";
 1401       }
 1402       elsif ($ip4_cidr_length < 32) {
 1403         my $cidr = Net::CIDR::Lite->new("$a/$ip4_cidr_length");
 1404 
 1405         $query->debuglog("  mechanism mx: looking for $query->{ipv4} in $a/$ip4_cidr_length");
 1406 
 1407         return (hit => "$domain_to_use MX $mx A $a /$ip4_cidr_length contains $query->{ipv4}")
 1408           if $cidr->find($query->{ipv4});
 1409 
 1410       }
 1411     }
 1412   }
 1413   return;
 1414 }
 1415 
 1416 # ----------------------------------------------------------
 1417 #                           ptr
 1418 # ----------------------------------------------------------
 1419 
 1420 sub mech_ptr {
 1421   my $query = shift;
 1422   my $argument = shift;
 1423 
 1424   if ($query->{ipv6}) { return "neutral", "ipv6 not yet supported"; }
 1425 
 1426   my $domain_to_use = $argument || $query->{domain};
 1427 
 1428   foreach my $ptrdname ($query->myquery(reverse_in_addr($query->{ipv4}) . ".in-addr.arpa", "PTR", "ptrdname")) {
 1429     $query->debuglog("  mechanism ptr: $query->{ipv4} is $ptrdname");
 1430     
 1431     $query->debuglog("  mechanism ptr: checking hostname $ptrdname for legitimacy.");
 1432     
 1433     # check for legitimacy --- PTR -> hostname A -> PTR
 1434     foreach my $ptr_to_a ($query->myquery($ptrdname, "A", "address")) {
 1435       
 1436       $query->debuglog("  mechanism ptr: hostname $ptrdname -> $ptr_to_a");
 1437       
 1438       if ($ptr_to_a eq $query->{ipv4}) {
 1439         $query->debuglog("  mechanism ptr: we have a valid PTR: $query->{ipv4} PTR $ptrdname A $ptr_to_a");
 1440         $query->debuglog("  mechanism ptr: now we see if $ptrdname ends in $domain_to_use.");
 1441         
 1442         if ($ptrdname =~ /(^|\.)\Q$domain_to_use\E$/i) {
 1443           $query->debuglog("  mechanism ptr: $query->{ipv4} PTR $ptrdname does end in $domain_to_use.");
 1444           return hit => "$query->{ipv4} PTR $ptrdname matches $domain_to_use";
 1445         }
 1446         else {
 1447           $query->debuglog("  mechanism ptr: $ptrdname does not end in $domain_to_use.  no match.");
 1448         }
 1449       }
 1450     }
 1451   }
 1452   return;
 1453 }
 1454 
 1455 # ----------------------------------------------------------
 1456 #                            exists
 1457 # ----------------------------------------------------------
 1458 
 1459 sub mech_exists {
 1460   my $query = shift;
 1461   my $argument = shift;
 1462 
 1463   return if (!$argument);
 1464 
 1465   my $domain_to_use = $argument;
 1466 
 1467   $query->debuglog("  mechanism exists: looking up $domain_to_use");
 1468   
 1469   foreach ($query->myquery($domain_to_use, "A", "address")) {
 1470     $query->debuglog("  mechanism exists: $_");
 1471     $query->debuglog("  mechanism exists: we have a match.");
 1472     my @txt = map { s/^"//; s/"$//; $_ } $query->myquery($domain_to_use, "TXT", "char_str_list");
 1473     if (@txt) {
 1474         return hit => join(" ", @txt);
 1475     }
 1476     return hit => "$domain_to_use found";
 1477   }
 1478   return;
 1479 }
 1480 
 1481 # ----------------------------------------------------------
 1482 #                           ip4
 1483 # ----------------------------------------------------------
 1484 
 1485 sub mech_ip4 {
 1486   my $query = shift;
 1487   my $cidr_spec = shift;
 1488 
 1489   if ($cidr_spec eq '') {
 1490     return ("unknown" => "no argument given to ip4");
 1491   }
 1492 
 1493   my ($network, $cidr_length) = split (/\//, $cidr_spec, 2);
 1494 
 1495   if (
 1496     $network !~ /^\d+\.\d+\.\d+\.\d+$/ ||
 1497     (defined($cidr_length) && $cidr_length !~ /^\d+$/)
 1498   ) { return ("unknown" => "bad argument to ip4: $cidr_spec"); }
 1499   
 1500   $cidr_length = "32" if not defined $cidr_length;
 1501 
 1502   local $@;
 1503   my $cidr = eval { Net::CIDR::Lite->new("$network/$cidr_length") };
 1504   if ($@) { return ("unknown" => "unable to parse ip4:$cidr_spec"); }
 1505 
 1506   $query->debuglog("  mechanism ip4: looking for $query->{ipv4} in $cidr_spec");
 1507 
 1508   return (hit => "$cidr_spec contains $query->{ipv4}") if $cidr->find($query->{ipv4});
 1509 
 1510   return;
 1511 }
 1512 
 1513 # ----------------------------------------------------------
 1514 #                           ip6
 1515 # ----------------------------------------------------------
 1516 
 1517 sub mech_ip6 {
 1518   my $query = shift;
 1519 
 1520   return;
 1521 }
 1522 
 1523 # ----------------------------------------------------------
 1524 #                        functions
 1525 # ----------------------------------------------------------
 1526 
 1527 sub ip { # accessor
 1528   my $query = shift;
 1529   return $query->{ipv4} || $query->{ipv6};
 1530 }
 1531 
 1532 sub reverse_in_addr {
 1533   return join (".", (reverse split /\./, shift));
 1534 }
 1535 
 1536 sub resolver {
 1537   my $query = shift;
 1538   return $query->{res} ||= Net::DNS::Resolver->new(
 1539                                                    tcp_timeout => $DNS_RESOLVER_TIMEOUT,
 1540                                                    udp_timeout => $DNS_RESOLVER_TIMEOUT,
 1541                                                   );
 1542 }
 1543 
 1544 sub fallbacks {
 1545   my $query = shift;
 1546   return @{$query->{fallbacks}};
 1547 }
 1548 
 1549 sub shorthand2value {
 1550   my $query = shift;
 1551   my $shorthand = shift;
 1552   return { "-" => "fail",
 1553            "+" => "pass",
 1554            "~" => "softfail",
 1555            "?" => "neutral" } -> {$shorthand} || $shorthand;
 1556 }
 1557 
 1558 sub value2shorthand {
 1559   my $query = shift;
 1560   my $value = lc shift;
 1561   return { "fail"     => "-",
 1562            "pass"     => "+",
 1563            "softfail" => "~",
 1564            "deny"     => "-",
 1565            "allow"    => "+",
 1566            "softdeny" => "~",
 1567            "unknown"  => "?",
 1568            "neutral"  => "?" } -> {$value} || $value;
 1569 }
 1570 
 1571 sub interpolate_explanation {
 1572   my $query = shift;
 1573   my $txt = shift;
 1574 
 1575   if ($query->{directive_set}->explanation) {
 1576     my @txt = map { s/^"//; s/"$//; $_ } $query->myquery($query->macro_substitute($query->{directive_set}->explanation), "TXT", "char_str_list");
 1577     $txt = join " ", @txt;
 1578   }
 1579 
 1580   return $query->macro_substitute($txt);
 1581 }
 1582 
 1583 sub find_ancestor {
 1584   my $query = shift;
 1585   my $which_hash = shift;
 1586   my $current_domain = shift;
 1587 
 1588   return if not exists $query->{$which_hash};
 1589 
 1590   $current_domain =~ s/\.$//g;
 1591   my @current_domain = split /\./, $current_domain;
 1592 
 1593   foreach my $ancestor_level (0 .. @current_domain) {
 1594     my @ancestor = @current_domain;
 1595     for (1 .. $ancestor_level) { shift @ancestor }
 1596     my $ancestor = join ".", @ancestor;
 1597 
 1598     for my $match ($ancestor_level > 0 ? "*.$ancestor" : $ancestor) {
 1599       $query->debuglog("  DirectiveSet $which_hash: is $match in the $which_hash hash?");
 1600       if (my $record = $query->{$which_hash}->{lc $match}) {
 1601         $query->debuglog("  DirectiveSet $which_hash: yes, it is.");
 1602         return wantarray ? ($which_hash, $match, $record) : $record;
 1603       }
 1604     }
 1605   }
 1606   return;
 1607 }
 1608 
 1609 sub found_record_for {
 1610   my $query = shift;
 1611   my ($which_hash, $matched_domain_glob, $record) = $query->find_ancestor(@_);
 1612   return if not $record;
 1613   $query->{spf_source} = "explicit $which_hash found: $matched_domain_glob defines $record";
 1614   $query->{spf_source_type} = "full-explanation";
 1615   $record = "v=spf1 $record" if $record !~ /^v=spf1\b/i;
 1616   return $record;
 1617 }
 1618 
 1619 sub try_override {
 1620   my $query = shift;
 1621   return $query->found_record_for("override", @_);
 1622 }
 1623 
 1624 sub try_fallback {
 1625   my $query = shift;
 1626   return $query->found_record_for("fallback", @_);
 1627 }
 1628 
 1629 # ----------------------------------------------------------
 1630 #                     algo
 1631 # ----------------------------------------------------------
 1632 
 1633 {
 1634   package DirectiveSet;
 1635 
 1636   sub new {
 1637     my $class = shift;
 1638     my $current_domain = shift;
 1639     my $query = shift;
 1640     my $override_text = shift;
 1641     my $localpolicy = shift;
 1642     my $default_record = shift;
 1643 
 1644     my $txt;
 1645 
 1646     # Overrides can come from two places:
 1647     # - When operating in best_guess mode, spfquery may be called with a $guess_mechs argument, which comes in as $override_text.
 1648     # - When operating with ->new(..., override => { ... }) we need to load the override dynamically.
 1649     if ($override_text) {
 1650       $txt = "v=spf1 $override_text ?all";
 1651       $query->{spf_source} = "local policy";
 1652       $query->{spf_source_type} = "full-explanation";
 1653     }
 1654     elsif (exists $query->{override}) {
 1655       $txt = $query->try_override($current_domain);
 1656     }
 1657 
 1658     # Retrieve a record from DNS:
 1659     if (!defined $txt) {
 1660       my @txt;
 1661       $query->debuglog("  DirectiveSet->new(): doing TXT query on $current_domain");
 1662       @txt = $query->myquery($current_domain, "TXT", "char_str_list");
 1663       $query->debuglog("  DirectiveSet->new(): TXT query on $current_domain returned error=$query->{error}, last_dns_error=$query->{last_dns_error}");
 1664 
 1665       # Combine multiple TXT strings into a single string:
 1666       foreach (@txt) {
 1667         $txt .= $1 if /^v=spf1\s*(.*)$/;
 1668       }
 1669 
 1670       $txt = undef
 1671         if $query->{error} or $query->{last_dns_error} eq 'NXDOMAIN';
 1672     }
 1673 
 1674     # Try the fallbacks:
 1675     if (!defined $txt and exists $query->{fallback}) {
 1676       $query->debuglog("  DirectiveSet->new(): will try fallbacks.");
 1677       $txt = $query->try_fallback($current_domain, "fallback");
 1678       defined($txt)
 1679         or $query->debuglog("  DirectiveSet->new(): fallback search failed.");
 1680     }
 1681 
 1682     if (!defined $txt and defined $default_record) {
 1683       $txt = "v=spf1 $default_record ?all";
 1684       $query->{spf_source} = "local policy";
 1685       $query->{spf_source_type} = "full-explanation";
 1686     }
 1687 
 1688     $query->debuglog("  DirectiveSet->new(): SPF policy: $txt");
 1689 
 1690     return if not defined $txt;
 1691 
 1692     # TODO: the prepending of the v=spf1 is a massive hack; get it right by saving the actual raw orig_txt.
 1693     my $directive_set = bless { orig_txt => ($txt =~ /^v=spf1/ ? $txt : "v=spf1 $txt"), txt => $txt } , $class;
 1694 
 1695     TXT_RESPONSE:
 1696     for ($txt) {
 1697       $query->debuglog("  lookup:   TXT $_");
 1698 
 1699       # parse the policy record
 1700       
 1701       while (/\S/) {
 1702         s/^\s*(\S+)\s*//;
 1703         my $word = $1;
 1704         # $query->debuglog("  lookup:  word parsing word $word");
 1705         if ($word =~ /^v=(\S+)/i) {
 1706           my $version = $1;
 1707           $query->debuglog("  lookup:   TXT version=$version");
 1708           $directive_set->{version} = $version;
 1709           next TXT_RESPONSE if ($version ne "spf1");
 1710           next;
 1711         }
 1712 
 1713         # modifiers always have an = sign.
 1714         if (my ($lhs, $rhs) = $word =~ /^([^:\/]+)=(\S*)$/) {
 1715           # $query->debuglog("  lookup:   TXT modifier found: $lhs = $rhs");
 1716 
 1717           # if we ever come to support multiple of the same modifier, we need to make this a list.
 1718           $directive_set->{modifiers}->{lc $lhs} = $rhs;
 1719           next;
 1720         }
 1721 
 1722         # RHS optional, defaults to domain.
 1723         # [:/] matches a:foo and a/24
 1724         if (my ($prefix, $lhs, $rhs) = $word =~ /^([-~+?]?)([\w_-]+)([\/:]\S*)?$/i) {
 1725           $rhs =~ s/^://;
 1726           $prefix ||= "+";
 1727           $query->debuglog("  lookup:   TXT prefix=$prefix, lhs=$lhs, rhs=$rhs");
 1728           push @{$directive_set->{mechanisms}}, [$prefix => lc $lhs => $rhs];
 1729           next;
 1730         }
 1731 
 1732       }
 1733     }
 1734 
 1735     if (my $rhs = delete $directive_set->{modifiers}->{default}) {
 1736       push @{$directive_set->{mechanisms}}, [ $query->value2shorthand($rhs), all => undef ];
 1737     }
 1738 
 1739     $directive_set->{mechanisms} = []           if not $directive_set->{mechanisms};
 1740     if ($localpolicy) {
 1741         my $mechanisms = $directive_set->{mechanisms};
 1742         my $lastmech = $mechanisms->[$#$mechanisms];
 1743         if (($lastmech->[0] eq '-' || $lastmech->[0] eq '?') &&
 1744              $lastmech->[1] eq 'all') {
 1745             my $index;
 1746 
 1747             for ($index = $#$mechanisms - 1; $index >= 0; $index--) {
 1748                 last if ($lastmech->[0] ne $mechanisms->[$index]->[0]);
 1749             }
 1750             if ($index >= 0) {
 1751                 # We want to insert the localpolicy just *after* $index
 1752                 $query->debuglog("  inserting local policy mechanisms into @{[$directive_set->show_mechanisms]} after position $index");
 1753                 my $localset = DirectiveSet->new($current_domain, $query->clone, $localpolicy);
 1754 
 1755                 if ($localset) {
 1756                     my @locallist = $localset->mechanisms;
 1757                     # Get rid of the ?all at the end of the list
 1758                     pop @locallist;
 1759                     # $_->[3] goes into $query->{spf_source}.
 1760                     map { $_->[3] = ($_->[1] eq 'include'
 1761                                      ? "local policy includes SPF record at " . $query->macro_substitute($_->[2])
 1762                                      : "local policy") }
 1763                       @locallist;
 1764                     splice(@$mechanisms, $index + 1, 0, @locallist);
 1765                 }
 1766             }
 1767         }
 1768     }
 1769     $query->debuglog("  lookup:  mec mechanisms=@{[$directive_set->show_mechanisms]}");
 1770     return $directive_set;
 1771   }
 1772 
 1773   sub version      {   shift->{version}      }
 1774   sub mechanisms   { @{shift->{mechanisms}}  }
 1775   sub explanation  {   shift->{modifiers}->{exp}      }
 1776   sub redirect     {   shift->{modifiers}->{redirect} }
 1777   sub get_modifier {   shift->{modifiers}->{shift()}  }
 1778   sub syntax_error {   shift->{syntax_error} }
 1779 
 1780   sub show_mechanisms   {
 1781     my $directive_set = shift;
 1782     my @toreturn = map { $_->[0] . $_->[1] . "(" . ($_->[2]||"") . ")" } $directive_set->mechanisms;
 1783     # print STDERR ("showing mechanisms @toreturn: " . Dumper($directive_set)); use Data::Dumper;
 1784     return @toreturn;
 1785   }
 1786 }
 1787 
 1788 1;
 1789 
 1790 =head1 WARNINGS
 1791 
 1792 Mail::Query::SPF should only be used at the point where messages are received
 1793 from the Internet.  The underlying assumption is that the sender of the e-mail
 1794 is sending the message directly to you or one of your secondary MXes.  If your
 1795 MTA does not have an exhaustive list of secondary MXes, then the C<result2()>
 1796 and C<message_result2()> methods can be used.  These methods take care to
 1797 permit mail from secondary MXes.
 1798 
 1799 =head1 AUTHORS
 1800 
 1801 Meng Weng Wong <mengwong+spf@pobox.com>, Philip Gladstone, Julian Mehnle
 1802 <julian@mehnle.net>
 1803 
 1804 =head1 SEE ALSO
 1805 
 1806 About SPF: L<http://www.openspf.org>
 1807 
 1808 Mail::SPF::Query: L<http://search.cpan.org/dist/Mail-SPF-Query>
 1809 
 1810 The latest release of the SPF specification: L<http://www.openspf.org/spf-classic-current.txt>
 1811 
 1812 =cut
 1813 
 1814 # vim:et sts=4 sw=4