#!/usr/bin/perl
use 5.20.0;
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use FindBin;
use lib -d "$FindBin::Bin/../lib/Mail/DKIM2" ? "$FindBin::Bin/../lib" : ();   # running from a checkout
use Sendmail::PMilter 1.28 ':all';   # 1.27 never answered MAIL FROM:<>

# Imported before _dkim2_info/_header_list_for_hash so the constants and
# should_skip are known at compile time. Spec version constants are the single
# source of truth in Mail::DKIM2::Common.
use Mail::DKIM2::Common qw(
    parse_dkim_pubkey load_private_key fold_header extract_mi_version strip_mi_versions should_skip parse_mime
    chain_number_error mi_version_tag
    DKIM2_DRAFT DKIM2_REPO DKIM2_DATE
);
use constant DKIM2_SOFTWARE => 'dkim2-milter';

# X-DKIM2-Info value per draft-gondwana-dkim2-debug-header-01: a tag-list in
# the DKIM2 syntax, every tag (the last included) followed by ";". A ";" has
# no escape and ends a tag, so one inside a value becomes ",".
sub _dkim2_info {
    my ($action, %extra) = @_;
    my @tags = ("draft=" . DKIM2_DRAFT, "repo=" . DKIM2_REPO,
                "date=" . DKIM2_DATE, "sw=" . DKIM2_SOFTWARE, "action=$action");
    push @tags, "$_=$extra{$_}" for grep { defined $extra{$_} } sort keys %extra;
    my $val = join ' ', map { (my $t = $_) =~ s/;/,/g; "$t;" } @tags;
    # Fold only after a ";" or a ","  (Section 5): never inside a token, so a
    # long hn= list breaks between names and a snaps= digest stays whole.
    # X-DKIM2-Info is excluded from the header hash by the x-* rule, so how it
    # is folded can never affect a signature.
    #
    # fold_header() budgets for the field name, so fold with it attached and
    # then strip it -- insheader() takes the value alone, in LF form for the
    # milter protocol.
    (my $folded = fold_header("X-DKIM2-Info: $val", undef, delimiters_only => 1))
        =~ s/^X-DKIM2-Info:\s*//;
    $folded =~ s/\r\n/\n/g;
    return $folded;
}

# Return (count, comma-separated-names) of headers that would be included
# in the header hash for the given Email::MIME message object.
sub _header_list_for_hash {
    my ($msg) = @_;
    my @fields;
    for my $header (sort { lc($a) cmp lc($b) } $msg->header_names) {
        next if should_skip($header);
        my @vals = $msg->header_raw($header);
        push @fields, (lc($header)) x scalar(@vals);
    }
    return (scalar(@fields), join(',', @fields));
}

use Mail::DKIM2::Signer;
use Mail::DKIM2::Verifier;
use Mail::DKIM2::Gate;
use Mail::DKIM2::MessageInstance;
use Mail::DKIM2::MessageStore;
use Mail::DKIM2::Wrap qw(wrap_single_part);
use Crypt::PRNG qw(random_bytes);
use Email::MIME;

# --- Command-line options ---

my %opts;
GetOptions(\%opts,
    'socket|s=s',
    'mode|m=s',
    'domain|d=s',
    'selector=s',
    'keyfile|k=s',
    'keydir=s',
    'algorithm|a=s',
    'snapshot-dir=s',
    'dns-json=s',
    'allow-null-body-recipe',
    'use-epilogue',
    'epilogue-threshold=i',
    'max-recipe-literals=i',
    'wrap-single-part',
    'help|h',
) or pod2usage(2);

pod2usage(-exitval => 0, -verbose => 2, -noperldoc => 1) if $opts{help};

if ($opts{'use-epilogue'} && defined $opts{'epilogue-threshold'}) {
    die "--use-epilogue and --epilogue-threshold are mutually exclusive\n";
}
if (defined $opts{'max-recipe-literals'}
    && ($opts{'use-epilogue'} || defined $opts{'epilogue-threshold'})) {
    die "--max-recipe-literals cannot be combined with --use-epilogue or --epilogue-threshold\n";
}
if (defined $opts{'max-recipe-literals'} && $opts{'max-recipe-literals'} < 0) {
    die "--max-recipe-literals must not be negative\n";
}

$opts{socket}    //= 'unix:/var/run/dkim2-milter.sock';
$opts{algorithm} //= 'rsa-sha256';
$opts{mode}      //= 'both';

unless ($opts{mode} =~ /^(inbound|outbound|both)$/) {
    die "Invalid --mode: must be inbound, outbound, or both\n";
}

if ($opts{'wrap-single-part'}) {
    die "--wrap-single-part needs --mode inbound\n" unless $opts{mode} eq 'inbound';
    die "--wrap-single-part needs --snapshot-dir\n" unless $opts{'snapshot-dir'};
}

my $do_verify = $opts{mode} eq 'inbound' || $opts{mode} eq 'both';
my $do_sign   = $opts{mode} eq 'outbound' || $opts{mode} eq 'both';

# Determine if signing is possible
my $can_sign_single = $opts{domain} && $opts{selector} && $opts{keyfile};
my $can_sign_keydir = $opts{keydir} && -d $opts{keydir};
my $can_sign = $can_sign_single || $can_sign_keydir;

if ($do_sign && !$can_sign) {
    die "Signing (--mode $opts{mode}) requires --keydir OR (--domain, --selector, and --keyfile)\n";
}

if ($can_sign_single && $can_sign_keydir) {
    die "Cannot use both --keydir and --domain/--selector/--keyfile\n";
}

# Preload single-domain signing key
my $sign_key;
if ($can_sign_single) {
    $sign_key = load_private_key($opts{keyfile});
    warn "dkim2-milter: signing enabled for $opts{domain} "
       . "(selector=$opts{selector}, algorithm=$opts{algorithm})\n";
}

# Key cache for keydir mode: { domain => { selector, key, algorithm } }
my %keydir_cache;

if ($can_sign_keydir) {
    warn "dkim2-milter: signing enabled via keydir $opts{keydir}\n";
}
warn "dkim2-milter: mode=$opts{mode}\n";
warn "dkim2-milter: wrapping single-part posts\n" if $opts{'wrap-single-part'};

# Preload DNS overrides if specified
my $dns_data;
if ($opts{'dns-json'}) {
    require JSON;
    open my $fh, '<', $opts{'dns-json'}
        or die "Cannot read $opts{'dns-json'}: $!\n";
    local $/;
    $dns_data = JSON::decode_json(<$fh>);
    close $fh;
    warn "dkim2-milter: using DNS overrides from $opts{'dns-json'}\n";
}

