package Sietima::Role::NoSpoof::DMARC;
use Moo::Role;
use Sietima::Policy;
use Email::Address;
use Mail::DMARC::PurePerl;
use namespace::clean;
with 'Sietima::Role::WithPostAddress';
has dmarc_resolver => ( is => 'ro' );
around munge_mail => sub ($orig,$self,$incoming_mail) {
my $sender = $self->post_address->address;
my ($from) = Email::Address->parse($incoming_mail->header_str('From'));
my $from_domain = $from->host;
my $dmarc = Mail::DMARC::PurePerl->new(
resolver => $self->dmarc_resolver,
);
$dmarc->header_from($from_domain);
if (my $policy = $dmarc->discover_policy) {
my $relevant_value = $dmarc->is_subdomain
? ( $policy->sp // $policy->p )
: $policy->p;
if ($relevant_value ne 'none') {
$incoming_mail->header_str_set(
'Original-From' => $from,
);
$from->address($sender);
$incoming_mail->header_str_set(
From => $from,
);
return $self->$orig($incoming_mail);
}
}
$incoming_mail->header_str_set(
Sender => $sender,
);
return $self->$orig($incoming_mail);
};
1;