package Amavis::DKIM;
use strict;
use re 'taint';
use warnings;
use warnings FATAL => qw(utf8 void);
no warnings 'uninitialized';
# use warnings 'extra'; no warnings 'experimental::re_strict'; use re 'strict';

BEGIN {
  require Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
  $VERSION = '2.412';
  @ISA = qw(Exporter);
  @EXPORT_OK = qw(&dkim_key_postprocess &generate_authentication_results
                  &dkim_make_signatures &adjust_score_by_signer_reputation
                  &collect_some_dkim_info);
}
use subs @EXPORT_OK;

use IO::File ();
use Crypt::OpenSSL::RSA ();
use MIME::Base64;
use Net::DNS::Resolver;
use Mail::DKIM::Verifier 0.31;
use Mail::DKIM::Signer   0.31;
use Mail::DKIM::TextWrap;
use Mail::DKIM::Signature;
use Mail::DKIM::DkSignature;

use Amavis::Conf qw(:platform c cr ca $myproduct_name
                    %dkim_signing_keys_by_domain
                    @dkim_signing_keys_list @dkim_signing_keys_storage);
use Amavis::DKIM::CustomSigner;
use Amavis::IO::RW;
use Amavis::Lookup qw(lookup lookup2);
use Amavis::rfc2821_2822_Tools qw(split_address quote_rfc2821_local
                                  qquote_rfc2821_local);
use Amavis::Timing qw(section_time);
use Amavis::Util qw(min max minmax untaint ll do_log unique_list
                    format_time_interval get_deadline
                    idn_to_ascii mail_addr_idn_to_ascii idn_to_utf8
                    safe_encode_utf8 proto_encode proto_decode);

