view release on metacpan or  search on metacpan

bin/qmail-dmarc  view on Meta::CPAN

}

my $message = MailX::Qmail::Queue::Message->receive
  or die "Invalid message\n";

$SIG{__DIE__} = sub {
    debug died => "@_" unless $^S;
    die @_;
};

my $envelope_from = $message->from;
debug 'RFC5321.MailFrom' => $envelope_from;
debug to => join ', ', $message->to;

if ( exists $ENV{RELAYCLIENT} ) {
    debug RELAYCLIENT => "$ENV{TCPREMOTEHOST} [$ENV{TCPREMOTEIP}]";
}
else {

    my $dkim = Mail::DKIM::Verifier->new;
    $dkim->PRINT( $message->body =~ s/\cM?\cJ/\cM\cJ/gr );
    $dkim->CLOSE;
    debug 'DKIM result' => $dkim->result;

    if ( $dkim->result ne 'pass' ) {

        debug 'Remote IP' => $ENV{TCPREMOTEIP};

        my %spf_query = ( ip_address => $ENV{TCPREMOTEIP} );

        debug helo => $spf_query{helo_identity} = $message->helo;

        my $header_from = $message->header_from;
        my $header_from_domain;
        if ($header_from) {
            debug 'RFC5322.From' => $spf_query{identity} =
              $header_from->address;
            $header_from_domain = $header_from->host;
            $spf_query{scope} = 'mfrom';
        }
        else {
            $spf_query{scope} = 'helo';
        }

        my $spf_result = spf_query(%spf_query);
        debug 'SPF result' => $spf_result;
        $message->add_header( $spf_result->received_spf_header );

        my $dmarc_text = (
            my $dmarc_result = Mail::DMARC::PurePerl->new(
                source_ip   => $ENV{TCPREMOTEIP},
                envelope_to => domain( ( $message->to )[0] ),
                if_set( envelope_from => domain($envelope_from) ),
                if_set( header_from   => $header_from_domain ),
                dkim => $dkim,
                spf  => {
                    if_set( domain => $header_from_domain ),
                    scope  => $spf_query{scope},
                    result => $spf_result->code,
                },
            )->validate
        )->result;
        debug 'DMARC result' => $dmarc_text;
        $message->add_header("DMARC-Status: $dmarc_text");

        if ( $dmarc_result->result ne 'pass' ) {
            my $disposition = $dmarc_result->disposition;
            debug 'DMARC disposition' => $disposition;
            reject 'Failed DMARC test.' if $disposition eq 'reject';
        }
    }
}

delete $ENV{QMAILQUEUE};    # use original qmail-queue
$message->send == 0 or die "Error sending message: exit status $?\n";
debug action => 'queue';

END {
    debug 'exit code' => $?;
    say STDERR "$FindBin::Script\[$$]: " . join '; ', @debug;
}

__END__

=head1 NAME

qmail-dmarc - verify using DMARC and queue a mail message for delivery

=head1 DESCRIPTION

qmail-dmarc is designed to be called by qmail-smtpd instead of qmail-queue
and will verify if incoming e-mail conforms to the DMARC policy of its
sender domain:

=over 4

=item 1.

If the environment variable C<RELAYCLIENT> exists, no verification is done,
and the e-mail is immediately passed to C<qmail-queue>.

=item 2.

In any other case, we check if the message contains a valid DKIM signature
matching the domain of the C<From:> header field.
If this is the case, the e-mail is passed to C<qmail-queue>.

=item 3.

If not, a SPF check is done, and a C<Received-SPF:> header field is added to
the message.
Then we check if the message is aligned with its sender's DMARC policy.
A C<DMARC-Status:> header field is added.

If the message does not align to the policy, the policy advises to reject such
messages and when the environment variable C<DMARC_REJECT> is set to a true
value, the message will be rejected with C<554 Failed DMARC test.>

=item 4.

In any other case the message is passed on to C<qmail-queue>.