r2103 - in packages/libmail-spf-query-perl/branches/upstream/current: . bin debian examples lib/Mail/SPF t

Julian Mehnle jmehnle-guest at costa.debian.org
Thu Feb 9 18:44:46 UTC 2006


Author: jmehnle-guest
Date: 2006-02-09 18:44:08 +0000 (Thu, 09 Feb 2006)
New Revision: 2103

Modified:
   packages/libmail-spf-query-perl/branches/upstream/current/CHANGES
   packages/libmail-spf-query-perl/branches/upstream/current/META.yml
   packages/libmail-spf-query-perl/branches/upstream/current/README
   packages/libmail-spf-query-perl/branches/upstream/current/bin/spfd
   packages/libmail-spf-query-perl/branches/upstream/current/bin/spfquery
   packages/libmail-spf-query-perl/branches/upstream/current/debian/changelog
   packages/libmail-spf-query-perl/branches/upstream/current/debian/compat
   packages/libmail-spf-query-perl/branches/upstream/current/debian/control
   packages/libmail-spf-query-perl/branches/upstream/current/debian/rules
   packages/libmail-spf-query-perl/branches/upstream/current/examples/postfix-policyd-spf
   packages/libmail-spf-query-perl/branches/upstream/current/lib/Mail/SPF/Query.pm
   packages/libmail-spf-query-perl/branches/upstream/current/t/00_all.t
   packages/libmail-spf-query-perl/branches/upstream/current/t/test.dat
Log:
Load /tmp/tmp.Or1lVS/libmail-spf-query-perl-1.999 into
packages/libmail-spf-query-perl/branches/upstream/current.


Modified: packages/libmail-spf-query-perl/branches/upstream/current/CHANGES
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/CHANGES	2006-02-05 18:24:43 UTC (rev 2102)
+++ packages/libmail-spf-query-perl/branches/upstream/current/CHANGES	2006-02-09 18:44:08 UTC (rev 2103)
@@ -1,20 +1,71 @@
 # Legend:
 # --- = A new release
-#   x = Changed something significant, or removed a feature
+#   + = Added a feature (in a backwards compatible way)
+#   ! = Changed something significant, or removed a feature
 #   * = Fixed a bug, or made a minor improvement
-#   + = Added a feature (in a backwards compatible way)
 
