Cope better with DNS responses in DMARC lookup.

1 files changed, 16 insertions, 1 deletions

diff --git a/perllib/Utils/Email.pm b/perllib/Utils/Email.pm
index 466c05ad1..a30e41c61 100644
--- a/perllib/Utils/Email.pm
+++ b/perllib/Utils/Email.pm
@@ -11,7 +11,7 @@ sub test_dmarc {
     return unless $addr;
 
     my $domain = $addr->host;
-    my @answers = Net::DNS::Resolver->new->send("_dmarc.$domain", 'TXT')->answer;
+    my @answers = _send(Net::DNS::Resolver->new, "_dmarc.$domain", 'TXT');
     @answers = map { $_->txtdata } @answers;
     my $dmarc = join(' ', @answers);
     return unless $dmarc =~ /p *= *reject/;
@@ -19,4 +19,19 @@ sub test_dmarc {
     return 1;
 }
 
+# Same as send->answer, but follows one CNAME and returns only matching results
+sub _send {
+    my ($resolver, $domain, $type) = @_;
+    my $packet = $resolver->send($domain, $type);
+    my @answers;
+    foreach my $rr ($packet->answer) {
+        if ($rr->type eq 'CNAME') {
+            push @answers, $resolver->send($rr->cname, $type)->answer;
+        } else {
+            push @answers, $rr;
+        }
+    }
+    return grep { $_->type eq $type } @answers;
+}
+
 1;