Only in Mail-SPF-Query-1.98-new: blib Only in Mail-SPF-Query-1.98-new: clean Only in Mail-SPF-Query-1.98-new: Makefile Only in Mail-SPF-Query-1.98-new: otest.txt Only in Mail-SPF-Query-1.98-new: pm_to_blib diff -u Mail-SPF-Query-1.98/Query.pm Mail-SPF-Query-1.98-new/Query.pm --- Mail-SPF-Query-1.98/Query.pm 2004-01-13 22:28:15.000000000 -0500 +++ Mail-SPF-Query-1.98-new/Query.pm 2004-01-23 17:48:12.000000000 -0500 @@ -41,6 +41,8 @@ my $TRUSTED_FORWARDER = "include:spf.trusted-forwarder.org"; +my $DEFAULT_EXPLANATION = "Please see http://spf.pobox.com/why.html?sender=%{S}&ip=%{I}&receiver=%{xR}"; + my @KNOWN_MECHANISMS = qw( a mx ptr include ip4 ip6 exists all ); my $MAX_LOOKUP_COUNT = 20; @@ -64,23 +66,19 @@ =head1 SYNOPSIS - my $query = new Mail::SPF::Query (ip => "127.0.0.1", sender=>'foo@example.com', helo=>"somehost.example.com"); + my $query = new Mail::SPF::Query (ip => "127.0.0.1", sender=>'foo@example.com', helo=>"somehost.example.com", trusted=>1, guess=>1); my ($result, # pass | fail | error | unknown [mechanism] $smtp_comment, # "please see http://spf.pobox.com/why.html?..." when rejecting, return this string to the SMTP client $header_comment, # prepend_header("Received-SPF" => "$result ($header_comment)") $spf_record, # "v=spf1 ..." original SPF record for the domain ) = $query->result(); - if ($result eq "pass") { "domain is not forged. apply RHSBL" } - elsif ($result eq "fail") { - if ($query->trusted_forwarder() eq "pass") { "message came through a legacy forwarder. apply RHSBL and content filters" } - else { "domain is forged. reject or save to spambox" } - } - elsif ($query->best_guess eq "pass") { "domain probably not forged. apply RHSBL and content filters" } - else { "domain has no SPF, may be forged. apply content filters" } + if ($result eq "pass") { "domain is (probably) not forged. apply RHSBL and content filters" } + elsif ($result eq "fail") { "domain is forged. reject or save to spambox" } + else { "domain has no SPF, or broken SPF, may be forged. apply content filters" } - The default mechanism for trusted_forwarder is "include:spf.trusted-forwarder.org". - The default mechanisms for best_guess are "a/24 mx/24 ptr". + The default mechanism for trusted=>1 is "include:spf.trusted-forwarder.org". + The default mechanisms for guess=>1 are "a/24 mx/24 ptr". =head1 ABSTRACT @@ -124,11 +122,38 @@ optional parameters: debug => 1, debuglog => sub { print STDERR "@_\n" }, + local => 'extra mechanisms', + trusted => 1, # do trusted forwarder processing + guess => 1, # do best_guess if no SPF record + default_explanation => 'Please see http://spf.my.isp/spferror.html for details', max_lookup_count => 20, # total number of SPF include/redirect queries + sanitize => 1, # sanitize all returned strings myhostname => "foo.example.com", # prepended to header_comment if ($@) { warn "bad input to Mail::SPF::Query: $@" } +Set C1> to turned on automatic trusted_forwarder processing. +The mechanism C is used just before a C<-all> or C. +The precise circumstances are somewhat more complicated, but it does get the case of C +right -- i.e. spf.trusted-forwarder.org is not checked. + +Set C1> to turned on automatic best_guess processing. +This will use the best_guess SPF record when one cannot be found +in the DNS. Note that this can only return C or C. +The C and C flags also operate when the best_guess is being used. + +Set C'include:local.domain'> to include some extra processing just before a C<-all> or C. +The local processing happens just before the trusted processing.o + +Set C to a string to be used if the SPF record does not provide +a specific explanation. The default value will direct the user to a page at spf.pobox.com with +"Please see http://spf.pobox.com/why.html?sender=%{S}&ip=%{I}&receiver=%{xR}". Note that the +string has macro substitution performed. + +Set C to 1 to get all the returned strings sanitized. Alternatively, pass a function reference +and this function will be used to sanitize the returned values. The function must take a single string +argument and return a single string which contains the sanitized result. + Set C1> to watch the queries happen. =cut @@ -144,12 +169,29 @@ $query->{ipv4} = delete $query->{ip} if $query->{ip} and $query->{ip} =~ $looks_like_ipv4; $query->{helo} = delete $query->{ehlo} if $query->{ehlo}; + $query->{local} .= ' ' . $TRUSTED_FORWARDER if ($query->{trusted}); + + $query->{trusted} = undef; + + $query->{spf_error_explanation} ||= "SPF record error"; + + $query->{default_explanation} ||= $DEFAULT_EXPLANATION; + + $query->{default_record} = $GUESS_MECHS if ($query->{guess}); + + if ($query->{sanitize} && !ref($query->{sanitize})) { + # Apply default sanitizer + $query->{sanitize} = \&strict_sanitize; + } + $query->{sender} =~ s/<(.*)>/$1/g; if (not ($query->{ipv4} and length $query->{ipv4})) { die "no IP address given to spfquery" } for ($query->{sender}) { s/^\s+//; s/\s+$//; } + $query->{spf_source} = "domain of $query->{sender}"; + ($query->{domain}) = $query->{sender} =~ /([^@]+)$/; # given foo@bar@baz.com, the domain is baz.com, not bar@baz.com. if (not $query->{helo}) { require Carp; import Carp qw(cluck); cluck ("Mail::SPF::Query: ->new() requires a \"helo\" argument.\n"); @@ -229,6 +271,14 @@ it will start with "v=spf1" and contain the SPF mechanisms and such that describe the domain. +Note that the strings returned by this method (and most of the other methods) +are (at least partially) under the control of the sender's +domain. This means that, if the sender is an attacker, +the contents can be assumed to be hostile. Thus they should +be sanitized before being used for sensitive purposes. +In particular, assume that the C might +contain a newline character. + =cut @@ -240,15 +290,11 @@ my $query = shift; my %result_set; - my ($result, $smtp_comment) = $query->spfquery( ($query->{best_guess} ? $query->{guess_mechs} : () ) ); + my ($result, $smtp_explanation, $smtp_why) = $query->spfquery( ($query->{best_guess} ? $query->{guess_mechs} : () ) ); # print STDERR "*** result = $result\n"; - if ($result eq "fail") { - my $receiver = uri_escape($query->{myhostname}); - my $why_url = $query->macro_substitute("http://spf.pobox.com/why.html?sender=%{S}&ip=%{I}&receiver=$receiver"); - $smtp_comment ||= "please see $why_url"; - } + my $smtp_comment = join(': ', $smtp_explanation, $smtp_why); $query->{smtp_comment} = $smtp_comment; @@ -256,13 +302,13 @@ # $result =~ s/\s.*$//; # this regex truncates "unknown some:mechanism" to just "unknown" - return (lc $result, - $smtp_comment, - $header_comment, - $query->{directive_set}->{orig_txt}, + return ($query->sanitize(lc $result), + $query->sanitize($smtp_comment), + $query->sanitize($header_comment), + $query->sanitize($query->{directive_set}->{orig_txt}), ) if wantarray; - return lc $result; + return $query->sanitize(lc $result); } sub header_comment { @@ -272,13 +318,13 @@ if ($result eq "pass" and $query->{smtp_comment} eq "localhost is always allowed.") { return $query->{smtp_comment} } return - ( $result eq "pass" ? "domain of $query->{sender} designates $ip as permitted sender" - : $result eq "fail" ? "domain of $query->{sender} does not designate $ip as permitted sender" - : $result eq "softfail" ? "transitioning domain of $query->{sender} does not designate $ip as permitted sender" + ( $result eq "pass" ? "$query->{spf_source} designates $ip as permitted sender" + : $result eq "fail" ? "$query->{spf_source} does not designate $ip as permitted sender" + : $result eq "softfail" ? "transitioning $query->{spf_source} does not designate $ip as permitted sender" : $result eq "error" ? "error in processing during lookup of $query->{sender}" : $result eq "UNKNOWN" ? "unable to determine SPF status for $query->{sender}" - : $result =~ /^UNKNOWN/ ? "encountered unrecognized mechanism during SPF processing of domain of $query->{sender}" - : "domain of $query->{sender} does not designate permitted sender hosts" ); + : $result =~ /^UNKNOWN/ ? "encountered unrecognized mechanism during SPF processing of $query->{spf_source}" + : "$query->{spf_source} does not designate permitted sender hosts" ); } @@ -294,8 +340,8 @@ recipients for a multi-recipient message, which is why result2 takes an argument list. See also C. -C<$result> will be one of C, C, C, or -C. See C above for meanings. +C<$result> will be one of C, C, C, or C. +See C above for meanings. If you have MX secondaries and if you are unable to explicitly whitelist those secondaries before SPF tests @@ -313,22 +359,17 @@ ... - my ($result, $smtp_comment, @header_comments); + my ($result, $smtp_comment, $header_comment); - ($result, $smtp_comment) = $query->result2('recip1@mydomain.com'); + ($result, $smtp_comment, $header_comment) = $query->result2('recip1@mydomain.com'); # return suitable error code based on $result eq 'fail' or not - ($result, $smtp_comment) = $query->result2('recip2@mydom.org'); + ($result, $smtp_comment, $header_comment) = $query->result2('recip2@mydom.org'); # return suitable error code based on $result eq 'fail' or not - ($result, @header_comments) = $query->message_result2(); + ($result, $smtp_comment, $header_comment) = $query->message_result2(); # return suitable error if $result eq 'fail' - # otherwise - my @headers; - while (my($name, $val) = splice(@header_comments, 0, 2)) { - push @headers, "$name: $val"; - } - # and then prefix message with join("\n", @headers) + # prefix message with "Received-SPF: $result ($header_comment)" This feature is relatively new to the module. You can get support on the mailing list spf-devel@listbox.com. @@ -336,6 +377,8 @@ The methods C and C use "2" because they work for secondary MXes. C takes care to minimize the number of DNS operations so that there is little performance penalty from using it in place of C. +In particular, if no arguments are supplied, then it just calls C and +returns the method response. =cut @@ -347,65 +390,44 @@ my $query = shift; my @recipients = @_; - if ($query->{is_forged}) { - return @{$query->{is_forged}->[0]} if wantarray; - return $query->{is_forged}->[0]->[0]; - } - - if ($query->{is_not_forged}) { - return @{$query->{is_not_forged}->[0]} if wantarray; - return $query->{is_not_forged}->[0]->[0]; - } + if (!$query->{result2}) { + my $all_mx_secondary = 'unknown'; - my $all_mx_secondary = 'yes'; + foreach my $recip (@recipients) { + my ($rhost) = $recip =~ /([^@]+)$/; - foreach my $recip (@recipients) { - my ($rhost) = $recip =~ /([^@]+)$/; + $query->debuglog("result2: Checking status of recipient $recip (at host $rhost)"); - $query->debuglog("result2: Checking status of recipient $recip (at host $rhost)"); - - my $cache_result = $query->{mx_cache}->{$rhost}; - if (!defined($cache_result)) { - $cache_result = $query->{mx_cache}->{$rhost} = is_secondary_for($rhost, $query->{ipv4}) ? 'yes' : 'no'; - $query->debuglog("result2: $query->{ipv4} is a MX for $rhost: $cache_result"); + my $cache_result = $query->{mx_cache}->{$rhost}; + if (!defined($cache_result)) { + $cache_result = $query->{mx_cache}->{$rhost} = is_secondary_for($rhost, $query->{ipv4}) ? 'yes' : 'no'; + $query->debuglog("result2: $query->{ipv4} is a MX for $rhost: $cache_result"); + } + + if ($cache_result eq 'yes') { + $query->{is_mx_good} = [$query->sanitize('pass'), + $query->sanitize('message from secondary MX'), + $query->sanitize("$query->{myhostname}: message received from $query->{ipv4} which is an MX secondary for $recip"), + undef]; + $all_mx_secondary = 'yes'; + } else { + $all_mx_secondary = 'no'; + last; + } } - if ($cache_result eq 'yes') { - $query->{is_mx_good} = [ undef, - ['pass', 'Received-SPF', "pass (message received from $query->{ipv4} which is an MX secondary for $recip)"]]; - } else { - $all_mx_secondary = 'no'; - last; + if ($all_mx_secondary eq 'yes') { + return @{$query->{is_mx_good}} if wantarray; + return $query->{is_mx_good}->[0]; } - } - if ($all_mx_secondary eq 'yes') { - return ('pass', - 'message from secondary MX', - "$query->{myhostname}: message received from $query->{ipv4} which is an MX secondary", - undef - ) if wantarray; + my @result = $query->result(); - return 'pass'; + $query->{result2} = \@result; } - my ($result, $smtp_comment, $header_comment, $spf_record) = $query->result(); - - if ($result eq 'fail') { - $query->{is_forged} = [[$result, $smtp_comment, $header_comment, $spf_record], - [$result, 'Received-SPF', "$result ($header_comment)"] ]; - } else { - $query->{is_not_forged} = [[$result, $smtp_comment, $header_comment, $spf_record], - [$result, 'Received-SPF', "$result ($header_comment)"] ]; - } - - return (lc $result, - $smtp_comment, - $header_comment, - $spf_record, - ) if wantarray; - - return lc $result; + return @{$query->{result2}} if wantarray; + return $query->{result2}->[0]; } sub is_secondary_for { @@ -438,18 +460,15 @@ =item C<< $query->message_result2() >> - my ($result, @header_comments) = $query->message_result2(); - -C returns an overall status for the message -after zero or more calls to C. + my ($result, $smtp_comment, $header_comment, $spf_record) = $query->message_result2(); -C<$result> will be one of C, C, C, or -C. See C above for meanings. +C returns an overall status for the message +after zero or more calls to C. It will always be the last +status returned by C, or the status returned by C if +C was never called. -C<@header_comments> are a sequence of header_name, header_value pairs -that should be inserted into the message. Typically, this will just -contain a Received-SPF header. Note that the colon seperator -between the name and value must be supplied by the user. +C<$result> will be one of C, C, C, or C. +See C above for meanings. =cut @@ -460,29 +479,21 @@ sub message_result2 { my $query = shift; - if ($query->{is_forged}) { - return @{$query->{is_forged}->[1]} if wantarray; - return $query->{is_forged}->[1]->[0]; - } - - if ($query->{is_not_forged}) { - return @{$query->{is_not_forged}->[1]} if wantarray; - return $query->{is_not_forged}->[1]->[0]; - } - - if ($query->{is_mx_good}) { - return @{$query->{is_mx_good}->[1]} if wantarray; - return $query->{is_mx_good}->[1]->[0]; - } + if (!$query->{result2}) { + if ($query->{is_mx_good}) { + return @{$query->{is_mx_good}} if wantarray; + return $query->{is_mx_good}->[0]; + } - # we are very unlikely to get here -- unless result2 was not called. + # we are very unlikely to get here -- unless result2 was not called. - my ($result, $smtp_comment, $header_comment) = $query->result(); + my @result = $query->result(); - return ($result, ('Received-SPF', "$result ($header_comment)") - ) if wantarray; + $query->{result2} = \@result; + } - return $result; + return @{$query->{result2}} if wantarray; + return $query->{result2}->[0]; } =item C<< $query->best_guess() >> @@ -578,12 +589,12 @@ my ($result, $smtp_comment, $header_comment) = $guess_query->result(); if (defined $result and $result eq "pass") { my $ip = $query->ip; - $header_comment = "seems reasonable for $query->{sender} to mail through $ip"; + $header_comment = $query->sanitize("seems reasonable for $query->{sender} to mail through $ip"); return ($result, $smtp_comment, $header_comment) if wantarray; return $result; } - return "unknown"; + return $query->sanitize("unknown"); } sub trusted_forwarder { @@ -594,6 +605,52 @@ # ---------------------------------------------------------- +=item C<< $query->sanitize('string') >> + +This applies the sanitization rules for the particular query +object. These rules are controlled by the C parameter +to the Mail::SPF::Query new method. + +=cut + +sub sanitize { + my $query = shift; + my $txt = shift; + + if (ref($query->{sanitize})) { + $txt = $query->{sanitize}->($txt); + } + + return $txt; +} + +# ---------------------------------------------------------- + +=item C<< strict_sanitize('string') >> + +This ensures that all the characters in the returned string are printable. +All whitespace is converted into spaces, and all other non-printable +characters are converted into question marks. This is probably +over aggressive for many applications. + +This function is used by default when the C option is passed to +the new method of Mail::SPF::Query. + +Note that this function is not a class method. + +=cut + +sub strict_sanitize { + my $txt = shift; + + $txt =~ s/\s/ /g; + $txt =~ s/[^[:print:]]/?/g; + + return $txt; +} + +# ---------------------------------------------------------- + =item C<< $query->debuglog() >> Subclasses may override this with their own debug logger. @@ -627,7 +684,7 @@ sub spfquery { # - # usage: my ($result, $text, $time) = $query->spfquery() + # usage: my ($result, $explanation, $text, $time) = $query->spfquery() # # performs a full SPF resolution using the data in $query. to use different data, clone the object. # @@ -638,22 +695,25 @@ $query->top->{lookup_count}++; - if ($query->is_looping) { return "UNKNOWN", $query->is_looping } + if ($query->is_looping) { return "UNKNOWN", $query->{spf_error_explanation}, $query->is_looping } if ($query->can_use_cached_result) { return $query->cached_result; } else { $query->tell_cache_that_lookup_is_underway; } - my $directive_set = DirectiveSet->new($query->{domain}, $query, @_); + my $directive_set = DirectiveSet->new($query->{domain}, $query, $_[0], $query->{local}, $query->{default_record}); if (not defined $directive_set) { $query->debuglog("no SPF record found for $query->{domain}"); $query->delete_cache_point; - return "unknown", "domain of sender $query->{sender} does not designate mailers"; + if ($query->{domain} ne $query->{orig_domain}) { + return "UNKNOWN", $query->{spf_error_explanation}, "Missing SPF record at $query->{domain}"; + } + return "unknown", "SPF", "domain of sender $query->{sender} does not designate mailers"; } if ($directive_set->{hard_syntax_error}) { $query->debuglog(" syntax error while parsing $directive_set->{txt}"); $query->delete_cache_point; - return "unknown", $directive_set->{hard_syntax_error}; + return "unknown", $query->{spf_error_explanation}, $directive_set->{hard_syntax_error}; } $query->{directive_set} = $directive_set; @@ -664,14 +724,17 @@ if ($query->{error}) { $query->debuglog(" returning fatal error: $query->{error}"); $query->delete_cache_point; - return "error", $query->{error}; + return "error", $query->{spf_error_explanation}, $query->{error}; } next if not defined $result; if ($result and $result !~ /^unknown/) { $query->debuglog(" saving result $result to cache point and returning."); - $query->save_result_to_cache($result, $comment); - return $result, $query->interpolate_explanation($comment); + my $explanation = $query->interpolate_explanation( + $result eq "error" or $result =~ /^UNKNOWN/ + ? $query->{spf_error_explanation} : $query->{default_explanation}); + $query->save_result_to_cache($result, $explanation, $comment); + return $result, $explanation, $comment; } } @@ -692,12 +755,14 @@ $query->debuglog(" executed redirect=$new_domain, got result @inner_result"); + $query->{spf_source} = $inner_query->{spf_source}; + return @inner_result; } $query->debuglog(" mechanisms returned unknown; deleting cache point and using unknown"); $query->delete_cache_point; - return "unknown", $directive_set->{soft_syntax_error} || $query->interpolate_explanation(); + return "unknown", $query->interpolate_explanation($query->{default_explanation}), $directive_set->{soft_syntax_error}; } # ---------------------------------------------------------- @@ -710,7 +775,9 @@ $query->{guess_mechs} || "", $query->{ipv4}, $query->{localpart}, - $query->{domain}); + $query->{domain}, + $query->{default_record}, + $query->{local}); } sub is_looping { @@ -824,7 +891,7 @@ $arg =~ s/^{(.*)}$/$1/; - my ($field, $num, $reverse, $delim) = $arg =~ /^(\w)(\d*)(r?)(.*)$/; + my ($field, $num, $reverse, $delim) = $arg =~ /^(x?\w)(\d*)(r?)(.*)$/; $delim = '.' if not length $delim; @@ -840,25 +907,26 @@ $newval = $timestamp if (lc $field eq 't'); $newval = $query->{helo} if (lc $field eq 'h'); $newval = $query->get_ptr_domain if (lc $field eq 'p'); + $newval = $query->{myhostname} if (lc $field eq 'xr'); # only used in explanation $newval = $query->{ipv4} ? 'in-addr' : 'ip6' if (lc $field eq 'v'); - # perl has a few rules about where ] and - may fall inside a character class. - if ($delim =~ s/_//g) { $delim .= "-" } - if ($delim =~ s/\]//g) { $delim = "]$delim" } - - if ($reverse) { - my @parts = split /[$delim]/, $newval; - $newval = join ".", reverse @parts; - } + # We need to escape a bunch of characters inside a character class + $delim =~ s/([\^\-\]\:\\])/\\$1/g; + + if ($reverse || $num) { + my @parts = split /[$delim]/, $newval; + + @parts = reverse @parts if ($reverse); + + if ($num) { + while (@parts > $num) { shift @parts } + } - if ($num) { - my @parts = split /[$delim]/, $newval; - while (@parts > $num) { shift @parts } - $newval = join ".", @parts; + $newval = join ".", @parts; } - $newval = uri_escape($newval) if ($field eq uc $field); + $newval = uri_escape($newval) if ($field ne lc $field); $query->debuglog(" macro_substitute_item: $arg: field=$field, num=$num, reverse=$reverse, delim=$delim, newval=$newval"); @@ -893,7 +961,7 @@ sub evaluate_mechanism { my $query = shift; - my ($modifier, $mechanism, $argument) = @{shift()}; + my ($modifier, $mechanism, $argument, $source) = @{shift()}; $modifier = "+" if not length $modifier; @@ -909,6 +977,8 @@ return ($hit, $text) if ($hit ne "hit"); + $query->{spf_source} = $source if ($source); + return $query->shorthand2value($modifier), $text; } else { @@ -983,13 +1053,30 @@ return @toreturn; } +# +# Mechanisms return one of the following: +# +# hit +# mechanism matched +# undef +# mechanism did not match +# +# error +# some error happened during processing +# unknown +# no spf record found +# UNKNOWN +# explicit unknown +# UNKNOWN error message +# some error happened during processing +# # ---------------------------------------------------------- # all # ---------------------------------------------------------- sub mech_all { my $query = shift; - return "hit"; + return "hit" => "default"; } # ---------------------------------------------------------- @@ -1010,15 +1097,18 @@ my $inner_query = $query->clone(domain => $argument, depth => $query->{depth} + 1, reason => "includes $argument", + local => undef, + guess => undef, ); - my ($result, $text, $time) = $inner_query->spfquery(); + my ($result, $explanation, $text, $time) = $inner_query->spfquery(); $query->debuglog(" mechanism include: got back result $result / $text / $time"); - if ( $result eq "pass") { return hit => $text, $time; } - if ( $result eq "error") { return error => $text, $time; } - if (lc $result eq "unknown") { return UNKNOWN => $text, $time; } + if ($result eq "pass") { return hit => $text, $time; } + if ($result eq "error") { return error => $text, $time; } + if ($result eq "unknown") { return undef, $text, $time; } + if ($result =~ /^UNKNOWN/) { return $result => $text, $time; } $query->debuglog(" mechanism include: reducing result $result to unknown"); return "unknown", $text, $time; @@ -1235,18 +1325,14 @@ sub interpolate_explanation { my $query = shift; - my $comment = shift; + my $txt = shift; - my $exp; if ($query->{directive_set}->explanation) { my @txt = map { s/^"//; s/"$//; $_ } $query->myquery($query->macro_substitute($query->{directive_set}->explanation), "TXT", "txtdata"); - $exp = $query->macro_substitute(join " ", @txt); + $txt = join " ", @txt; } - if (not $exp) { return $comment } - if (not $comment) { return $exp } - - return "$exp: $comment"; + return $query->macro_substitute($txt); } # ---------------------------------------------------------- @@ -1261,11 +1347,14 @@ my $current_domain = shift; my $query = shift; my $override_text = shift; + my $localpolicy = shift; + my $default_record = shift; my $txt; if ($override_text) { $txt = "v=spf1 $override_text ?all"; + $query->{spf_source} = "local policy"; } else { $query->debuglog(" DirectiveSet->new(): doing TXT query on $current_domain"); @@ -1282,6 +1371,11 @@ $txt .= $1; } } + + if (!$txt && $default_record) { + $txt = "v=spf1 $default_record ?all"; + $query->{spf_source} = "local policy"; + } } $query->debuglog(" DirectiveSet->new(): SPF policy: $txt"); @@ -1336,6 +1430,31 @@ } $directive_set->{mechanisms} = [] if not $directive_set->{mechanisms}; + if ($localpolicy) { + my $mechanisms = $directive_set->{mechanisms}; + my $lastmech = $mechanisms->[$#$mechanisms]; + if (($lastmech->[0] eq '-' || $lastmech->[0] eq '?') && + $lastmech->[1] eq 'all') { + my $index; + + for ($index = $#$mechanisms - 1; $index >= 0; $index--) { + last if ($lastmech->[0] ne $mechanisms->[$index]->[0]); + } + if ($index >= 0) { + # We want to insert the localpolicy just *after* $index + $query->debuglog(" inserting local policy mechanisms into @{[$directive_set->show_mechanisms]} after position $index"); + my $localset = DirectiveSet->new($current_domain, $query->clone, $localpolicy); + + if ($localset) { + my @locallist = $localset->mechanisms; + # Get rid of the ?all at the end of the list + pop @locallist; + map { $_->[3] = $_->[1] eq 'include' ? "SPF record at " . $query->macro_substitute($_->[2]) : "local policy" } @locallist; + splice(@$mechanisms, $index + 1, 0, @locallist); + } + } + } + } $query->debuglog(" lookup: mec mechanisms=@{[$directive_set->show_mechanisms]}"); return $directive_set; } Common subdirectories: Mail-SPF-Query-1.98/sample and Mail-SPF-Query-1.98-new/sample diff -u Mail-SPF-Query-1.98/test.pl Mail-SPF-Query-1.98-new/test.pl --- Mail-SPF-Query-1.98/test.pl 2004-01-11 13:07:20.000000000 -0500 +++ Mail-SPF-Query-1.98-new/test.pl 2004-01-23 16:55:08.000000000 -0500 @@ -5,6 +5,10 @@ ######################### use Test; +use strict; + +my @test_table; + BEGIN { open TESTFILE, "test.txt"; @@ -25,7 +29,9 @@ foreach my $tuple (@test_table) { my ($num, $domain, $ipv4, $expected_result, $expected_smtp_comment, $expected_header_comment) = $tuple =~ /\t/ ? split(/\t/, $tuple) : split(' ', $tuple); - my $sender = $domain; + my ($sender, $localpolicy) = split(':', $domain, 2); + $sender =~ s/\\([0-7][0-7][0-7])/chr(oct($1))/ge; + $domain = $sender; if ($domain =~ /\@/) { ($domain) = $domain =~ /\@(.+)/ } if ($expected_result =~ /=(pass|fail),/) { @@ -35,16 +41,19 @@ sender => $sender, helo => $domain, debug => $debug, + local => $localpolicy, + sanitize => 1, ); }; my $ok = 1; + my $header_comment; foreach my $e_result (split(/,/, $expected_result)) { if ($e_result !~ /=/) { - my ($msg_result, @header_comment) = eval { $query->message_result2 }; + my ($msg_result, $smtp_comment); + ($msg_result, $smtp_comment, $header_comment) = eval { $query->message_result2 }; $ok = ok($msg_result, $e_result) if (!$debug); - $header_comment = join(':', @header_comment); if (!$ok) { last; } @@ -59,7 +68,7 @@ } } - $header_comment =~ s/\(\S+: /\(/; # strip the reporting hostname prefix + $header_comment =~ s/\S+: //; # strip the reporting hostname prefix if ($expected_header_comment) { $ok &= ok($header_comment, $expected_header_comment) if (!$debug); @@ -70,6 +79,9 @@ my ($result, $smtp_comment, $header_comment) = eval { new Mail::SPF::Query (ipv4 => $ipv4, sender => $sender, helo => $domain, + local => $localpolicy, + default_explanation => "explanation", + sanitize => 1, )->result; }; $header_comment =~ s/^\S+: //; # strip the reporting hostname prefix @@ -85,6 +97,8 @@ sender => $sender, helo => $domain, debug => 1, + local => $localpolicy, + sanitize => 1, )->result) }; if ($@) { print " trapped error: $@\n"; diff -u Mail-SPF-Query-1.98/test.txt Mail-SPF-Query-1.98-new/test.txt --- Mail-SPF-Query-1.98/test.txt 2004-01-11 13:07:20.000000000 -0500 +++ Mail-SPF-Query-1.98-new/test.txt 2004-01-23 12:13:08.000000000 -0500 @@ -332,19 +332,64 @@ # '105.spf1-test.mailzone.com:v=spf1 redirect=106.%{d3}:60 # '106.spf1-test.mailzone.com:v=spf1 redirect=107.%{d3}:60 # '107.spf1-test.mailzone.com:v=spf1 include\072104.%{d3}:60 -126,127,128 droid@104.spf1-test.mailzone.com 192.0.2.98 unknown loop encountered: 104.spf1-test.mailzone.com redirects to 105.spf1-test.mailzone.com redirects to 106.spf1-test.mailzone.com redirects to 107.spf1-test.mailzone.com includes 104.spf1-test.mailzone.com unable to determine SPF status for droid@104.spf1-test.mailzone.com +126,127,128 droid@104.spf1-test.mailzone.com 192.0.2.98 unknown SPF record error: loop encountered: 104.spf1-test.mailzone.com redirects to 105.spf1-test.mailzone.com redirects to 106.spf1-test.mailzone.com redirects to 107.spf1-test.mailzone.com includes 104.spf1-test.mailzone.com unable to determine SPF status for droid@104.spf1-test.mailzone.com -129,130,131 droid@110.spf1-test.mailzone.com 192.0.2.98 unknown some:unrecognized=mechanism unrecognized mechanism some:unrecognized=mechanism encountered unrecognized mechanism during SPF processing of domain of droid@110.spf1-test.mailzone.com +129,130,131 droid@110.spf1-test.mailzone.com 192.0.2.98 unknown some:unrecognized=mechanism SPF record error: unrecognized mechanism some:unrecognized=mechanism encountered unrecognized mechanism during SPF processing of domain of droid@110.spf1-test.mailzone.com # the following tests are for Mail::SPF::Query's result2 and message_result2 methods only. 132,133,134 20.spf1-test.mailzone.com 192.0.2.33 foo@bar.com=fail,foo@spf1-test.mailzone.com=fail,fail -135,136,137,138 20.spf1-test.mailzone.com 192.0.2.33 foo@spf1-test.mailzone.com=pass,foo@bar.com=fail,fail . Received-SPF:fail (domain of 20.spf1-test.mailzone.com does not designate 192.0.2.33 as permitted sender) -139,140,141 20.spf1-test.mailzone.com 192.0.2.33 foo@spf1-test.mailzone.com=pass,pass . Received-SPF:pass (message received from 192.0.2.33 which is an MX secondary for foo@spf1-test.mailzone.com) +135,136,137,138 20.spf1-test.mailzone.com 192.0.2.33 foo@spf1-test.mailzone.com=pass,foo@bar.com=fail,fail . domain of 20.spf1-test.mailzone.com does not designate 192.0.2.33 as permitted sender +139,140,141 20.spf1-test.mailzone.com 192.0.2.33 foo@spf1-test.mailzone.com=pass,pass . message received from 192.0.2.33 which is an MX secondary for foo@spf1-test.mailzone.com 142,143 20.spf1-test.mailzone.com 192.0.2.33 foo@bar.com=fail,fail 144,145,146 20.spf1-test.mailzone.com 192.0.2.34 foo@spf1-test.mailzone.com=fail,foo@bar.com=fail,fail 147,148,149 20.spf1-test.mailzone.com 192.0.2.120 dog@cat.com=pass,foo@bar.com=pass,pass 150,151 20.spf1-test.mailzone.com 192.0.2.120 dog@cat.com;foo@bar.com=pass,pass -152,153,154 20.spf1-test.mailzone.com 192.0.2.33 foo@spf1-test.mailzone.com;foo@bar.com=fail,fail . Received-SPF:fail (domain of 20.spf1-test.mailzone.com does not designate 192.0.2.33 as permitted sender) -155,156,157 20.spf1-test.mailzone.com 192.0.2.33 foo@bar.com;foo@spf1-test.mailzone.com=fail,fail . Received-SPF:fail (domain of 20.spf1-test.mailzone.com does not designate 192.0.2.33 as permitted sender) +152,153,154 20.spf1-test.mailzone.com 192.0.2.33 foo@spf1-test.mailzone.com;foo@bar.com=fail,fail . domain of 20.spf1-test.mailzone.com does not designate 192.0.2.33 as permitted sender +155,156,157 20.spf1-test.mailzone.com 192.0.2.33 foo@bar.com;foo@spf1-test.mailzone.com=fail,fail . domain of 20.spf1-test.mailzone.com does not designate 192.0.2.33 as permitted sender + +# tests for localpolicy overrides + +158 103.spf1-test.mailzone.com:-all 192.0.2.98 pass + +159,160,161 20.spf1-test.mailzone.com:+all 192.0.2.1 pass /./ local policy designates 192.0.2.1 as permitted sender +162,163,164 20.spf1-test.mailzone.com:+ip4:192.0.2.1 192.0.2.1 pass /./ local policy designates 192.0.2.1 as permitted sender +165 20.spf1-test.mailzone.com:+ip4:192.0.2.2 192.0.2.1 fail + +# '91.spf1-test.mailzone.com:v=spf1 -ip4\072192.0.2.128/25 ip4\072192.0.2.0/24 -all:60 +166 91.spf1-test.mailzone.com:ip4:192.168.1.0/24 192.168.1.1 pass +167 91.spf1-test.mailzone.com:-ip4:192.0.0.0/8 192.0.2.127 pass +168 91.spf1-test.mailzone.com:ip4:192.0.0.0/8 192.0.2.129 fail + +# '92.spf1-test.mailzone.com:v=spf1 ?ip4\072192.0.2.192/26 ip4\072192.0.2.128/25 -ip4\072192.0.2.0/24 -all:60 +169 92.spf1-test.mailzone.com:+all 192.168.2.1 pass +170 92.spf1-test.mailzone.com:+all 192.0.2.1 pass +171 92.spf1-test.mailzone.com:-all 192.0.2.129 pass +172 92.spf1-test.mailzone.com:-all 192.0.2.193 unknown + +# '100.spf1-test.mailzone.com:v=spf1 redirect=98.spf1-test.mailzone.com:60 +173 100.spf1-test.mailzone.com:+all 192.0.2.1 pass +174 100.spf1-test.mailzone.com:-all 192.0.2.98 pass + +# '101.spf1-test.mailzone.com:v=spf1 -all redirect=98.spf1-test.mailzone.com:60 +175 101.spf1-test.mailzone.com:+all 192.0.2.98 fail + +# '102.spf1-test.mailzone.com:v=spf1 ?all redirect=98.spf1-test.mailzone.com:60 +176 102.spf1-test.mailzone.com:+all 192.0.2.98 unknown + +# '51.spf1-test.mailzone.com:v=spf1 include\07242.spf1-test.mailzone.com -all:60 +# '10.spf1-test.mailzone.com:v=spf1 mx -all:60 +177,178,179 10.spf1-test.mailzone.com:include:42.%{d3} 192.0.2.200 fail explanation: default domain of 10.spf1-test.mailzone.com does not designate 192.0.2.200 as permitted sender +180,181,182 10.spf1-test.mailzone.com:include:42.%{d3} +all 192.0.2.200 pass /./ local policy designates 192.0.2.200 as permitted sender +183,184,185 10.spf1-test.mailzone.com:include:42.%{d3} +all 192.0.2.110 pass /./ SPF record at 42.spf1-test.mailzone.com designates 192.0.2.110 as permitted sender + +186,187,188 42-27@10.spf1-test.mailzone.com:include:%{l1r-}.%{d3} +all 192.0.2.110 pass /./ SPF record at 42.spf1-test.mailzone.com designates 192.0.2.110 as permitted sender +189,190,191 42-27@10.spf1-test.mailzone.com:include:%{l1r0-9}.%{d3} +all 192.0.2.110 pass /./ SPF record at 42.spf1-test.mailzone.com designates 192.0.2.110 as permitted sender +192,193,194 42-27@10.spf1-test.mailzone.com:include:%{l1r^-}.%{d3} +all 192.0.2.110 pass /./ SPF record at 42.spf1-test.mailzone.com designates 192.0.2.110 as permitted sender +195,196,197 42di27@10.spf1-test.mailzone.com:include:%{l1r:digit:}.%{d3} +all 192.0.2.110 pass /./ SPF record at 42.spf1-test.mailzone.com designates 192.0.2.110 as permitted sender +198,199,200 42\07227@10.spf1-test.mailzone.com:include:%{l1r:digit:}.%{d3} +all 192.0.2.110 pass /./ SPF record at 42.spf1-test.mailzone.com designates 192.0.2.110 as permitted sender +201,202,203 42\07227@10.spf1-test.mailzone.com:include:%{l1r$foo:}.%{d3} +all 192.0.2.110 pass /./ SPF record at 42.spf1-test.mailzone.com designates 192.0.2.110 as permitted sender +204,205,206 42\27@10.spf1-test.mailzone.com:include:%{l1r$fo\o:}.%{d3} +all 192.0.2.110 pass /./ SPF record at 42.spf1-test.mailzone.com designates 192.0.2.110 as permitted sender +207,208,209 42-27@10.spf1-test.mailzone.com:include:%{l1r-[]}.%{d3} +all 192.0.2.110 pass /./ SPF record at 42.spf1-test.mailzone.com designates 192.0.2.110 as permitted sender +210,211,212 42327@10.spf1-test.mailzone.com:include:%{l1r-[]3}.%{d3} +all 192.0.2.110 pass /./ SPF record at 42.spf1-test.mailzone.com designates 192.0.2.110 as permitted sender