From ad52c4e64179aab27ef085de2bc009dc3b8147ee Mon Sep 17 00:00:00 2001
From: dlucredativ <5663995+dlucredativ@users.noreply.github.com>
Date: Wed, 30 Oct 2024 20:46:46 +0100
Subject: [PATCH] Change validation result for RFC7489 6.6.3 step 6.2 (#248)

---
 lib/Mail/DMARC/PurePerl.pm | 10 +++++++++-
 t/04.PurePerl.t            | 35 +++++++++++++++++++++++++++++++++++
 2 files changed, 44 insertions(+), 1 deletion(-)

diff --git a/lib/Mail/DMARC/PurePerl.pm b/lib/Mail/DMARC/PurePerl.pm
index 97f1c92d..6b12acb2 100644
--- a/lib/Mail/DMARC/PurePerl.pm
+++ b/lib/Mail/DMARC/PurePerl.pm
@@ -35,7 +35,15 @@ sub validate {
     # 9.6. reject email if the domain appears to not exist
     $self->exists_in_dns() or return $self->result;
     $policy ||= $self->discover_policy();  # 11.2.2 Query DNS for DMARC policy
-    $policy or return $self->result;
+    if (!$policy) {
+        # RFC7489 section 4.3 step 8:
+        #  If a policy is found, it is combined with the Author's domain
+        #  and the SPF and DKIM results to produce a DMARC policy result (a
+        #  "pass" or "fail")
+        # Hence, if no (valid) policy has been found, produce "none" instead.
+        $self->result->result('none');
+        return $self->result;
+    }
 
     #   3.5 Out of Scope  DMARC has no "short-circuit" provision, such as
     #         specifying that a pass from one authentication test allows one
diff --git a/t/04.PurePerl.t b/t/04.PurePerl.t
index be09e1a5..522b480b 100644
--- a/t/04.PurePerl.t
+++ b/t/04.PurePerl.t
@@ -20,6 +20,11 @@ $resolver->zonefile_parse(join("\n",
 'tnpi.net._report._dmarc.theartfarm.com.            600 TXT "v=DMARC1"',
 'cadillac.net._report._dmarc.theartfarm.com.        600 TXT "v=DMARC1"',
 'mail-dmarc.tnpi.net._report._dmarc.theartfarm.com. 600 TXT "v=DMARC1; rua=mailto:invalid-test@theartfarm.com;"',
+
+'invalid-sp-and-with-rua.example.com.               600 MX  10 mail.example.com.',
+'invalid-sp-and-without-rua.example.com.            600 MX  10 mail.example.com.',
+'_dmarc.invalid-sp-and-with-rua.example.com.        600 TXT "v=DMARC1; p=reject; sp=invalid; rua=mailto:rua@example.com"',
+'_dmarc.invalid-sp-and-without-rua.example.com.     600 TXT "v=DMARC1; p=reject; sp=invalid"',
 ''));
 
 my @test_policy = (
@@ -52,6 +57,7 @@ test_is_aligned();
 test_is_whitelisted();
 test_discover_policy();
 test_validate();
+test_validate_invalid_sp();
 test_has_valid_reporting_uri();
 test_external_report();
 test_verify_external_reporting( 'tnpi.net',            'theartfarm.com', 1 );
@@ -393,6 +399,35 @@ sub test_validate {
     ok(!$dmarc->is_dkim_aligned(), "validate, one-shot, is_dkim_aligned, no" );
 }
 
+sub test_validate_invalid_sp {
+    my %subtests = (
+        'invalid-sp-and-with-rua.example.com'    => 'pass',
+        'invalid-sp-and-without-rua.example.com' => 'none',
+    );
+    while (my ($header_from, $expected_result) = each %subtests) {
+        my %sample_dmarc = (
+            config_file   => 'mail-dmarc.ini',
+            source_ip     => '192.0.1.1',
+            envelope_to   => 'example.com',
+            envelope_from => 'cars4you.info',
+            header_from   => $header_from,
+            dkim          => [],
+            spf           => [
+                {
+                    domain => $header_from,
+                    scope  => 'mfrom',
+                    result => 'pass',
+                }
+            ],
+        );
+
+        $dmarc = Mail::DMARC::PurePerl->new(%sample_dmarc);
+        $dmarc->set_resolver($resolver);
+        eval { $dmarc->validate(); };
+        is($dmarc->result->result, $expected_result, "DMARC result is ${expected_result}") or diag Dumper($dmarc->result);
+    }
+}
+
 sub test_exists_in_dns {
     my %tests = (
         'tnpi.net'                 => 1,