our $VERSION = '1.20141119';
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 connect_smtp {
my ( $self, $to ) = @_;
my $smtp = Net::SMTP->new(
[ $self->get_smtp_hosts($to) ],
Timeout => 10,
Port => 25,
Hello => $self->get_helo_hostname,
Debug => $self->verbose ? 1 : 0,
)
or do {
carp "SMTP connection failed\n";
return;
};
return $smtp;
};
sub connect_smtp_tls {
my ($self, $to) = @_;
my $smtp = Net::SMTPS->new(
[ $self->get_smtp_hosts($to) ],
Timeout => 12,
Port => $self->config->{smtp}{smarthost} ? 587 : 25,
Hello => $self->get_helo_hostname,
doSSL => 'starttls',
SSL_verify_mode => 'SSL_VERIFY_NONE',
Debug => $self->verbose ? 1 : 0,
)
or do {
warn "SSL connection failed\n";
return;
};
my $c = $self->config->{smtp};
if ( $c->{smarthost} && $c->{smartuser} && $c->{smartpass} ) {
$smtp->auth( $c->{smartuser}, $c->{smartpass} ) or do {
carp "auth attempt for $c->{smartuser} failed";
};
}
return $smtp;
};
sub get_smtp_hosts {
my $self = shift;
my $email = shift or croak "missing email!";
if ( $self->config->{smtp}{smarthost} ) {
return $self->config->{smtp}{smarthost};
}
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 || time;
my $id = POSIX::strftime( "%Y.%m.%d.", localtime ) . $rid;
my $us = $self->config->{organization}{domain};
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 || '';
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 ) = @_;
return join( '!',
$self->config->{organization}{domain},
$$agg_ref->policy_published->domain,
$$agg_ref->metadata->begin,
$$agg_ref->metadata->end,
$$agg_ref->metadata->report_id || time,
) . '.xml';
}
sub assemble_message {
my ( $self, $agg_ref, $to, $shrunk ) = @_;
my $filename = $self->get_filename($agg_ref);
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->as_string;
}
sub get_timestamp_rfc2822 {
my ($self, @args) = @_;
my @ts = scalar @args ? @args : localtime;
return POSIX::strftime( '%a, %d %b %Y %H:%M:%S %z', @ts );
};
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;