You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
482 lines
12 KiB
482 lines
12 KiB
#!/usr/bin/env perl
|
|
#=============================================================================
|
|
#
|
|
# FILE: dmarc-report-display.pl
|
|
#
|
|
# USAGE: ./dmarc-report-display.pl REPORT
|
|
#
|
|
# DESCRIPTION: Parse and display a DMARC report
|
|
#
|
|
# REQUIREMENTS: Perl 5.10; File::LibMagic, Term::ANSIColor; XML::LibXML
|
|
# OPTIONAL: Archive::Zip, Email::MIME,
|
|
# BUGS: none known
|
|
# AUTHOR: nemunaire <nemunaire@nemunai.re>
|
|
# CREATED: 05/24/2014 12:23:00 PM
|
|
#=============================================================================
|
|
|
|
use v5.10;
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Getopt::Long;
|
|
use Pod::Usage;
|
|
use Term::ANSIColor;
|
|
use Socket;
|
|
use XML::LibXML;
|
|
use File::LibMagic;
|
|
|
|
### GLOBALS #############################################################
|
|
|
|
our $VERSION = 1.5;
|
|
|
|
### COMMAND-LINE #############################################################
|
|
|
|
my $HELP = 0;
|
|
my $NUMERIC = 0;
|
|
my @REPORTS;
|
|
my $LIBMAGIC = File::LibMagic->new;
|
|
|
|
GetOptions(
|
|
'help|?' => \$HELP,
|
|
'numeric' => \$NUMERIC,
|
|
) or pod2usage(2);
|
|
|
|
pod2usage( -exitval => 0, -verbose => 2 ) if $HELP;
|
|
|
|
|
|
### FUNCTIONS ################################################################
|
|
|
|
sub format_alignment($) {
|
|
my $at = shift;
|
|
|
|
return colored("strict", "bold", "green") if ($at eq "s");
|
|
colored("relaxed", "bold", "magenta")
|
|
}
|
|
|
|
sub format_auth_result($) {
|
|
my $ar = shift;
|
|
|
|
"=> " . colored("DKIM: ", "yellow") .
|
|
format_dkim_auth_result( $ar->findnodes("dkim") ) . "\n" .
|
|
"=> " . colored("SPF: ", "yellow") .
|
|
format_spf_auth_result( $ar->findnodes("spf") );
|
|
}
|
|
|
|
sub format_dkim_auth_result($) {
|
|
my @res;
|
|
while (my $ar = shift) {
|
|
my $domain = @{ $ar->find("domain") }[0]->textContent;
|
|
my $result = @{ $ar->find("result") }[0]->textContent;
|
|
|
|
my $human = "";
|
|
$human = " (" . @{ $ar->find("human_result") }[0]->textContent . ")"
|
|
if @{ $ar->find("human_result") };
|
|
|
|
push @res, colored($domain, "magenta") . $human if $result eq "none";
|
|
push @res, colored("✓ " . $domain, "green") . $human if $result eq "pass";
|
|
push @res, colored("✘ " . $domain, "red") . $human if $result eq "fail";
|
|
push @res, $domain . $human if $result eq "policy";
|
|
push @res, colored("? " . $domain, "blue") . $human if $result eq "neutral";
|
|
push @res, colored("! " . $domain, "yellow") . $human if $result eq "temperror";
|
|
push @res, colored("@ " . $domain, "yellow") . $human if $result eq "permerror";
|
|
}
|
|
|
|
join ", ", @res;
|
|
}
|
|
|
|
sub format_spf_auth_result($) {
|
|
my @res;
|
|
while (my $ar = shift) {
|
|
my $domain = @{ $ar->find("domain") }[0]->textContent;
|
|
my $result = @{ $ar->find("result") }[0]->textContent;
|
|
|
|
push @res, colored($domain, "magenta") if $result eq "none";
|
|
push @res, colored("? " . $domain, "blue") if $result eq "neutral";
|
|
push @res, colored("+ " . $domain, "green") if $result eq "pass";
|
|
push @res, colored("- " . $domain, "red") if $result eq "fail";
|
|
push @res, colored("~ " . $domain, "red") if $result eq "softfail";
|
|
push @res, colored("! " . $domain, "yellow") if $result eq "temperror";
|
|
push @res, colored("@ " . $domain, "yellow") if $result eq "permerror";
|
|
}
|
|
|
|
join ", ", @res;
|
|
}
|
|
|
|
sub format_daterange($) {
|
|
my $dr = shift;
|
|
|
|
my $begin = localtime(@{ $dr->find("begin") }[0]->textContent);
|
|
my $end = localtime(@{ $dr->find("end") }[0]->textContent);
|
|
|
|
"from $begin to $end"
|
|
}
|
|
|
|
sub format_disposition($) {
|
|
my $dt = shift;
|
|
|
|
return colored("reject", "red") if ($dt eq "reject");
|
|
return colored("quarantine", "bold", "magenta") if ($dt eq "quarantine");
|
|
colored("none", "bold", "cyan")
|
|
}
|
|
|
|
sub format_identifier($) {
|
|
my $i = shift;
|
|
|
|
my $env = "";
|
|
$env = colored("To: ", "yellow") . colored(@{ $i->find("envelope_to") }[0]->textContent, "bold") . "\n"
|
|
if @{ $i->find("envelope_to") };
|
|
|
|
$env . colored("From: ", "yellow") . colored(@{ $i->find("header_from") }[0]->textContent, "bold")
|
|
}
|
|
|
|
sub format_ipaddress($) {
|
|
my $ip = shift;
|
|
|
|
return $ip if $NUMERIC;
|
|
|
|
my $pip = inet_aton($ip);
|
|
|
|
# IPv6
|
|
return gethostbyaddr(Socket::inet_pton(AF_INET6, $ip), AF_INET6) // $ip if not $pip;
|
|
|
|
# IPv4
|
|
gethostbyaddr($pip, AF_INET) // $ip;
|
|
}
|
|
|
|
sub format_metadata($) {
|
|
my $rp = shift;
|
|
|
|
colored("Report ID: ", "yellow") .
|
|
@{ $rp->find("report_id") }[0]->textContent . "\n" .
|
|
colored("Organization: ", "yellow") .
|
|
colored(@{ $rp->find("org_name") }[0]->textContent, "bold") .
|
|
" (" . @{ $rp->find("email") }[0]->textContent . ")\n" .
|
|
colored("Period: ", "yellow") .
|
|
format_daterange( @{ $rp->find("date_range") }[0] ) . "\n";
|
|
}
|
|
|
|
sub format_policy($) {
|
|
my $pp = shift;
|
|
|
|
my $sp = "";
|
|
$sp = colored("Subdomains policy: ", "yellow") .
|
|
format_disposition( @{ $pp->find("sp") }[0]->textContent ) . "\n"
|
|
if $pp->find("sp");
|
|
|
|
colored("Domain: ", "yellow") .
|
|
colored(@{ $pp->find("domain") }[0]->textContent, "bold") . "\n" .
|
|
colored("DKIM checks: ", "yellow") .
|
|
format_alignment( @{ $pp->find("adkim") }[0]->textContent ) . "\n" .
|
|
colored("SPF checks: ", "yellow") .
|
|
format_alignment( @{ $pp->find("aspf") }[0]->textContent ) . "\n" .
|
|
"\n" .
|
|
colored("Domain policy: ", "yellow") .
|
|
format_disposition( @{ $pp->find("p") }[0]->textContent ) . "\n" .
|
|
$sp .
|
|
colored("Policy applies on: ", "yellow") .
|
|
@{ $pp->find("pct") }[0]->textContent . "%\n" ;
|
|
}
|
|
|
|
sub format_policy_evaluated($) {
|
|
my $pe = shift;
|
|
|
|
my @reasons;
|
|
for my $r ($pe->findnodes("reason")) {
|
|
push @reasons, format_policy_override_reason($r)
|
|
}
|
|
my $reason = "";
|
|
$reason = "; " . join ", ", @reasons if @reasons;
|
|
|
|
format_disposition( @{ $pe->find("disposition") }[0]->textContent ) .
|
|
" (DKIM: " . format_result_type( @{ $pe->find("dkim") }[0]->textContent ) .
|
|
"; SPF: " . format_result_type( @{ $pe->find("spf") }[0]->textContent ) .
|
|
$reason . ")"
|
|
}
|
|
|
|
sub format_policy_override($) {
|
|
my $po = shift;
|
|
|
|
return colored("forwarded", "blue", "bold") if ($po eq "forwarded");
|
|
return colored("sampled_out", "cyan", "bold") if ($po eq "sampled_out");
|
|
return colored("trusted_forwarder", "green", "bold") if ($po eq "trusted_forwarder");
|
|
colored($po, "bold")
|
|
}
|
|
|
|
sub format_policy_override_reason($) {
|
|
my $por = shift;
|
|
|
|
my $comment = "";
|
|
$comment = ": " .@{ $por->find("comment") }[0]->textContent
|
|
if @{ $por->find("comment") } && @{ $por->find("comment") }[0]->textContent;
|
|
|
|
format_policy_override( @{ $por->find("type") }[0]->textContent ) .
|
|
$comment
|
|
}
|
|
|
|
sub format_record($) {
|
|
my $r = shift;
|
|
|
|
format_row( @{ $r->find("row") }[0] ) . "\n" .
|
|
format_identifier( @{ $r->find("identifiers") }[0] ) . "\n" .
|
|
format_auth_result( @{ $r->find("auth_results") }[0] );
|
|
}
|
|
|
|
sub format_result_type($) {
|
|
my $rt = shift;
|
|
|
|
return colored("✓ pass", "green") if ($rt eq "pass");
|
|
colored("✘ fail", "red", "bold")
|
|
}
|
|
|
|
sub format_row($) {
|
|
my $r = shift;
|
|
|
|
@{ $r->find("count") }[0]->textContent . " messages matching from " .
|
|
format_ipaddress( @{ $r->find("source_ip") }[0]->textContent ) . ": " .
|
|
format_policy_evaluated( @{ $r->find("policy_evaluated") }[0] );
|
|
}
|
|
|
|
sub treat_report($) {
|
|
my $dom = shift;
|
|
|
|
say format_metadata @{ $dom->find("/feedback/report_metadata") }[0];
|
|
say format_policy @{ $dom->find("/feedback/policy_published") }[0];
|
|
for my $record (@{ $dom->find("/feedback/record") }) {
|
|
say format_record $record;
|
|
} continue { print "\n" }
|
|
}
|
|
|
|
sub treat_data($);
|
|
sub treat_data($) {
|
|
my $data = shift;
|
|
my $mimetype = $LIBMAGIC->checktype_contents($data);
|
|
for ($mimetype) {
|
|
if (/gzip/) {
|
|
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
|
|
open my $dh, '<', \$data;
|
|
my $buffer;
|
|
gunzip $dh => \$buffer or die "gunzip failed: $GunzipError\n";
|
|
treat_data( $buffer );
|
|
} elsif (/zip/) {
|
|
require Archive::Zip;
|
|
open my $dh, '<', \$data;
|
|
my $zip = Archive::Zip->new();
|
|
my $errno = $zip->readFromFileHandle($dh);
|
|
die "Can't open zip archive (error code $errno)\n" if $errno != 0;
|
|
for my $zipped ( $zip->memberNames ) {
|
|
treat_data( $zip->contents($zipped) );
|
|
}
|
|
} elsif (/rfc822/) {
|
|
require Email::MIME;
|
|
my $email = Email::MIME->new($data);
|
|
for my $part ( $email->parts ) {
|
|
my $ct = $part->header('Content-Type');
|
|
next if $ct =~ m{^text/plain};
|
|
treat_data( $part->body );
|
|
}
|
|
} elsif (/\b xml \b/x || /\b text \b/x) {
|
|
treat_report( XML::LibXML->load_xml( string => $data ) );
|
|
} else {
|
|
warn "Sorry! $mimetype not yet supported!\n";
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
|
|
### MAIN ################################################################
|
|
|
|
my @reports = map { open my $fh, '<', $_; local $/; <$fh> } @ARGV;
|
|
push @reports, do { local $/; <STDIN> } if !@reports;
|
|
for my $report (@reports) {
|
|
treat_data($report);
|
|
} continue { print "#" x 79 . "\n" }
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
DMARC report display - Parse and display a DMARC report
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
./dmarc-report-display.pl [OPTIONS] [REPORT [REPORT ...]]
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over
|
|
|
|
=item B<-help>
|
|
|
|
Displays the help.
|
|
|
|
=item B<-numeric>
|
|
|
|
IP addresses will be printed in numeric format. By default, the program will try
|
|
to display them as host names, network names, or services (whenever applicable).
|
|
|
|
=back
|
|
|
|
=head1 EXIT STATUS
|
|
|
|
This script should always return 0.
|
|
|
|
=head1 DEPENDENCIES
|
|
|
|
=over
|
|
|
|
=item
|
|
|
|
perl >= 5.10
|
|
|
|
=item
|
|
|
|
File::LibMagic
|
|
|
|
=item
|
|
|
|
Email::MIME v1.910+ (only required for opening mailed reports)
|
|
|
|
=item
|
|
|
|
Archive::Zip (only required for opening zipped reports)
|
|
|
|
=item
|
|
|
|
Term::ANSIColor v5.001+
|
|
|
|
=item
|
|
|
|
XML::LibXML v2.1.400+
|
|
|
|
=back
|
|
|
|
=head1 AUTHOR
|
|
|
|
nemunaire <nemunaire@nemunai.re>
|
|
|
|
=head1 CHANGELOG
|
|
|
|
=over
|
|
|
|
=item v0.2
|
|
|
|
=over
|
|
|
|
=item
|
|
|
|
By default, display reverse DNS instead of raw IP. New option -numeric restore
|
|
the original behaviour.
|
|
|
|
=item
|
|
|
|
Can treat zipped (-zip option) and emailed (-mail) reports.
|
|
|
|
=back
|
|
|
|
=item v0.3
|
|
|
|
Author: thilp <thilp@thilp.net>
|
|
|
|
=over
|
|
|
|
=item
|
|
|
|
Replaced command-line switches --zip and --mail with mime-type autodetection
|
|
(thanks to L<File::LibMagic>).
|
|
|
|
=item
|
|
|
|
Can now process arbitrarily nested xml/zip/email formats. Also, it will be
|
|
much easier to support other formats.
|
|
|
|
=item
|
|
|
|
Replaced L<IO::Uncompress::Unzip> with L<Archive::Zip>.
|
|
|
|
=back
|
|
|
|
=item v1.0
|
|
|
|
=over
|
|
|
|
=item
|
|
|
|
Improve report readability.
|
|
|
|
=back
|
|
|
|
=item v1.1
|
|
|
|
=over
|
|
|
|
=item
|
|
|
|
Display numeric IP when no reverse exists (bug reported by thilp).
|
|
|
|
=back
|
|
|
|
=item v1.2
|
|
|
|
=over
|
|
|
|
=item
|
|
|
|
Optional information about subdomain policy in policy_published (after receiving a report from Yahoo).
|
|
|
|
=back
|
|
|
|
=item v1.3
|
|
|
|
=over
|
|
|
|
=item
|
|
|
|
Add GZip reports support (after receiving a report from fastmail.com).
|
|
|
|
=back
|
|
|
|
=item v1.4
|
|
|
|
=over
|
|
|
|
=item
|
|
|
|
Consider any text file as report, not only XML ones (after receiving a report from tagmail.eu).
|
|
|
|
=back
|
|
|
|
=item v1.5
|
|
|
|
=over
|
|
|
|
=item
|
|
|
|
Revert partially the previous commit to keep allowing application/xml MIME type, that doesn't match 'text'.
|
|
|
|
=back
|
|
|
|
=back
|
|
|
|
=head1 VERSION
|
|
|
|
This is B<dmarc-report-display.pl> version 1.5.
|
|
|
|
=head1 LICENSE AND COPYRIGHT
|
|
|
|
B<The GNU GPLv3 License>
|
|
|
|
Copyright (C) 2014-2019 nemunaire
|
|
|
|
This program is free software: you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation, either version 3 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|