#!/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(
    extract_mi_version
    strip_mi_versions
    parse_mime
    DKIM2_DRAFT
    DKIM2_REPO
    DKIM2_DATE
);
use Mail::DKIM2::Address qw(from_refusal_note);
use Mail::DKIM2::Canon qw(should_skip);
use Mail::DKIM2::Fold qw(fold_header);
use Mail::DKIM2::Key qw(parse_dkim_pubkey load_private_key);
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::Hop;
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',
    'parent-from=s@',
    'algorithm|a=s',
    'snapshot-dir=s',
    'dns-json=s',
    'allow-null-body-recipe',
    'max-recipe-literals=i',
    'wrap-single-part',
    'no-envelope-check',
    'help|h',
) or pod2usage(2);

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

if (defined $opts{'max-recipe-literals'} && $opts{'max-recipe-literals'} < 0) {
    die "--max-recipe-literals must not be negative\n";
}
# Retired in 0.29 (-09 contract E2): this hop's own null body Recipe is
# always signed. Still accepted so an existing unit file starts.
warn "dkim2-milter: --allow-null-body-recipe is deprecated and does nothing: "
   . "an unsigned null body Recipe is always signed (Mail::DKIM2 0.29)\n"
    if $opts{'allow-null-body-recipe'};

$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';
# -09 section 14.4: the envelope must match the top signature. Only where the
# transaction is the one the message arrived in: in --mode both it is the
# outgoing one.
my $check_envelope = $opts{mode} eq 'inbound' && !$opts{'no-envelope-check'};

# 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 (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 ---

# The parent From domains a keydir domain may sign for (-09 contract E3.4):
# <keydir>/<domain>/parent-from, one domain per line, "#" comments. None
# when the file is absent.
sub _read_parent_from {
    my ($file) = @_;
    open my $fh, '<', $file or return [];
    my @d = map { s/#.*//r =~ s/\A\s+|\s+\z//gr } <$fh>;
    close $fh;
    return [ grep { length } @d ];
}

# 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,
                        parent_from => _read_parent_from("$dir/parent-from"),
                    };
                    # 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) = @_;
    my $priv = $ctx->getpriv;
    $priv->{verify} = _start_verify($priv) if $do_verify;
    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;
    _feed_verify($priv->{verify}, $chunk) if $priv->{verify};
    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);

    # X-DKIM2-Exploded: a list manager on this host (Mailman, Sympa) marks each
    # distribution copy, asking the signer for the -08 "exploded" flag. Only
    # a signing milter acts on it, and it never leaves: removed before signing.
    $priv->{exploded} = _strip_exploded_header($ctx, $priv, \$message) if $do_sign;
    # A List-Id says the same without being asked: a list sent this copy,
    # and a list sends copies to more than one address. That covers a list
    # manager that adds no hint (stock Mailman). The Signer drops the flag
    # from a first signature (-09 section 12.5), so an unsigned post the
    # list originates as i=1 is unaffected.
    $priv->{exploded} ||= 1
        if $do_sign && substr($message, 0, index($message, "\r\n\r\n") + 2) =~ /^List-Id[ \t]*:/mi;

    # 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) {
        # Started at the end of the headers; should no eoh have come, here.
        $verify_result = _finish_verify($priv->{verify} // do {
            my $state = _start_verify($priv);
            _feed_verify($state, $priv->{body});
            $state;
        });
        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=" . _ar_result($result);
        my $info_value = _dkim2_info("verify=" . _ar_result($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 {
                    my $why;
                    ($wrap, $why) = wrap_single_part($arrival);
                    warn "dkim2-milter: not wrapping $msgid: $why\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. -08
        # §14'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). A null body Recipe on an UNSIGNED instance (no
        # upstream signature has its m=: a null this hop is introducing) is
        # signed; one that arrived signed fails the upstream verification
        # and is refused (-09 contract E2).
        # 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, Outbound => 1,
                                (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) : ()),
                ($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};

        # -09 section 13: a message that carries DKIM2 header fields but is
        # not one this hop can sign MUST NOT be sent on -- so a refusal of a
        # message with an upstream DKIM2-Signature is a 550 5.7.1 with the
        # reason (section 13.3). One with no signature (only instances this
        # host's list manager added, which are removed) goes on unsigned.
        if ($gate->{reason}
            && grep { lc $_->[0] eq 'dkim2-signature' } @{$priv->{headers}}) {
            warn "dkim2-milter: not signing $msgid: $gate->{message} (rejected 550 5.7.1)\n";
            return _reject($ctx, "not signing: $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=$gate->{reason}")), 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, $sign_why) = _do_sign($sign_msg, $priv, $sign_config);
            # A list posting domain that is not the signing domain (or below
            # it) has every rewritten post refused here: say which two.
            warn "dkim2-milter: $msgid: "
               . from_refusal_note($sign_config->{domain},
                     map { $_->[1] } grep { lc $_->[0] eq 'from' } @{$priv->{headers}}) . "\n"
                if !$sig_header && ($sign_why // '') =~ /From header field is not Authentic/;
            # As for a gate refusal: with an upstream DKIM2-Signature on it
            # (and this hop's change unsigned) the message is not sent on.
            return _reject($ctx, "not signing: $sign_why")
                if !$sig_header
                && grep { lc $_->[0] eq 'dkim2-signature' } @{$priv->{headers}};
            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).
                # Last index first, so each index still counts the fields
                # as received.
                if ($mi_info{strip_mi_versions}) {
                    my %gone = map { $_ => 1 } @{$mi_info{strip_mi_versions}};
                    my ($count, @del) = (0);
                    for my $hdr (@{$priv->{headers}}) {
                        next unless lc($hdr->[0]) eq 'message-instance';
                        $count++;
                        my $v = extract_mi_version($hdr->[1] =~ s/^\s+//r) // 0;
                        push @del, [$count, $v] if $gone{$v};
                    }
                    for my $d (reverse @del) {
                        $ctx->chgheader('Message-Instance', $d->[0], '');
                        warn "dkim2-milter: deleted " . ($mi_info{restart} ? 'unsigned' : 'broken')
                           . " MI m=$d->[1] 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', $mi_info{restart}
                        ? _dkim2_info("restarted-unsigned-mi=$stripped_str")
                        : _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 this hop's own null body
                # Recipe (an unsigned one, our own diff's included: the gate
                # sees this hop's instance as unsigned too). The message
                # will PERMERROR downstream, but our header changes are signed.
                $ctx->insheader('X-DKIM2-Info',
                    _milter_value(_dkim2_info("null-body-recipe")), 0)
                    if $gate->{unsigned_null};
            }
        }
    }

    return SMFIS_CONTINUE;
}

