File Coverage

lib/Mail/DMARC/Report/Aggregate.pm

Criterion	Covered	Total	%
statement	111	123	90.2
branch	33	46	71.7
condition	12	15	80.0
subroutine	16	17	94.1
pod	0	10	0.0
total	172	211	81.5

package Mail::DMARC::Report::Aggregate;
use strict;
use warnings;

our $VERSION = '1.20211209';

use Carp;
use Data::Dumper;
use XML::LibXML;

use parent 'Mail::DMARC::Base';
use Mail::DMARC::Report::Aggregate::Metadata;

sub metadata {
    my $self = shift;
    return $self->{metadata} if ref $self->{metadata};
    return $self->{metadata} = Mail::DMARC::Report::Aggregate::Metadata->new;
}

sub policy_published {
    my ( $self, $policy ) = @_;
    return $self->{policy_published} if ! $policy;
    croak "not a policy object!" if 'Mail::DMARC::Policy' ne ref $policy;
    return $self->{policy_published} = $policy;
}

sub record {   ## no critic (Ambiguous)
    my ($self, $record, @extra) = @_;
    if ( !$record) {
       return $self->{record} || [];
    }

    if (@extra) { croak "invalid args"; }

    if ('Mail::DMARC::Report::Aggregate::Record' ne ref $record) {
        croak "not a record object";
    }

    $self->{record} ||= [];

    push @{ $self->{record} }, $record;

    return $self->{record};
};

sub dump_report {
    my $self = shift;
    carp Dumper( $self->{metadata}, $self->{policy_published}, $self->{record} );
    return;
}

sub as_xml {
    my $self = shift;
    my $meta = $self->metadata->as_xml;
    my $pubp = $self->get_policy_published_as_xml;
    my $reco = $self->get_record_as_xml;

    return <<"EO_XML"


\t1.0
$meta
$pubp
$reco
EO_XML
;
}

sub get_record_as_xml {
    my $self = shift;

    my $rec_xml = '';
    foreach my $rec ( @{ $self->{record} } ) {
        $rec_xml .= "\t\n";
        my $ip = $rec->{row}{source_ip} or croak "no source IP!?";
        my $count = $rec->{row}{count} or croak "no count!?";
        $rec->{row}{policy_evaluated}{disposition} or croak "no disposition?";
        $ip    = XML::LibXML::Text->new( $ip )->toString();
        $count = XML::LibXML::Text->new( $count )->toString();
        $rec_xml
            .="\t\t\n"
            . "\t\t\t$ip\n"
            . "\t\t\t$count\n"
            . $self->get_policy_evaluated_as_xml( $rec )
            . "\t\t\n"
            . $self->get_identifiers_as_xml($rec)
            . $self->get_auth_results_as_xml($rec);
        $rec_xml .= "\t\n";
    }
    return $rec_xml;
}

sub get_identifiers_as_xml {
    my ( $self, $rec ) = @_;
    my $id = "\t\t\n";
    foreach my $f (qw/ envelope_to envelope_from header_from /) {
        if ( $f eq 'header_from' ) {        # min occurs = 1
            croak "missing header_from!" if ! $rec->{identifiers}{$f};
        }
        elsif ( $f eq 'envelope_from') {    # min occurs = 1
            $rec->{identifiers}{$f} = '' if ! $rec->{identifiers}{$f};
        }
        elsif ( $f eq 'envelope_to' ) {     # min occurs = 0
            next if ! $rec->{identifiers}{$f};
        };

        my $val = XML::LibXML::Text->new( $rec->{identifiers}{$f} )->toString();
        $id .= "\t\t\t<$f>$val\n";
    }
    $id .= "\t\t\n";
    return $id;
}

sub get_auth_results_as_xml {
    my ( $self, $rec ) = @_;
    my $ar = "\t\t\n";

    foreach my $dkim_sig ( @{ $rec->{auth_results}{dkim} } ) {
        $ar .= "\t\t\t\n";
        foreach my $g (qw/ domain selector result human_result /) {
            next if !defined $dkim_sig->{$g};
            my $val = XML::LibXML::Text->new( $dkim_sig->{$g} )->toString();
            $ar .= "\t\t\t\t<$g>$val\n";
        }
        $ar .= "\t\t\t\n";
    }

    foreach my $spf ( @{ $rec->{auth_results}{spf} } ) {
        $ar .= "\t\t\t\n";
        foreach my $g (qw/ domain scope result /) {
            next if !defined $spf->{$g};
            my $val = XML::LibXML::Text->new( $spf->{$g} )->toString();
            $ar .= "\t\t\t\t<$g>$val\n";
        }
        $ar .= "\t\t\t\n";
    }

    $ar .= "\t\t\n";
    return $ar;
}

sub get_policy_published_as_xml {
    my $self = shift;
    my $pp = $self->policy_published or return '';
    my $xml = "\t\n\t\t$pp->{domain}\n";
    foreach my $f (qw/ adkim aspf p sp pct fo /) {
        my $v = $pp->{$f};
        # Set some default values for missing optional fields if necessary
        if ( $f eq 'sp' && !defined $v ) {
            $v = $pp->{'p'};
        }
        if ( $f eq 'pct' && !defined $v ) {
            $v = '100';
        }
        if ( $f eq 'fo' && !defined $v ) {
            $v = '0';
        }
        next if !defined $v;
        $v = XML::LibXML::Text->new( $v )->toString();
        $xml .= "\t\t<$f>$v\n";
    }
    $xml .= "\t";
    return $xml;
}

sub get_policy_evaluated_as_xml {
    my ( $self, $rec ) = @_;
    my $pe = "\t\t\t\n";

    foreach my $f (qw/ disposition dkim spf /) {
        my $val = XML::LibXML::Text->new( $rec->{row}{policy_evaluated}{$f} )->toString();
        $pe .= "\t\t\t\t<$f>$val\n";
    }

    my $reasons = $rec->{row}{policy_evaluated}{reason};
    if ( $reasons && scalar @$reasons ) {
        foreach my $reason ( @$reasons ) {
            my $typeval    = XML::LibXML::Text->new( $reason->{type} )->toString();
            my $commentval = XML::LibXML::Text->new( $reason->{comment} )->toString();
            $pe .= "\t\t\t\t\n";
            $pe .= "\t\t\t\t\t$typeval\n";
            $pe .= "\t\t\t\t\t$commentval\n";
            $pe .= "\t\t\t\t\n";
        }
    };
    $pe .= "\t\t\t\n";
    return $pe;
}

1;

__END__