+--- 1.999 (2006-02-07 00:00)
+
+  Mail::SPF::Query:
+  ! No longer accept malformed SPF records such as "\"v=spf1 ...\"" (spurious
+    double quotes) or " v=spf1 ..." (leading whitespace).
+  * Combine multiple TXT strings into a single string _before_ fallbacks are
+    tried.  Thus, fallbacks now also get applied if there are only non-
+    "v=spf1" TXT records; this wasn't the case before.
+  * Guard against non-numeric cidr-lengths (closes rt.cpan.org bug #17061).
+  * Flattened the { 'domain' => { record => '...' } } override and fallback
+    argument format to just { 'domain' => '...' }.  The old format is still
+    supported for backwards compatibility.
+  * Added a "BUGS" section to the man-page documenting M:S:Q's known
+    deficiencies.
+  * Lots of minor code improvements.
+
+  spfquery:
+  * Correctly recognize the --mail-from (AKA --sender) option.  The version
+    in the M:S:Q 1.998 release was broken in this regard.
+  * Actually require the --helo option for the --mail-from (AKA --sender)
+    form.
+  * Cleaned up command-line argument validation code.
+  * Cleaned up the inconsistent short and long (--help) usage and man-page
+    texts.
+  * Clarified the file input syntax in the help and man-page texts.
+  + The "--override" and "--fallback" options are now actually working and
+    documented.
+
+  Tests:
+  * Overhauled 00_all.t test script:
+    * Don't skip tests when a non-last test in a test tuple fails (this made
+      test 223 "fail", for example, because Test::Harness thought that some
+      planned tests were not performed).
+    * Marked test 219 (SERVFAIL) as non-critical, because it isn't completely
+      reliable (sometimes, apparently behind some NATs and firewalls, the
+      query just times out instead of returning SERVFAIL) (closes rt.cpan.org
+      bug #17099).
+    * Generate and collect debug log output (internally) along with the normal
+      M:S:Q->result() calls right away, so that extra just-to-get-debug-output
+      M:S:Q->result() calls can be saved.  Also we can make debug log output
+      Test::Harness-compatible this way by printing it ourselves with '#'
+      chars at the beginnings of lines.
+    * Cleaned up code.
+  * Cleaned up comments in t/test.dat test data file.
+
+  Debian:
+  ! Build-Depend, not Build-Depend-Indep, on debhelper.  Also, depend on
+    debhelper >= 5.
+  * Build-Depend-Indep on netbase to allow testing to work when building in a
+    pbuilder chroot (closes Debian bug #351030).
+
 --- 1.998 (2005-12-31 23:00)
 
   Mail::SPF::Query:
-  x Require Perl 5.6 or better.
-  x Require URI::Escape module, not URI module.
-  x Removed obsolete Caller-ID support (closes Debian bugs #337319, #337500).
-  x Always use Sys::Hostname::Long. And thus, require Sys::Hostname::Long to be
+  ! Require Perl 5.6 or better.
+  ! Require URI::Escape module, not URI module.
+  ! Removed obsolete Caller-ID support (closes Debian bugs #337319, #337500).
+  ! Always use Sys::Hostname::Long. And thus, require Sys::Hostname::Long to be
     installed (closes Debian bugs #332952, #342629).
   * Changed local machine hostname macro from "xr" to "r" (closes rt.cpan.org
     bug #9744).
-  x Restrict the number of SPF record lookups to a maximum of 10 (was: 20).
+  ! Restrict the number of SPF record lookups to a maximum of 10 (was: 20).
     Thanks to Craig Whitmore!
   * Fixes to mechanisms implementation:
     * a, mx: Check if domain is a valid FQDN, i.e. ends in ".<toplabel>".
@@ -27,7 +78,7 @@
   spfd:
   + Added complete POD documentation/man-page.
   * Both "--xxx" and "-xxx" forms of command-line options are now supported.
-  x Renamed most of the command-line options:
+  ! Renamed most of the command-line options:
       --path       => --socket
       --pathuser   => --socket-user
       --pathgroup  => --socket-group
@@ -47,7 +98,7 @@
     #237751, has been already resolved in Debian release 1.997-3).
   * Both "--xxx" and "-xxx" forms of command-line options are now supported.
     Also, a "-x" (short) form is now supported for the most important options.
-  x Renamed the "--max-lookup" option to "--max-lookup-count" to match the
+  ! Renamed the "--max-lookup" option to "--max-lookup-count" to match the
     Mail::SPF::Query API.  "--max-lookup" is still supported for backwards
     compatibility.
   * Added "--mail-from" and "-m" synonyms for the "--sender" option for
@@ -67,12 +118,12 @@
     package!
 
   Miscellaneous:
-  x Updated URLs everywhere:
+  ! Updated URLs everywhere:
       http://spf.pobox.com                            -> http://www.openspf.org
       http://www.anarres.org/projects/srs/            -> http://www.libsrs2.org
       http://asarian-host.net/srs/sendmailsrs.htm
                                    -> http://srs-socketmap.info/sendmailsrs.htm
-  x Point out everywhere the "non-standard"-ness of best guess processing,
+  ! Point out everywhere the "non-standard"-ness of best guess processing,
     trusted forwarder accreditation checking, and several other features.
   * Cleaned up source package file and directory layout:
       Query.pm     -> lib/Mail/SPF/Query.pm
@@ -86,7 +137,7 @@
       (error/TempError) the message.
     * Verbose mode is disabled by default.
     Thanks to Arjen de Korte!
-  x spf.py: Removed, because it was really old, and this is a Perl package, not
+  ! spf.py: Removed, because it was really old, and this is a Perl package, not
     a Python one.
   * Did I mention lots of minor code and documentation fixes/improvements?
 

Modified: packages/libmail-spf-query-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/META.yml	2006-02-05 18:24:43 UTC (rev 2102)
+++ packages/libmail-spf-query-perl/branches/upstream/current/META.yml	2006-02-09 18:44:08 UTC (rev 2103)
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Mail-SPF-Query
-version:      1.998
+version:      1.999
 version_from: lib/Mail/SPF/Query.pm
 installdirs:  site
 requires:

Modified: packages/libmail-spf-query-perl/branches/upstream/current/README
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/README	2006-02-05 18:24:43 UTC (rev 2102)
+++ packages/libmail-spf-query-perl/branches/upstream/current/README	2006-02-09 18:44:08 UTC (rev 2103)
@@ -1,4 +1,4 @@
-Mail::SPF::Query 1.998
+Mail::SPF::Query 1.999
 ======================
 
 The SPF protocol relies on sender domains to publish a DNS whitelist of their

Modified: packages/libmail-spf-query-perl/branches/upstream/current/bin/spfd
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/bin/spfd	2006-02-05 18:24:43 UTC (rev 2102)
+++ packages/libmail-spf-query-perl/branches/upstream/current/bin/spfd	2006-02-09 18:44:08 UTC (rev 2103)
@@ -1,10 +1,17 @@
 #!/usr/bin/perl
 
+#
 # spfd: Simple forking daemon to provide SPF query services
-# 2005-12-27 16:17 UTC
+# 
 # (C) 2003-2004 Meng Weng Wong <mengwong+spf at pobox.com>
-# Improved argument parsing added by Julian Mehnle <julian at mehnle.net>
-# If you're reading source code, you should probably be on spf-devel at v2.listbox.com.
+#     2005-2006 Julian Mehnle <julian at mehnle.net>
+# 
+# If you're reading source code, you should probably be on
+# spf-devel at v2.listbox.com.
+#
+# $Id: spfd 141 2006-02-07 00:04:51Z julian $
+#
+##############################################################################
 
 =head1 NAME
 
@@ -12,7 +19,7 @@
 
 =head1 VERSION
 
-2005-12-27
+2006-02-07
 
 =head1 SYNOPSIS
 


Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/bin/spfd
___________________________________________________________________
Name: svn:executable
   - 
   + *

Modified: packages/libmail-spf-query-perl/branches/upstream/current/bin/spfquery
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/bin/spfquery	2006-02-05 18:24:43 UTC (rev 2102)
+++ packages/libmail-spf-query-perl/branches/upstream/current/bin/spfquery	2006-02-09 18:44:08 UTC (rev 2103)
@@ -4,9 +4,10 @@
 #
 #  Author: Wayne Schlitt <wayne at midwestcs.com>
 #
-#  File:   spfquery.c
+#  File:   spfquery
 #  Desc:   SPF command line utility
 #
+# $Id: spfquery 138 2006-01-22 18:00:34Z julian $
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of either:
@@ -51,15 +52,14 @@
 
 =head1 VERSION
 
-2.2
+2.3
 
 =head1 SYNOPSIS
 
 B<spfquery> B<--mail-from>|B<-m>|B<--sender>|B<-s> I<email-address>|I<domain>
-B<--ip>|B<-i> I<ip-address> [B<--rcpt-to>|B<-r> I<email-address>] [I<OPTIONS>]
+B<--helo>|B<-h> I<hostname> B<--ip>|B<-i> I<ip-address> [I<OPTIONS>]
 
-B<spfquery> B<--helo>|B<-h> I<hostname> B<--ip>|B<-i> I<ip-address>
-[B<--rcpt-to>|B<-r> I<email-address>] [I<OPTIONS>]
+B<spfquery> B<--helo>|B<-h> I<hostname> B<--ip>|B<-i> I<ip-address> [I<OPTIONS>]
 
 B<spfquery> B<--file>|B<-f> I<filename>|B<-> [I<OPTIONS>]
 
@@ -74,13 +74,14 @@
 For information on SPF see L<http://www.openspf.org>.
 
 The B<--mail-from> form checks if the given I<ip-address> is an authorized SMTP
-sender for the given envelope sender I<domain> or I<email-address> (so-called
-C<MAIL FROM> check).
+sender for the given envelope sender I<domain> or I<email-address> and C<HELO>
+I<hostname> (so-called C<MAIL FROM> check).  If a I<domain> is given,
+C<postmaster> will be substituted for the localpart.
 
 The B<--helo> form checks if the given I<ip-address> is an authorized SMTP
 sender for the given C<HELO> I<hostname> (so-called C<HELO> check).
 
-The B<--file> form reads (I<ip-address>, I<sender-address>, I<helo-hostname>)
+The B<--file> form reads "I<ip-address> I<sender-address> I<helo-hostname>"
 tuples from the file with the specified I<filename>, or from standard input if
 I<filename> is B<->.
 
@@ -98,6 +99,23 @@
 
 Print out debug information.
 
+=item B<--default-explanation> I<string>
+
+Use the specified I<string> as the default explanation if the SPF record does
+not specify an explanation string itself.
+
+=item B<--guess> I<spf-terms>
+
+Use I<spf-terms> as a default record if no SPF record is found.  B<This is a
+non-standard feature.>
+
+=item B<--keep-comments>
+
+=item B<--no-keep-comments>
+
+Do (not) print any comments found when reading from a file or from standard
+input.
+
 =item B<--local> I<spf-terms>
 
 Process I<spf-terms> as local policy before resorting to a default result
@@ -105,26 +123,28 @@
 record).  For example, this could be used for white-listing one's secondary
 MXes: C<mx:mydomain.example.org>.
 
-=item B<--trusted>
+=item B<--max-lookup-count> I<n>
 
-=item B<--no-trusted>
+Perform a maximum of I<n> SPF record lookups.  Defaults to B<10>.
 
-Do (not) perform C<trusted-forwarder.org> accreditation checking.  Disabled by
-default.  B<This is a non-standard feature.>
+=item B<--name> I<hostname>
 
-=item B<--guess> I<spf-terms>
+Use I<hostname> as the hostname of the local system instead of auto-detecting
+it.
 
-Use I<spf-terms> as a default record if no SPF record is found.  B<This is a
-non-standard feature.>
+=item B<--override> I<domain>B<=>I<spf-record>
 
-=item B<--default-explanation> I<string>
+=item B<--fallback> I<domain>B<=>I<spf-record>
 
-Use the specified I<string> as the default explanation if the SPF record does
-not specify an explanation string itself.
+Set overrides and fallbacks.  Each option can be specified multiple times.  For
+example: C<--override example.org='v=spf1 -all' --override
+'*.example.net'='v=spf1 a mx -all' --fallback example.com='v=spf1 -all'>.
+B<This is a non-standard feature.>
 
-=item B<--max-lookup-count> I<n>
+=item B<--rcpt-to> I<email-addresses>
 
-Perform a maximum of I<n> SPF record lookups.  Defaults to B<10>.
+Automatically allow the secondary MXes of the comma-separated list of
+I<email-addresses>.
 
 =item B<--sanitize>
 
@@ -134,24 +154,13 @@
 single space and replacing non-printable characters with question marks.
 Enabled by default.
 
-=item B<--name> I<hostname>
+=item B<--trusted>
 
-Use I<hostname> as the hostname of the local system instead of auto-detecting
-it.
+=item B<--no-trusted>
 
-=item B<--override> I<...>
+Do (not) perform C<trusted-forwarder.org> accreditation checking.  Disabled by
+default.  B<This is a non-standard feature.>
 
-=item B<--fallback> I<...>
-
-Set overrides and fallbacks.  See L<Mail::SPF::Query>.
-
-=item B<--keep-comments>
-
-=item B<--no-keep-comments>
-
-Do (not) print any comments found when reading from a file or from standard
-input.
-
 =back
 
 =head1 RESULT CODES
@@ -245,7 +254,7 @@
 
 =cut
 
-our $VERSION = "2.2";
+our $VERSION = '2.3';
 
 use warnings;
 use strict;
@@ -257,9 +266,13 @@
 {
   printf STDERR <<'EOT';
 Usage:
-    spfquery [ control options | data options ]
+    spfquery --mail-from|-m <email-address>|<domain> --helo|-h <hostname>
+        --ip|-i <ip-address> [OPTIONS]
+    spfquery --helo|-h <hostname> --ip|-i <ip-address> [OPTIONS]
+    spfquery --file|-f <filename>|- [OPTIONS]
+    spfquery --version|-V
 
-Use the --help option for more information.
+See `spfquery --help` for more information.
 EOT
 }
 
@@ -267,45 +280,49 @@
 {
   print STDERR <<'EOT';
 Usage:
-    spfquery [ control options | data options ]
+    spfquery --mail-from|-m <email-address>|<domain> --helo|-h <hostname>
+        --ip|-i <ip-address> [OPTIONS]
+    spfquery --helo|-h <hostname> --ip|-i <ip-address> [OPTIONS]
+    spfquery --file|-f <filename>|- [OPTIONS]
+    spfquery --version|-V
 
-Valid data options are:
-    --mail-from <sender-address>
-                        The email address used as the envelope sender address
-                        (SMTP MAIL FROM command).  If no local part is given,
-                        'postmaster' will be assumed.
-    --helo <hostname>   The domain name given as the envelope sender hostname
-                        (SMTP HELO command).
-    --file <filename>   Read parameters from a file.  Use '-' to read from
-                        stdin.
+spfquery performs SPF checks based on the command-line arguments or data given
+in a file or on standard input.
 
-    --ip <ip-address>   The IP address that is sending email.
-    --rcpt-to <email-addresses>
-                        A comma-separated lists of email addresses that will
-                        have email from their secondary MXes automatically
-                        allowed.
+The "--mail-from" form checks if the given <ip-address> is an authorized SMTP
+sender for the given envelope sender <domain> or <email-address> and HELO
+<hostname> (so-called MAIL FROM check).  If a <domain> is given, "postmaster"
+will be substituted for the localpart.
 
-Any one of --sender, --helo, or --file is required.  The --rcpt-to option is
-optional.  The --file option conflicts with all the other data options
- 
-Valid control options are:
+The "--helo" form checks if the given <ip-address> is an authorized SMTP sender
+for the given HELO <hostname> (so-called HELO check).
+
+The "--file" form reads "<ip-address> <sender-address> <helo-hostname>" tuples
+from the file with the specified <filename>, or from standard input if
+<filename> is "-".
+
+The "--version" form prints version information of spfquery.
+
+Valid OPTIONS are:
     --debug             Output debugging information.
-    --local <spf-terms> Local policy for whitelisting.
-    --trusted           Check trusted-forwarder.org white-list.
-    --guess <spf-terms> Default checks if no SPF record is found.
     --default-explanation <string>
                         Default explanation string to use.
+    --guess <spf-terms> Default checks if no SPF record is found.
+    --keep-comments     Print comments found when reading from a file.
+    --local <spf-terms> Local policy for whitelisting.
     --max-lookup-count <n>
                         Maximum number of DNS lookups to allow.
+    --name <hostname>   The name of the system doing the SPF checking.
+    --override <domain>=<spf-record>
+    --fallback <domain>=<spf-record>
+                        Set override and fallback SPF records for domains.
+    --rcpt-to <email-addresses>
+                        A comma-separated lists of email addresses that will
+                        have email from their secondary MXes automatically
+                        allowed.
     --no-sanitize       Do not clean up invalid characters in output.
-    --name <hostname>   The name of the system doing the SPF checking.
-    --fallback <...>    Fallback SPF records for domains.
-    --override <...>    Override SPF records for domains.
-    --keep-comments     Print comments found when reading from a file.
+    --trusted           Check trusted-forwarder.org white-list.
 
-    --version           Print version of spfquery.
-    --help              Print out these options.
-
 Examples:
     spfquery -i 11.22.33.44 -m user at example.com -h spammer.example.net
     spfquery -f test_data
@@ -332,98 +349,92 @@
   'max-lookup-count|max-lookup=i',
   'sanitize!',
   'name=s',
-  'fallback=s',
-  'override=s',
+  'override=s%',
+  'fallback=s%',
   'keep-comments!',
   
   'version|V!',
   'help!'
 );
 
-$opt{name} = 'spfquery' if not defined($opt{name});
+if (!$result) {
+  usage();
+  exit 255;
+}
 
 if ($opt{help}) {
   help();
   exit 255;
 }
 
-if (!$result) {
-  usage();
-  exit 255;
-}
-
 if ($opt{version}) {
   printf STDERR "spfquery version %s\n\n", $VERSION;
   exit 0;
 }
 
+$opt{name} = 'spfquery' if not defined($opt{name});
+
 #
-# process the SPF request
+# Process the SPF request
 #
+
 my $res;
 
-if (!defined($opt{ip}) || (!defined($opt{sender}) && !defined($opt{helo}))) {
-  if (!defined($opt{file}) ||
-      defined($opt{ip}) || defined($opt{sender}) || defined($opt{helo})) {
-    usage();
-    exit 255;
-  }
-
-  #
-  # the requests are on STDIN
-  #
-        
+if (
+  defined($opt{'mail-from'}) and defined($opt{helo}) and defined($opt{ip}) and
+  not defined($opt{file})
+) {
+  # --mail-from form:
+  $res = do_query();
+}
+elsif (
+  defined($opt{helo}) and defined($opt{ip}) and
+  not defined($opt{'mail-from'}) and not defined($opt{file})
+) {
+  # --helo form:
+  $res = do_query();
+}
+elsif (
+  defined($opt{file}) and
+  not defined($opt{'mail-from'}) and not defined($opt{helo}) and not defined($opt{ip})
+) {
+  # --file form:
   local *FIN;
-
-  if ( $opt{file} eq "-" ) {
+  if ($opt{file} eq '-') {
     *FIN = \*STDIN;
   }
   else {
-    open( FIN, $opt{file} ) || die "Could not open: %s\n", $opt{file};
+    open(FIN, $opt{file}) || die("Could not open: $opt{file}\n");
   }
-        
-  while ( <FIN> ) {
+  while (<FIN>) {
     chomp;
-
     if ( /^\s*$/ || /^\s*#/ ) {
-      if ( $opt{'keep-comments'} ) {
-        printf "%s\n", $_;
-      }
-
+      print("$_\n") if $opt{'keep-comments'};
       next;
     }
     s/^\s*//;
-
-    ($opt{ip}, $opt{sender}, $opt{helo}, $opt{'rcpt-to'}) = split;
-
+    @opt{'ip', 'mail-from', 'helo', 'rcpt-to'} = split;
     $res = do_query();
   }
 }
 else {
-  if (defined($opt{file})) {
-    usage();
-    exit 255;
-  }
-
-  $res = do_query();
+  # Invalid usage.
+  usage();
+  exit 255;
 }
 
 exit $res;
 
 
-
+#
+# Process the SPF request and print the results
+#
 sub do_query {
+  $opt{'mail-from'} = '' if not defined($opt{'mail-from'});
+  $opt{helo}        = '' if not defined($opt{helo});
 
-
-  #
-  # Process the SPF request and print the results
-  #
-
-  $opt{sender} = '' if not defined($opt{sender});
-  $opt{helo}   = '' if not defined($opt{helo});
-
   my $query = new Mail::SPF::Query (ipv4       => $opt{ip},
-                                    sender     => $opt{sender},
+                                    sender     => $opt{'mail-from'},
                                     helo       => $opt{helo},
                                     local      => $opt{local},
                                     trusted    => $opt{trusted},
@@ -467,7 +478,7 @@
         
   my $received_spf;
   $received_spf = "Received-SPF: $per_result ($header_comment) client-ip=$opt{ip};";
-  $received_spf .= " envelope-from=$opt{sender};" if defined($opt{sender});
+  $received_spf .= " envelope-from=$opt{'mail-from'};" if defined($opt{'mail-from'});
   $received_spf .= " helo=$opt{helo};" if defined($opt{helo});
   { no warnings 'uninitialized';
     print "$result\n$smtp_comment\n$header_comment\n$received_spf\n";


Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/bin/spfquery
___________________________________________________________________
Name: svn:executable
   - 
   + *

Modified: packages/libmail-spf-query-perl/branches/upstream/current/debian/changelog
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/debian/changelog	2006-02-05 18:24:43 UTC (rev 2102)
+++ packages/libmail-spf-query-perl/branches/upstream/current/debian/changelog	2006-02-09 18:44:08 UTC (rev 2103)
@@ -1,3 +1,56 @@
+libmail-spf-query-perl (1.999) unstable; urgency=low
+
+  Debian:
+  * Build-Depend, not Build-Depend-Indep, on debhelper.  Also, depend on
+    debhelper >= 5.
+  * Build-Depend-Indep on netbase to allow testing to work when building in a
+    pbuilder chroot (closes: #351030).
+
+  Mail::SPF::Query:
+  * No longer accept malformed SPF records such as "\"v=spf1 ...\"" (spurious
+    double quotes) or " v=spf1 ..." (leading whitespace).
+  * Combine multiple TXT strings into a single string _before_ fallbacks are
+    tried.  Thus, fallbacks now also get applied if there are only non-
+    "v=spf1" TXT records; this wasn't the case before.
+  * Guard against non-numeric cidr-lengths (closes rt.cpan.org bug #17061).
+  * Flattened the { 'domain' => { record => '...' } } override and fallback
+    argument format to just { 'domain' => '...' }.  The old format is still
+    supported for backwards compatibility.
+  * Added a "BUGS" section to the man-page documenting M:S:Q's known
+    deficiencies.
+  * Lots of minor code improvements.
+
+  spfquery:
+  * Correctly recognize the --mail-from (AKA --sender) option.  The version
+    in the M:S:Q 1.998 release was broken in this regard.
+  * Actually require the --helo option for the --mail-from (AKA --sender)
+    form.
+  * Cleaned up command-line argument validation code.
+  * Cleaned up the inconsistent short and long (--help) usage and man-page
+    texts.
+  * Clarified the file input syntax in the help and man-page texts.
+  * The "--override" and "--fallback" options are now actually working and
+    documented.
+
+  Tests:
+  * Overhauled 00_all.t test script:
+    * Don't skip tests when a non-last test in a test tuple fails (this made
+      test 223 "fail", for example, because Test::Harness thought that some
+      planned tests were not performed).
+    * Marked test 219 (SERVFAIL) as non-critical, because it isn't completely
+      reliable (sometimes, apparently behind some NATs and firewalls, the
+      query just times out instead of returning SERVFAIL) (closes rt.cpan.org
+      bug #17099).
+    * Generate and collect debug log output (internally) along with the normal
+      M:S:Q->result() calls right away, so that extra just-to-get-debug-output
+      M:S:Q->result() calls can be saved.  Also we can make debug log output
+      Test::Harness-compatible this way by printing it ourselves with '#'
+      chars at the beginnings of lines.
+    * Cleaned up code.
+  * Cleaned up comments in t/test.dat test data file.
+
+ -- Julian Mehnle <julian at mehnle.net>  Tue,  7 Feb 2006 00:00:00 +0000
+
 libmail-spf-query-perl (1.998) unstable; urgency=low
 
   Debian:
@@ -83,7 +136,7 @@
     a Python one.
   * Did I mention lots of minor code and documentation fixes/improvements?
 
- -- Julian Mehnle <julian at mehnle.net>  Thu, 31 Dec 2005 23:00:00 +0000
+ -- Julian Mehnle <julian at mehnle.net>  Sat, 31 Dec 2005 23:00:00 +0000
 
 libmail-spf-query-perl (1.997-3) unstable; urgency=low
 

Modified: packages/libmail-spf-query-perl/branches/upstream/current/debian/compat
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/debian/compat	2006-02-05 18:24:43 UTC (rev 2102)
+++ packages/libmail-spf-query-perl/branches/upstream/current/debian/compat	2006-02-09 18:44:08 UTC (rev 2103)
@@ -1 +1 @@
-4
+5

Modified: packages/libmail-spf-query-perl/branches/upstream/current/debian/control
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/debian/control	2006-02-05 18:24:43 UTC (rev 2102)
+++ packages/libmail-spf-query-perl/branches/upstream/current/debian/control	2006-02-09 18:44:08 UTC (rev 2103)
@@ -1,7 +1,8 @@
 Source: libmail-spf-query-perl
 Section: perl
 Priority: optional
-Build-Depends-Indep: debhelper (>= 4.0.2), perl (>= 5.8.0-7), libsys-hostname-long-perl, libnet-dns-perl (>= 0.46), libnet-cidr-lite-perl (>= 0.15), liburi-perl
+Build-Depends-Indep: perl (>= 5.8.0-7), netbase, libsys-hostname-long-perl, libnet-dns-perl (>= 0.46), libnet-cidr-lite-perl (>= 0.15), liburi-perl
+Build-Depends: debhelper (>= 5)
 Maintainer: Julian Mehnle <julian at mehnle.net>
 Standards-Version: 3.6.2
 


Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/debian/rules
___________________________________________________________________
Name: svn:executable
   - 
   + *


Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/examples/postfix-policyd-spf
___________________________________________________________________
Name: svn:executable
   - 
   + *

Modified: packages/libmail-spf-query-perl/branches/upstream/current/lib/Mail/SPF/Query.pm
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/lib/Mail/SPF/Query.pm	2006-02-05 18:24:43 UTC (rev 2102)
+++ packages/libmail-spf-query-perl/branches/upstream/current/lib/Mail/SPF/Query.pm	2006-02-09 18:44:08 UTC (rev 2103)
@@ -12,31 +12,6 @@
 # License: like Perl, i.e. GPL-2 and Artistic License
 #
 # $Id$
-# 
-# This version is compatible with spf-draft-20040209.
-#
-# The result of evaluating a SPF record associated with a domain is one of:
-# 
-#   pass      Explicit pass -- message is not a forgery.
-#   fail      Explicit fail -- MTA may reject, MUA may discard.
-#   softfail  Explicit softfail -- please apply strict antispam checks.
-#   neutral   Domain explicitly wishes you to pretend it had no SPF record.
-#   none      The domain does not have an SPF record.
-#   error     Some type of temporary failure, usually DNS-related.
-#   unknown   A permanent error, such as missing SPF record during "include"
-#             or "redirect", parse error, unknown mechanism, or record loop.
-#
-# TODO:
-#   * Add ipv6 support.
-#   * Add support for doing HELO tests before MAIL FROM tests.
-#   * If the spf_source is not 'original-spf-record' (but e.g. a local policy
-#     source), do not return the "why.html" default explanation, because
-#     "why.html" will not be able to reproduce the local policy.
-#   * If there are multiple unrecognized mechanisms, they all need to be
-#     preserved in the 'unknown' Received-SPF header.  Right now only the
-#     first appears.
-#   * Override and fallback keys need to be lc()ed at start.
-# 
 # ----------------------------------------------------------
 
 use 5.006;
@@ -45,7 +20,7 @@
 use warnings;
 no warnings 'uninitialized';
 
-our $VERSION = '1.998';
+our $VERSION = '1.999';
 $VERSION = eval($VERSION);
 
 use Sys::Hostname::Long;
@@ -82,7 +57,7 @@
 
 =head1 VERSION
 
-1.998
+1.999
 
 =head1 SYNOPSIS
 
@@ -127,16 +102,50 @@
 
     perl -MMail::SPF::Query -le 'print for Mail::SPF::Query->new(helo=>shift, ipv4=>shift, sender=>shift)->result' helohost.example.com 1.2.3.4 user at example.com
 
-=head1 NON-STANDARD FEATURES
+=head1 BUGS
 
 Mail::SPF::Query tries to implement the SPF specification (see L</"SEE ALSO">)
 as close as reasonably possible given that M:S:Q has been the very first SPF
-implementation and has changed with the SPF specification over time.
+implementation and has changed with the SPF specification over time.  As a
+result, M:S:Q has various known deficiencies that cannot be corrected with
+reasonably little effort:
 
-As such, M:S:Q does have some legacy features that are not parts of the
-official SPF specification, most notably I<best guess processing> and I<trusted
-forwarder accreditation checking>.  Please be careful when using these
-I<non-standard> features or when reproducing them in your own SPF
+=over
+
+=item *
+
+B<Unable to query HELO and MAIL FROM separately.>  M:S:Q is not designed to
+support the I<separate> querying of the HELO and MAIL FROM identities.  Passing
+the HELO identity as the C<sender> argument for a stand-alone HELO check might
+generally work but could yield unexpected results.
+
+=item *
+
+B<No IPv6 support.>  IPv6 is not supported.  C<ip6> mechanisms in SPF records
+and everywhere else are simply ignored.
+
+=item *
+
+B<Result explanation may be inappropriate for local policy results.>  If a
+query result was caused by anything other than a real SPF record (i.e. local
+policy, overrides, fallbacks, etc.), and no custom C<default_explanation> was
+specified, the domain's explanation or M:S:Q's hard-coded default explanation
+will still be returned.  Be aware that in this case the explanation may not
+correctly explain the reason for such an artificial result.
+
+=for comment
+INTERNAL NOTE:  If the spf_source is not 'original-spf-record' (but e.g. a
+local policy source), do not return the "why.html" default explanation, because
+"why.html" will not be able to reproduce the local policy.
+
+=back
+
+=head1 NON-STANDARD FEATURES
+
+Also due to its long history, M:S:Q does have some legacy features that are not
+parts of the official SPF specification, most notably I<best guess processing>
+and I<trusted forwarder accreditation checking>.  Please be careful when using
+these I<non-standard> features or when reproducing them in your own SPF
 implementation, as they may cause unexpected results.
 
 =head1 METHODS
@@ -156,11 +165,11 @@
         default_explanation => 'Please see http://spf.my.isp/spferror.html for details',
         max_lookup_count    => 10,       # total number of SPF include/redirect queries
         sanitize            => 0,        # do not sanitize all returned strings
-        myhostname => "foo.example.com", # prepended to header_comment
-        fallback => {   "foo.com" => { record => "v=spf1 a mx -all", OPTION => VALUE },
-                      "*.foo.com" => { record => "v=spf1 a mx -all", OPTION => VAULE }, },
-        override => {   "bar.com" => { record => "v=spf1 a mx -all", OPTION => VALUE },
-                      "*.bar.com" => { record => "v=spf1 a mx -all", OPTION => VAULE }, }
+        myhostname => 'foo.example.com', # prepended to header_comment
+        override => {   'example.net' => 'v=spf1 a mx -all',
+                      '*.example.net' => 'v=spf1 a mx -all' },
+        fallback => {   'example.org' => 'v=spf1 a mx -all',
+                      '*.example.org' => 'v=spf1 a mx -all' }
     ) };
 
     if ($@) { warn "bad input to Mail::SPF::Query: $@" }
@@ -196,28 +205,32 @@
 
 Set C<debug=E<gt>1> to watch the queries happen.
 
-Set C<fallback> to define "pretend" SPF records for domains that don't publish
-them yet.  Wildcards are supported.  B<This is a non-standard feature.>
-
 Set C<override> to define SPF records for domains that do publish but which you
 want to override anyway.  Wildcards are supported.  B<This is a non-standard
 feature.>
 
-Note: domain name arguments to fallback and override need to be in all
+Set C<fallback> to define "pretend" SPF records for domains that don't publish
+them yet.  Wildcards are supported.  B<This is a non-standard feature.>
+
+Note: domain name arguments to override and fallback need to be in all
 lowercase.
 
 =cut
 
 # ----------------------------------------------------------
+#                            new
+# ----------------------------------------------------------
+
 sub new {
-# ----------------------------------------------------------
   my $class = shift;
   my $query = bless { @_ }, $class;
 
   $query->{lookup_count} = 0;
 
-  $query->{ipv4} = delete $query->{ip}   if $query->{ip}   and $query->{ip} =~ $looks_like_ipv4;
-  $query->{helo} = delete $query->{ehlo} if $query->{ehlo};
+  $query->{ipv4} = delete $query->{ip}
+    if defined($query->{ip}) and $query->{ip} =~ $looks_like_ipv4;
+  $query->{helo} = delete $query->{ehlo}
+    if defined($query->{ehlo});
 
   $query->{local} .= ' ' . $TRUSTED_FORWARDER if ($query->{trusted});
 
@@ -283,9 +296,19 @@
   if (not $query->{myhostname}) {
     $query->{myhostname} = Sys::Hostname::Long::hostname_long();
   }
-
   $query->{myhostname} ||= "localhost";
 
+  # Unfold legacy { 'domain' => { record => '...' } } override and fallback
+  # structures to just { 'domain' => '...' }:
+  foreach ('override', 'fallback') {
+    if (ref(my $domains_hash = $query->{$_}) eq 'HASH') {
+      foreach my $domain (keys(%$domains_hash)) {
+        $domains_hash->{$domain} = $domains_hash->{$domain}->{record}
+          if ref($domains_hash->{$domain}) eq 'HASH';
+      }
+    }
+  }
+
   $query->post_new(@_) if $class->can("post_new");
 
   return $query;
@@ -1467,7 +1490,10 @@
 
   my ($network, $cidr_length) = split (/\//, $cidr_spec, 2);
 
-  if ($network !~ /^\d+\.\d+\.\d+\.\d+$/) { return ("unknown" => "bad argument to ip4: $cidr_spec"); }
+  if (
+    $network !~ /^\d+\.\d+\.\d+\.\d+$/ ||
+    (defined($cidr_length) && $cidr_length !~ /^\d+$/)
+  ) { return ("unknown" => "bad argument to ip4: $cidr_spec"); }
   
   $cidr_length = "32" if not defined $cidr_length;
 
@@ -1569,9 +1595,9 @@
 
     for my $match ($ancestor_level > 0 ? "*.$ancestor" : $ancestor) {
       $query->debuglog("  DirectiveSet $which_hash: is $match in the $which_hash hash?");
-      if (my $found = $query->{$which_hash}->{lc $match}) {
+      if (my $record = $query->{$which_hash}->{lc $match}) {
         $query->debuglog("  DirectiveSet $which_hash: yes, it is.");
-        return wantarray ? ($which_hash, $match, $found) : $found;
+        return wantarray ? ($which_hash, $match, $record) : $record;
       }
     }
   }
@@ -1580,13 +1606,12 @@
 
 sub found_record_for {
   my $query = shift;
-  my ($which_hash, $matched_domain_glob, $found) = $query->find_ancestor(@_);
-  return if not $found;
-  my $txt = $found->{record};
-  $query->{spf_source} = "explicit $which_hash found: $matched_domain_glob defines $txt";
+  my ($which_hash, $matched_domain_glob, $record) = $query->find_ancestor(@_);
+  return if not $record;
+  $query->{spf_source} = "explicit $which_hash found: $matched_domain_glob defines $record";
   $query->{spf_source_type} = "full-explanation";
-  $txt = "v=spf1 $txt" if $txt !~ /^v=spf1\b/i;
-  return $txt;
+  $record = "v=spf1 $record" if $record !~ /^v=spf1\b/i;
+  return $record;
 }
 
 sub try_override {
@@ -1616,66 +1641,54 @@
 
     my $txt;
 
-    # overrides can come from two places:
-    #  1 - when operating in best_guess mode, spfquery may be called with a ($guess_mechs) argument, which comes in as $override_text.
-    #  2 - when operating with ->new(..., override => { ... }) we need to load the override dynamically.
-
-    if (not $override_text
-        and
-        exists $query->{override}
-       ) {
-      $txt = $query->try_override($current_domain);
-    }
-
+    # Overrides can come from two places:
+    # - When operating in best_guess mode, spfquery may be called with a $guess_mechs argument, which comes in as $override_text.
+    # - When operating with ->new(..., override => { ... }) we need to load the override dynamically.
     if ($override_text) {
       $txt = "v=spf1 $override_text ?all";
       $query->{spf_source} = "local policy";
       $query->{spf_source_type} = "full-explanation";
     }
-    else {
+    elsif (exists $query->{override}) {
+      $txt = $query->try_override($current_domain);
+    }
+
+    # Retrieve a record from DNS:
+    if (!defined $txt) {
       my @txt;
-
       $query->debuglog("  DirectiveSet->new(): doing TXT query on $current_domain");
       @txt = $query->myquery($current_domain, "TXT", "char_str_list");
       $query->debuglog("  DirectiveSet->new(): TXT query on $current_domain returned error=$query->{error}, last_dns_error=$query->{last_dns_error}");
 
-      if ($query->{error} || $query->{last_dns_error} eq 'NXDOMAIN' || ! @txt) {
-        # try the fallbacks.
-        $query->debuglog("  DirectiveSet->new(): will try fallbacks.");
-        if (exists $query->{fallback}
-            and
-            my $found_txt = $query->try_fallback($current_domain, "fallback")) {
-          @txt = $found_txt;
-        }
-        else {
-          $query->debuglog("  DirectiveSet->new(): fallback search failed.");
-        }
-      }
-
       # Combine multiple TXT strings into a single string:
       foreach (@txt) {
-        s/^"(.*)"$/$1/;
-        s/^\s+//;
-        s/\s+$//;
-        
-        if (/^v=spf1(\s.*|)$/i) {
-          $txt .= $1;
-        }
+        $txt .= $1 if /^v=spf1\s*(.*)$/;
       }
 
-      if (!defined $txt && $default_record) {
-          $txt = "v=spf1 $default_record ?all";
-          $query->{spf_source} = "local policy";
-          $query->{spf_source_type} = "full-explanation";
-      }
+      $txt = undef
+        if $query->{error} or $query->{last_dns_error} eq 'NXDOMAIN';
     }
 
+    # Try the fallbacks:
+    if (!defined $txt and exists $query->{fallback}) {
+      $query->debuglog("  DirectiveSet->new(): will try fallbacks.");
+      $txt = $query->try_fallback($current_domain, "fallback");
+      defined($txt)
+        or $query->debuglog("  DirectiveSet->new(): fallback search failed.");
+    }
+
+    if (!defined $txt and defined $default_record) {
+      $txt = "v=spf1 $default_record ?all";
+      $query->{spf_source} = "local policy";
+      $query->{spf_source_type} = "full-explanation";
+    }
+
     $query->debuglog("  DirectiveSet->new(): SPF policy: $txt");
 
     return if not defined $txt;
 
     # TODO: the prepending of the v=spf1 is a massive hack; get it right by saving the actual raw orig_txt.
-    my $directive_set = bless { orig_txt => ($txt =~ /^v=spf1/ ? $txt : "v=spf1$txt"), txt => $txt } , $class;
+    my $directive_set = bless { orig_txt => ($txt =~ /^v=spf1/ ? $txt : "v=spf1 $txt"), txt => $txt } , $class;
 
     TXT_RESPONSE:
     for ($txt) {

Modified: packages/libmail-spf-query-perl/branches/upstream/current/t/00_all.t
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/t/00_all.t	2006-02-05 18:24:43 UTC (rev 2102)
+++ packages/libmail-spf-query-perl/branches/upstream/current/t/00_all.t	2006-02-09 18:44:08 UTC (rev 2103)
@@ -1,141 +1,163 @@
 # Before `make install' is performed this script should be runnable with
 # `make test'.  After `make install' it should work as `perl t/00all.t'.
 
-#########################
+use warnings;
+use strict;
 
 use Test;
-use strict;
 use Getopt::Std;
+use IO::File;
 
-my %opts;
+use constant TEST_FILENAME => 't/test.dat';
 
-getopts('d:',\%opts);
-
 my @test_table;
 
 BEGIN {
-  open TESTFILE, "t/test.dat";
-  @test_table = grep { /\S/ and not /^\s*#/ } <TESTFILE>;
-  chomp @test_table;
-  close TESTFILE;
-
-  plan tests => 1 + map(/\G,?(\d+)/g, @test_table);
+    my $test_file = IO::File->new(TEST_FILENAME);
+    @test_table = grep { /\S/ && !/^\s*#/ } <$test_file>;
+    chomp(@test_table);
+    
+    plan(
+        tests   => 1 + map(/\G,?(\d+)/g, @test_table),
+        todo    => [219]  # The SERVFAIL test isn't completely reliable.
+    );
 };
 
 use Mail::SPF::Query;
 
-# 1: did the library load okay?
+# Test #1: Did the library load okay?
 ok(1);
 
+my %opts;
+getopts('d:', \%opts);
+
+my $test_log;
 if ($opts{d}) {
-    open(TEST, ">$opts{d}") || die "Cannot open $opts{d} for output";
+    $test_log = IO::File->new(">$opts{d}") || die("Cannot open $opts{d} for output");
 }
 
 my $testnum = 2;
 
-#########################
-
 foreach my $tuple (@test_table) {
-  my ($num, $domain, $ipv4, $expected_result, $expected_smtp_comment, $expected_header_comment) =
-    ($tuple =~ /\t/ ? split(/\t/, $tuple) : split(' ', $tuple));
-
-  my ($actual_result, $actual_smtp_comment, $actual_header_comment);
-
-  my ($sender, $localpolicy) = split(':', $domain, 2);
-  $sender =~ s/\\([0-7][0-7][0-7])/chr(oct($1))/ge;
-  $domain = $sender;
-  if ($domain =~ /\@/) { ($domain) = $domain =~ /\@(.+)/ }
-
-  my $testcnt = 3;
-
-  if ($expected_result =~ /=(pass|fail),/) {
-      for (my $debug = 0; $debug < 2; $debug++) {
-          Mail::SPF::Query->clear_cache;
-          my $query = eval  { new Mail::SPF::Query (ipv4   => $ipv4,
-                                                    sender => $sender,
-                                                    helo   => $domain,
-                                                    debug  => $debug,
-                                                    local  => $localpolicy,
-                                                   ); };
-
-          my $ok = 1;
-          my $header_comment;
-
-          $actual_result = "";
-
-          foreach my $e_result (split(/,/, $expected_result)) {
-              if ($e_result !~ /=/) {
-                  my ($msg_result, $smtp_comment);
-                  ($msg_result, $smtp_comment, $header_comment) = eval { $query->message_result2 };
-
-                  $actual_result .= $msg_result;
-
-                  $ok = ok($msg_result, $e_result) if (!$debug);
-                  if (!$ok) {
-                      last;
-                  }
-              } else {
-                  my ($recip, $expected_recip_result) = split(/=/, $e_result, 2);
-                  my ($recip_result, $smtp_comment) = eval { $query->result2(split(';',$recip)) };
-
-                  $actual_result .= "$recip=$recip_result,";
-                  $testcnt++;
-
-                  $ok = ok($recip_result, $expected_recip_result) if (!$debug);
-                  if (!$ok) {
-                      last;
-                  }
-              }
-          }
-
-          $header_comment =~ s/\S+: //; # strip the reporting hostname prefix
-
-          if ($expected_header_comment) {
-              $ok &= ok($header_comment, $expected_header_comment) if (!$debug);
-          }
-          $actual_header_comment = $header_comment;
-          $actual_smtp_comment = '.';
-          last if ($ok);
-      }
-  } else {
-      my ($result, $smtp_comment, $header_comment) = eval  { new Mail::SPF::Query (ipv4   => $ipv4,
-                                                                                   sender => $sender,
-                                                                                   helo   => $domain,
-                                                                                   local  => $localpolicy,
-                                                                                   default_explanation => "explanation",
-                                                                                  )->result; };
-      $header_comment =~ s/^\S+: //; # strip the reporting hostname prefix
-
-      my $ok = (! $expected_smtp_comment
-                ?  ok($result, $expected_result)
-                : (ok($result, $expected_result) &&
-                   ok($smtp_comment, $expected_smtp_comment) &&
-                   ok($header_comment, $expected_header_comment)));
-
-      $actual_smtp_comment = $smtp_comment;
-      $actual_result = $result;
-      $actual_header_comment = $header_comment;
-      
-      if (not $ok) {
+    my ($num, $domain, $ipv4, $expected_result, $expected_smtp_comment, $expected_header_comment) =
+        ($tuple =~ /\t/ ? split(/\t/, $tuple) : split(' ', $tuple));
+    
+    my ($actual_result, $actual_smtp_comment, $actual_header_comment);
+    
+    my ($sender, $localpolicy) = split(':', $domain, 2);
+    $sender =~ s/\\([0-7][0-7][0-7])/chr(oct($1))/ge;
+    $domain = $sender;
+    if ($domain =~ /\@/) { ($domain) = $domain =~ /\@(.+)/ }
+    
+    my $testcnt = 3;
+    
+    if ($expected_result =~ /=(pass|fail),/) {
+        my $debug_log_buf = "# Detailed debug log for test(s) $num:\n";
         Mail::SPF::Query->clear_cache;
-        my $result = eval { scalar(new Mail::SPF::Query (ipv4   => $ipv4,
-                                                         sender => $sender,
-                                                         helo   => $domain,
-                                                         debug  => 1,
-                                                         local  => $localpolicy,
-                                                        )->result) };
-        if ($@) {
-          print "  trapped error: $@\n";
-          next;
+        my $query = eval {
+            Mail::SPF::Query->new(
+                ipv4    => $ipv4,
+                sender  => $sender,
+                helo    => $domain,
+                debug   => 1,
+                debuglog
+                        => make_debug_log_accumulator(\$debug_log_buf),
+                local   => $localpolicy
+            )
+        };
+        
+        my $ok = 1;
+        my $header_comment;
+        
+        $actual_result = '';
+        
+        foreach my $e_result (split(/,/, $expected_result)) {
+            if ($e_result !~ /=/) {
+                my ($msg_result, $smtp_comment);
+                ($msg_result, $smtp_comment, $header_comment) = eval {
+                    $query->message_result2()
+                };
+                
+                $actual_result .= $msg_result;
+                
+                $ok = ok($msg_result, $e_result) && $ok;
+            }
+            else {
+                my ($recip, $expected_recip_result) = split(/=/, $e_result, 2);
+                my ($recip_result, $smtp_comment) = eval {
+                    $query->result2(split(';', $recip))
+                };
+                
+                $actual_result .= "$recip=$recip_result,";
+                $testcnt++;
+                
+                $ok = ok($recip_result, $expected_recip_result) && $ok;
+            }
         }
-      }
-  }
-  if ($opts{d}) {
-      $num = join(",", $testnum .. $testnum + $testcnt - 1);
-      $testnum += $testcnt;
-      print TEST join("\t", $num, $sender . ($localpolicy ? ":$localpolicy": ""), $ipv4, $actual_result, $actual_smtp_comment, $actual_header_comment),
-            "\n";
-  }
+        
+        $header_comment =~ s/\S+: //;  # strip the reporting hostname prefix
+        
+        if ($expected_header_comment) {
+            $ok = ok($header_comment, $expected_header_comment) && $ok;
+        }
+        
+        $actual_header_comment = $header_comment;
+        $actual_smtp_comment = '.';
+        
+        STDERR->print($debug_log_buf) if !$ok;
+    }
+    else {
+        my $debug_log_buf = "# Detailed debug log for test(s) $num:\n";
+        my ($result, $smtp_comment, $header_comment) = eval {
+            Mail::SPF::Query->new(
+                ipv4    => $ipv4,
+                sender  => $sender,
+                helo    => $domain,
+                local   => $localpolicy,
+                debug   => 1,
+                debuglog
+                        => make_debug_log_accumulator(\$debug_log_buf),
+                default_explanation
+                        => 'explanation'
+            )->result()
+        };
+        
+        $header_comment =~ s/^\S+: //;  # strip the reporting hostname prefix
+        
+        my $ok = ok($result,         $expected_result);
+        if ($expected_smtp_comment) {
+           $ok = ok($smtp_comment,   $expected_smtp_comment  ) && $ok;
+           $ok = ok($header_comment, $expected_header_comment) && $ok;
+        }
+        
+        $actual_result          = $result;
+        $actual_smtp_comment    = $smtp_comment;
+        $actual_header_comment  = $header_comment;
+        
+        STDERR->print($debug_log_buf) if !$ok;
+    }
+    
+    if ($opts{d}) {
+        $num = join(',', $testnum .. $testnum + $testcnt - 1);
+        $testnum += $testcnt;
+        $test_log->print(
+            join(
+                "\t",
+                $num,
+                $sender . ($localpolicy ? ":$localpolicy": ''),
+                $ipv4,
+                $actual_result,
+                $actual_smtp_comment,
+                $actual_header_comment
+            ),
+            "\n"
+        );
+    }
 }
 
+sub make_debug_log_accumulator {
+    my ($log_buffer_ref) = @_;
+    return sub { $$log_buffer_ref .= "# $_[0]\n" };
+}
+
 # vim:syn=perl


Property changes on: packages/libmail-spf-query-perl/branches/upstream/current/t/00_all.t
___________________________________________________________________
Name: svn:executable
   - 
   + *

Modified: packages/libmail-spf-query-perl/branches/upstream/current/t/test.dat
===================================================================
--- packages/libmail-spf-query-perl/branches/upstream/current/t/test.dat	2006-02-05 18:24:43 UTC (rev 2102)
+++ packages/libmail-spf-query-perl/branches/upstream/current/t/test.dat	2006-02-09 18:44:08 UTC (rev 2103)
@@ -26,10 +26,10 @@
 # '01.spf1-test.mailzone.com:v=spf1                                                             :60
 # '02.spf1-test.mailzone.com:v=spf1                                             -all       :60
 # '03.spf1-test.mailzone.com:v=spf1                                             ~all:60
-# '04.spf1-test.mailzone.com:v=spf1                                             +all   :60::poboxnet
 # '05.spf1-test.mailzone.com:v=spf1                                             default=deny   :60
 # '06.spf1-test.mailzone.com:v=spf1                                             ?all :60
 # '07.spf1-test.mailzone.com:v=spf2                                             default=bogus   :60
+# '08.spf1-test.mailzone.com:v=spf1                       -all      ?all  :60
 
 3  01.spf1-test.mailzone.com  192.0.2.1           neutral
 4  02.spf1-test.mailzone.com  192.0.2.1           fail
@@ -39,9 +39,6 @@
 10  07.spf1-test.mailzone.com  192.0.2.1           none
 11  08.spf1-test.mailzone.com  192.0.2.1           fail
 
-# '08.spf1-test.mailzone.com:v=spf1                       -all      ?all  :60
-# '09.spf1-test.mailzone.com:v=spf1    scope=header-from scope=envelope         -all  :60
-
 # '10.spf1-test.mailzone.com:v=spf1 mx                                          -all:60
 12  10.spf1-test.mailzone.com  192.0.2.1           fail
 13  10.spf1-test.mailzone.com  192.0.2.10          pass
@@ -230,7 +227,7 @@
 82	55.spf1-test.mailzone.com	192.0.2.200	unknown
 83	55.spf1-test.mailzone.com	192.0.2.130	unknown
 
-# SPF1_TEST(56) deliberately left blank
+# 56.spf1-test.mailzone.com deliberately left blank
 84 56.spf1-test.mailzone.com    192.0.2.200       unknown
 
 # TODO: none and fail are both acceptable.  we need a way to indicate that multiple result codes are OK.
@@ -253,7 +250,7 @@
 # 
 # # no entries for joe.
 
-# 'SPF1_TEST(70):v=spf1 exists\072%{lr+=}.lp._spf.spf1-test.mailzone.com -all:60
+# '70.spf1-test.mailzone.com:v=spf1 exists\072%{lr+=}.lp._spf.spf1-test.mailzone.com -all:60
 89 droid at 70.spf1-test.mailzone.com  192.0.2.103          fail
 
 90 bob+1 at 70.spf1-test.mailzone.com  192.0.2.103          pass
@@ -262,7 +259,6 @@
 93 joe+1 at 70.spf1-test.mailzone.com  192.0.2.103          fail
 94 joe-2 at 70.spf1-test.mailzone.com  192.0.2.103          fail
 95 moe-1 at 70.spf1-test.mailzone.com  192.0.2.103          fail
-
 # client should substitute postmaster when no localpart.
 96 70.spf1-test.mailzone.com  192.0.2.103                pass
 
@@ -310,8 +306,8 @@
 118 98.spf1-test.mailzone.com  208.210.124.1      fail
 119 98.spf1-test.mailzone.com  208.210.124.181    pass
 
-# 'SPF1_TEST(08):v=spf2                       default=softdeny      default=deny  :60
-# 'SPF1_TEST(09):v=spf2    scope=header-from scope=envelope         default=deny  :60
+# '08.spf1-test.mailzone.com:v=spf1                       default=softdeny      default=deny  :60
+# '09.spf1-test.mailzone.com:v=spf1    scope=header-from scope=envelope         -all  :60
 120 08.spf1-test.mailzone.com  192.0.2.1     fail
 121 09.spf1-test.mailzone.com  192.0.2.1     fail
 
@@ -382,7 +378,6 @@
 # '102.spf1-test.mailzone.com:v=spf1 ?all redirect=98.spf1-test.mailzone.com:60
 178 102.spf1-test.mailzone.com:+all  192.0.2.98    neutral
 
-# '51.spf1-test.mailzone.com:v=spf1 include\07242.spf1-test.mailzone.com                  -all:60
 # '10.spf1-test.mailzone.com:v=spf1 mx                                          -all:60
 179,180,181	10.spf1-test.mailzone.com:include:42.%{d3}	192.0.2.200	fail	explanation	domain of 10.spf1-test.mailzone.com does not designate 192.0.2.200 as permitted sender
 182,183,184	10.spf1-test.mailzone.com:include:42.%{d3} +all	192.0.2.200	pass	/./	local policy




More information about the Pkg-perl-cvs-commits mailing list