# Convert private keys (as strings in PEM format) into RSA objects
# and do some pre-processing on @dkim_signing_keys_list entries
# (may run unprivileged)
#
sub dkim_key_postprocess() {
  # convert private keys (as strings in PEM format) into RSA objects
  for my $ks (@dkim_signing_keys_storage) {
    my($pkcs1,$dev,$inode,$fname) = @$ks;
    if (ref $pkcs1 && UNIVERSAL::isa($pkcs1,'Crypt::OpenSSL::RSA')) {
      # it is already a Crypt::OpenSSL::RSA object
    } else {
      # assume a string is a private key in PEM format, convert it to RSA obj
      $ks->[0] = $pkcs1 = Crypt::OpenSSL::RSA->new_private_key($pkcs1);
    }
    my $key_size = 8 * $pkcs1->size;
    my $minimum_key_bits = c('dkim_minimum_key_bits');
    if ($key_size < 1024) {
      do_log(0,"NOTE: DKIM %d-bit signing key is shorter than ".
               "a recommended RFC 6376 minimum of %d bits, file: %s",
               $key_size, 1024, $fname);
    } elsif ($minimum_key_bits && $key_size < $minimum_key_bits) {
      do_log(0,"INFO: DKIM %d-bit signing key is shorter than ".
               "a configured \$dkim_minimum_key_bits of %d bits, file: %s",
               $key_size, $minimum_key_bits, $fname);
    }
  }
  for my $ent (@dkim_signing_keys_list) {
    my $domain = $ent->{domain};
    $dkim_signing_keys_by_domain{$domain} = []
      if !$dkim_signing_keys_by_domain{$domain};
  }
  my $any_wild; my $j = 0;
  for my $ent (@dkim_signing_keys_list) {
    $ent->{v} = 'DKIM1'  if !defined $ent->{v};  # provide a default
    if (defined $ent->{n}) {  # encode n as qp-section (RFC 6376, RFC 2047)
      $ent->{n} =~ s{([\000-\037\177=;"])}{sprintf('=%02X',ord($1))}gse;
    }
    my $domain = $ent->{domain};
    if (exists $ent->{g}) {
      do_log(0,"INFO: the 'g' tag is historic (RFC 6376), signers are ".
               "advised not to include a 'g' tag in key records: ".
               "s=%s d=%s g=%s", $ent->{selector}, $domain, $ent->{g});
    }
    if (ref($domain) eq 'Regexp') {
      $ent->{domain_re} = $domain;
      $any_wild = sprintf("key#%d, %s", $j+1, $domain)  if !defined $any_wild;
    } elsif ($domain =~ /\*/) {
      # wildcarded signing domain in a key declaration, evil, asks for trouble!
      # support wildcards in signing domain for compatibility with dkim_milter
      my $regexp = $domain;
      $regexp =~ s/\*{2,}/*/gs;   # collapse successive wildcards
      # '*' is a wildcard, quote the rest
      $regexp =~ s{ ([@\#/.^\$|*+?(){}\[\]\\]) }
                  { $1 eq '*' ? '.*' : '\\'.$1 }xgse;
      $regexp = '^' . $regexp . '\\z';  # implicit anchors
      $regexp =~ s/^\^\.\*//s;    # remove leading anchor if redundant
      $regexp =~ s/\.\*\\z\z//s;  # remove trailing anchor if redundant
      $regexp = '(?:)'  if $regexp eq '';  # just in case, non-empty regexp
      # presence of {'domain_re'} entry lets get_dkim_key use this regexp
      # instead of a direct string comparison with {'domain'}
      $ent->{domain_re} = qr{$regexp};  # compiled regexp object
      $any_wild = sprintf("key#%d, %s", $j+1, $domain)  if !defined $any_wild;
    }
    # %dkim_signing_keys_by_domain entries contain lists of indices into
    # the @dkim_signing_keys_list of all potentially applicable signing keys.
    # This hash (keyed by domain name) avoids linear searching for signing
    # keys for all fully-specified domains in @dkim_signing_keys_list.
    # Wildcarded entries must still be looked up sequentially at run-time
    # to preserve the declared order and the 'first match wins' paradigm.
    # Such entries are only supported for compatibility with dkim_milter
    # and are evil because amavisd has no quick way of verifying that DNS RR
    # really exists, so signatures generated by amavisd can fail when not all
    # possible DNS resource records exist for wildcarded signing domains.
    #
    if (!defined($ent->{domain_re})) { # no regexp, just plain match on domain
      push(@{$dkim_signing_keys_by_domain{$domain}}, $j);
    } else {  # a wildcard in a signing domain, compatibility with dkim_milter
      # wildcarded signing domain potentially matches any _by_domain entry
      for my $d (keys %dkim_signing_keys_by_domain) {
        push(@{$dkim_signing_keys_by_domain{$d}}, $j);
      }
      # the '*' entry collects only wildcarded signing keys
      $dkim_signing_keys_by_domain{'*'} = []
        if !$dkim_signing_keys_by_domain{'*'};
      push(@{$dkim_signing_keys_by_domain{'*'}}, $j);
    }
    $j++;
  }
  do_log(0,"dkim: wildcard in signing domain (%s), may produce unverifiable ".
           "signatures with no published public key, avoid!", $any_wild)
        if $any_wild;
}

# Fetch a private DKIM signing key for a given signing domain, with its
# resource-record (RR) constraints compatible with proposed signature options.
# The first such key is returned as a hash; if no key is found an empty hash
# is returned. When a selector (s) is given it must match the selector of
# a key; when algorithm (a) is given, the key type and a hash algorithm must
# match the desired use too; the service type (s) must be 'email' or '*';
# when identity (i) is given it must match the granularity (g) of a key.
# RFC 6376: the "g=" tag has been deprecated in this version of the DKIM
# specification (and thus MUST now be ignored), signers are advised not to
# include the "g=" tag in key records.
#
# sign.opts.     key options
# ----------     -----------
#  d         =>  domain
#  s         =>  selector
#  a         =>  k, h(list)
#  i         =>  g, t=s
#
sub get_dkim_key(@) {
  @_ % 2 == 0 or die "get_dkim_key: a list of pairs is expected as query opts";
  my(%options) = @_;  # signature options (v, a, c, d, h, i, l, q, s, t, x, z),
    # of which d is required, while s, a and t are optional but taken into
    # account in searching for a compatible key - the rest are ignored
  my(%key_options);
  my $domain = $options{d}; my $selector = $options{s};
  defined $domain && $domain ne ''
    or die "get_dkim_key: domain is required, but tag 'd' is missing";
  $domain   = idn_to_ascii($domain);
  $selector = idn_to_ascii($selector)  if defined $selector;
  my(@indices) = $dkim_signing_keys_by_domain{$domain} ?
                   @{$dkim_signing_keys_by_domain{$domain}} :
                 $dkim_signing_keys_by_domain{'*'} ?
                   @{$dkim_signing_keys_by_domain{'*'}} : ();
  if (@indices) {
    $selector = $selector eq '' ? undef : lc($selector)  if defined $selector;
    local($1,$2);
    my($keytype,$hashalg) =
      defined $options{a} && $options{a} =~ /^([a-z0-9]+)-(.*)\z/is ? ($1,$2)
                                                              : ('rsa',undef);
    my($identity_localpart,$identity_domain) =
      !defined($options{i}) ? () : split_address($options{i});
    $identity_localpart = ''  if !defined $identity_localpart;
    $identity_domain    = ''  if !defined $identity_domain;
    $identity_domain =
      idn_to_ascii($identity_domain)  if $identity_domain ne '';
    # find the first key (associated with a domain) with compatible options
    for my $j (@indices) {
      my $ent = $dkim_signing_keys_list[$j];
      next unless defined $ent->{domain_re} ? $domain =~ $ent->{domain_re}
                                            : $domain eq $ent->{domain};
      next if defined $selector && $ent->{selector} ne $selector;
      next if $keytype ne (exists $ent->{k} ? $ent->{k} : 'rsa');
      next if exists $ent->{s} &&
              !(grep($_ eq '*' || $_ eq 'email', split(/:/, $ent->{s})) );
      next if defined $hashalg && exists $ent->{'h'} &&
              !(grep($_ eq $hashalg, split(/:/, $ent->{'h'})) );
      if (defined($options{i})) {
        if ($identity_domain eq $domain) {
          # ok
        } elsif (exists $ent->{t} && (grep($_ eq 's', split(/:/,$ent->{t})))) {
          next;  # no subdomains allowed
        }
        # the 'g' tag is now historic, RFC 6376
        if (!exists($ent->{g}) || $ent->{g} eq '*') {
          # ok
        } elsif ($ent->{g} =~ /^ ([^*]*) \* (.*) \z/xs) {
          next if $identity_localpart !~ /^ \Q$1\E .* \Q$2\E \z/xs;
        } else {
          next if $identity_localpart ne $ent->{g};
        }
      }
      %key_options = %$ent;  last;  # found a suitable match
    }
  }
  if (defined $key_options{key_storage_ind}) {
    # obtain actual key from @dkim_signing_keys_storage
    ($key_options{key}) =
      @{$dkim_signing_keys_storage[$key_options{key_storage_ind}]};
  }
  %key_options;
}

# send a query to a signing service, collect its response and parse it;
# the protocol is much like the AM.PDP protocol, except that attributes
# are different
#
sub query_signing_service($$) {
  my($server, $query) = @_;
  my($remaining_time, $deadline) = get_deadline('query_signing_service');
  my $sock = Amavis::IO::RW->new($server, Eol => "\015\012", Timeout => 10);
  $sock or die "Error connecting to a signing server $server: $!";
  my $req_id = sprintf("%08x", rand(0x7fffffff));
  my $req_id_attr = proto_encode('request_id', $req_id);
  $sock->print(join('', map($_."\015\012", (@$query, $req_id_attr, ''))))
    or die "Error sending a query to a signing server";
  ll(5) && do_log(5, "dkim: query_signing_service, query: %s",
                     join('; ', @$query, $req_id_attr));
  $sock->flush or die "Error flushing signing server session";
  # collect a reply
  $sock->timeout(max(2, $deadline - Time::HiRes::time));
  my(%attr,$ln); local($1,$2);
  while (defined($ln = $sock->get_response_line)) {
    last  if $ln eq "\015\012";  # end of a response block
    if ($ln =~ /^ ([^=\000\012]*?) = ([^\012]*?) \015\012 \z/xsi) {
      $attr{proto_decode($1)} = proto_decode($2);
    }
  }
  $sock->close  or die "Error closing session to a signing server $server: $!";
  ll(5) && do_log(5, "dkim: query_signing_service, got: %s",
                  join('; ', map($_.'='.$attr{$_}, keys %attr)));
  $attr{request_id} eq $req_id
    or die "Answer id '$attr{request_id}' from $server ".
           "does not match the query id '$req_id'";
  \%attr;
}

# send candidate originator addresses and signature options to a signing
# service and let it choose a selector 's' and a domain 'd', thus uniquely
# identifying a signing key
#
sub let_signing_service_choose($$$$) {
  my($server, $msginfo, $sender_search_list_ref, $sig_opt_prelim) = @_;
  my(@query) = (
    proto_encode('request', 'choose_key'),
    proto_encode('log_id',  $msginfo->log_id),
  );
  # provide some additional information potentially useful in decision-making
  if ($sig_opt_prelim) {
    for my $opt (sort keys %$sig_opt_prelim) {
      push(@query, proto_encode('sig.'.$opt, $sig_opt_prelim->{$opt}));
    }
  }
  push(@query, proto_encode('sender', $msginfo->sender_smtp));
  for my $r (@{$msginfo->per_recip_data}) {
    push(@query, proto_encode('recip', $r->recip_addr_smtp));
  }
  for my $pair (!$sender_search_list_ref ? () : @$sender_search_list_ref) {
    my($addr,$addr_src) = @$pair;
    push(@query, proto_encode('candidate', $addr_src,
                              qquote_rfc2821_local($addr)));
  }
  my $attr;
  eval {
    $attr = query_signing_service($server,\@query);  1;
  } or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    do_log(0, "query_signing_service failed: %s", $eval_stat);
  };
  my(%sig_options, $chosen_addr_src, $chosen_addr);
  if ($attr) {
    for my $opt (keys %$attr) {
      if ($opt =~ /^sig\.(.+)\z/) {
        $sig_options{$1} = $attr->{$opt}  if !exists($sig_options{$1});
      }
    }
    if (defined $attr->{chosen_candidate}) {
      ($chosen_addr_src, $chosen_addr) =
        split(' ', $attr->{chosen_candidate}, 2);
    }
  }
  (!$attr ? undef : \%sig_options,  $chosen_addr_src, $chosen_addr);
}

# a CustomSigner callback routine passed to Mail::DKIM in place of a key;
# the routine will be called by Mail::DKIM::Algorithm::*rsa_sha* routines
# instead of calling their own Mail::DKIM::PrivateKey::sign_digest()
#
sub remote_signer {
  my($digest_alg_name, $digest, %args) = @_;
  # $digest: header digest (binary), ready for signing,
  #          e.g. $algorithm->{header_digest}->digest
  my $server  = $args{Server};   # our own info passed back to us
  my $msginfo = $args{MsgInfo};  # our own info passed back to us
  my(@query) = (
    proto_encode('request', 'sign'),
    proto_encode('digest_alg', $digest_alg_name),
    proto_encode('digest', encode_base64($digest,'')),
    proto_encode('s',      $args{Selector}),
    proto_encode('d',      $args{Domain}),
    proto_encode('log_id', $msginfo->log_id),
  );
  my($attr, $b, $reason);
  eval {
    $attr = query_signing_service($server, \@query);  1;
  } or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    $reason = $eval_stat;
  };
  if ($attr) { $b = $attr->{b};  $reason = $attr->{reason} }
  if (!defined($b) || $b eq '') {
    $reason = 'no signature from a signing server'  if !defined $reason;
  # die "Can't sign, $reason, query: " . join('; ',@query) . "\n";
    do_log(0, "dkim: can't sign, %s, query: %s", $reason, join('; ',@query));
    return '';  # Mail::DKIM::Algorithm::rsa_sha256 doesn't like undef
  }
  decode_base64($b);  # resulting signature
}

# prepare requested DKIM signatures for a provided message,
# returning them as a list of Mail::DKIM::Signature objects
#
sub dkim_make_signatures($$;$) {
  my($msginfo,$initial_submission,$callback) = @_;
  my(@signatures);   # resulting signature objects
  my(%sig_options);  # signature options and constraints for choosing a key
  my(%key_options);  # options associated with a signing key, IDN as ACE
  my(@tried_domains);  # used for logging a failure
  my($chosen_addr,$chosen_addr_src); my $do_sign = 0;
  my $fm = $msginfo->rfc2822_from;  # authors
  my(@rfc2822_from) = !defined($fm) ? () : ref $fm ? @$fm : $fm;
  my $allowed_hdrs = cr('allowed_added_header_fields');
  my $from_str = join(', ', qquote_rfc2821_local(@rfc2822_from));  # logging
  substr($from_str,100) = '[...]'  if length($from_str) > 100;
  if (!$allowed_hdrs || !$allowed_hdrs->{lc('DKIM-Signature')}) {
    do_log(5, "dkim: inserting a DKIM-Signature header field disabled");
  } elsif (!$msginfo->originating) {
    do_log(5, "dkim: not signing mail which is not originating from our site");
  } elsif ($msginfo->is_in_contents_category(CC_VIRUS)) {
    do_log(2, "dkim: not signing infected mail (from inside), From: %s",
              $from_str);
  } elsif ($msginfo->is_in_contents_category(CC_SPAM)) {
    # it is prudent not to sign outgoing spam, otherwise an attacker may be
    # able to replay a signed message, re-sending it to other recipients
    # in bulk directly from botnets
    do_log(2, "dkim: not signing spam (from inside), From: %s", $from_str);
  } elsif ($msginfo->is_in_contents_category(CC_SPAMMY)) {
    do_log(2, "dkim: not signing suspected spam (from inside), From: %s",
              $from_str);
  } else {
    # Choose a signing key based on the first match on the following
    # addresses (in this order): 2822.From, followed by 2822.Resent-From and
    # 2822.Resent-Sender address pairs traversed top-down by resent blocks,
    # followed by 2822.Sender and 2821.mail_from. We choose to look up
    # a From first, as it generates an author domain signature, but the
    # search order on remaining entries is admittedly unusual.
    # Btw, dkim-milter uses the following search order:
    #   Resent-Sender, Resent-From, Sender, From.
    # Only a signature based on 2822.From is considered an author domain
    # signature, others are just third-party signatures and have no more
    # merit than any other third-party signature according to RFC 6376.
    #
    my $rf = $msginfo->rfc2822_resent_from;
    my $rs = $msginfo->rfc2822_resent_sender;
    my(@rfc2822_resent_from, @rfc2822_resent_sender);
    @rfc2822_resent_from   = @$rf  if defined $rf;
    @rfc2822_resent_sender = @$rs  if defined $rs;
    my(@search_list); # collects candidate addresses for choosing a signing key
    # author addresses go first (typically exactly one, but possibly more)
    push(@search_list, map([$_,'From'], @rfc2822_from));
    # merge Resent-From and Resent-Sender addresses by resent blocks, top-down;
    # a merge is simplified by the fact that there is an equal number of
    # resent blocks in @rfc2822_resent_from and @rfc2822_resent_sender lists
    while (@rfc2822_resent_from || @rfc2822_resent_sender) {
      # for each resent block
      while (@rfc2822_resent_from) {
        my $addr = shift(@rfc2822_resent_from);
        last  if !defined $addr;  # undef delimits resent blocks
        push(@search_list, [$addr, 'Resent-From']);
      }
      while (@rfc2822_resent_sender) {
        my $addr = shift(@rfc2822_resent_sender);
        last  if !defined $addr;  # undef delimits resent blocks
        push(@search_list, [$addr, 'Resent-Sender']);
      }
    }
    push(@search_list, [$msginfo->rfc2822_sender, 'Sender']);
    push(@search_list, [$msginfo->sender,      'mail_from']);
    { # remove duplicates and empty addresses
      my(%addr_seen);
      @search_list =
        grep { my($a,$src) = @$_; defined $a && $a ne '' && !$addr_seen{$a}++ }
             @search_list;
    }
    ll(2) && do_log(2, "dkim: candidate originators: %s",
                    join(", ", map($_->[1].':'.qquote_rfc2821_local($_->[0]),
                                   @search_list)));

    # dkim_signwith_sd() may provide a ref to a pair [selector,domain] - if
    # available (e.g. by a custom hook), it will force signing with a private
    # key associated with this selector and domain, otherwise we fall back
    # to consulting an external service if available, or else we use our
    # built-in algorithm for choosing a selector & domain and their associated
    # signing key
    #
    my $sd_pair = $msginfo->dkim_signwith_sd;
    if (ref($sd_pair) eq 'ARRAY') {
      my($s,$d) = @$sd_pair;
      if (defined $s && $s ne '' && defined $d && $d ne '') {
        do_log(5, "dkim: dkim_signwith_sd presets d=%s, s=%s", $d,$s);
        $sig_options{s} = $s; $sig_options{d} = $d;
      }
    }

    my $dkim_signing_service = c('dkim_signing_service');
    if (defined $dkim_signing_service && $dkim_signing_service ne '') {
      # try the signing service: it should provide an 's' and 'd' if it has
      # a suitable signing key available, and/or may supply signing options,
      # overriding the defaults set so far
      my $sig_opt_ref;
      ($sig_opt_ref, $chosen_addr_src, $chosen_addr) =
        let_signing_service_choose($dkim_signing_service,
                                   $msginfo, \@search_list, undef);
      if ($sig_opt_ref) {  # merge returned signature options with ours
        while (my($k,$v) = each(%$sig_opt_ref)) {
          $sig_options{$k} = $v  if defined $v;
        }
      }
    }

    my $sobm = ca('dkim_signature_options_bysender_maps');
    # last resort: fall back to our local configuration settings
    for my $pair (@search_list) {
      my($addr,$addr_src) = @$pair;
      my($addr_localpart,$addr_domain) = split_address($addr);
      # fetch a list of hashes from all entries matching the address
      my($dkim_options_ref,$mk_ref);
      ($dkim_options_ref,$mk_ref) = lookup2(1,$addr,$sobm)  if $sobm && @$sobm;
      $dkim_options_ref = []  if !defined $dkim_options_ref;
      # signature options (parenthesized options are set automatically;
      # the RFC 6651 (failure reporting) added a tag: r=y) :
      #   (v), a, (b), (bh), c, d, (h), i, (l), q, r, s, (t), x, (z)
      # place a catchall default at the end of the list of options;
      push(@$dkim_options_ref, { c => 'relaxed/simple', a => 'rsa-sha256' });
      # start each iteration with the same set of options collected so far
      my(%tmp_sig_options) = %sig_options;
      # traverse list of hashes from specific to general, first match wins
      for my $opts_hash_ref (@$dkim_options_ref) {
        next  if ref $opts_hash_ref ne 'HASH';  # just in case
        while (my($k,$v) = each(%$opts_hash_ref)) {  # for each entry in a hash
          $tmp_sig_options{$k} = $v  if !exists $tmp_sig_options{$k};
        }
      }
      # a default for a signing domain is a domain of each tried address
      if (!exists($tmp_sig_options{d})) {
        my $d = $addr_domain; $d =~ s/^\@//; $tmp_sig_options{d} = $d;
      }
      push(@tried_domains, $tmp_sig_options{d});
      ll(5) && do_log(5, "dkim: signature options for %s(%s): %s",
                      $addr, $addr_src,
                      join('; ', map($_.'='.$tmp_sig_options{$_},
                                     keys %tmp_sig_options)));

      # find a private key associated with a signing domain and selector,
      # and meeting constraints
      %key_options = get_dkim_key(%tmp_sig_options)
        if defined $tmp_sig_options{d} && $tmp_sig_options{d} ne '';
    # my(@domain_path); # host.sub.example.com sub.example.com example.com com
    # $addr_domain =~ s/^\@//; $addr_domain =~ s/\.\z//;
    # if ($addr_domain !~ /\[/) {  # don't split address literals
    #   for (my $d=$addr_domain; $d ne ''; $d =~ s/^[^.]*(?:\.|\z)//s)
    #     { push(@domain_path,$d) }
    # }
    # for my $d (@domain_path) {
    #   $tmp_sig_options{d} = $d;
    #   %key_options = get_dkim_key(%tmp_sig_options);
    #   last  if defined $key_options{key};
    # }
      my $key = $key_options{key};
      if (defined $key && $key ne '') {  # found; copy the key and its options
        $tmp_sig_options{key} = $key;
        $tmp_sig_options{s} = idn_to_utf8($key_options{selector});
        $chosen_addr = $addr; $chosen_addr_src = $addr_src;
        # merge the just collected signature options into the final set
        while (my($k,$v) = each(%tmp_sig_options)) {
          $sig_options{$k} = $v  if defined $v;
        }
        last;
      }
    }

    # provide defaults for 'c' and 'a' tags if missing
    $sig_options{c} = 'relaxed/simple'  if !exists $sig_options{c};
    $sig_options{a} = 'rsa-sha256'      if !exists $sig_options{a};

    # prepare for a second stage of using an external signing service:
    # when we do have a 's' and 'd', thus uniquely identifying a signing key,
    # but do not have a key ourselves, we'll provide a callback routine
    # in place of a key object so that Mail::DKIM will call it at the time
    # of signing, and our routine will consult a remote signing service
    #
    if (!defined $sig_options{key} &&
        defined $dkim_signing_service && $dkim_signing_service ne '' &&
        defined $sig_options{d} && $sig_options{d} ne '' &&
        defined $sig_options{s} && $sig_options{s} ne '') {
      my $s = $sig_options{s};  my $d = $sig_options{d};
      # let Mail::DKIM use our custom code for signing (pref. 0.38 or later)
      $key_options{key} = Amavis::DKIM::CustomSigner->new(
           CustomSigner => \&remote_signer, MsgInfo => $msginfo,
           Selector => idn_to_ascii($s),
           Domain => idn_to_ascii($d),
           Server => $dkim_signing_service);
      $key_options{selector} = $s;  $key_options{domain} = $d;
      $sig_options{key} = $key_options{key};
    }

    my $sig_opt_d_ace = idn_to_ascii($sig_options{d});
    if (!defined $sig_opt_d_ace || $sig_opt_d_ace eq '') {
      do_log(2, "dkim: not signing, empty signing domain, From: %s",$from_str);
    } elsif (!defined $sig_options{key} || $sig_options{key} eq '') {
      do_log(2, "dkim: not signing, no applicable private key for domains %s,".
                " s=%s, From: %s",
                join(", ",@tried_domains), $sig_options{s}, $from_str);
    } else {
      # copy key's options to signature options for convenience
      for (keys %key_options) {
        $sig_options{'KEY.'.$_} = $key_options{$_}  if /^[ghknst]\z/;
      }
      $sig_options{'KEY.key_ind'} = $key_options{key_ind};

      # check matching of identity to a signing domain or provide a default;
      # presence of a t=s flag in a public key RR prohibits subdomains in i
      my $key_allows_subdomains =
        grep($_ eq 's', split(/:/,$sig_options{'KEY.t'})) ? 0 : 1;
      if (defined $sig_options{i}) {  # explicitly given, possibly empty
        # have mercy: provide a leading '@' if missing
        $sig_options{i} = '@'.$sig_options{i}  if $sig_options{i} ne '' &&
                                                  $sig_options{i} !~ /\@/;
      } elsif (!$key_allows_subdomains) {
        # we have no other choice but to keep it at its default @d
      } else {  # the public key record permits subdomains
        # provide default for i in a form of a sender's domain
        local($1);
        if ($chosen_addr =~ /\@([^\@]*)\z/) {
          my $identity_domain = $1;
          if (idn_to_ascii($identity_domain) =~ /.\.\Q$sig_opt_d_ace\E\z/s) {
            $sig_options{i} = '@'.$identity_domain;
            do_log(5, "dkim: identity defaults to %s", $sig_options{i});
          }
        }
      }
      if (!defined $sig_options{i} || $sig_options{i} eq '') {
        $do_sign = 1;  # just sign, don't bother with i
      } else {  # check if the requested i is compatible with d
        local($1);
        my $identity_domain = $sig_options{i} =~ /\@([^\@]*)\z/ ? $1 : '';
        my $identity_domain_ace = idn_to_ascii($identity_domain);
        if (!$key_allows_subdomains && $identity_domain_ace ne $sig_opt_d_ace){
          do_log(2, "dkim: not signing, identity domain %s not the same as ".
                    "a signing domain %s, flags t=%s, From: %s",
                    $sig_options{i}, $sig_options{d}, $sig_options{'KEY.t'},
                    $from_str);
        } elsif ($key_allows_subdomains &&
                 $identity_domain_ace !~ /(?:^|\.)\Q$sig_opt_d_ace\E\z/i) {
          do_log(2, "dkim: not signing, identity %s not a subdomain of %s, ".
                    "From: %s", $sig_options{i}, $sig_options{d}, $from_str);
        } else {
          $do_sign = 1;
        }
      }
    }
  }
  my $sig_opt_d_ace = idn_to_ascii($sig_options{d});
  if ($do_sign) {  # avoid adding same signature on multiple passes through MTA
    my $sigs_ref = $msginfo->dkim_signatures_valid;
    if ($sigs_ref) {
      for my $sig (@$sigs_ref) {
        if ( idn_to_ascii($sig->domain) eq $sig_opt_d_ace &&
             (!defined $sig_options{i} || $sig_options{i} eq $sig->identity)) {
          do_log(2, "dkim: not signing, already signed by domain %s, ".
                    "From: %s", $sig_opt_d_ace, $from_str);
          $do_sign = 0;
        }
      }
    }
  }
  if ($do_sign) {
    # relative expiration time
    if (defined $sig_options{ttl} && $sig_options{ttl} > 0) {
      my $xt = $msginfo->rx_time + $sig_options{ttl};
      $sig_options{x} = int($xt) + ($xt > int($xt) ? 1 : 0);  # ceiling
    }
    # remove redundant options with RFC 6376 -default values
    for my $k (keys %sig_options) { delete $sig_options{$k} if !defined $k }
    delete $sig_options{i}  if $sig_options{i} =~ /^\@/ &&
                          idn_to_ascii($sig_options{i}) eq '@'.$sig_opt_d_ace;
    delete $sig_options{c}  if $sig_options{c} eq 'simple/simple' ||
                               $sig_options{c} eq 'simple';
    delete $sig_options{q}  if $sig_options{q} eq 'dns/txt';
    if (ref $callback eq 'CODE') { &$callback($msginfo,\%sig_options) }
    if (ll(2)) {
      my $opts = join(', ',map($_ eq 'key' ? ()
                            : ($_ . '=>' . safe_encode_utf8($sig_options{$_})),
                               sort keys %sig_options));
      do_log(2,"dkim: signing (%s), From: %s (%s:%s), %s",
               grep(/\@\Q$sig_opt_d_ace\E\z/si,
                    map(mail_addr_idn_to_ascii($_), @rfc2822_from))
                 ? 'author' : '3rd-party',
               $from_str, $chosen_addr_src, qquote_rfc2821_local($chosen_addr),
               $opts);
    }
    my $key = $sig_options{key};
    if (UNIVERSAL::isa($key,'Crypt::OpenSSL::RSA')) {
      # my $pkcs1 = $key->get_private_key_string;  # most compact
      # $pkcs1 =~ s/^---.*?---(?:\r?\n|\z)//gm;  $pkcs1 =~ tr/\r\n//d;
      # $key = Mail::DKIM::PrivateKey->load(Data => $pkcs1);
      $key = Mail::DKIM::PrivateKey->load(Cork => $key);  # avail since 0.31
    } elsif (ref $key) {
      # already a Mail::DKIM::PrivateKey or Amavis::DKIM::CustomSigner object
    } else {
      $key = Mail::DKIM::PrivateKey->load(File => $key);  # read from a file
    }

    # Sendmail milter interface does not provide a just-generated Received
    # header field to milters. Milters therefore need to fabricate a pseudo
    # Received header field in order to provide client IP address to a filter.
    # Unfortunately it is not possible to reliably fabricate a header field
    # which will exactly match the later-inserted one, so we must not sign
    # it to avoid a likely possibility of a signature being invalidated.
    my $conn = $msginfo->conn_obj;
    my $appl_proto = !$conn ? undef : $conn->appl_proto;
    my $skip_topmost_received = defined($appl_proto) &&
                           ($appl_proto eq 'AM.PDP' || $appl_proto eq 'AM.CL');
    my $policyfn = sub {
      my $dkim = $_[0];
      my $signed_header_fields_ref = cr('signed_header_fields') || {};
      my $hfn = $dkim->{header_field_names};
      my(@field_names_to_be_signed);
      #
      # when $signed_header_fields_ref->{$nm} is greater than 1 it indicates
      # that one surplus occurrence of a header filed name in an 'h' tag
      # should be inserted, consequently prohibiting further instances of
      # such header field to be added to a message header section without
      # breaking a signature; useful for example for a From and Subject
      #
      if ($hfn) {
        my(%hfn_cnt);
        $hfn_cnt{lc $_}++  for @$hfn;
        for (@$hfn) {
          my $nm = lc($_);
          push(@field_names_to_be_signed, $nm);  $hfn_cnt{$nm}--;
          if (!$hfn_cnt{$nm} && $signed_header_fields_ref->{$nm} > 1) {
            # causes signing one additional null occurrence of a header field
            push(@field_names_to_be_signed, $nm);
          }
        }
      }
      @field_names_to_be_signed =
        grep($signed_header_fields_ref->{$_}, @field_names_to_be_signed);
      if ($skip_topmost_received) {  # don't sign topmost Received header field
        for my $j (0..$#field_names_to_be_signed) {
          if (lc($field_names_to_be_signed[$j]) eq 'received')
            { splice(@field_names_to_be_signed,$j,1); last }
        }
      }
      my $expiration;
      if (defined $sig_options{x}) {
        $expiration = $sig_options{x};
        my $j = int($expiration);
        $expiration = $expiration > $j ? $j+1 : $j;  # ceiling
      }
      # RFC 6531 section 3.2: Any domain name to be looked up in the DNS
      # MUST conform to and be processed as specified for Internationalizing
      # Domain Names in Applications (IDNA) [RFC5890].  When doing lookups,
      # the SMTPUTF8-aware SMTP client or server MUST either use a Unicode-
      # aware DNS library, or transform the internationalized domain name
      # to A-label form (i.e., a fully- qualified domain name that contains
      # one or more A-labels but no U-labels) as specified in RFC 5890.
      $dkim->add_signature( Mail::DKIM::Signature->new(
        Selector  => idn_to_ascii($sig_options{s}),
        Domain    => idn_to_ascii($sig_options{d}),
        Timestamp => int($msginfo->rx_time),  # floor
        Headers   => join(':', reverse @field_names_to_be_signed),
        Key       => $key,
        !defined $sig_options{c} ? () : (Method     => $sig_options{c}),
        !defined $sig_options{a} ? () : (Algorithm  => $sig_options{a}),
        !defined $sig_options{q} ? () : (Query      => $sig_options{q}),
        !defined $sig_options{i} ? () : (Identity   =>
                                mail_addr_idn_to_ascii($sig_options{i})),
        !defined $expiration     ? () : (Expiration => $expiration), # ceiling
      ));
      undef;
    };  # end sub

    my $dkim_wrapper;
    eval {
      my $dkim_signer = Mail::DKIM::Signer->new(Policy => $policyfn);
      $dkim_signer or die "Could not create a Mail::DKIM::Signer object\n";
      #
      # NOTE: dkim wrapper will strip bare CR before signing, which suits
      # forwarding by SMTP which does the same; with other forwarding methods
      # such as a pipe or milter, bare CRs in a message may break signatures
      #
      # feeding mail to a DKIM signer
      require Amavis::Out::SMTP;
      $dkim_wrapper = Amavis::Out::SMTP->new_dkim_wrapper($dkim_signer,1);
      my $msg = $msginfo->mail_text;  # a file handle or a MIME::Entity object
      my $msg_str_ref = $msginfo->mail_text_str;  # have an in-memory copy?
      $msg = $msg_str_ref  if ref $msg_str_ref;
      my $hdr_edits = $msginfo->header_edits;
      $hdr_edits = Amavis::Out::EditHeader->new  if !$hdr_edits;
      my($received_cnt,$file_position) =
        $hdr_edits->write_header($msginfo,$dkim_wrapper,!$initial_submission);
      if (!defined $msg) {
        # empty mail
      } elsif (ref $msg eq 'SCALAR') {
        # do it in chunks, saves memory, cache friendly
        while ($file_position < length($$msg)) {
          $dkim_wrapper->print(substr($$msg,$file_position,16384))
            or die "Can't write to dkim signer: $!";
          $file_position += 16384;  # may overshoot, no problem
        }
      } elsif ($msg->isa('MIME::Entity')) {
        $msg->print_body($dkim_wrapper);
      } else {
        my($nbytes,$buff);
        while (($nbytes = $msg->read($buff,16384)) > 0) {
          $dkim_wrapper->print($buff) or die "Can't write to dkim signer: $!";
        }
        defined $nbytes or die "Error reading: $!";
      }
      $dkim_wrapper->close or die "Can't close dkim wrapper: $!";
      undef $dkim_wrapper;
      $dkim_signer->CLOSE or die "Can't close dkim signer: $!";
      @signatures = $dkim_signer->signatures;
      undef $dkim_signer;
      1;
    } or do {
      my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
      do_log(0, "dkim: signing error: %s", $eval_stat);
    };
    if (defined $dkim_wrapper) { $dkim_wrapper->close }  # ignoring status
    section_time('fwd-data-dkim');
  }

  # signatures must have all the required tags: d, s, b, bh; check to make sure
  # if (ll(5)) { do_log(5, "dkim: %s", $_->as_string) for @signatures }
  my(@sane_signatures);
  for my $s (@signatures) {
    my(@missing);
    for my $pair ( ['d', $s->domain],  ['s', $s->selector],
                   ['b', $s->data],   ['bh', $s->body_hash] ) {
      my($tag,$val) = @$pair;
      push(@missing,$tag)  if !defined($val) || $val eq '';
    }
    if (!@missing) {
      push(@sane_signatures, $s);
      # remember just the last one (typically the only one)
      $msginfo->dkim_signwith_sd( [$s->selector, $s->domain] );
    } else {
      do_log(2, "dkim: signature is missing tag %s, skipping: %s",
                 join(',',@missing), $s->as_string);
    }
  }
  @sane_signatures;
}

# Prepare Authentication-Results header fields according to RFC 7601.
#
sub generate_authentication_results($;$$) {
  my($msginfo,$allow_none,$sigs_ref) = @_;
  $sigs_ref = $msginfo->dkim_signatures_all  if @_ < 3;  # for all by default
  my $authservid = c('myauthservid');
  $authservid = c('myhostname')  if !defined $authservid || $authservid eq '';
  $authservid = idn_to_ascii($authservid);
  # note that RFC 7601 declares A-R header field as structured, which is why
  # we are inserting a \n into top-level locations suitable for folding,
  # and let sub hdr() choose suitable folding points
  my(@results, %all_b, %all_b_valid, %all_b_8);
  my($sig_cnt_dk, $sig_cnt_dkim, $result_str) = (0, 0, '');

  for my $sig (!$sigs_ref ? () : @$sigs_ref) {  # first pass
    my($sig_result, $details, $str);
    $sig_result = $sig->result;
    if (defined $sig_result) {
      $sig_result = lc $sig_result;
    } else {
      ($sig_result, $details) = ('pass', 'just generated, assumed good');
      $sig->result($sig_result, $details);
    }
    my $valid = $sig_result eq 'pass';
    if ($valid) {
      my $expiration_time = $sig->expiration;
      if (defined $expiration_time &&
          $expiration_time =~ /^0*\d{1,10}\z/ &&
          $msginfo->rx_time > $expiration_time) {
        ($sig_result, $details) = ('fail', 'good, but expired');
        $sig->result($sig_result, $details);
        $valid = 0;
      }
    }
    if ($sig->isa('Mail::DKIM::DkSignature')) { $sig_cnt_dk++ }
                                         else { $sig_cnt_dkim++ };
    my $b = $sig->data;
    if (defined $b) {
      $b =~ tr/ \t\n//d;  # remove FWS, just in case
      $all_b_8{substr($b,0,8)}++;
      $all_b{$b}++;
      $all_b_valid{$b}++  if $valid;
    }
  }

  # RFC 7601 result: none, pass, fail, policy, neutral, temperror, permerror
  # Mail::DKIM result: pass, fail, invalid, temperror, none
  for my $sig (!$sigs_ref ? () : @$sigs_ref) {  # second pass
    my $result_val;  # RFC 7601 result value
    my $sig_result = lc $sig->result;
    my $details = $sig->result_detail;
    my $valid = $sig_result eq 'pass';
    if ($valid) {
      $result_val = 'pass';
    } else {
      # map a Mail::DKIM::Signature result into an RFC 7601 result value
      $result_val = $sig_result eq 'temperror' ? 'temperror'
                  : $sig_result eq 'fail'      ? 'fail'
                  : $sig_result eq 'invalid'   ? 'neutral' : 'permerror';
    }
    my $sdid_ace = idn_to_ascii($sig->domain);
    my $str = '';
    my $add_header_b;  # RFC 6008, should we add a header.b for this signature?
    my $key_size = eval {
      my $pk = $sig->get_public_key;
      $pk && $pk->cork && $pk->cork->size * 8;
    };
    if ($sig->isa('Mail::DKIM::DkSignature')) {
      $add_header_b = 1  if $sig_cnt_dk > 1;
      my $rfc2822_sender = $msginfo->rfc2822_sender;
      my $fm = $msginfo->rfc2822_from;
      my(@rfc2822_from) = !defined($fm) ? () : ref $fm ? @$fm : $fm;
      my $id_ace = defined $sdid_ace ? '@'.$sdid_ace : '';
      $str .= ";\n domainkeys=" . $result_val;
      $str .= sprintf(' (%d-bit key)', $key_size)  if $key_size;
      if (defined $details && $details ne '' && lc $details ne lc $result_val){
        local($1);  # turn it into an RFC 2045 quoted-string
        $details =~ s{([\000-\037\177"\\])}{\\$1}gs;  # RFC 5322 qtext
        $str .= "\n reason=\"$details\"";
      }
      if (@rfc2822_from && $rfc2822_from[0] =~ /(\@[^\@]*)\z/s &&
          idn_to_ascii($1) eq $id_ace) {
        $str .= "\n header.from=" .
                join(',', map(quote_rfc2821_local($_), @rfc2822_from));
      }
      if (defined($rfc2822_sender) && $rfc2822_sender =~ /(\@[^\@]*)\z/s &&
          idn_to_ascii($1) eq $id_ace) {
        $str .= "\n header.sender=" . quote_rfc2821_local($rfc2822_sender);
      }
    } else {  # a DKIM signature
      $add_header_b = 1  if $sig_cnt_dkim > 1;
      $str .= ";\n dkim=" . $result_val;
      $str .= sprintf(' (%d-bit key)', $key_size)  if $key_size;
      if (defined $details && $details ne '' && lc $details ne lc $result_val){
        local($1);  # turn it into an RFC 2045 quoted-string
        $details =~ s{([\000-\037\177"\\])}{\\$1}gs;  # RFC 5322 qtext
        $str .= "\n reason=\"$details\"";
      }
    }

    $str .= "\n header.d=" . $sdid_ace  if defined $sdid_ace;
    my $b = $sig->data;
    if (defined $b && $add_header_b) {
      # RFC 6008: The value associated with this item in the header field
      # MUST be at least the first eight characters of the digital signature
      # (the "b=" tag from a DKIM-Signature) for which a result is being
      # relayed, and MUST be long enough to be unique among the results
      # being reported.
      $b =~ tr/ \t\n//d;  # remove FWS, just in case
      if ($b !~ m{^ [A-Za-z0-9+/]+ =* \z}xs) {  # ensure base64 syntax
        do_log(2, "generate_AR: bad signature tag b=%s", $b);
      } elsif ($all_b{$b} > 1 && $all_b_valid{$b} && !$valid) {
        # exact duplicates: do not report invalid ones if at least one is valid
        # RFC 6008 section 6.2.: a cautious implementation could discard
        # the false negative in that instance.
        do_log(2, "generate_AR: not reporting bad duplicates: %s", $b);
        $str = '';  # ditch the report for this signature
      } elsif ($all_b_8{$b} > $all_b{$b}) {
        do_log(2, "generate_AR: not reporting b for collisions: %s", $b);
      } else {
        $str .= "\n header.b=" . '"'.substr($b,0,8) .'"';
      }
    }
    $result_str .= $str;
  }
  # just provide a single A-R with all results combined
  push(@results, $result_str)  if $result_str ne '';
  push(@results, ";\n dkim=none")  if !@results && $allow_none;
  $_ = sprintf("%s (%s)%s", $authservid, $myproduct_name, $_)  for @results;
  @results;  # none, one, or more A-R header field bodies
}

# adjust spam score for each recipient so that the final spam score
# will be shifted towards a fixed score assigned to a signing domain (its
# 'reputation', as obtained through @signer_reputation_maps); the formula is:
#   adjusted_spam_score = f*reputation + (1-f)*spam_score;  0 <= f <= 1
# which has the same semantics as auto_whitelist_factor in SpamAssassin AWL
#
sub adjust_score_by_signer_reputation($) {
  my $msginfo = $_[0];
  my $reputation_factor = c('reputation_factor');
  $reputation_factor = 0  if $reputation_factor < 0;
  $reputation_factor = 1  if $reputation_factor > 1;
  my $sigs_ref = $msginfo->dkim_signatures_valid;
  if (defined $reputation_factor && $reputation_factor > 0 &&
      $sigs_ref && @$sigs_ref) {
    my($best_reputation_signer,$best_reputation_score);
    my $minimum_key_bits = c('dkim_minimum_key_bits');
    my $srm = ca('signer_reputation_maps');
    # walk through all valid signatures, find best (smallest) reputation value
    for my $sig (@$sigs_ref) {
      my $sdid = $sig->domain;
      my($val,$key) = lookup2(0, '@'.$sdid, $srm);
      if (defined $val &&
          (!defined $best_reputation_score || $val < $best_reputation_score)) {
        my $key_size;
        $key_size = eval {
          my $pk = $sig->get_public_key;
          $pk && $pk->cork && $pk->cork->size * 8 }  if $minimum_key_bits;
        if ($key_size && $key_size < $minimum_key_bits) {
          do_log(1, "dkim: reputation for signing domain %s not used, ".
                    "valid signature ignored, %d-bit key is shorter than %d",
                     $sdid, $key_size, $minimum_key_bits);
        } else {
          $best_reputation_signer = $sdid;
          $best_reputation_score = $val;
        }
      }
    }
    if (defined $best_reputation_score) {
      my $ll = 2;  # initial log level
      for my $r (@{$msginfo->per_recip_data}) {
        my $spam_level = $r->spam_level;
        next  if !defined $spam_level;
        my $new_level = $reputation_factor  * $best_reputation_score
                  +  (1-$reputation_factor) * $spam_level;
        $r->spam_level($new_level);
        my $spam_tests = 'AM.DKIM_REPUT=' .
                         (0+sprintf("%.3f", $new_level-$spam_level));
        if (!$r->spam_tests) {
          $r->spam_tests([ \$spam_tests ]);
        } else {
          unshift(@{$r->spam_tests}, \$spam_tests);
        }
        ll($ll) &&
          do_log($ll, "dkim: score %.3f adjusted to %.3f due to reputation ".
                      "(%s) of a signer domain %s",  $spam_level, $new_level,
                      $best_reputation_score, $best_reputation_signer);
        $ll = 5;  # reduce log clutter after the first recipient
      }
    }
  }
}

# check if we have a valid author domain signature, and do
# other DKIM pre-processing;  called from collect_some_dkim()
#
sub collect_some_dkim_info($) {
  my $msginfo = $_[0];

  my $rfc2822_sender = $msginfo->rfc2822_sender;
  my(@rfc2822_from) = $msginfo->rfc2822_from;
  # now that we have a parsed From, check if we have a valid
  # author domain signature and do other DKIM pre-processing
  my(@bank_names, %bn_auth_already_queried);
  my $atpbm = ca('author_to_policy_bank_maps');
  my(@signatures_valid);
  my $sigs_ref = $msginfo->dkim_signatures_all;
  my $sig_ind = 0;  # index of a signature in a signature array
  for my $sig (!$sigs_ref ? () : @$sigs_ref) {  # for each signature
    my $valid = lc($sig->result) eq 'pass';
    my($timestamp_age, $creation_time, $expiration_time);
    if (!$sig->isa('Mail::DKIM::DkSignature')) {
      $creation_time = $sig->timestamp;  # method only implemented for DKIM sig
      $timestamp_age = $msginfo->rx_time - $creation_time
        if defined $creation_time && $creation_time =~ /^0*\d{1,10}\z/;
    }
    $expiration_time = $sig->expiration;
    my $expired =
      defined $expiration_time && $expiration_time =~ /^0*\d{1,10}\z/ &&
      ($msginfo->rx_time > $expiration_time ||
       ( defined $creation_time && $creation_time =~ /^0*\d{1,10}\z/ &&
         $creation_time > $expiration_time )
      );

    my($pubkey, $key_size, $eval_stat);
    eval {
      # Mail::DKIM >=0.31 caches a public key result
      $pubkey = $sig->get_public_key;  # can die with "not available"
      $pubkey or die "No public key";
      $key_size = $pubkey->cork && $pubkey->cork->size * 8;
      $key_size or die "Can't determine a public key size";
      1;
    } or do {
      $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
      do_log(5, "dkim: public key s=%s d=%s, error: %s",
                $sig->selector, $sig->domain, $eval_stat);
    };
    if ($pubkey && ll(5)) {
      # RFC 6376: Although the "g=" tag has been deprecated in this version
      # of the DKIM specification (and thus MUST now be ignored), signers are
      # advised not to include the "g=" tag in key records...
      do_log(5, "dkim: public key s=%s d=%s%s, %d-bit key",
                $sig->selector, $sig->domain,
                join('', map { my $v = $pubkey->get_tag($_);
                               defined $v ? " $_=$v" : '' } qw(v g h k t s)),
                $key_size||0 );
    }

    # See if a signature matches address in any of the sender/author fields.
    # In the absence of an explicit Sender header field, the first author
    # acts as the 'agent responsible for the transmission of the message'.
    my(@addr_list) = ($msginfo->sender,
                  defined $rfc2822_sender ? $rfc2822_sender : $rfc2822_from[0],
                  @rfc2822_from);
    my $sdid_ace = idn_to_ascii($sig->domain);
    for my $addr (@addr_list) {
      next  if !defined $addr;
      local($1); my $domain;
      $domain = $1  if $addr =~ /\@([^\@]*)\z/s;
      # turn addresses in @addr_list into booleans, representing match outcome
      $addr = defined $domain && idn_to_ascii($domain) eq $sdid_ace ? 1 : 0;
    }

  # # Label which header fields are covered by each signature;
  # # doesn't work for old DomainKeys signatures where h may be missing
  # # and where recurring header fields may only be listed once.
  # # NOTE: currently unused and commented out
  # { my(%field_counts);
  #   my(@signed_header_field_names) = map(lc($_), $sig->headerlist); # 'h' tag
  #   $field_counts{$_}++  for @signed_header_field_names;
  #   for (my $j=-1;  ; $j--) {   # walk through header fields, bottom-up
  #     my($f_ind,$fld) = $msginfo->get_header_field2(undef,$j);
  #     last if !defined $f_ind;  # reached the top
  #     local $1;
  #     my $f_name; $f_name = lc $1 if $fld =~ /^([^:]*?)[ \t]*:/s;
  #     if ($field_counts{$f_name} > 0) { # header field is covered by this sig
  #       $msginfo->header_field_signed_by($f_ind,$sig_ind);  # store sig index
  #       $field_counts{$f_name}--;
  #     }
  #   }
  # }

    if ($valid && !$expired) {
      push(@signatures_valid, $sig);
      my $sig_domain = $sig->domain;
      $sig_domain = '?'  if !$sig_domain;  # make sure it is true as a boolean
      #
      # note that only the author domain signature (based on RFC 2822.From)
      # is a valid concept in ADSP; we are also using the same rules to match
      # against RFC 2822.Sender and envelope sender address, but results are
      # only of informational/curiosity interest and deeper significance
      # must not be attributed to dkim_envsender_sig and dkim_sender_sig!
      #
      $msginfo->dkim_envsender_sig($sig_domain)  if $addr_list[0];
      $msginfo->dkim_sender_sig($sig_domain)     if $addr_list[1];
      $msginfo->dkim_author_sig($sig_domain)
        if grep($_, @addr_list[2..$#addr_list]);  # SDID matches addr
      $msginfo->dkim_thirdparty_sig($sig_domain) if !$msginfo->dkim_author_sig;
      if (@$atpbm) {  # any author to policy bank name mappings?
        for my $j (0..$#rfc2822_from) {  # for each author (usually only one)
          my $key_ace = mail_addr_idn_to_ascii($rfc2822_from[$j]);
          # query key: as-is author address for author domain signatures, and
          # author address with '/@signer-domain' appended for 3rd party sign.
          # e.g.: 'user@example.com', 'user@sub.example.com/@example.org'
          my $sdid_ace = idn_to_ascii($sig->domain);
          for my $opt ( ($addr_list[$j+2] ? '' : ()), '/@'.$sdid_ace ) {
            next  if $bn_auth_already_queried{$key_ace.$opt};
            my($result,$matchingkey) = lookup2(0,$key_ace,$atpbm,
                       Label=>'AuthToPB', $opt eq '' ? () : (AppendStr=>$opt));
            $bn_auth_already_queried{$key_ace.$opt} = 1;
            next if !$result;
            if ($result eq '1') {
              # a handy usability trick to supply a hardwired policy bank
              # name when acl-style lookup table is used, which can only
              # return a boolean (undef, 0, or 1)
              $result = 'AUTHOR_APPROVED';
            }
            my $minimum_key_bits = c('dkim_minimum_key_bits');
            # $result is a list of bank names as a comma-separated string
            local $1;
            my(@pbn) = map(/^\s*(\S.*?)\s*\z/s ? $1 : (), split(/,/, $result));
            if (!@pbn) {
              # no policy banks specified, nothing to do
            } elsif ($key_size && $minimum_key_bits &&
                     $key_size < $minimum_key_bits) {
              do_log(1, "dkim: policy bank %s by %s NOT LOADED, valid ".
                        "signature ignored, %d-bit key is shorter than %d",
                        join(',',@pbn), $matchingkey,
                        $key_size, $minimum_key_bits);
            } else {
              push(@bank_names, @pbn);
              ll(2) && do_log(2, "dkim: policy bank %s by %s",
                                 join(',',@pbn), $matchingkey);
            }
          }
        }
      }
    }
    ll(2) && do_log(2, "dkim: %s%s%s %s signature by d=%s, From: %s, ".
                       "a=%s, c=%s, s=%s, i=%s%s%s%s",
      $valid  ? 'VALID' : 'FAILED',  $expired ? ', EXPIRED' : '',
      $timestamp_age >= -1 ? ''
        : ', IN_FUTURE:('.format_time_interval(-$timestamp_age).')',
      join('+', (map($_ ? 'Author' : (), @addr_list[2..$#addr_list])),
                $addr_list[1] ? 'Sender'   : (),
                $addr_list[0] ? 'MailFrom' : (),
                !grep($_, @addr_list) ? 'third-party' : ()),
      $sig->domain, join(", ", qquote_rfc2821_local(@rfc2822_from)),
      $sig->algorithm, scalar($sig->canonicalization),
      $sig->selector, $sig->identity,
      !$msginfo->originating ? ''
        : ', ORIG [' . $msginfo->client_addr . ']:' . $msginfo->client_port,
      !defined($msginfo->is_mlist) ? '' : ", m.list(".$msginfo->is_mlist.")",
      $valid ? '' : ', '.$sig->result_detail,
    );
    $sig_ind++;
  }
  Amavis::load_policy_bank($_,$msginfo) for @bank_names;
  $msginfo->originating(c('originating'));
  $msginfo->dkim_signatures_valid(\@signatures_valid)  if @signatures_valid;
# if (ll(5) && $sig_ind > 0) {
#   # show which header fields are covered by which signature
#   for (my $j=0; ; $j++) {
#     my($f_ind,$fld) = $msginfo->get_header_field2(undef,$j);
#     last if !defined $f_ind;
#     my(@sig_ind) = $msginfo->header_field_signed_by($f_ind);
#     do_log(5, "dkim: %-5s %s.", !@sig_ind ? '' : '['.join(',',@sig_ind).']',
#               substr($fld,0,54));
#   }
# }
}

1;