# Snapshot store
my $snapshot_store;
if ($opts{'snapshot-dir'}) {
    $snapshot_store = Mail::DKIM2::MessageStore->new(
        directory => $opts{'snapshot-dir'},
    );
    warn "dkim2-milter: snapshots in $opts{'snapshot-dir'}\n";
}

# Options passed to MessageInstance->calculate() for diff-based MI
my %mi_opts;
if ($opts{'use-epilogue'}) {
    $mi_opts{UseEpilogue} = 1;
    warn "dkim2-milter: MI strategy: UseEpilogue (always store body in MIME epilogue)\n";
}
elsif (defined $opts{'epilogue-threshold'}) {
    $mi_opts{EpilogueThreshold} = $opts{'epilogue-threshold'};
    warn "dkim2-milter: MI strategy: EpilogueThreshold=$opts{'epilogue-threshold'}\n";
}
elsif (defined $opts{'max-recipe-literals'}) {
    $mi_opts{MaxRecipeLiterals} = $opts{'max-recipe-literals'};
    warn "dkim2-milter: MI strategy: MaxRecipeLiterals=$opts{'max-recipe-literals'}\n";
}

# --- Key directory lookup ---

# Look up signing config for a domain from the keydir.
# Tries exact domain first, then walks up parent domains.
# Returns { domain, selector, key, algorithm } or undef.
sub _keydir_lookup {
    my ($domain) = @_;
    $domain = lc($domain);

    # Check cache
    return $keydir_cache{$domain} if exists $keydir_cache{$domain};

    my $try = $domain;
    while ($try) {
        my $dir = "$opts{keydir}/$try";
        # A directory we cannot read is treated like one that is not there,
        # and the walk-up below still runs: `next` here would never advance
        # $try and the milter would spin forever on a permissions mistake.
        if (-d $dir && opendir(my $dh, $dir)) {
            # Find the newest .key file (by ctime)
            my @keys = map { $_->[0] }
                       sort { $b->[1] <=> $a->[1] }
                       map { [$_, (stat("$dir/$_"))[10] || 0] }
                       grep { /\.key$/ } readdir $dh;
            closedir $dh;

            if (@keys) {
                my $file = $keys[0];
                (my $selector = $file) =~ s/\.key$//;
                my $key = eval { load_private_key("$dir/$file") };
                if ($key) {
                    # Detect algorithm from key type
                    my $alg = ref($key) =~ /Ed25519/
                        ? 'ed25519-sha256' : 'rsa-sha256';
                    my $config = {
                        domain    => $try,
                        selector  => $selector,
                        key       => $key,
                        algorithm => $alg,
                    };
                    # Cache for both the looked-up domain and the matched domain
                    $keydir_cache{$domain} = $config;
                    $keydir_cache{$try} = $config if $try ne $domain;
                    return $config;
                }
            }
        } elsif (-d $dir) {
            warn "dkim2-milter: key directory $dir is not readable: $!\n";
        }
        # Walk up: sub.example.com -> example.com -> (stop)
        $try =~ s/^[^.]+\.// or last;
    }

    # Cache the miss too
    $keydir_cache{$domain} = undef;
    return undef;
}

# --- Milter setup ---

my $milter = Sendmail::PMilter->new();
$milter->setconn($opts{socket});

# Insert, change and delete headers; replace the body (--wrap-single-part).
$milter->register('dkim2-milter', {
    envfrom => \&cb_envfrom,
    envrcpt => \&cb_envrcpt,
    header  => \&cb_header,
    eoh     => \&cb_eoh,
    body    => \&cb_body,
    eom     => \&cb_eom,
    close   => \&cb_close,
}, SMFIF_ADDHDRS | SMFIF_CHGHDRS | SMFIF_CHGBODY);

warn "dkim2-milter: listening on $opts{socket}\n";
$milter->main();

# --- Milter callbacks ---

sub cb_envfrom {
    my ($ctx, $from) = @_;
    $from =~ s/^<//;
    $from =~ s/>$//;
    $ctx->setpriv({
        env_from  => $from,
        env_rcpt  => [],
        headers   => [],
        raw_hdrs  => [],
        body      => '',
    });
    return SMFIS_CONTINUE;
}

sub cb_envrcpt {
    my ($ctx, $rcpt) = @_;
    $rcpt =~ s/^<//;
    $rcpt =~ s/>$//;
    push @{$ctx->getpriv->{env_rcpt}}, $rcpt;
    return SMFIS_CONTINUE;
}

sub cb_header {
    my ($ctx, $field, $value) = @_;
    my $priv = $ctx->getpriv;
    my $EOL = "\015\012";
    # Postfix delivers folded header values with LF continuations;
    # normalize to CRLF so the reconstructed message is RFC 5322 compliant.
    $value =~ s/\r?\n/$EOL/g;
    # Store parsed form and raw form
    push @{$priv->{headers}}, [$field, $value];
    push @{$priv->{raw_hdrs}}, "$field: $value$EOL";
    return SMFIS_CONTINUE;
}

sub cb_eoh {
    my ($ctx) = @_;
    return SMFIS_CONTINUE;
}

sub cb_body {
    my ($ctx, $chunk) = @_;
    my $priv = $ctx->getpriv;
    my $EOL = "\015\012";
    $chunk =~ s/\015?\012/$EOL/g;
    $priv->{body} .= $chunk;
    return SMFIS_CONTINUE;
}