# Refuse the message with 550 5.7.1 and $reason as the reply text (-08
# section 13.3), one line, with sendmail's "%" expansion escaped.
sub _reject {
    my ($ctx, $reason) = @_;
    (my $text = $reason // 'not signing') =~ s/[\r\n]+/ /g;
    $text =~ s/%/%%/g;
    $text = substr($text, 0, 900) if length $text > 900;
    $ctx->setreply('550', '5.7.1', $text);
    return SMFIS_REJECT;
}

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},
            parent_from => [ @{ $opts{'parent-from'} || [] } ],
        };
    }

    # 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.
# The Domain Policy Record (-09 section 3.8) for the gate's Verifier, from
# --dns-json's records for the domains it lists, else DNS. Nothing without
# --dns-json: the Verifier then uses DNS. (The Signer never looks it up:
# --parent-from / the keydir parent-from file, contract E3.4.)
sub _policy_cb {
    return unless $dns_data;
    return (PolicyCallback => sub {
        my ($dom, $who) = @_;
        return [ map { $_->[1] } @{ $dns_data->{$dom}{_domainkey} || [] } ]
            if $dns_data->{$dom};
        return $who->fetch_domain_policy($dom);
    });
}

sub _gate_pubkey_cb {
    return unless $dns_data;
    return (_policy_cb(), 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
    });
}

