diff options
| -rw-r--r-- | perllib/Utils/Email.pm | 17 |
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; |