sub cb_eom {
    my ($ctx) = @_;
    my $priv = $ctx->getpriv;
    my $EOL = "\015\012";

    # Reconstruct the full message
    my $message = join('', @{$priv->{raw_hdrs}}) . $EOL . $priv->{body};

    # X-DKIM2-Snapshot names the snapshot an inbound milter on this host took
    # of this message. Nothing from outside may supply one, and it never
    # leaves: every mode removes it on sight (inbound adds a fresh one).
    my @snapshot_tokens = _strip_snapshot_header($ctx, $priv, \$message);

    # Extract message-id for logging
    my $msgid = '';
    for my $hdr (@{$priv->{headers}}) {
        if (lc($hdr->[0]) eq 'message-id') {
            $msgid = $hdr->[1];
            $msgid =~ s/^\s+//;
            last;
        }
    }

    warn "dkim2-milter: processing $msgid from=$priv->{env_from} mode=$opts{mode}\n";

    # Verification result, shared between the verify and sign blocks.
    # 'none' means no DKIM2-Signature headers were present.
    my $verify_result = 'none';

    # --- Inbound: verify and cache snapshot ---
    if ($do_verify) {
        $verify_result = _do_verify($message);
        my $result = $verify_result;
        warn "dkim2-milter: verify $msgid result=$result\n";

        # Build the A-R and X-DKIM2-Info headers we're about to add.
        # Authentication-Results is not in the spec exclusion list so it
        # is included in the header hash.  The MI must be computed over
        # a synthetic message that already contains these headers.
        my $ar_value = "localhost; dkim2=$result";
        my $info_value = _dkim2_info("verify=$result");
        my $ar_raw = "Authentication-Results: $ar_value$EOL";
        # _dkim2_info() folds with bare LF (the milter wire form); the
        # message we stamp, snapshot and may wrap is CRLF throughout.
        my $info_raw = "X-DKIM2-Info: " . ($info_value =~ s/\r?\n/$EOL/gr) . $EOL;
        my $message_with_ar = $info_raw . $ar_raw . $message;

        # Insert the headers into the milter output
        $ctx->insheader('Authentication-Results', $ar_value, 0);
        $ctx->insheader('X-DKIM2-Info', _milter_value($info_value), 0);

        # Compute MI from the message that includes A-R
        my $mi_header;
        my %mi_info;
        if ($snapshot_store) {
            # Fail closed: an exception computing the instance (a crafted
            # message must never take the callback down with it) means no
            # Message-Instance; the message passes with its A-R.
            # On arrival: stamp m=1, or accept a top instance that matches
            # the content. A top that does not match gets no snapshot.
            my $ok = eval { $mi_header = _compute_mi($message_with_ar, \%mi_info); 1 };
            unless ($ok) {
                warn "dkim2-milter: no Message-Instance for $msgid: internal error: "
                   . _error_text($@) . "\n";
                $mi_header = undef;
            }
            if ($mi_header) {
                warn "dkim2-milter: computed MI for $msgid\n";
            }
        }

        # The arrival snapshot: our own m=1 over everything, or a top
        # instance that matches the content. Nothing else is vouched for.
        my $arrival = $mi_header ? "Message-Instance: $mi_header$EOL" . $message_with_ar
                    : $mi_info{matched} ? $message_with_ar
                    : undef;
        my $token = defined $arrival ? unpack('H*', random_bytes(16)) : undef;
        my $snapshot = $arrival;

        if ($mi_header) {
            $ctx->insheader('Message-Instance', _milter_value($mi_header), 0);
            my ($mi_ver) = $mi_header =~ /m=(\d+)/;
            $ctx->insheader('X-DKIM2-Info', _dkim2_info("mi-m=$mi_ver",
                hc => $mi_info{hc}, hn => $mi_info{hn},
                snaps => $token && $snapshot_store->rel_path_for_mi(_snapshot_key($token))), 0);
            warn "dkim2-milter: added MI header for $msgid\n";
        }

        # --wrap-single-part: stock Mailman pastes a footer into a single-part
        # body (re-encoding it); a multipart/mixed gets the footer as an extra
        # part instead. Wrap here, record the wrap as its own unsigned
        # instance, and snapshot the wrapped message for the outbound diff.
        # Everything is computed before anything is sent, so any failure
        # leaves the message unwrapped with only its arrival headers.
        if ($opts{'wrap-single-part'}) {
            my ($wrap, $wrap_mi, %wrap_info);
            if ($verify_result !~ /^(?:pass|none)\b/) {
                warn "dkim2-milter: not wrapping $msgid: arrival result $verify_result\n";
            } elsif (!defined $arrival) {
                warn "dkim2-milter: not wrapping $msgid: no arrival snapshot\n";
            } else {
                my $ok = eval {
                    $wrap = wrap_single_part($arrival);
                    warn "dkim2-milter: not wrapping $msgid: already multipart\n" unless $wrap;
                    $wrap_mi = _compute_mi($wrap->{message}, \%wrap_info, Snapshot => $arrival) if $wrap;
                    1;
                };
                if (!$ok) {
                    warn "dkim2-milter: not wrapping $msgid: internal error: " . _error_text($@) . "\n";
                    $wrap = undef;
                } elsif ($wrap && !$wrap_mi) {
                    warn "dkim2-milter: not wrapping $msgid: no Message-Instance for the wrap\n";
                    $wrap = undef;
                } elsif ($wrap && $wrap_info{strip_mi_versions}) {
                    # The inbound side never removes instances; a diff that
                    # wants to is not one to put on the wire.
                    warn "dkim2-milter: not wrapping $msgid: the wrap's diff would strip instances\n";
                    $wrap = undef;
                }
            }
            if ($wrap) {
                for my $e (@{$wrap->{edits}}) {
                    if    ($e->{op} eq 'delete') { $ctx->chgheader($e->{name}, $e->{index}, '') }
                    elsif ($e->{op} eq 'change') { $ctx->chgheader($e->{name}, $e->{index}, $e->{value}) }
                    else                         { $ctx->addheader($e->{name}, $e->{value}) }
                }
                my $body = $wrap->{body};
                for (my $o = 0; $o < length $body; $o += 65535) {
                    $ctx->replacebody(substr($body, $o, 65535));
                }
                $ctx->insheader('Message-Instance', _milter_value($wrap_mi), 0);
                my ($wrap_ver) = $wrap_mi =~ /m=(\d+)/;
                $ctx->insheader('X-DKIM2-Info', _milter_value(_dkim2_info("wrap-single-part")), 0);
                $ctx->insheader('X-DKIM2-Info', _dkim2_info("mi-m=$wrap_ver",
                    hc => $wrap_info{hc}, hn => $wrap_info{hn},
                    snaps => $snapshot_store->rel_path_for_mi(_snapshot_key($token))), 0);
                warn "dkim2-milter: wrapped $msgid as m=$wrap_ver\n";
                $snapshot = "Message-Instance: $wrap_mi$EOL" . $wrap->{message};
            }
        }

        # Keep the snapshot (the wrapped form, if wrapped) under a fresh
        # random token, and name it on the message for the outbound milter.
        if (defined $snapshot && $snapshot_store) {
            $snapshot_store->store(_snapshot_key($token), $snapshot);
            $ctx->insheader('X-DKIM2-Snapshot', $token, 0);
        }
    }

    # --- Outbound: compute MI diff if needed, then sign ---
    if ($do_sign) {
        # No key for this sender: this message is not ours to sign, so it
        # leaves exactly as it came -- no Message-Instance (unsigned, a
        # receiver reports it as permerror), no X-DKIM2-Info, no snapshot.
        # The From: domain is the null-sender fallback for the key lookup,
        # and is logged for alignment below.
        my $from_hdr_domain = '';
        for my $hdr (@{$priv->{headers}}) {
            if (lc($hdr->[0]) eq 'from') {
                ($from_hdr_domain) = $hdr->[1] =~ /\@([\w.-]+)/;
                $from_hdr_domain = lc($from_hdr_domain // '');
                last;
            }
        }
        my $sign_config = _get_sign_config($priv->{env_from}, $from_hdr_domain);
        unless ($sign_config) {
            warn "dkim2-milter: no signing key for $msgid from=$priv->{env_from}\n";
            _remove_unsigned_instances($ctx, $priv, $msgid);
            return SMFIS_CONTINUE;
        }

        # If there are upstream DKIM2-Signature headers we must verify the
        # chain before extending it.  In mode=both the verify block already
        # ran; in mode=outbound we run it now on demand.
        #
        # allow_unsigned_mi: the message may carry a Message-Instance above the
        # top signature that is OURS to sign. A list manager on this host
        # (Mailman, Sympa) records its changes as a new m= and hands the
        # message to us unsigned; the milter is the step that signs it. spec-06
        # §11's "Message-Instance m=<x> is not signed" PERMERROR is a receiver's
        # rule about mail on the wire, and applying it here refused to sign
        # every list post whose upstream chain was signed. The opt-out does not
        # loosen the chain gate: i=1..n still have to verify, and
        # chain_verifies() below still requires the unsigned instance to match
        # the content and undo cleanly.
        # The decision itself lives in Mail::DKIM2::Gate, shared with
        # bin/dkim2sign so the two front ends cannot drift apart: verify the
        # upstream signatures (allowing our own unsigned instance on top), run
        # the full undo check on the Message-Instance chain (an upstream that
        # emitted a non-reversible Recipe would give a signature that fails at
        # every recipient), and refuse a null body Recipe on an UNSIGNED top
        # instance (no upstream signature has its m=: a null this hop is
        # introducing) unless --allow-null-body-recipe. A null top that
        # arrived signed (a list post forwarded unchanged) is extended.
        # nd= bridge: when the top signature carries nd= we may extend it only
        # if nd= names the domain we sign as, so tell the gate which. (The
        # gate ignores this unless the top signature has nd=.)
        #
        # The gate judges the message as it will be signed: with this hop's
        # own Message-Instance (the diff against the snapshot) on top and any
        # broken intermediate instances removed. A list manager that changed
        # the message without recording an instance (stock Mailman: the
        # snapshot diff is its instance) leaves a top instance that no longer
        # matches; gating before the diff refused every such copy.
        # DKIM2Sign has always computed first and gated second.
        my $mi_header;
        my %mi_info;
        if ($snapshot_store) {
            # Fail closed: an exception computing the instance means no
            # Message-Instance and no signature.
            # The snapshot is the one the inbound milter named on this very
            # message (X-DKIM2-Snapshot, stripped above); one token or none.
            # In --mode both the message came from outside in this same
            # transaction, so a token on it is not one we gave it.
            my $snap;
            if (!$do_verify && @snapshot_tokens == 1 && $snapshot_tokens[0] =~ /^[0-9a-f]{32}\z/) {
                $snap = $snapshot_store->fetch(_snapshot_key($snapshot_tokens[0]));
                $mi_info{snapf} = $snapshot_store->rel_path_for_mi(_snapshot_key($snapshot_tokens[0]))
                    if defined $snap;
            }
            my $ok = eval { $mi_header = _compute_mi($message, \%mi_info,
                                (defined $snap ? (Snapshot => $snap) : ())); 1 };
            unless ($ok) {
                warn "dkim2-milter: not signing $msgid: internal error computing the "
                   . "Message-Instance: " . _error_text($@) . "\n";
                _remove_unsigned_instances($ctx, $priv, $msgid);
                return SMFIS_CONTINUE;
            }
            warn "dkim2-milter: computed MI for $msgid\n" if $mi_header;
        }
        my $sign_msg = $mi_info{strip_mi_versions}
            ? strip_mi_versions($message, @{$mi_info{strip_mi_versions}})
            : $message;
        $sign_msg = "Message-Instance: $mi_header$EOL" . $sign_msg if $mi_header;

        my $gate_sd = $sign_config->{domain};
        # Fail closed: an exception anywhere in the gate (a crafted message
        # must never take the callback down with it) is a logged refusal.
        # The inbound verdict (mode both) still describes the message only if
        # this hop added and removed nothing.
        my $gate = eval {
            Mail::DKIM2::Gate->check($sign_msg,
                (defined $gate_sd ? (SigningDomain => $gate_sd) : ()),
                AllowNullBodyRecipe => $opts{'allow-null-body-recipe'},
                ($do_verify && $sign_msg eq $message ? (VerifyResult => $verify_result) : ()),
                _gate_pubkey_cb());
        };
        unless ($gate) {
            my $err = _error_text($@);
            $gate = { reason => 'error', verify_result => $verify_result,
                      message => "internal error checking the upstream chain: $err" };
        }
        $verify_result = $gate->{verify_result};
        $gate->{message} =~ s/AllowNullBodyRecipe not set/--allow-null-body-recipe not set/
            if defined $gate->{message};

        if ($gate->{reason}
            && ($gate->{reason} eq 'upstream-chain' || $gate->{reason} eq 'error')) {
            # Upstream chain is broken — don't extend it with a new signature.
            warn "dkim2-milter: not signing $msgid: $gate->{message}\n";
            _remove_unsigned_instances($ctx, $priv, $msgid);
        } elsif ($gate->{reason} && $gate->{reason} eq 'broken-mi-chain') {
            warn "dkim2-milter: not signing $msgid: $gate->{message}\n";
            $ctx->insheader('X-DKIM2-Info',
                _milter_value(_dkim2_info("not-signed=broken-mi-chain")), 0);
            _remove_unsigned_instances($ctx, $priv, $msgid);
        } elsif ($gate->{reason}) {
            warn "dkim2-milter: not signing $msgid: $gate->{message}\n";
            $ctx->insheader('X-DKIM2-Info',
                _milter_value(_dkim2_info("not-signed=null-body-recipe")), 0);
            _remove_unsigned_instances($ctx, $priv, $msgid);
        } else {
            # Chain is valid (or there is no upstream chain) — proceed.
            # Log domain alignment: signing domain vs envelope-from and From:
            my ($env_domain) = ($priv->{env_from} || '') =~ /\@(.+)$/;
            $env_domain = lc($env_domain // '');
            my $env_aligned  = ($env_domain  eq lc($sign_config->{domain})) ? 'yes' : 'no';
            my $from_aligned = ($from_hdr_domain eq lc($sign_config->{domain})) ? 'yes' : 'no';
            warn "dkim2-milter: domain alignment $msgid"
               . " signing=$sign_config->{domain}"
               . " env_from=$env_domain aligned=$env_aligned"
               . " from_hdr=$from_hdr_domain aligned=$from_aligned\n";

            # Sign before touching the headers, so a signer failure leaves no
            # instance of ours behind.
            my $sig_header = _do_sign($sign_msg, $priv, $sign_config);
            unless ($sig_header) {
                _remove_unsigned_instances($ctx, $priv, $msgid);
            } else {
                # If _compute_mi stripped broken intermediate MI headers, delete them
                # from the wire message and log a warning. Deletes go first: their
                # indexes count the Message-Instance fields as received, and an
                # MTA that counts fields inserted earlier in this end-of-message
                # would otherwise delete one place off (our own new instance).
                if ($mi_info{strip_mi_versions}) {
                    for my $v (@{$mi_info{strip_mi_versions}}) {
                        my $count = 0;
                        my $del_idx = 0;
                        for my $hdr (@{$priv->{headers}}) {
                            if (lc($hdr->[0]) eq 'message-instance') {
                                $count++;
                                my $val = $hdr->[1];
                                $val =~ s/^\s+//;
                                if ((extract_mi_version($val) // 0) == $v) {
                                    $del_idx = $count;
                                    last;
                                }
                            }
                        }
                        if ($del_idx) {
                            $ctx->chgheader('Message-Instance', $del_idx, '');
                            warn "dkim2-milter: deleted broken MI m=$v from wire message\n";
                        }
                    }
                    my $stripped_str = join(',', map { "m=$_" } @{$mi_info{strip_mi_versions}});
                    my $recomp_from  = $mi_info{strip_mi_versions}[0] - 1;
                    $ctx->insheader('X-DKIM2-Info',
                        _dkim2_info("stripped-broken-mi=$stripped_str,recomputed-from=m$recomp_from"), 0);
                }
                if ($mi_header) {
                    $ctx->insheader('Message-Instance', _milter_value($mi_header), 0);
                    my ($mi_ver) = $mi_header =~ /m=(\d+)/;
                    $ctx->insheader('X-DKIM2-Info', _dkim2_info("mi-m=$mi_ver",
                        hc => $mi_info{hc}, hn => $mi_info{hn},
                        snapf => $mi_info{snapf}), 0);
                    warn "dkim2-milter: added MI header for $msgid\n";
                }

                $ctx->insheader('DKIM2-Signature', _milter_value($sig_header), 0);
                $ctx->insheader('X-DKIM2-Info',
                    _dkim2_info("sign d=$sign_config->{domain} a=$sign_config->{algorithm}"), 0);
                warn "dkim2-milter: signed $msgid d=$sign_config->{domain} "
                   . "a=$sign_config->{algorithm} sel=$sign_config->{selector}\n";
                # Informational: we signed over a null body Recipe --
                # a null top that arrived signed (no option needed), or an
                # unsigned null, our own diff's included (the option was
                # set: the gate sees this hop's instance as unsigned too).
                $ctx->insheader('X-DKIM2-Info',
                    _milter_value(_dkim2_info("null-body-recipe")), 0)
                    if $gate->{top_null} || $gate->{unsigned_null};
            }
        }
    }

    return SMFIS_CONTINUE;
}

sub cb_close {
    my ($ctx) = @_;
    $ctx->setpriv(undef);
    return SMFIS_CONTINUE;
}

# --- Signing config lookup ---

# Returns { domain, selector, key, algorithm } or undef.
sub _get_sign_config {
    my ($env_from, $from_domain_fallback) = @_;
    my ($from_domain) = ($env_from || '') =~ /\@(.+)$/;
    # Null sender (bounce/DSN): no envelope domain — fall back to the From:
    # header domain so our own Postfix-generated bounces still get signed.
    $from_domain = $from_domain_fallback
        if (!$from_domain && defined $from_domain_fallback && length $from_domain_fallback);
    return unless $from_domain;
    $from_domain = lc($from_domain);

    # Single-domain mode — sign regardless of alignment; caller logs alignment.
    if ($can_sign_single) {
        return {
            domain    => $opts{domain},
            selector  => $opts{selector},
            key       => $sign_key,
            algorithm => $opts{algorithm},
        };
    }

    # Keydir mode
    if ($can_sign_keydir) {
        return _keydir_lookup($from_domain);
    }

    return;
}

# --- Verification ---

# _gate_pubkey_cb(): PubkeyCallback option answering from --dns-json, else real DNS.
sub _gate_pubkey_cb {
    return unless $dns_data;
    return (PubkeyCallback => sub {
        my ($sig, $idx, $v) = @_;
        $idx //= 0;
        my $sel = $sig->selector($idx);
        my $dom = $sig->domain;
        my $key_txt = $dns_data->{$dom}{"$sel._domainkey"}[0][1]
            if $dns_data->{$dom} && $dns_data->{$dom}{"$sel._domainkey"};
        return parse_dkim_pubkey($key_txt) if $key_txt;
        return $v->fetch_public_key($sig, $idx);  # fall back to real DNS
    });
}

# _do_verify($message, %opts): run the Verifier over a reconstructed message.
#   allow_unsigned_mi => 1   permit a Message-Instance above the top signature
#                            (outbound only: it is the instance we are about to
#                            sign -- see the sign block in cb_eom).
sub _do_verify {
    my ($message, %o) = @_;

    my $verifier = Mail::DKIM2::Verifier->new();
    $verifier->allow_unsigned_mi(1) if $o{allow_unsigned_mi};

    my %cb = _gate_pubkey_cb();
    $verifier->set_pubkey_callback($cb{PubkeyCallback}) if $cb{PubkeyCallback};

    # Fail closed: a verifier exception is reported as temperror (never
    # pass) and logged, rather than killing the milter callback.
    my $ok = eval { $verifier->PRINT($message); $verifier->CLOSE(); 1 };
    unless ($ok) {
        warn "dkim2-milter: verify failed with an internal error: "
           . _error_text($@) . "\n";
        return 'temperror (internal error)';
    }

    return $verifier->result_detail();
}

# One line of an exception, for the log.
sub _error_text {
    my ($err) = @_;
    $err = "$err" if defined $err;
    $err = 'unknown error' unless defined $err && length $err;
    $err =~ s/\s+\z//;
    $err =~ s/\s*\n\s*/ /g;
    return $err;
}

# --- Message-Instance ---

# _compute_mi($message, \%info, %o): the Message-Instance this hop adds, or
# undef when none is needed or none can be justified.
#   Snapshot => $previous   the message as this host last vouched for it (the
#                           snapshot the X-DKIM2-Snapshot token names); a top
#                           instance that no longer matches is explained by a
#                           diff against it and nothing else.
# Sets $info->{matched} when the top instance matches the content, and
# $info->{hc}/{hn} (the hashed header names) for X-DKIM2-Info. Stores nothing:
# the callers decide what becomes a snapshot.
sub _compute_mi {
    my ($message, $info, %o) = @_;
    $info //= {};

    my $msg = eval { parse_mime($message) };
    return unless $msg;

    # Record which headers will be included in any hash we compute.
    my ($hcount, $hnames) = _header_list_for_hash($msg);
    $info->{hc} = $hcount;
    $info->{hn} = $hnames;

    my @mi_hdrs = $msg->header_raw('Message-Instance');

    # The top instance already describes the content: nothing to add.
    if (@mi_hdrs && Mail::DKIM2::MessageInstance->verify($msg)) {
        $info->{matched} = 1;
        return undef;
    }

    # An m= above MAX_CHAIN_LENGTH is a PERMERROR (the verifier and the gate
    # say so) and is never a range bound below: snap_max_v+1 .. max_v with
    # m=99999999999999999999 dies, and m=4294967297 is a four-billion
    # element list. Add no instance over such a chain.
    if (my ($e) = grep { defined } map { chain_number_error('Message-Instance', 'm', mi_version_tag($_)) }
                                    @mi_hdrs) {
        warn "dkim2-milter: not computing a Message-Instance: $e\n";
        return undef;
    }

    # No instance yet: this hop originates the chain, m=1 over everything.
    return _format_mi(Mail::DKIM2::MessageInstance->calculate($msg)) unless @mi_hdrs;

    # The top instance does not match. Only a snapshot this host took of this
    # very message can say what changed; anything else (a lookup by instance
    # value would find a different message that carried the same instance)
    # would book someone else's change as ours.
    unless (defined $o{Snapshot}) {
        warn "dkim2-milter: top Message-Instance does not match the content and no snapshot of ours describes it\n";
        return undef;
    }
    my $snap_msg = parse_mime($o{Snapshot});
    my @snap_mi = $snap_msg->header_raw('Message-Instance');
    my %by_v      = map { (extract_mi_version($_) || 0) => $_ } @mi_hdrs;
    my %snap_by_v = map { (extract_mi_version($_) || 0) => $_ } @snap_mi;
    # The snapshot's instances must be the message's lower ones, unchanged.
    for my $v (keys %snap_by_v) {
        my ($a, $b) = map { defined $_ ? s/\s+/ /gr =~ s/^ | $//gr : '' } $snap_by_v{$v}, $by_v{$v};
        if ($a ne $b) {
            warn "dkim2-milter: snapshot does not belong to this message (m=$v differs)\n";
            return undef;
        }
    }

    # The message may have more instances than the snapshot: a hop between
    # added some, and since the top one does not match, they are broken.
    # Strip them and recompute a fresh diff from the snapshot rather than
    # propagating a broken chain.
    my ($work_message, $work_msg) = ($message, $msg);
    my $max_v      = (sort { $b <=> $a } keys %by_v)[0];
    my $snap_max_v = (sort { $b <=> $a } keys %snap_by_v)[0] // 0;
    if ($max_v > $snap_max_v) {
        my @to_strip = ($snap_max_v + 1 .. $max_v);
        $work_message = strip_mi_versions($message, @to_strip);
        $work_msg = eval { parse_mime($work_message) };
        $info->{strip_mi_versions} = \@to_strip;
        warn "dkim2-milter: stripping broken MI versions "
           . join(',', map { "m=$_" } @to_strip)
           . " (snapshot at m=$snap_max_v) — broken chain detected\n";
    }

    my $mi = eval {
        Mail::DKIM2::MessageInstance->calculate($work_msg, $snap_msg, %mi_opts);
    };
    return $mi ? _format_mi($mi) : undef;
}

# Not signing: remove every Message-Instance no DKIM2-Signature on the
# message covers (m= above every signature's m=). Those are instances hops on
# this host added for a signature that is not going to be made; left in,
# every receiver reports "m=N is not signed". Without them an unsigned post
# has no DKIM2 at all, and a signed one fails honestly against the last
# signature (a hop changed it without signing). Deletes go last first, by
# index among the fields as received; nothing of ours has been inserted.
sub _remove_unsigned_instances {
    my ($ctx, $priv, $msgid) = @_;
    my $covered = 0;
    for my $h (grep { lc $_->[0] eq 'dkim2-signature' } @{$priv->{headers}}) {
        my ($m) = $h->[1] =~ /(?:\A|;)\s*m\s*=\s*(\d+)/;
        $covered = $m if defined $m && $m > $covered;
    }
    my @mi = grep { lc $_->[0] eq 'message-instance' } @{$priv->{headers}};
    my @gone;
    for my $i (0 .. $#mi) {
        my $v = extract_mi_version($mi[$i][1] =~ s/^\s+//r) // 0;
        push @gone, [$i + 1, $v] if $v > $covered;
    }
    return unless @gone;
    $ctx->chgheader('Message-Instance', $_->[0], '') for reverse @gone;
    my $list = join(',', map { "m=$_->[1]" } sort { $a->[1] <=> $b->[1] } @gone);
    $ctx->insheader('X-DKIM2-Info', _milter_value(_dkim2_info("removed-unsigned-mi=$list")), 0);
    warn "dkim2-milter: not signing $msgid: removed unsigned $list\n";
}

# The snapshot store key for an X-DKIM2-Snapshot token.
sub _snapshot_key { "X-DKIM2-Snapshot:$_[0]" }

# Remove every X-DKIM2-Snapshot field: from the wire (deleted last first, by
# index among the fields as received, before anything is inserted) and from
# the reconstructed message. Returns the tokens that were there.
sub _strip_snapshot_header {
    my ($ctx, $priv, $message_ref) = @_;
    my @tok = map { $_->[1] =~ s/^\s+|\s+$//gr }
              grep { lc $_->[0] eq 'x-dkim2-snapshot' } @{$priv->{headers}};
    return () unless @tok;
    $ctx->chgheader('X-DKIM2-Snapshot', $_, '') for reverse 1 .. @tok;
    my $sep = index($$message_ref, "\015\012\015\012");
    if ($sep >= 0) {
        my $head = substr($$message_ref, 0, $sep + 2);
        $head =~ s/^X-DKIM2-Snapshot[ \t]*:[^\r\n]*\r\n(?:[ \t][^\r\n]*\r\n)*//mig;
        substr($$message_ref, 0, $sep + 2) = $head;
    }
    return @tok;
}

sub _format_mi {
    my ($mi) = @_;
    my $folded = fold_header("Message-Instance: " . $mi->as_string());
    $folded =~ s/^Message-Instance: //;
    return $folded;
}

# Convert CRLF folding to LF for milter insheader (CRLF = end of value)
sub _milter_value {
    my ($val) = @_;
    $val =~ s/\r\n/\n/g;
    return $val;
}

# --- Signing ---

sub _do_sign {
    my ($message, $priv, $config) = @_;

    my $signer;
    # Fail closed, as for the gate: an exception means no signature.
    my $ok = eval {
        $signer = Mail::DKIM2::Signer->new(
            Domain    => $config->{domain},
            Selector  => $config->{selector},
            Key       => $config->{key},
            Algorithm => $config->{algorithm},
            MailFrom  => ( length($priv->{env_from} // '') ? $priv->{env_from} : '<>' ),
            RcptTo    => $priv->{env_rcpt},
        );
        $signer->PRINT($message);
        $signer->CLOSE();
        1;
    };
    unless ($ok) {
        warn "dkim2-milter: not signing: internal error in the signer: "
           . _error_text($@) . "\n";
        return;
    }

    unless (($signer->result // '') eq 'signed') {
        warn "dkim2-milter: not signing: signer result="
           . ($signer->result_detail // $signer->result // 'none') . "\n";
        return;
    }

    my $header = $signer->as_string();
    # Strip "DKIM2-Signature: " prefix for insheader
    $header =~ s/^DKIM2-Signature:\s*//;
    # Convert CRLF folding to LF folding for milter protocol
    $header =~ s/\r\n/\n/g;
    return $header;
}

__END__

=encoding utf8

=head1 NAME

dkim2-milter - Standalone DKIM2 milter for Postfix

=head1 SYNOPSIS

    # Verify only (no signing)
    dkim2-milter --socket unix:/var/run/dkim2.sock

    # Sign for a single domain
    dkim2-milter --socket unix:/var/run/dkim2.sock \
        --domain example.com \
        --selector sel1 \
        --keyfile /etc/dkim2/sel1.pem

    # Sign for any domain with keys in a directory
    dkim2-milter --socket unix:/var/run/dkim2.sock \
        --keydir /etc/dkim2/keys

    # With message snapshots for diff-based Message-Instance
    dkim2-milter --socket unix:/var/run/dkim2.sock \
        --keydir /etc/dkim2/keys \
        --snapshot-dir /var/spool/dkim2/snapshots

    # Epilogue-based MI (body in MIME epilogue, compact header)
    dkim2-milter --socket unix:/var/run/dkim2.sock \
        --keydir /etc/dkim2/keys \
        --snapshot-dir /var/spool/dkim2/snapshots \
        --use-epilogue

    # Auto-switch to epilogue when diff exceeds 5 literal lines
    dkim2-milter --socket unix:/var/run/dkim2.sock \
        --keydir /etc/dkim2/keys \
        --snapshot-dir /var/spool/dkim2/snapshots \
        --epilogue-threshold 5

    # Testing with dns.json instead of real DNS
    dkim2-milter --socket inet:8891@localhost \
        --keydir keys \
        --dns-json dns.json

=head1 DESCRIPTION

A standalone milter daemon that provides DKIM2 signature verification and
signing for Postfix (or any milter-compatible MTA).  Uses L<Sendmail::PMilter>
for the milter protocol.

Verification is enabled by default for all inbound messages.

Signing can be configured in two ways:

=over 4

=item B<Single domain>: C<--domain>, C<--selector>, and C<--keyfile>.
Signs only when the envelope sender matches the configured domain.

=item B<Key directory>: C<--keydir PATH>.  The directory contains
subdirectories named by domain, each containing key files named
C<selector.key>.  The milter looks up the sender domain (with parent
domain fallback) and uses the first key found.  The algorithm is
auto-detected from the key type (RSA or Ed25519).

=back

This program implements draft-ietf-dkim-dkim2-spec-06; see L<Mail::DKIM2/STATUS>.

=head1 KEY DIRECTORY LAYOUT

The C<--keydir> option points to a directory tree where each subdirectory
is named after a domain and contains one or more PEM key files with a
C<.key> extension.  The filename (minus the extension) becomes the DKIM
selector.

    /etc/dkim2/keys/
        example.com/
            sel1.key              # RSA key, selector "sel1"
            sel2.key              # another key (used if newer)
        sub.example.com/
            default.key           # selector "default"
        other.org/
            ed25519.key           # Ed25519 key, auto-detected

=head2 Domain lookup

When a message arrives from C<user@sub.example.com>, the milter:

=over 4

=item 1.

Looks for a directory named C<sub.example.com/> under the keydir.

=item 2.

If not found, strips the leftmost label and tries C<example.com/>.

=item 3.

Continues stripping labels until a match is found or no labels remain.

=back

The signing domain (C<d=> tag) is set to the directory name that matched,
not necessarily the full sender domain.

=head2 Key selection

If a domain directory contains multiple C<.key> files, the newest file
by ctime is used.  This makes key rotation straightforward:

    # Generate a new key and publish its DNS record
    openssl genrsa -out /etc/dkim2/keys/example.com/sel2.key 2048

    # The milter will start using sel2 for new signatures immediately
    # (after the domain lookup cache is refreshed on next restart).
    # Keep sel1.key around until its DNS record has propagated.

=head2 Algorithm detection

The signing algorithm is auto-detected from each key file:

=over 4

=item *

Ed25519 keys (32-byte raw or PEM-wrapped) use the C<ed25519> algorithm.

=item *

All other keys (RSA) use C<rsa-sha256>.

=back

No C<--algorithm> flag is needed in keydir mode.

=head2 Caching

Domain-to-key mappings are cached in memory for the lifetime of the milter
process.  After adding or removing key files, restart the milter to pick up
the changes.

=head1 OPTIONS

=over 4

=item B<--socket>, B<-s> I<SPEC>

Milter socket specification.  Default: C<unix:/var/run/dkim2-milter.sock>.
Examples: C<unix:/path/to/sock>, C<inet:8891@localhost>.

=item B<--domain>, B<-d> I<DOMAIN>

Signing domain (single-domain mode).  Requires C<--selector> and C<--keyfile>.

=item B<--selector> I<SELECTOR>

DKIM selector (single-domain mode).  Requires C<--domain> and C<--keyfile>.

=item B<--keyfile>, B<-k> I<PATH>

Path to a PEM-encoded private key (single-domain mode).

=item B<--keydir> I<PATH>

Directory of per-domain key subdirectories (multi-domain mode).
Cannot be combined with C<--domain>/C<--selector>/C<--keyfile>.

=item B<--algorithm>, B<-a> I<ALG>

Signing algorithm for single-domain mode.  Default: C<rsa-sha256>.
In keydir mode, the algorithm is auto-detected from each key file.

=item B<--snapshot-dir> I<PATH>

Directory for message snapshots.  Enables diff-based Message-Instance
computation.  On inbound, a message gets a snapshot only when the milter
stamps its own C<m=1> or the top Message-Instance matches the content; the
snapshot is stored under a random token, which is added to the message as
C<X-DKIM2-Snapshot>.  On outbound, a top Message-Instance that no longer
matches is explained by a diff against the snapshot that token names, and
nothing else.  Every mode removes any C<X-DKIM2-Snapshot> a message arrives
with (inbound then adds its own), so a token can neither come from outside
nor leave the host.  Both milters must share the directory.

=item Not signing

Whenever the outbound milter does not sign (no key for the sender, a
refused upstream chain, a signer failure), it adds no Message-Instance and
removes every Message-Instance no DKIM2-Signature on the message covers (an
C<m=> above every signature's C<m=>), with
C<X-DKIM2-Info: action=removed-unsigned-mi=...;>.

=item B<--allow-null-body-recipe>

Sign a message with a Message-Instance that has a null body Recipe no upstream
DKIM2-Signature covers (its C<m=> is above every valid signature's C<m=>; a
signature with C<m=k> covers instances 1 to I<k>), whether it is the top
instance or another unsigned instance was added over it: a null this host is
introducing.  Default: off, and such a message is delivered unsigned with
C<X-DKIM2-Info: not-signed=null-body-recipe>.  When set, the message is
signed provided the upstream signatures verify and the header history below
the null Recipe checks out.  For list hosts whose list manager rewrites
bodies (content filtering, DMARC wrap) and adds an unsigned instance for the
milter to sign.

A null that arrived already signed (a list host's post, forwarded unchanged)
needs no option: the domain that declared the null signed it, and the milter
extends the chain as for any other valid one.  Whenever the milter signs over
a null top, in either case, or over an unsigned null under the top (with the
option), it adds the informational C<X-DKIM2-Info: action=null-body-recipe;>.

=item B<--wrap-single-part>

Inbound mode only, and needs C<--snapshot-dir>. After verifying, stamping and
keeping the arrival snapshot, wrap a message that is not C<multipart/*> into a
one-part C<multipart/mixed> (its C<Content-*> fields and body unchanged, see
L<Mail::DKIM2::Wrap>), record the wrap as a new unsigned Message-Instance, and
keep the wrapped message as the snapshot the outbound milter diffs against.
For stock Mailman, whose footer then becomes an extra MIME part instead of
re-encoding the body. A message whose arrival snapshot could not be kept (an
upstream instance that does not match) is not wrapped. Adds
C<X-DKIM2-Info: action=wrap-single-part;>.

=item B<--use-epilogue>

When computing a diff-based MI, always store the previous message body in
the MIME epilogue rather than as inline diff lines.  This keeps MI headers
small regardless of how much the body changed, at the cost of increasing
the transmitted message size.  Cannot be combined with C<--epilogue-threshold>.

=item B<--epilogue-threshold> I<N>

When computing a diff-based MI, switch to epilogue storage only when the
diff recipe would contain more than I<N> literal (non-range) lines.  Small
changes (C<< <= N >> lines) stay as a compact inline diff; large changes
fall back to epilogue.  C<5> is a reasonable starting value.
Cannot be combined with C<--use-epilogue>.

=item B<--max-recipe-literals> I<N>

Without either epilogue option, a diff-based MI whose body recipe would
need more than I<N> literal lines (default 1000) gets a null body recipe
instead: the previous body is declared unrecoverable rather than carried
in the header.  Cannot be combined with the epilogue options.

=item B<--dns-json> I<PATH>

Path to a JSON file with DNS key records (for testing without real DNS).
Format: C<< { "domain": { "selector._domainkey": [["txt", "v=DKIM1; ..."]] } } >>.

=item B<--verify>, B<--no-verify>

Enable or disable verification.  Default: enabled.

=item B<--sign>, B<--no-sign>

Enable or disable signing.  Default: enabled if signing config is available.

=item B<--help>, B<-h>

Show this help message.

=back

=head1 POSTFIX CONFIGURATION

Add to C<main.cf>:

    # For inbound verification
    smtpd_milters = unix:/var/run/dkim2-milter.sock

    # For outbound signing (locally-generated mail)
    non_smtpd_milters = unix:/var/run/dkim2-milter.sock

    # Milter default action if the milter is unavailable
    milter_default_action = accept

=head1 DEPENDENCIES

Requires L<Sendmail::PMilter> 1.28 or later, a recommended (not required)
dependency of the Mail-DKIM2 distribution:

    cpanm Sendmail::PMilter

1.28 (July 2026) is the first release that answers a null-sender
C<MAIL FROM:E<lt>E<gt>>; with 1.27 the MTA waited out its milter timeout
and bounces went out unsigned. This program refuses to start with an older
version. C<deploy/smoke-null-sender-milter.pl> in the interop repository
checks a running milter answers a null sender.

=head1 AUTHOR

Bron Gondwana E<lt>brong@fastmailteam.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2025 Fastmail Pty Ltd.  This is free software; you can
redistribute it and/or modify it under the same terms as Perl itself.

=cut