# Verification runs as the message arrives: the Verifier gets the header
# fields at the end of the headers -- and sends for every signature's key
# then, so the answers come back while the body is still arriving -- then
# each body chunk, and its verdict at the end of the message. The fields
# are the message's less any X-DKIM2-Snapshot, which cb_eom strips.
#
# Fail closed: a verifier exception, at any step, is reported as temperror
# (never pass) and logged at the end, rather than killing the callback.
# A verdict ("fail (FAIL: ...)") as Authentication-Results carries it: the
# result word, then the detail as an RFC 5322 comment. The detail quotes
# signature fields (a bad i= or m= value, as written), so it is cut to
# printable ASCII, its "\", "(" and ")" quoted, and kept short: a crafted
# i= must not close the comment and add properties of its own.
sub _ar_result {
    my ($verdict) = @_;
    my ($word, $detail) = ($verdict // '') =~ /\A([a-z]+)(?: \((.*)\))?\z/s
        or return 'temperror (unreadable verdict)';
    return $word unless defined $detail && length $detail;
    $detail =~ s/[^\x20-\x7e]//g;
    $detail = substr($detail, 0, 200) . '...' if length $detail > 200;
    $detail =~ s/([\\()])/\\$1/g;
    return "$word ($detail)";
}

sub _start_verify {
    my ($priv) = @_;
    my $raw_hdrs = $priv->{raw_hdrs};
    my $state = {};
    eval {
        my $verifier = Mail::DKIM2::Verifier->new($check_envelope ? (
            MailFrom => '<' . ($priv->{env_from} // '') . '>',
            RcptTo   => [ map { "<$_>" } @{ $priv->{env_rcpt} || [] } ],
        ) : ());
        my %cb = _gate_pubkey_cb();
        $verifier->set_pubkey_callback($cb{PubkeyCallback}) if $cb{PubkeyCallback};
        $state->{verifier} = $verifier;
        $verifier->PRINT(join('', grep { !/\AX-DKIM2-Snapshot[ \t]*:/i } @$raw_hdrs)
                         . "\015\012");
        1;
    } or $state->{error} = $@;
    return $state;
}

sub _feed_verify {
    my ($state, $chunk) = @_;
    return if defined $state->{error} || $state->{verifier}->stopped;
    eval { $state->{verifier}->PRINT($chunk); 1 } or $state->{error} = $@;
}

sub _finish_verify {
    my ($state) = @_;
    unless (defined $state->{error}) {
        eval { $state->{verifier}->CLOSE(); 1 } or $state->{error} = $@;
    }
    if (defined $state->{error}) {
        warn "dkim2-milter: verify failed with an internal error: "
           . _error_text($state->{error}) . "\n";
        return 'temperror (internal error)';
    }
    return $state->{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.
#   Outbound => 1           the instance the signer is about to sign. On a
#                           message with no DKIM2-Signature, every instance is
#                           this host's own and unsigned, and the copy leaves
#                           with ONE m=1 (-09 section 12.1): hashes of what is
#                           sent, Recipes back to the message as it arrived.
#                           $info->{restart} then lists the instances that
#                           go (in $info->{strip_mi_versions} too).
# 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;

    # Which instance, if any, and over what: Mail::DKIM2::Hop decides.
    my $next = Mail::DKIM2::Hop->next_instance($message, %mi_opts,
        map { defined $o{$_} ? ($_ => $o{$_}) : () } qw(Snapshot Outbound));
    $info->{matched} = 1 if $next->{matched};
    if (@{ $next->{removed} }) {
        $info->{strip_mi_versions} = $next->{removed};
        $info->{restart} = $next->{removed} if $next->{restart};
    }
    warn "dkim2-milter: $next->{detail}\n"
        if $next->{reason} !~ /\A(?:unchanged|first|changed)\z/ || @{ $next->{removed} };
    return $next->{instance} ? $next->{instance}->as_header_value : 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) = @_;
    return _strip_header($ctx, $priv, $message_ref, 'X-DKIM2-Snapshot');
}

# Remove every X-DKIM2-Exploded field, as above. True if there was one: the
# -07 contract makes its presence, whatever its value, the request.
sub _strip_exploded_header {
    my ($ctx, $priv, $message_ref) = @_;
    my @values = _strip_header($ctx, $priv, $message_ref, 'X-DKIM2-Exploded');
    return @values ? 1 : 0;
}

# Remove every $name 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 values that were there, trimmed.
sub _strip_header {
    my ($ctx, $priv, $message_ref, $name) = @_;
    my @val = map { $_->[1] =~ s/^\s+|\s+$//gr }
              grep { lc $_->[0] eq lc $name } @{$priv->{headers}};
    return () unless @val;
    $ctx->chgheader($name, $_, '') for reverse 1 .. @val;
    my $sep = index($$message_ref, "\015\012\015\012");
    if ($sep >= 0) {
        my $head = substr($$message_ref, 0, $sep + 2);
        $head =~ s/^\Q$name\E[ \t]*:[^\r\n]*\r\n(?:[ \t][^\r\n]*\r\n)*//mig;
        substr($$message_ref, 0, $sep + 2) = $head;
    }
    return @val;
}

# 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},
            ($priv->{exploded} ? (Exploded => 1) : ()),
            # -09 contract E3.4: a d= below the From domain signs only for
            # a parent the configuration lists; no DNS lookup.
            ParentFromCallback => Mail::DKIM2::Address::parent_from_matcher(
                @{ $config->{parent_from} || [] }),
        );
        $signer->PRINT($message);
        $signer->CLOSE();
        1;
    };
    unless ($ok) {
        my $why = "internal error in the signer: " . _error_text($@);
        warn "dkim2-milter: not signing: $why\n";
        return (undef, $why);
    }

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

    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

    # 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

When signing, a message carrying an C<X-DKIM2-Exploded> header field (any
value; Mailman and Sympa add C<X-DKIM2-Exploded: yes> to every
distribution copy) is signed with the C<exploded> flag (-09 section 12.5),
which a signature also gets whenever the message has a C<List-Id> header
field (a list sent it, whether or not the list manager added the hint) or
more than one recipient; never at C<i=1>. The C<X-DKIM2-Exploded> field is
removed from the message before it is signed and never leaves.

When the signing gate (L<Mail::DKIM2::Gate>) refuses a message that carries
an upstream DKIM2-Signature, the milter rejects it with C<550 5.7.1> and the
reason (-09 sections 13.1 and 13.3: a message with DKIM2 header fields that
is not Fully Verified must not be sent on). A refused message with no
signature goes on unsigned, the Message-Instances this host added removed.
The same goes for a message the Signer refuses, such as one whose From is
not Authentic for the signing domain (-09 section 11). New in 0.23;
before, every refused message went on.

This program implements draft-ietf-dkim-dkim2-spec-09; 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>.

A domain's subdirectory may hold a file C<parent-from>: the parent domains
(one per line, C<#> comments) whose From that domain may sign for, as
C<--parent-from> does in single-domain mode.

=item B<--parent-from> I<DOMAIN>

Repeatable, single-domain mode. A parent of the signing domain whose From
it may make Authentic (draft -09 sections 7.1 item 4 and 11.1, new in 0.29):
with C<--domain mail.example.org --parent-from example.org> a post from
C<a@example.org> is signed. Without it such a message is refused (From not
Authentic), and the milter makes no DNS lookup for it: a parent that does
not want this publishes C<v=DKIM1; f=strict>, which verifiers enforce, so
list only parents that allow it.

=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 Unsigned posts leave with one m=1

A message with no DKIM2-Signature (an unsigned post the inbound milter
stamped C<m=1>, perhaps a C<--wrap-single-part> C<m=2> or a list manager's
instance over it) is signed with B<one> Message-Instance, C<m=1> (-08
section 12.1): the hashes of the copy sent and Recipes back to the post as
it arrived, a From munge included. The instances it carried are removed,
with C<X-DKIM2-Info: action=restarted-unsigned-mi=m=1,...;>. The post as it
arrived comes from those instances when the top one matches the content,
else from the snapshot; a chain that does not undo cleanly gets no
instance and the message is not signed. The From sent must still be
Authentic for the signing domain (-09 section 11): without a From munge an
outside author's post goes out unsigned. A post that arrived signed is
extended with C<m=N+1> as before.

=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>

Deprecated in 0.29 and does nothing beyond a warning at startup. A
Message-Instance with a null body Recipe that no upstream DKIM2-Signature
covers (a null this host is introducing) is always signed: the message will
be a PERMERROR at every verifier (draft -09 sections 13 and 14.2), but the
header changes this host made are signed.  The milter then adds the
informational C<X-DKIM2-Info: action=null-body-recipe;>.  A null that
arrived already signed fails the upstream verification and is refused like
any broken upstream chain.

=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<--no-envelope-check>

Inbound mode checks the SMTP envelope against the top DKIM2-Signature (-09
section 14.4): MAIL FROM must equal its C<mf=> and every RCPT TO must be in
its C<rt=>, or the result is C<fail>. Turn that off for a milter on an
internal hop, after an earlier one has checked the envelope the message
arrived with and the MTA may have rewritten it since (the wrap milter behind
port 25, say). The other modes never check: there the transaction is the
outgoing one.

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

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.

=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
