File Coverage

lib/Mail/DMARC/Report/Send/SMTP.pm

Criterion	Covered	Total	%
statement	87	96	90.6
branch	18	40	45.0
condition	4	11	36.3
subroutine	16	17	94.1
pod	0	9	0.0
total	125	173	72.2

package Mail::DMARC::Report::Send::SMTP;
use strict;
use warnings;

our $VERSION = '1.20230215';

use Carp;
use English '-no_match_vars';
use Email::MIME;
#use Mail::Sender;  # something to consider
use Sys::Hostname;
use POSIX;

use parent 'Mail::DMARC::Base';

sub get_domain_mx {
    my ( $self, $domain ) = @_;
    print "getting MX for $domain\n";
    my $query;
    eval {
        $query = $self->get_resolver->send( $domain, 'MX' ) or return [];
    } or print $@;

    if ( ! $query ) {
        print "\terror:\n\t$@";
        return [];
    };

    my @mx;
    for my $rr ( $query->answer ) {
        next if $rr->type ne 'MX';
        push @mx, { pref => $rr->preference, addr => $rr->exchange };
        print $rr->exchange if $self->verbose;
    }
    if ( $self->verbose ) {
        print "found " . scalar @mx . "MX exchanges\n";
    };
    return \@mx;
}

sub get_smtp_hosts {
    my $self = shift;
    my $email = shift or croak "missing email!";

    my ($domain) = ( split /@/, $email )[-1];
    my @mx = map  { $_->{addr} }
             sort { $a->{pref} <=> $b->{pref} }
             @{ $self->get_domain_mx($domain) };

    push @mx, $domain;
    print "\tfound " . scalar @mx . " MX for $email\n" if $self->verbose;
    return @mx;
}

sub get_subject {
    my ( $self, $agg_ref ) = @_;


    my $rid = $$agg_ref->metadata->report_id || $self->time;
    my $id = POSIX::strftime( "%Y.%m.%d.", localtime $self->time ) . $rid;
    my $us = $self->config->{organization}{domain};
    if ($us eq 'example.com') {
        die "Please update mail-dmarc.ini";
    }
    my $pol_dom = $$agg_ref->policy_published->domain;
    return "Report Domain: $pol_dom Submitter: $us Report-ID:$id";
}

sub human_summary {
    my ( $self, $agg_ref ) = @_;

    my $records = scalar @{ $$agg_ref->{record} };
    my $OrgName = $self->config->{organization}{org_name};
    my $pass = grep { 'pass' eq $_->{row}{policy_evaluated}{dkim}
                   || 'pass' eq $_->{row}{policy_evaluated}{spf}  }
                   @{ $$agg_ref->{record} };
    my $fail = grep { 'pass' ne $_->{row}{policy_evaluated}{dkim}
                   && 'pass' ne $_->{row}{policy_evaluated}{spf} }
                   @{ $$agg_ref->{record} };
    my $ver  = $Mail::DMARC::Base::VERSION || ''; # undef in author environ
    my $from = $$agg_ref->{policy_published}{domain} or croak;

    return <<"EO_REPORT"

This is a DMARC aggregate report for $from

$records records.
$pass passed.
$fail failed.

Submitted by $OrgName
Generated with Mail::DMARC $ver

EO_REPORT
        ;
}

sub get_filename {
    my ( $self, $agg_ref ) = @_;

    #  2013 DMARC Draft, 12.2.1 Email
    #
    #   filename = receiver "!" policy-domain "!" begin-timestamp "!"
    #              end-timestamp [ "!" unique-id ] "." extension
    #   filename="mail.receiver.example!example.com!1013662812!1013749130.gz"
    return join( '!',
        $self->config->{organization}{domain},
        $$agg_ref->policy_published->domain,
        $$agg_ref->metadata->begin,
        $$agg_ref->metadata->end,
        $$agg_ref->metadata->report_id || $self->time,
    ) . '.xml';
}

sub assemble_too_big_message_object {
    my ( $self, $to, $body ) = @_;

    my @parts    = Email::MIME->create(
        attributes => {
            content_type => "text/plain",
            disposition  => "inline",
            charset      => "US-ASCII",
        },
        body => $body,
    ) or croak "unable to add body!";

    my $email = Email::MIME->create(
        header_str => [
            From => $self->config->{organization}{email},
            To   => $to,
            Date => $self->get_timestamp_rfc2822,
            Subject => 'DMARC too big report',
        ],
        parts => [@parts],
    ) or croak "unable to assemble message\n";

    return $email;
}

sub assemble_message_object {
    my ( $self, $agg_ref, $to, $shrunk ) = @_;

    my $filename = $self->get_filename($agg_ref);
# WARNING: changes made here MAY affect Send::compress. Check it!
#   my $cf       = ( time > 1372662000 ) ? 'gzip' : 'zip';   # gz after 7/1/13
    my $cf       = 'gzip';
      $filename .= $cf eq 'gzip' ? '.gz' : '.zip';

    my @parts    = Email::MIME->create(
        attributes => {
            content_type => "text/plain",
            disposition  => "inline",
            charset      => "US-ASCII",
        },
        body => $self->human_summary( $agg_ref ),
    ) or croak "unable to add body!";

    push @parts,
        Email::MIME->create(
        attributes => {
            filename     => $filename,
            content_type => "application/$cf",
            encoding     => "base64",
            name         => $filename,
        },
        body => $shrunk,
        ) or croak "unable to add report!";

    my $email = Email::MIME->create(
        header_str => [
            From => $self->config->{organization}{email},
            To   => $to,
            Date => $self->get_timestamp_rfc2822,
            Subject => $self->get_subject( $agg_ref ),
        ],
        parts => [@parts],
    ) or croak "unable to assemble message\n";

    return $email;
}

sub get_timestamp_rfc2822 {
    my ($self, @args) = @_;
    my @ts = scalar @args ? @args : localtime $self->time;
    my $locale = setlocale(LC_CTYPE);
    setlocale(LC_ALL, 'C');
    my $timestamp = POSIX::strftime( '%a, %d %b %Y %H:%M:%S %z', @ts );
    setlocale(LC_ALL, $locale);
    return $timestamp;
}

sub get_helo_hostname {
    my $self = shift;
    my $host = $self->config->{smtp}{hostname};
    return $host if $host && $host ne 'mail.example.com';
    return Sys::Hostname::hostname;
};

1;

__END__