Server IP : 85.214.239.14 / Your IP : 18.118.120.13 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/share/perl5/Amavis/ |
Upload File : |
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;