[Amavisd-new-commits] [pkg-amavisd-new] 01/02: New upstream version 2.11.0
Alexander Wirt
formorer at debian.org
Sun Nov 6 15:44:01 UTC 2016
This is an automated email from the git hooks/post-receive script.
formorer pushed a commit to branch master
in repository pkg-amavisd-new.
commit 2fbdcdb232fae7c06a4e6d476402f3ee422936ef
Author: Alexander Wirt <formorer at debian.org>
Date: Sun Nov 6 16:43:47 2016 +0100
New upstream version 2.11.0
---
README_FILES/README.customize | 17 +-
README_FILES/README.sql-mysql | 4 +-
RELEASE_NOTES | 514 ++++++++-
TinyRedis.pm | 9 +-
amavisd | 2566 +++++++++++++++++++++++++++--------------
amavisd-new-courier.patch | 44 +-
amavisd-new-qmqpqq.patch | 34 +-
amavisd-release | 1 +
amavisd-status | 12 +-
amavisd.conf | 7 +-
amavisd.conf-default | 84 +-
11 files changed, 2299 insertions(+), 993 deletions(-)
diff --git a/README_FILES/README.customize b/README_FILES/README.customize
index e9419d8..5d0c9f0 100644
--- a/README_FILES/README.customize
+++ b/README_FILES/README.customize
@@ -346,11 +346,26 @@ The substitution text for the following simple macros is built-in:
k any recipient declared the message be killed ?
T list of triggered SA tests (only in $log_templ and $log_recip_templ)
- report_json expands to a JSON representation of a structured log event
+ report_json expands to a JSON representation of a structured log event.
+ The macro can take arguments, which can include or exclude fields
+ (key/values) from the JSON report object. Arguments to a macro are
+ either field names (keys) to be included in a report, or are field
+ names to be excluded, each prefixed with an exclamation mark,
+ to produce a report with all but excluded fields.
+ Field names are case-sensitive. The order of fields in a serialized
+ JSON object is unaffected by the order of field names in a filter.
+ Unknown or non-present field names in a filter are silently ignored.
+ For better clarity, instead of listing field names as individual
+ arguments to a macro, it is also possible to provide a single argument
+ in which field names are separated by whitespace.
+ If at least one field name has an exclamation mark (i.e. is to be
+ excluded), all but excluded fields are implied, so any field names
+ without an exclamation mark are redundant;
wrap with arguments: width, prefix, indent, string
will wrap a string to a multiline string of the specified width;
for details see comments before the 'sub wrap_string' in file amavisd;
+
lc lowercases arguments and concatenates them to a single string
uc uppercases arguments and concatenates them to a single string
substr same as Perl function substr: returns a substring of the first
diff --git a/README_FILES/README.sql-mysql b/README_FILES/README.sql-mysql
index dddfa95..398770c 100644
--- a/README_FILES/README.sql-mysql
+++ b/README_FILES/README.sql-mysql
@@ -227,9 +227,9 @@ CREATE TABLE msgs (
dsn_sent char(1), -- was DSN sent? Y/N/q (q=quenched)
spam_level float, -- SA spam level (no boosts)
message_id varchar(255) DEFAULT '', -- mail Message-ID header field
- from_addr varchar(255) CHARACTER SET utf8 COLLATE utf8_bin DEFAULT '',
+ from_addr varchar(255) CHARACTER SET utf8mb4 COLLATE utf8_bin DEFAULT '',
-- mail From header field, UTF8
- subject varchar(255) CHARACTER SET utf8 COLLATE utf8_bin DEFAULT '',
+ subject varchar(255) CHARACTER SET utf8mb4 COLLATE utf8_bin DEFAULT '',
-- mail Subject header field, UTF8
host varchar(255) NOT NULL, -- hostname where amavisd is running
PRIMARY KEY (partition_tag,mail_id)
diff --git a/RELEASE_NOTES b/RELEASE_NOTES
index 60dcb81..3337bfb 100644
--- a/RELEASE_NOTES
+++ b/RELEASE_NOTES
@@ -1,3 +1,495 @@
+
+---------------------------------------------------------------------------
+ April 26, 2016
+amavisd-new-2.11.0 release notes
+
+Contents:
+ DEPRECATION NOTICE
+ COMPATIBILITY
+ BUG FIXES
+ NEW FEATURES
+ OTHER
+ SUPERVISED PROCESS NOTES
+
+
+DEPRECATION NOTICE
+
+- The old DomainKey signatures (a predecessor to DKIM) has been published
+ as a historic document RFC 4870 and obsoleted by RFC 4871 in May 2007;
+ Support for DomainKey signatures is likely to be removed with a next
+ version of amavisd.
+
+- It is expected that the next release of amavisd will start using some
+ of the features made available with perl 5.10.0 (such as a defined-or
+ operator, or a possessive quantifier in regular expressions), so
+ consider running amavisd under perl 5.8.9 or earlier as unsupported.
+ In practice, using such old version of perl is problematic even now,
+ as their support for Unicode / UTF-8 is incomplete and unreliable.
+
+
+COMPATIBILITY
+
+There are some minor incompatibilities between versions 2.10.1 and 2.11.0:
+
+- During startup more detailed testing is performed for taint bugs of
+ a module Encode and the function utf8::is_utf8(), which may produce
+ warnings on old versions of perl with its old core module Encode,
+ or may exit on detecting more sinister bugs in these modules.
+ Note that the module Encode may be upgraded independently of perl,
+ if desired;
+
+- with MySQL: changed character set 'utf8' to 'utf8mb4' for fields
+ msgs.subject and msgs.from_addr, as previously some of the UTF-8
+ characters could not be stored in a database;
+
+- when logging to stderr a timestamp prefix to each message is only
+ still inserted if $DEBUG is true. When $DEBUG is false each message
+ is prefixed with a syslog log level in angle brackets, and a timestamp
+ is omitted (for compatibility with systemd);
+
+- a perl module Digest::SHA is now a required module. It is a perl core
+ module since perl 5.10, so it shouldn't introduce a new dependency,
+ and it was a de-facto required module even previously, as it was needed
+ for DKIM processing;
+
+
+BUG FIXES
+
+- delivery method was undefined when always_bcc was used;
+ reported by Marieke Janssen;
+
+- avoid warnings issued by perl 5.21.7 and later:
+ Negative repeat count does nothing at ./amavisd line 16408
+ and similarly in amavisd-status;
+
+- releasing from an SQL quarantine failed to provide the original
+ envelope sender address to a released message;
+ reported, and a fix suggested by Tom Johnson and Tobias;
+
+- remove a stale database file __db.nanny.db on a reload or restart,
+ as it can prevent a successful start when a previous start failed
+ for some reason; a patch by Trent Lloyd;
+
+
+NEW FEATURES
+
+- Polished rough corners to facilitate running amavisd as a non-daemonized
+ supervised process, e.g. under systemd:
+
+ * make it possible/easier to disable use of a pid_file;
+
+ * send status notifications to systemd when a NOTIFY_SOCKET environment
+ variable is provided;
+
+ * improved logging to stderr when $do_syslog and $logfile are undefined
+ (although logging through syslog might still be preferred, as writing
+ to a shared pipe from multiple child processes only guarantees atomicity
+ of writes shorter than PIPE_BUF, which is typically 512 bytes on *BSD,
+ and 4096 bytes on Linux systems);
+
+ See below for a sample amavisd.service file.
+
+- A log template macro 'report_json' can now take arguments, which can
+ include or exclude fields (key/values) from the JSON report object.
+ Arguments to a macro are either field names (keys) to be included
+ in a report, or are field names to be excluded, each prefixed with
+ an exclamation mark, to produce a report with all but excluded fields.
+
+ Field names are case-sensitive. The order of fields in a serialized
+ JSON object is unaffected by the order of field names in a filter.
+ Unknown or non-present field names in a filter are silently ignored.
+
+ Example:
+ [:report_json|mail_id|action|content_type|queued_as|mail_from|size]
+ or:
+ [:report_json|!recipients|!elapsed|!os_fp|!subject|!subject_rot13]
+
+ For better clarity, instead of listing field names as individual
+ arguments to a macro, it is also possible to provide a single argument
+ to a macro, in which field names are separated by whitespace:
+ [:report_json|mail_id action content_type queued_as mail_from size]
+ or:
+ [:report_json| !message !recipients !to_addr !elapsed !os_fp
+ !subject !subject_rot13 !user_agent !tests !tests_ham !tests_spam]
+
+ As an example, a setting in a config file may look like:
+ $log_templ = '[:report_json|mail_id action queued_as mail_from]';
+
+ If at least one field name has an exclamation mark (i.e. is to be
+ excluded), all but excluded fields are implied, so any field names
+ without an exclamation mark are redundant.
+
+ Currently this is a simple filter where subfields of a structured
+ object cannot be selectively filtered (e.g. elapsed.SpamCheck).
+ For finer control on JSON content use some external JSON-processing
+ utility. Based on a patch by Markus Benning.
+
+- Two new configuration settings are added: %smtpd_tls_server_options
+ and %smtp_tls_client_options. These two associative arrays are passed
+ to IO::Socket::SSL->start_SSL when establishing a server-side or a
+ client-side TLS session with an MTA, and provide more control over
+ a TLS session - like providing certificates and restricting ciphers.
+ See documentation of a perl module IO::Socket::SSL for a list of
+ all options with their descriptions and their defaults.
+
+ When TLS is in use, it is recommended to stick to fresh versions
+ of the module IO::Socket::SSL and the underlying ssl library,
+ as it can provide a safer set of defaults (e.g. excluded SSLv2).
+
+ Existing config options $smtpd_tls_cert_file and $smtpd_tls_key_file
+ are now deprecated in favour of a more generic %smtpd_tls_server_options.
+ Preferably set fields 'SSL_key_file' and 'SSL_cert_file' directly in
+ %smtpd_tls_server_options instead. For compatibility with 2.10 the
+ values of $smtpd_tls_cert_file and $smtpd_tls_key_file are fed into
+ the associative array %smtpd_tls_server_options if fields 'SSL_key_file'
+ and 'SSL_cert_file' are not provided (do not exist) there.
+
+ Example:
+
+ %smtp_tls_client_options = (
+ SSL_verifycn_scheme => 'smtp',
+ SSL_version => '!SSLv2,!SSLv3',
+ SSL_cipher_list => 'HIGH:!MD5:!DSS:!aNULL',
+# SSL_client_ca_file => ... ,
+ );
+
+ %smtpd_tls_server_options = (
+ SSL_verifycn_scheme => 'smtp',
+ SSL_session_cache => 2,
+ SSL_key_file => "$MYHOME/cert/amavisd-key.pem",
+ SSL_cert_file => "$MYHOME/cert/amavisd-cert.pem",
+ SSL_dh_file => "$MYHOME/cert/amavisd-dh.dat",
+ # SSL_ca_file => ... ,
+ SSL_version => '!SSLv2,!SSLv3',
+ SSL_cipher_list => 'HIGH:!MD5:!DSS:!aNULL',
+ );
+
+ Or just to change some field and leave the rest at their default:
+
+ $smtp_tls_client_options{SSL_verify_mode} = 0; # SSL_VERIFY_NONE
+
+ Suggested by Marc Grooz and Patrick Ben Koetter, based on a patch
+ by Markus Benning.
+
+- Supports receiving SMTP/LMTP connections through a HAProxy,
+ recognizing 'PROXY protocol Version 1' data on the first line read,
+ after a connection from HAProxy to amavisd has been established.
+ Connection data (IP addresses and ports) received via this protocol
+ end up replacing such data in the the Amavis::In::Connection object
+ ($conn). Set configuration variable $haproxy_target_enabled (also
+ a member of policy banks) to true in order to enable this protocol.
+
+- redis: allow a scoped / link-local IP address specification
+ (avoiding current limitation in IO::Socket::IP [rt.cpan.org #89608]);
+
+- the Amavis::Unpackers::Part::digest method now holds a digest (SHA1,
+ hex) of a decoded (base64 or quoted-printable) MIME part contents,
+ followed by a colon and a lowercased Content-Type of the MIME part.
+ Canonical line endings CRLF in decoded textual parts are normalized
+ to a native newline (\n) before feeding them to a digest algorithm.
+
+ These digests are passed to SpamAssassin through a 'mimepart_digests'
+ supplementary attribute, and are available to custom hooks. As of
+ version SpamAssassin 3.4.1, these are used as additional tokens in
+ a Bayes plugin. Even though SpamAssassin is capable of computing
+ the same or similar digests on its own, the advantage of computing
+ them in amavisd is that they reflect all and completely unmodified
+ and untruncated MIME parts of a mail message, including non-textual
+ attachments.
+
+ For debugging, search the log for "mimepart digest: ", logged at
+ log level 5, and ".* Content-Type: .*, size:" at log level 2.
+ Based on a suggestion by Andreas Schulze back in 2014.
+
+ A configuration setting $mail_part_digest_algorithm was added, which
+ chooses an algorithm name for generating digests of decoded MIME
+ parts of a message. The value is an algorithm name as accepted by
+ Digest::SHA->new(), e.g. 'sha1' or 'SHA-1' or 'SHA-256' or 'sha256',
+ or a string 'MD5' (case-insensitive) which chooses the MD5 algorithm
+ as implemented by a module Digest::MD5. An undefined value disables
+ generating digests of MIME parts. The $mail_part_digest_algorithm
+ setting is a dynamic setting, i.e. it is a member of policy banks.
+
+ For compatibility with SpamAssassin the chosen algorithm should be
+ SHA1 (which is a default), otherwise bayes tokens won't match those
+ generated by sa-learn (which is typically used for off-line learning).
+ Bayes auto-learning in SpamAssassin is unaffected by a mismatch of
+ the algorithm, as it believes digests received from amavisd.
+
+- Policy bank names in a @client_ipaddr_policy setting can now accept
+ a comma-separated list of policy names to be loaded on a match
+ (for loading of policy banks based on an IP address of a SMTP client).
+ Whitespace around each policy name is allowed and is stripped.
+ Previously only a single policy bank name was allowed in each entry
+ of @client_ipaddr_policy.
+
+ This makes it consistent with loading of policy banks based on a
+ DKIM-based setting @author_to_policy_bank_maps, and on virus checker
+ results via the @virus_name_to_policy_bank_maps setting.
+
+- Experimental feature: IP lookups (as implemented by lookup_ip_acl()
+ and used by @client_ipaddr_policy) can now also do DNS-based lookups,
+ in addition to array- and hash- based lookups.
+ Suggested by Patrick Ben Koetter and loosely based on his patch.
+
+ DNS lookups follow RFC 5782 conventions (DNS Blacklists and Whitelists:
+ DNSBL, DNSWL, collectively known as DNSxL). A DNS query of a type 'A'
+ is performed on a reversed IP address prepended to a specified domain
+ name (zone name). RFC 5782 suggests that only type-A resource records
+ of a DNS reply in an address range 127.0.0.0/8 may be considered.
+
+ For example, given a zone name 'rbl.example.org' and a SMTP client's
+ IP address 198.51.100.12, a DNS type-A query for a domain name
+ "12.100.51.198.rbl.example.org" would be sent to a specified or to a
+ default DNS resolver or server. Similarly, an IP address 2001:db8::2:f
+ would produce a DNS type-A query for a domain name "f.0.0.0.2.0.0.0.0.
+ 0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.b.d.0.1.0.0.2.rbl.example.org" .
+
+ The setting @client_ipaddr_policy contains a list of pairs, each pair
+ consisting of a lookup object (arrayref or hashref, or now also an
+ Amavis::Lookup::DNSxL object), followed by a policy bank name (which
+ is a string: one or more policy bank names, comma-separated).
+
+ The object constructor Amavis::Lookup::DNSxL->new accepts as its
+ arguments: a dns zone name, expected result(s) for a match, and a
+ resolver object. Only the first argument (a DNSxL zone name) is
+ required, the remaining two arguments are optional. A default
+ expected result is '127.0.0.2', and a default Net::DNS::Resolver
+ persistent object is provided implicitly if not provided by a caller
+ (it reads a DNS resolver's IP address from /etc/resolv.conf).
+
+ The "expected result(s) for a match" argument (the second argument)
+ is compared to the address found in a DNS reply (in a 127.0.0.0/8 range).
+ It can be:
+ a) an integer between 0 and 255 (or a string representing such
+ integer), which is used to match the last byte on the 127.0.0.x quad;
+ b) a string in a dotted-quad form of an IPv4 address in a 127.0.0.0/8
+ range, where leading bytes may be omitted (e.g. '1.8' == '127.0.1.8');
+ c) a reference to an array consisting of entries in an (a) or (b) form,
+ where a match with any of the array elements suffices for a match;
+ d) a perl regular expression object (e.g. qr{^127\.[3-8]\.0\.\d*$} ).
+
+ If an IP address in a DNS reply matches the provided "expected result"
+ argument, the policy banks associated with that entry are loaded,
+ and a search through a @client_ipaddr_policy list stops.
+
+ As a shorthand a subroutine Amavis::Conf::q_dns_a() is provided,
+ which is just a convenient wrapper for Amavis::Lookup::DNSxL->new().
+
+ Example:
+
+ @client_ipaddr_policy = (
+ [qw( 0.0.0.0/8 127.0.0.0/8 [::] [::1] )] => 'MYNETS, LOCALHOST',
+ [qw( 169.254.0.0/16 [fe80::]/10 )] => 'MYNETS, LINKLOCAL',
+ [qw( 10.0.0.0/8 172.16.0.0/12 192.168.0.0/16 )] => 'MYNETS, PRIVATENET',
+ \@mynetworks => 'MYNETS',
+ q_dns_a('rbl.example.org') => 'MY-CUSTOMER-A', # 127.0.0.2
+ q_dns_a('rbl.example.org', 3) => 'MYNETS,MY-CUSTOMER-B', # 127.0.0.3
+ q_dns_a('rbl.example.org', '0.2.99') => 'MY-CUSTOMER-C', # 127.0.2.99
+ q_dns_a('rbl.example.org', '127.0.0.7') => 'MY-CUSTOMER-D', # 127.0.0.7
+ q_dns_a('rbl.example.org', qr/^127\.1\.\d+\.2\d*\z/) =>'X', # 127.1.*.2*
+ q_dns_a('rbl.example.org', '192.0.2.0.2')=>'never matches', # not in 127/8
+ );
+
+ Below is an example of an amavisd.conf section with an explicitly
+ provided Net::DNS::Resolver object, which offers finer control over
+ its settings:
+
+ use Net::DNS;
+ my $dnsxl_res = Net::DNS::Resolver->new(
+ config_file => '/etc/resolv.conf',
+ port => 5333, retry => 1, persistent_udp => 1,
+ tcp_timeout => 2, udp_timeout => 2, retrans => 1,
+ );
+ $dnsxl_res or die "Module Net::DNS not available for DNSxL usage";
+ $dnsxl_res->udppacketsize(1220);
+
+ my $myrbl = 'rbl.example.org';
+
+ @client_ipaddr_policy = (
+ \@mynetworks => 'MYNETS',
+ q_dns_a($myrbl, 2, $dnsxl_res) => 'MY-CUSTOMER-A', # 127.0.0.2
+ q_dns_a($myrbl, [3,4,5], $dnsxl_res) => 'MY-CUSTOMER-B', # 127.0.0.{3,4,5}
+ );
+
+ This DNS-lookup feature is considered experimental in a sense that
+ its API may change in future versions. As it is currently implemented,
+ each q_dns_a() entry in a @client_ipaddr_policy results in its own
+ DNS query, which is quite inefficient with more that one or two such
+ entries. It would make more sense to do a single DNS lookup and provide
+ some mapping between results returned and policy bank names to be
+ loaded. Note also that DNS lookups are performed synchronously and
+ sequentially (one at a time, one after another), so a slowly responding
+ DNS server combined with multisecond timeouts and retries could severely
+ bog down the amavisd response time, easily to exceed the time a MTA or
+ a SMTP client is willing to wait for a response. YOU HAVE BEEN WARNED!
+
+
+OTHER
+
+- Relax a check on a PID number found in a pid file, considering
+ that amavisd may run as PID #1 under Docker; reported by Imre Rad.
+
+- Relax a check on $pid_file being configured or provided by a command
+ line option -P. Amavisd can now run without checking or providing a
+ PID file of a running master process, which is appropriate for running
+ non-daemonized amavisd as a supervised process (e.g. under supervision
+ suites such as systemd, s6, nosh, runit, launchd or similar). Also,
+ specifying a command line option -P '' (i.e. giving it an empty name
+ of a pid_file) overrides a configuration option $pid_file and is a
+ quick way to disable usage of a pid_file.
+
+ A default value of $pid_file is now only provided if a global
+ setting $daemonize is true (which is a default, unless running
+ with 'foreground' or 'debug' command line options).
+ A non-daemonized amavisd leaves $pid_file undefined as a default,
+ which facilitates running amavisd as a supervised process, e.g.
+ $daemonize = $pid_file = $daemon_user = undef;
+
+ When a pid_file is disabled and running under systemd, amavisd obtains
+ a PID of a master process from systemd through environment variable
+ MAINPID, which allows operations like 'amavisd reload' and 'amavisd stop'
+ from a .service file (ExecReload and ExecStop in systemd.exec(5)).
+
+ Btw, a command line argument 'foreground' is a quick way to override
+ a configuration setting $daemonize - it sets its value to 0.
+
+ To let amavisd provide and use a PID file even when not daemonized,
+ configure a PID file explicitly, e.g.: $pid_file = "$MYHOME/amavisd.pid";
+
+
+- provide sensible diagnostics when $daemon_user is undefined and
+ starting as root;
+
+- 'sanitize_nul' function is now enabled by default (this is currently
+ not configurable). Null octets found in a message are replaced by a
+ pair of octets \xC0 \x80, which is a "Modified UTF-8" encoding of a
+ NUL. This is done to avoid a mailbox server (like Cyrus) or a mail
+ client on choking on such mail. The downside is that such sanitation
+ can invalidate a DKIM signature - but non-encoded NUL octets are not
+ allowed in mail anyway, so not much harm is done;
+
+- overhauled a client side of the ClamAV clamd protocol;
+
+- updated decoder for 7z archives to improve handling of encrypted
+ content; based on a patch by Markus Benning;
+
+- recognize and handle completely encrypted zip archives by 7z
+ (in do_7zip); a patch provided by Thomas Jarosch;
+
+- adjusted log levels of some log/debug messages;
+
+- reject a message with an 8BITMIME body type if a back-end MTA does
+ not announce 8bit-MIMEtransport capability in its EHLO response
+ ( 550 5.6.3 Conversion to 7BIT required but not supported );
+
+- replaced calls to Encode::is_utf8() by utf8::is_utf8() - less buggy
+ in old versions of perl, but requires perl 5.8.1 or later;
+
+- replaced calls to Encode::encode_utf8() by utf8::encode() - is
+ much faster, and is less buggy in old versions of perl;
+
+- more detailed testing for taint bugs of a module Encode and in
+ utf8::is_utf8() during startup;
+
+- decode a supposedly (or guessably) character set ISO-8859-1 as
+ Windows-1252, which is a proper superset of ISO-8859-1 and often
+ mistaken for ISO-8859-1; (this follows advice of HTML5);
+
+- with MySQL: changed character set 'utf8' to 'utf8mb4' for fields
+ msgs.subject and msgs.from_addr;
+
+- in case the Net::Server receives a connection over a Unix socket
+ (e.g. from amavisd-release) but is unable to determine a socket name,
+ supply a dummy socket name 'UNKNOWN' so that a policy bank 'SOCK'
+ can still be loaded;
+
+- the setting $mail_digest_algorithm is now a dynamic setting, i.e.
+ can be configured per policy bank. The change makes it consistent
+ with a new setting $mail_part_digest_algorithm, which is also dynamic;
+
+- updated the @av_scanners Avast entry ( http://www.avast.com/ )
+ in the sample config file amavisd.conf to a new version
+ of their scanner:
+ ['avast! Antivirus', '/bin/scan', '{}', [0], [1], qr/\t(.+)/m]
+ Thanks to Martin Tůma from Avast for the new entry;
+
+- updated a default @$map_full_type_to_short_type_re to distinguish
+ encrypted PGP/GnuPG files from other PGP/GnuPG containers like
+ a detached signature, exported public key files, etc., if a
+ newer version of a file(1) utility is in use (5.20?);
+
+- relaxed the /\bscript\b.* text executable\b/ regexp entry in the
+ default @$map_full_type_to_short_type_re list so that a mail part
+ such as qualified by a file(1) utility as:
+ Python script, Non-ISO extended-ASCII text executable
+ does not qualify as an executable; reported by Tilman Schmidt;
+
+- updated a default @$map_full_type_to_short_type_re to recognize
+ a Microsoft Word document as type doc; thanks to Jörg Backschues;
+
+- added PhishTank.Phishing to a default @virus_name_to_spam_score_maps;
+
+- reworded some notification texts;
+
+
+SUPERVISED PROCESS NOTES
+
+Socket activation (running under a superserver with fd-holding) is
+currently not available. Note that 'amavisd reload' does fd-holding
+and socket passing to a new incarnation of amavisd server on its own,
+which means that a client (an MTA) does not see a disruption on a
+reload (= warm restart), unlike in case of restarting amavisd.
+
+As a reminder: a full restart is only necessary when changing the set
+of listening sockets in a configuration file. For all other needs
+(like changing other settings, updating SpamAssassin rules, upgrading
+the amavisd program, or perl modules, or perl itself) a reload suffices.
+
+Here is a sample file amavisd.service for use under systemd
+(indented for clarity). Lightly tested on Debian 8.0 (Jessie)
+on a Raspberry Pi.
+
+/lib/systemd/system/amavisd.service
+
+ [Unit]
+ Description=amavisd-new mail filter
+ Before=shutdown.target
+ After=systemd-journald-dev-log.socket network-online.target local-fs.target
+ Wants=network-online.target
+ Conflicts=shutdown.target
+
+ [Service]
+ Type=notify
+ NotifyAccess=main
+ KillMode=mixed
+ TimeoutStartSec=1min
+ TimeoutStopSec=3min
+ User=amavis
+ Group=amavis
+ WorkingDirectory=/var/lib/amavis/tmp
+ StandardOutput=syslog
+ SyslogFacility=mail
+ SyslogIdentifier=amavis
+ ProtectSystem=full
+ ProtectHome=yes
+ NoNewPrivileges=yes
+ ExecStart = /usr/sbin/amavisd-new -P '' foreground
+ ExecReload = /usr/sbin/amavisd-new -P '' reload
+ ExecStop = /usr/sbin/amavisd-new -P '' stop
+
+ [Install]
+ WantedBy = multi-user.target
+
+
+Consider the following amavisd.conf settings when running as a
+supervised process:
+
+ $pid_file = ''; # can be overridden by a command line option -P ''
+ $daemonize = 0; # also implied by a command line argument 'foreground'
+ $do_syslog = 0; # or set it to 1 to log to syslog instead of stderr
+
+
---------------------------------------------------------------------------
October 25, 2014
amavisd-new-2.10.1 release notes
@@ -52,7 +544,7 @@ COMPATIBILITY
- Support for international email relies heavily on perl to do the
right thing in its support of Unicode, so using a reasonably recent
version of perl is recommended. Amavisd was tested with perl 5.18
- and 5.20.1. Versions of perl older than 5.12 may cause problems
+ and 5.20.1. Versions of perl older than 5.12 may cause problems
with handling, encoding, and decoding of Unicode characters.
It is reasonable to expect that versions 5.14 and 5.16 are fine too,
but have not been tested extensively.
@@ -84,13 +576,13 @@ COMPATIBILITY
BUG FIXES
-- releasing a message from an SQL quarantine was broken in version 2.9.1
- due to introduction of parent_mail_id(); patches provided by Stef Simoens
- and Gionatan Danti;
+- releasing a message from an SQL quarantine was broken in version
+ 2.9.1 due to introduction of parent_mail_id(); patches provided by
+ Stef Simoens and Gionatan Danti;
-- if checking of a message was aborted prematurely (like due to a timeout
- or some fatal error), JSON log could receive a copy of a previous
- log entry;
+- if checking of a message was aborted prematurely (like due to a
+ timeout or some fatal error), JSON log could receive a copy of a
+ previous log entry;
- prevent non-ASCII non-UTF-8 octets from reaching a JSON log/report
(which produced an invalid JSON object and Elasticsearch complaining);
@@ -2086,10 +2578,12 @@ BUG FIXES
'xz') were glued together, so the xz decoder was only available if found
under names 'unxz' or 'xzcat';
-- provide a workaround for a bug [rt.cpan.org #64642] in a perl module
- Encode, which gratuitously untaints a string when encoding or decoding it:
+- provide a workaround for a bug [rt.cpan.org #64642] [rt.cpan.org #84879]
+ in a perl module Encode, which gratuitously untaints a string when encoding
+ or decoding it:
https://rt.cpan.org/Public/Bug/Display.html?id=64642
- (still unfixed in Encode 2.44, perl 5.14.2);
+ https://rt.cpan.org/Ticket/Display.html?id=84879
+ (fixed in Encode 2.50);
A module Scalar::Util is now required, which should not be a compatibility
problem, as this module is a Perl core module since perl 5.8.0.
diff --git a/TinyRedis.pm b/TinyRedis.pm
index 82a6d00..efb4425 100755
--- a/TinyRedis.pm
+++ b/TinyRedis.pm
@@ -18,7 +18,7 @@ use Time::HiRes ();
use vars qw($VERSION $io_socket_module_name);
BEGIN {
- $VERSION = '1.000';
+ $VERSION = '1.001';
if (eval { require IO::Socket::IP }) {
$io_socket_module_name = 'IO::Socket::IP';
} elsif (eval { require IO::Socket::INET6 }) {
@@ -60,9 +60,12 @@ sub connect {
if ($server =~ m{^/}) {
$sock = IO::Socket::UNIX->new(
Peer => $server, Type => SOCK_STREAM);
- } else {
+ } elsif ($server =~ /^(?: \[ ([^\]]+) \] | ([^:]+) ) : ([^:]+) \z/xs) {
+ $server = defined $1 ? $1 : $2; my $port = $3;
$sock = $io_socket_module_name->new(
- PeerAddr => $server, Proto => 'tcp');
+ PeerAddr => $server, PeerPort => $port, Proto => 'tcp');
+ } else {
+ die "Invalid 'server:port' specification: $server";
}
if ($sock) {
$self->{sock} = $sock;
diff --git a/amavisd b/amavisd
index f50a708..7f93194 100755
--- a/amavisd
+++ b/amavisd
@@ -14,7 +14,7 @@
# on amavisd-snapshot-20020300).
#
# All work since amavisd-snapshot-20020300:
-# Copyright (C) 2002-2014 Mark Martinec,
+# Copyright (C) 2002-2016 Mark Martinec,
# All Rights Reserved.
# with contributions from the amavis-user mailing list and individuals,
# as acknowledged in the release notes.
@@ -62,11 +62,11 @@
#Index of packages in this file
# Amavis::Boot
# Amavis::Conf
+# Amavis::JSON
# Amavis::Log
# Amavis::DbgLog
# Amavis::Timing
# Amavis::Util
-# Amavis::JSON
# Amavis::ProcControl
# Amavis::rfc2821_2822_Tools
# Amavis::Lookup::RE
@@ -139,6 +139,7 @@ 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';
#
package Amavis::Boot;
@@ -284,19 +285,20 @@ use constant CC_VIRUS => 9;
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
%EXPORT_TAGS = (
'dynamic_confvars' => # per- policy bank settings
[qw(
$child_timeout $smtpd_timeout
- $policy_bank_name $protocol @inet_acl
+ $policy_bank_name $protocol $haproxy_target_enabled @inet_acl
$myhostname $myauthservid $snmp_contact $snmp_location
$myprogram_name $syslog_ident $syslog_facility
$log_level $log_templ $log_recip_templ $enable_log_capture_dump
$forward_method $notify_method $resend_method $report_format
$release_method $requeue_method $release_format
$attachment_password $attachment_email_name $attachment_outer_name
+ $mail_digest_algorithm $mail_part_digest_algorithm
$os_fingerprint_method $os_fingerprint_dst_ip_and_port
$originating @smtpd_discard_ehlo_keywords $soft_bounce
$propagate_dsn_if_possible $terminate_dsn_on_notify_success
@@ -384,9 +386,9 @@ BEGIN {
$min_servers $min_spare_servers $max_spare_servers
%current_policy_bank %policy_bank %interface_policy
@listen_sockets $inet_socket_port $inet_socket_bind $listen_queue_size
- $unix_socketname $unix_socket_mode
+ $smtpd_recipient_limit $unix_socketname $unix_socket_mode
$smtp_connection_cache_on_demand $smtp_connection_cache_enable
- $smtpd_recipient_limit
+ %smtp_tls_client_options %smtpd_tls_server_options
$smtpd_tls_cert_file $smtpd_tls_key_file
$enforce_smtpd_message_size_limit_64kb_min
$MAXLEVELS $MAXFILES
@@ -398,9 +400,8 @@ BEGIN {
$sql_schema_version $timestamp_fmt_mysql
$sql_quarantine_chunksize_max $sql_allow_8bit_address
$sql_lookups_no_at_means_domain $ldap_lookups_no_at_means_domain
- $sql_store_info_for_all_msgs
+ $sql_store_info_for_all_msgs $default_ldap
$trim_trailing_space_in_lookup_result_fields
- $default_ldap $mail_digest_algorithm
@keep_decoded_original_maps @map_full_type_to_short_type_maps
%banned_rules $penpals_threshold_low $penpals_threshold_high
%dkim_signing_keys_by_domain
@@ -677,7 +678,7 @@ BEGIN { # init_primary: version, base policy bank
$myprogram_name = $0; # typically 'amavisd'
local $1; $myprogram_name =~ s{([^/]*)\z}{$1}s;
$myproduct_name = 'amavisd-new';
- $myversion_id = '2.10.1'; $myversion_date = '20141025';
+ $myversion_id = '2.11.0'; $myversion_date = '20160426';
$myversion = "$myproduct_name-$myversion_id ($myversion_date)";
$myversion_id_numeric = # x.yyyzzz, allows numerical compare, like Perl $]
@@ -724,7 +725,7 @@ BEGIN {
$allow_preserving_evidence = 1;
# Cause Net::Server parameters 'background' and 'setsid' to be set,
- # resulting in the program to detach itself from the terminal
+ # resulting in the process to detach itself from the terminal
$daemonize = 1;
# Net::Server pre-forking settings - defaults, overruled by amavisd.conf
@@ -804,6 +805,16 @@ BEGIN {
#
$mail_digest_algorithm = 'MD5'; # or 'SHA-1' or 'SHA-256', ...
+ # Algorithm name for generating digests of decoded MIME parts of a message.
+ # The value is an algorithm name as accepted by Digest::SHA->new(),
+ # e.g. 'SHA-1' or 'SHA-256' or 'sha256', or a string 'MD5' which implies
+ # the MD5 algorithm as implemented by a module Digest::MD5.
+ # For compatibility with SpamAssassin the chosen algorithm should be SHA1,
+ # otherwise bayes tokens won't match those generated by sa-learn.
+ # Undefined value disables generating digests of MIME parts.
+ #
+ $mail_part_digest_algorithm = 'SHA1';
+
# Where to find SQL server(s) and database to support SQL lookups?
# A list of triples: (dsn,user,passw). Specify more than one
# for multiple (backup) SQL servers.
@@ -1008,10 +1019,49 @@ BEGIN {
#$auth_required_inp = 1; # incoming SMTP authentication required by amavisd?
#$auth_required_out = 1; # SMTP authentication required by MTA
$auth_required_release = 1; # secret_id is required for a quarantine release
+
$tls_security_level_in = undef; # undef, 'may', 'encrypt', ...
$tls_security_level_out = undef; # undef, 'may', 'encrypt', ...
- $smtpd_tls_cert_file = undef; # e.g. "$MYHOME/cert/amavisd-cert.pem"
- $smtpd_tls_key_file = undef; # e.g. "$MYHOME/cert/amavisd-key.pem"
+
+ # Server side certificate and key: $smtpd_tls_cert_file, $smtpd_tls_key_file.
+ # These two settings are now deprecated, set fields 'SSL_key_file'
+ # and 'SSL_cert_file' directly in %smtpd_tls_server_options instead.
+ # For compatibility with 2.10 the values of $smtpd_tls_cert_file
+ # and $smtpd_tls_key_file are fed into %smtpd_tls_server_options
+ # if fields 'SSL_key_file' and 'SSL_cert_file' are not provided.
+ #
+ # $smtpd_tls_cert_file = undef; # e.g. "$MYHOME/cert/amavisd-cert.pem"
+ # $smtpd_tls_key_file = undef; # e.g. "$MYHOME/cert/amavisd-key.pem"
+
+ # The following options are passed to IO::Socket::SSL::start_SSL() when
+ # setting up a server side of a TLS session (from MTA). The only options
+ # passed implicitly are SSL_server, SSL_hostname, and SSL_error_trap.
+ # See IO::Socket::SSL documentation.
+ #
+ %smtpd_tls_server_options = (
+ SSL_verifycn_scheme => 'smtp',
+ SSL_session_cache => 2,
+# SSL_key_file => $smtpd_tls_key_file,
+# SSL_cert_file => $smtpd_tls_cert_file,
+# SSL_dh_file => ... ,
+# SSL_ca_file => ... ,
+# SSL_version => '!SSLv2,!SSLv3',
+# SSL_cipher_list => 'HIGH:!MD5:!DSS:!aNULL',
+# SSL_passwd_cb => sub { 'example' },
+# ...
+ );
+
+ # The following options are passed to IO::Socket::SSL::start_SSL() when
+ # setting up a client side of a TLS session back to MTA. The only options
+ # passed implicitly are SSL_session_cache and SSL_error_trap.
+ # See IO::Socket::SSL documentation.
+ #
+ %smtp_tls_client_options = (
+ SSL_verifycn_scheme => 'smtp',
+# SSL_version => '!SSLv2,!SSLv3',
+# SSL_cipher_list => 'HIGH:!MD5:!DSS:!aNULL',
+# SSL_client_ca_file => ... ,
+ );
$dkim_minimum_key_bits = 1024; # min acceptable DKIM key size (in bits)
# for whitelisting
@@ -1494,10 +1544,15 @@ BEGIN {
[qr/^UTF.* Unicode text\b/i => 'txt'],
[qr/^'diff' output text\b/ => 'txt'],
[qr/^GNU message catalog\b/ => 'mo'],
- [qr/^(?:PGP|GPG) encrypted data\b/ => ['pgp','pgp.enc'] ],
- [qr/^PGP message\b/ => ['pgp','pgp.enc'] ],
+
+ [qr/^PGP message [Ss]ignature\b/ => ['pgp','pgp.asc'] ],
+ [qr/^PGP message.*[Ee]ncrypted\b/ => ['pgp','pgp.enc'] ],
+ [qr/^PGP message\z/ => ['pgp','pgp.enc'] ],
+ [qr/^(?:PGP|GPG) encrypted data\b/ => ['pgp','pgp.enc'] ],
+ [qr/^PGP public key\b/ => ['pgp','pgp.asc'] ],
[qr/^PGP armored data( signed)? message\b/ => ['pgp','pgp.asc'] ],
- [qr/^PGP armored\b/ => ['pgp','pgp.asc'] ],
+ [qr/^PGP armored\b/ => ['pgp','pgp.asc'] ],
+ [qr/^PGP\b/ => 'pgp' ],
### 'file' is a bit too trigger happy to claim something is 'mail text'
# [qr/^RFC 822 mail text\b/ => 'mail'],
@@ -1537,6 +1592,7 @@ BEGIN {
[qr/^PDF document\b/ => 'pdf'],
[qr/^Rich Text Format data\b/ => 'rtf'],
[qr/^Microsoft Office Document\b/i => 'doc'], # OLE2: doc, ppt, xls,...
+ [qr/^Microsoft Word\b/i => 'doc'],
[qr/^Microsoft Installer\b/i => 'doc'], # file(1) may misclassify
[qr/^ms-windows meta(file|font)\b/i => 'wmf'],
[qr/^LaTeX\b.*\bdocument text\b/ => 'lat'],
@@ -1578,7 +1634,7 @@ BEGIN {
[qr/^binhex\b/i => 'hqx'],
[qr/^(ASCII|text)\b/i => 'asc'],
[qr/^Emacs.*byte-compiled Lisp data/i => 'asc'], # BinHex with empty line
- [qr/\bscript text executable\b/ => 'txt'],
+ [qr/\bscript\b.* text executable\b/ => 'txt'],
[qr/^MS Windows\b.*\bDLL\b/ => ['exe','dll'] ],
[qr/\bexecutable for MS Windows\b.*\bDLL\b/ => ['exe','dll'] ],
@@ -2001,8 +2057,12 @@ no warnings 'once';
*iso8601_timestamp = \&Amavis::rfc2821_2822_Tools::iso8601_timestamp;
*iso8601_utc_timestamp = \&Amavis::rfc2821_2822_Tools::iso8601_utc_timestamp;
+# a shorthand for creating a regexp-based lookup table
sub new_RE { Amavis::Lookup::RE->new(@_) }
+# shorthand: construct a query object for a DNSxL query on an IP address
+sub q_dns_a { Amavis::Lookup::DNSxL->new(@_) } # dns zone, expect, resolver
+
# shorthand: construct a query object for an SQL field
sub q_sql_s { Amavis::Lookup::SQLfield->new(undef, $_[0], 'S-') } # string
sub q_sql_n { Amavis::Lookup::SQLfield->new(undef, $_[0], 'N-') } # numeric
@@ -2047,6 +2107,7 @@ use vars qw(%final_destiny_by_ccat %defang_by_ccat
[ qr'^(Heuristics\.)?Phishing\.' => 0.1 ],
[ qr'^(Email|HTML)\.Phishing\.(?!.*Sanesecurity)' => 0.1 ],
[ qr'^Sanesecurity\.(Malware|Rogue|Trojan)\.' => undef ],# keep as infected
+ [ qr'^Sanesecurity\.Foxhole\.Zip_exe' => 0.1 ], # F.P.
[ qr'^Sanesecurity\.Foxhole\.' => undef ],# keep as infected
[ qr'^Sanesecurity\.' => 0.1 ],
[ qr'^Sanesecurity_PhishBar_' => 0 ],
@@ -2067,6 +2128,7 @@ use vars qw(%final_destiny_by_ccat %defang_by_ccat
[ qr'^PORCUPINE_JUNK' => 0.1 ],
[ qr'^PORCUPINE_PHISHING' => 0.1 ],
[ qr'^Porcupine\.Junk' => 0.1 ],
+ [ qr'^PhishTank\.Phishing\.' => 0.1 ],
[ qr'-SecuriteInfo\.com(\.|\z)' => undef ], # keep as infected
[ qr'^MBL_NA\.UNOFFICIAL' => 0.1 ], # false positives
[ qr'^MBL_' => undef ], # keep as infected
@@ -2179,7 +2241,7 @@ sub supply_after_defaults() {
$helpers_home = $MYHOME if !defined $helpers_home;
$db_home = "$MYHOME/db" if !defined $db_home;
@zmq_sockets = ( "ipc://$MYHOME/amavisd-zmq.sock" ) if !@zmq_sockets;
- $pid_file = "$MYHOME/amavisd.pid" if !defined $pid_file;
+ $pid_file = "$MYHOME/amavisd.pid" if !defined $pid_file && $daemonize;
# just keep $lock_file undefined by default, a temp file (POSIX::tmpnam) will
# be provided by Net::Server for 'flock' serialization on a socket accept()
# $lock_file = "$MYHOME/amavisd.lock" if !defined $lock_file;
@@ -2237,6 +2299,72 @@ sub supply_after_defaults() {
1;
#
+package Amavis::JSON;
+use strict;
+use re 'taint';
+
+# serialize a data structure to JSON, RFC 7159
+
+BEGIN {
+ require Exporter;
+ use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+ $VERSION = '2.412';
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(&boolean &numeric);
+}
+use subs @EXPORT_OK;
+
+our %jesc = ( # JSON escaping
+ "\x22" => '\\"', "\x5C" => '\\\\',
+ "\x08" => '\\b', "\x09" => '\\t',
+ "\x0A" => '\\n', "\x0C" => '\\f', "\x0D" => '\\r',
+ "\x{2028}" => '\\u2028', "\x{2029}" => '\\u2029' );
+ # escape also the Line Separator (U+2028) and Paragraph Separator (U+2029)
+ # http://timelessrepo.com/json-isnt-a-javascript-subset
+
+our($FALSE, $TRUE) = ('false', 'true');
+sub boolean { bless($_[0] ? \$TRUE : \$FALSE) }
+sub numeric { my $value = $_[0]; bless(\$value) }
+
+# serialize a data structure to JSON, RFC 7159
+# expects logical characters in scalars, returns a string of logical chars
+#
+sub encode($); # prototype
+sub encode($) {
+ my $val = $_[0];
+ my $ref = ref $val;
+ local $1;
+ if ($ref) {
+ if ($ref eq 'ARRAY') {
+ return '[' . join(',', map(encode($_), @$val)) . ']';
+ } elsif ($ref eq 'HASH') {
+ return '{' .
+ join(',',
+ map {
+ my $k = $_;
+ $k =~ s{ ([\x00-\x1F\x7F\x{2028}\x{2029}"\\]) }
+ { $jesc{$1} || sprintf('\\u%04X',ord($1)) }xgse;
+ '"' . $k . '":' . encode($val->{$_});
+ } sort keys %$val
+ ) . '}';
+ } elsif ($ref->isa('Amavis::JSON')) { # numeric or boolean type
+ return defined $$val ? $$val : 'null';
+ }
+ # fall through, encode other refs as strings, helps debugging
+ }
+ return 'null' if !defined $val;
+ { # concession on a perl 5.20.0 bug [perl #122148] (fixed in 5.20.1)
+ # - just warn, do not abort
+ use warnings NONFATAL => qw(utf8);
+ $val =~ s{ ([\x00-\x1F\x7F\x{2028}\x{2029}"\\]) }
+ { $jesc{$1} || sprintf('\\u%04X',ord($1)) }xgse;
+ };
+ '"' . $val . '"';
+}
+
+1;
+
+#
package Amavis::Log;
use strict;
use re 'taint';
@@ -2244,7 +2372,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&init &amavis_log_id &collect_log_stats
&log_to_stderr &log_fd &open_log &close_log &write_log);
@@ -2255,10 +2383,10 @@ BEGIN {
use subs @EXPORT_OK;
use POSIX qw(locale_h strftime);
-use Fcntl qw(:flock);
+use Fcntl qw(:flock F_GETFL F_SETFL FD_CLOEXEC);
+use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL);
use Unix::Syslog qw(:macros :subs);
use Time::HiRes ();
-use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL);
# since IO::File 1.10 (comes with perl 5.8.1):
# If "IO::File::open" is given a mode that includes the ":" character,
@@ -2271,6 +2399,7 @@ use vars qw($current_actual_syslog_ident $current_actual_syslog_facility);
use vars qw($log_lines $log_retries %log_entries_by_level %log_status_counts);
use vars qw($log_prio_debug $log_prio_info $log_prio_notice
$log_prio_warning $log_prio_err $log_prio_crit);
+
BEGIN { # saves a few ms by avoiding a subroutine call later
$log_prio_debug = LOG_DEBUG;
$log_prio_info = LOG_INFO;
@@ -2278,15 +2407,16 @@ BEGIN { # saves a few ms by avoiding a subroutine call later
$log_prio_warning = LOG_WARNING;
$log_prio_err = LOG_ERR;
$log_prio_crit = LOG_CRIT;
+ $log_to_stderr = 1; # default until config files have been read
}
sub init($$) {
($log_to_syslog, $logfile_name) = @_;
$log_lines = 0; %log_entries_by_level = ();
$log_retries = 0; %log_status_counts = ();
+ $log_to_stderr =
+ $log_to_syslog || (defined $logfile_name && $logfile_name ne '') ? 0 : 1;
open_log();
- if (!$log_to_syslog && $logfile_name eq '')
- { print STDERR "Logging to STDERR (no \$logfile and no \$do_syslog)\n" }
}
sub collect_log_stats() {
@@ -2315,13 +2445,12 @@ sub log_to_stderr(;$) {
#
sub log_fd() {
$log_to_stderr ? fileno(STDERR)
- : $log_to_syslog ? undef # how to obtain fd on syslog?
+ : $log_to_syslog ? undef # no fd for syslog
: defined $loghandle ? $loghandle->fileno : fileno(STDERR);
}
sub open_log() {
- # don't bother to skip opening the log even if $log_to_stderr (debug) is true
- if ($log_to_syslog) {
+ if ($log_to_syslog && !$log_to_stderr) {
my $id = c('syslog_ident'); my $fac = c('syslog_facility');
$fac =~ /^[A-Za-z0-9_]+\z/
or die "Suspicious syslog facility name: $fac";
@@ -2335,6 +2464,12 @@ sub open_log() {
# is to use a string constant. (we use a static variable here)
$current_actual_syslog_ident = $id; $current_actual_syslog_facility = $fac;
openlog($id, LOG_PID | LOG_NDELAY, $syslog_facility_num);
+
+ } elsif ($log_to_stderr || $logfile_name eq '') { # logging to STDERR
+ STDERR->autoflush(1); # just in case (should already be on by default)
+ STDERR->fcntl(F_SETFL, O_APPEND)
+ or warn "Error setting O_APPEND on STDERR: $!";
+
} elsif ($logfile_name ne '') {
$loghandle = IO::File->new;
# O_WRONLY etc. can become tainted in Perl5.8.9 [perlbug #62502]
@@ -2343,7 +2478,7 @@ sub open_log() {
or die "Failed to open log file $logfile_name: $!";
binmode($loghandle,':bytes') or die "Can't cancel :utf8 mode: $!";
$loghandle->autoflush(1);
- if ($> == 0) {
+ if (defined $daemon_user && $daemon_user ne '' && $> == 0) {
local($1);
my $uid = $daemon_user=~/^(\d+)$/ ? $1 : (getpwnam($daemon_user))[2];
if ($uid) {
@@ -2351,8 +2486,6 @@ sub open_log() {
or die "Can't chown logfile $logfile_name to $uid: $!";
}
}
- } else { # logging to STDERR
- STDERR->autoflush(1); # just in case
}
}
@@ -2378,14 +2511,16 @@ sub write_log($$) {
my $alert_mark = $level >= 0 ? '' : $level >= -1 ? '(!)' : '(!!)';
# $alert_mark .= '*' if $> == 0;
$log_entries_by_level{"$level"}++;
+
+ my $prio = $level >= 3 ? $log_prio_debug # most frequent first
+ # : $level >= 2 ? $log_prio_info
+ : $level >= 1 ? $log_prio_info
+ : $level >= 0 ? $log_prio_notice
+ : $level >= -1 ? $log_prio_warning
+ : $level >= -2 ? $log_prio_err
+ : $log_prio_crit;
+
if ($log_to_syslog && !$log_to_stderr) {
- my $prio = $level >= 3 ? $log_prio_debug # most frequent first
- # : $level >= 2 ? $log_prio_info
- : $level >= 1 ? $log_prio_info
- : $level >= 0 ? $log_prio_notice
- : $level >= -1 ? $log_prio_warning
- : $level >= -2 ? $log_prio_err
- : $log_prio_crit;
if ($Amavis::Util::current_config_syslog_ident
ne $current_actual_syslog_ident ||
$Amavis::Util::current_config_syslog_facility
@@ -2412,29 +2547,52 @@ sub write_log($$) {
# syslog($prio, '%s', $am_id . $pre . $errmsg);
Unix::Syslog::_isyslog($prio, $am_id . $pre . $errmsg);
if ($! != 0) { $log_retries++; $log_status_counts{"$!"}++ }
- } else {
+
+ } elsif ($log_to_stderr || !defined $loghandle) {
$log_lines++;
- my $now = Time::HiRes::time;
- if ($log_to_stderr || !defined $loghandle) {
- # milliseconds in timestamp
- my $prefix = sprintf('%s:%06.3f %s %s[%s]: ', # syslog-like prefix
+ my $prefix;
+ if ($DEBUG) {
+ my $now = Time::HiRes::time; # timestamp with milliseconds
+ $prefix = sprintf('%s:%06.3f %s %s[%s]: ', # syslog-like prefix
strftime('%b %e %H:%M',localtime($now)), $now-int($now/60)*60,
Amavis::Util::idn_to_utf8(c('myhostname')), c('myprogram_name'), $$);
- # avoid multiple calls to write(2), join the string first!
- my $s = $prefix . $am_id . $alert_mark . $errmsg . "\n";
- print STDERR ($s) or die "Error writing to STDERR: $!";
} else {
- my $prefix = sprintf('%s %s %s[%s]: ', # prepare a syslog-like prefix
- strftime('%b %e %H:%M:%S',localtime($now)),
- Amavis::Util::idn_to_utf8(c('myhostname')), c('myprogram_name'), $$);
- my $s = $prefix . $am_id . $alert_mark . $errmsg . "\n";
- # NOTE: a lock is on a file, not on a file handle
- flock($loghandle,LOCK_EX) or die "Can't lock a log file: $!";
- seek($loghandle,0,2) or die "Can't position log file to its tail: $!";
- $loghandle->print($s) or die "Error writing to log file: $!";
- # we have autoflush on, so unlocking here is safe
- flock($loghandle,LOCK_UN) or die "Can't unlock a log file: $!";
+ $prefix = "<$prio>"; # sd-daemon(3), SyslogLevelPrefix=true
}
+ # avoid multiple calls to write(2), join the string first!
+ my $s = $prefix . $am_id . $alert_mark . $errmsg . "\n";
+ #
+ # IEEE Std 1003.1, 2013: Write requests to a pipe or FIFO shall be handled
+ # in the same way as a regular file with the following exceptions: [...]
+ # - There is no file offset associated with a pipe, hence each write
+ # request shall append to the end of the pipe.
+ # - Write requests of {PIPE_BUF} bytes or less shall not be interleaved
+ # with data from other processes doing writes on the same pipe.
+ # Writes of greater than {PIPE_BUF} bytes may have data interleaved, on
+ # arbitrary boundaries, with writes by other processes, whether or not
+ # the O_NONBLOCK flag of the file status flags is set.
+ #
+ # PIPE_BUF is 512 on *BSD, 4096 on Linux.
+ print STDERR ($s) or die "Error writing to STDERR: $!";
+
+ } else {
+ $log_lines++;
+ my $now = Time::HiRes::time;
+ my $prefix = sprintf('%s %s %s[%s]: ', # prepare a syslog-like prefix
+ strftime('%b %e %H:%M:%S',localtime($now)),
+ Amavis::Util::idn_to_utf8(c('myhostname')), c('myprogram_name'), $$);
+ my $s = $prefix . $am_id . $alert_mark . $errmsg . "\n";
+ # NOTE: a lock is on a file, not on a file handle
+ flock($loghandle,LOCK_EX) or die "Can't lock a log file: $!";
+ # seek() seems redundant with O_APPEND:
+ # IEEE Std 1003.1, 2013: If the O_APPEND flag of the file status flags is
+ # set, the file offset shall be set to the end of the file prior to each
+ # write and no intervening file modification operation shall occur between
+ # changing the file offset and the write operation.
+ seek($loghandle,0,2) or die "Can't position log file to its tail: $!";
+ $loghandle->print($s) or die "Error writing to log file: $!";
+ # we have autoflush on, so unlocking here is safe
+ flock($loghandle,LOCK_UN) or die "Can't unlock a log file: $!";
}
# POSIX::setlocale(LC_TIME, $old_locale);
$within_write_log = 0;
@@ -2449,7 +2607,7 @@ use re 'taint';
BEGIN {
use vars qw(@ISA $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
import Amavis::Conf qw(:platform $TEMPBASE);
import Amavis::Log qw(write_log);
}
@@ -2546,7 +2704,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&init §ion_time &report &get_time_so_far
&get_rusage &rusage_report);
@@ -2701,12 +2859,12 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&untaint &untaint_inplace &min &max &minmax
&unique_list &unique_ref &format_time_interval
&is_valid_utf_8 &truncate_utf_8
- &safe_encode &safe_encode_utf8 &safe_encode_ascii
+ &safe_encode &safe_encode_utf8 &safe_encode_utf8_inplace
&safe_decode &safe_decode_utf8 &safe_decode_latin1
&safe_decode_mime &q_encode &orcpt_encode &orcpt_decode
&xtext_encode &xtext_decode &proto_encode &proto_decode
@@ -2747,28 +2905,52 @@ use Encode (); # Perl 5.8 UTF-8 support
use Scalar::Util qw(tainted);
use Net::LibIDN ();
-use vars qw($enc_ascii $enc_utf8 $enc_latin1 $enc_tainted
+use vars qw($enc_ascii $enc_utf8 $enc_latin1 $enc_w1252 $enc_tainted
$enc_taintsafe $enc_is_utf8_buggy);
BEGIN {
$enc_ascii = Encode::find_encoding('ascii');
$enc_utf8 = Encode::find_encoding('UTF-8'); # same as utf-8-strict
$enc_latin1 = Encode::find_encoding('ISO-8859-1');
- $enc_ascii or die "Amavis::Util: unknown encoding 'ascii'";
- $enc_utf8 or die "Amavis::Util: unknown encoding 'UTF-8'";
- $enc_latin1 or die "Amavis::Util: unknown encoding 'ISO-8859-1'";
+ $enc_w1252 = Encode::find_encoding('Windows-1252');
+ $enc_ascii or die "Amavis::Util: unknown encoding 'ascii'";
+ $enc_utf8 or die "Amavis::Util: unknown encoding 'UTF-8'";
+ $enc_latin1 or die "Amavis::Util: unknown encoding 'ISO-8859-1'";
+ $enc_w1252 or warn "Amavis::Util: unknown encoding 'Windows-1252'";
$enc_tainted = substr($ENV{PATH}.$ENV{HOME}, 0,0); # tainted empty string
- # Encode::is_utf8 is always false on tainted in Perl 5.8, Perl bug #32687
- $enc_is_utf8_buggy = 1 if $] < 5.010;
+ $enc_taintsafe = 1; # guessing
if (!tainted($enc_tainted)) {
warn "Amavis::Util: can't obtain a tainted string";
- $enc_taintsafe = 1; # guessing
} else {
- # test for Encode taint laundering bug [rt.cpan.org #84879], fixed in 2.50
# NOTE: [rt.cpan.org #85489] - Encode::encode turns on the UTF8 flag
# on a passed argument. Give it a copy to avoid turning $enc_tainted
- # into a UTF-8 string!
- my $t = $enc_ascii->encode("$enc_tainted");
- $enc_taintsafe = 1 if tainted($t);
+ # or $enc_ps into a UTF-8 string!
+
+ # Encode::is_utf8 is always false on tainted in Perl 5.8, Perl bug #32687
+ my $enc_ps = "\x{2029}"; # Paragraph Separator, utf8 flag on
+ if (!Encode::is_utf8("$enc_ps $enc_tainted")) {
+ $enc_is_utf8_buggy = 1;
+ warn "Amavis::Util, Encode::is_utf8() fails to detect utf8 on tainted";
+ }
+ # test for Encode taint laundering bug [rt.cpan.org #84879], fixed in 2.50
+ if (!tainted($enc_ascii->encode("$enc_ps $enc_tainted"))) {
+ $enc_taintsafe = 0;
+ warn "Amavis::Util, Encode::encode() taint laundering bug, ".
+ "fixed in Encode 2.50";
+ } elsif (!tainted($enc_ascii->decode("xx $enc_tainted"))) {
+ $enc_taintsafe = 0;
+ warn "Amavis::Util, Encode::decode() taint laundering bug, ".
+ "fixed in Encode 2.50";
+ }
+ utf8::is_utf8("$enc_ps $enc_tainted")
+ or die "Amavis::Util, utf8::is_utf8() fails to detect utf8 on tainted";
+ !utf8::is_utf8("\xA0 $enc_tainted")
+ or die "Amavis::Util, utf8::is_utf8() claims utf8 on tainted";
+ my $t = "$enc_ps $enc_tainted";
+ utf8::encode($t);
+ tainted($t)
+ or die "Amavis::Util, utf8::encode() taint laundering bug";
+ !utf8::is_utf8($t)
+ or die "Amavis::Util, utf8::encode() failed to clear utf8 flag";
}
1;
}
@@ -2872,8 +3054,10 @@ sub is_valid_utf_8($) {
# UTF8-tail = %x80-BF
#
# loose variant:
- # [\x00-\x7F] | [\xC0-\xDF][\x80-\xBF] |
- # [\xE0-\xEF][\x80-\xBF]{2} | [\xF0-\xF4][\x80-\xBF]{3}
+ # [\x00-\x7F] |
+ # [\xC0-\xDF][\x80-\xBF] |
+ # [\xE0-\xEF][\x80-\xBF]{2} |
+ # [\xF0-\xF4][\x80-\xBF]{3}
#
$_[0] =~ /^ (?: [\x00-\x7F] |
[\xC2-\xDF] [\x80-\xBF] |
@@ -2910,9 +3094,9 @@ sub truncate_utf_8($;$) {
# A wrapper for Encode::encode, avoiding a bug in Perl 5.8.0 which causes
# Encode::encode to loop and fill memory when given a tainted string.
# Also works around a CPAN bug #64642 in module Encode:
-# Tainted values have the taint flag cleared when encoded (or decoded)
+# Tainted values have the taint flag cleared when encoded or decoded.
# https://rt.cpan.org/Public/Bug/Display.html?id=64642
-# (still unresolved with Encode as bundled with Perl 5.14.2)
+# Fixed in Encode 2.50 [rt.cpan.org #84879].
#
sub safe_encode($$;$) {
# my($encoding,$str,$check) = @_;
@@ -2929,14 +3113,6 @@ sub safe_encode($$;$) {
$enc_tainted . $enc->encode(untaint($_[0]), $_[1]);
}
-sub safe_encode_ascii($) {
-# my $str = $_[0];
- return undef if !defined $_[0]; # must return undef even in a list context!
- return $enc_ascii->encode($_[0]) if $enc_taintsafe || !tainted($_[0]);
- # propagate taintedness across taint-related bugs in module Encode
- $enc_tainted . $enc_ascii->encode(untaint($_[0]));
-}
-
# Encodes logical characters to UTF-8 octets, or returns a string of octets
# (with utf8 flag off) unchanged. Ensures the result is always a string of
# octets (utf8 flag off). Unlike safe_encode(), a non-ASCII string with
@@ -2946,32 +3122,52 @@ sub safe_encode_ascii($) {
sub safe_encode_utf8($) {
my $str = $_[0];
return undef if !defined $str; # must return undef even in a list context!
- if ( ($enc_taintsafe && !$enc_is_utf8_buggy) || !tainted($str) ) {
- Encode::is_utf8($str) ? $enc_utf8->encode($str) : $str;
- } else { # work around bugs in Encode
- # propagate taintedness across taint-related bugs in module Encode
- untaint_inplace($str);
- $enc_tainted . (Encode::is_utf8($str) ? $enc_utf8->encode($str) : $str);
- }
+ utf8::encode($str) if utf8::is_utf8($str);
+ $str;
}
-sub safe_decode_latin1($) {
-# my $str = $_[0];
+sub safe_encode_utf8_inplace($) {
return undef if !defined $_[0]; # must return undef even in a list context!
- $enc_latin1->decode($_[0]);
+ utf8::encode($_[0]) if utf8::is_utf8($_[0]);
+}
+
+sub safe_decode_latin1($) {
+ my $str = $_[0];
+ return undef if !defined $str; # must return undef even in a list context!
+ #
+ # -> http://en.wikipedia.org/wiki/Windows-1252
+ # Windows-1252 character encoding is a superset of ISO 8859-1, but differs
+ # from the IANA's ISO-8859-1 by using displayable characters rather than
+ # control characters in the 80 to 9F (hex) range. [...]
+ # It is very common to mislabel Windows-1252 text with the charset label
+ # ISO-8859-1. A common result was that all the quotes and apostrophes
+ # (produced by "smart quotes" in word-processing software) were replaced
+ # with question marks or boxes on non-Windows operating systems, making
+ # text difficult to read. Most modern web browsers and e-mail clients
+ # treat the MIME charset ISO-8859-1 as Windows-1252 to accommodate
+ # such mislabeling. This is now standard behavior in the draft HTML 5
+ # specification, which requires that documents advertised as ISO-8859-1
+ # actually be parsed with the Windows-1252 encoding.
+ #
+ if ($enc_taintsafe || !tainted($str)) {
+ return ($enc_w1252||$enc_latin1)->decode($str);
+ } else { # work around bugs in Encode
+ untaint_inplace($str);
+ return $enc_tainted . ($enc_w1252||$enc_latin1)->decode($str);
+ }
}
sub safe_decode_utf8($;$) {
my($str,$check) = @_;
return undef if !defined $str; # must return undef even in a list context!
- if ( ($enc_taintsafe && !$enc_is_utf8_buggy) || !tainted($str)) {
- Encode::is_utf8($str) ? $str : $enc_utf8->decode($str,$check);
+ if ($enc_taintsafe || !tainted($str)) {
+ return utf8::is_utf8($str) ? $str : $enc_utf8->decode($str,$check);
} else {
# Work around a taint laundering bug in Encode [rt.cpan.org #84879].
# Propagate taintedness across taint-related bugs in module Encode.
untaint_inplace($str);
- $enc_tainted . (Encode::is_utf8($str) ? $str
- : $enc_utf8->decode($str,$check));
+ return $enc_tainted .
+ (utf8::is_utf8($str) ? $str : $enc_utf8->decode($str,$check));
}
}
@@ -3000,14 +3196,14 @@ sub clear_idn_cache() { %idn_encode_cache = () }
sub idn_to_ascii($) {
# propagate taintedness of the argument, but not its utf8 flag
return tainted($_[0]) ? $idn_encode_cache{$_[0]} . $enc_tainted
- : $idn_encode_cache{$_[0]}
+ : $idn_encode_cache{$_[0]}
if exists $idn_encode_cache{$_[0]};
my $s = $_[0];
my $t = tainted($s); # taintedness of the argument
return undef if !defined $s;
untaint_inplace($s) if $t;
- # to octets if needed, not necessarily valid UTF-8 (inlined safe_encode_utf8)
- $s = $enc_utf8->encode($s) if Encode::is_utf8($s);
+ # to octets if needed, not necessarily valid UTF-8
+ utf8::encode($s) if utf8::is_utf8($s);
if ($s !~ tr/\x00-\x7F//c) { # is all-ASCII (including IP address literal)
$s = lc $s;
} else {
@@ -3037,7 +3233,7 @@ sub idn_to_ascii($) {
sub idn_to_utf8($) {
my $s = $_[0];
return undef if !defined $s;
- $s = safe_encode_utf8($s); # to octets (if not already)
+ safe_encode_utf8_inplace($s); # to octets (if not already)
if ($s =~ /(?: ^ | \. ) xn-- [\x00-\x2D\x2F-\xFF]{0,58} [\x00-\x2C\x2F-\xFF]
(?: \z | \. )/xsi) { # contains XN-label
my $su = Net::LibIDN::idn_to_unicode(lc $s, 'UTF-8');
@@ -3062,6 +3258,7 @@ sub safe_decode_mime($) {
return $str; # good, keep as-is, all-ASCII with no encoded-words
}
# normal, all-ASCII with some encoded-words, try to decode encoded-words
+ # using Encode::MIME::Header
eval { $chars = safe_decode('MIME-Header',$str); 1 } # RFC 2047
and return $chars;
# give up, is all-ASCII but not MIME, just return as-is
@@ -3074,14 +3271,14 @@ sub safe_decode_mime($) {
[Qq] \? [\x20-\x3E\x40-\x7F]* ) \?= }xs) {
# strange/rare, non-ASCII, but also contains RFC 2047 encoded-words !?
# decode any RFC 2047 encoded-words, attempt to decode the rest
- # as UTF-8 if valid, or as ISO-8859-1 otherwise
+ # as UTF-8 if valid, or as Windows-1252 (or ISO-8859-1) otherwise
local($1);
$str =~ s{ ( =\? [^?]* \? (?: [Bb] \? [A-Za-z0-9+/=]* |
[Qq] \? [\x20-\x3E\x40-\x7F]* ) \?= ) |
( [^=]* | . )
}{ my $s;
if (defined $1) {
- $s = $1;
+ $s = $1; # using Encode::MIME::Header
eval { $s = safe_decode('MIME-Header',$s) };
} else {
$s = $2;
@@ -3116,12 +3313,14 @@ sub safe_decode_mime($) {
# FB_CROAK | LEAVE_SRC
eval { $chars = $enc_utf8->decode($str,1|8); 1; } # try strict UTF-8
and return $chars;
- return $enc_latin1->decode($str); # fallback, assumed Latin1
+ # fallback, assume Windows-1252 or ISO-8859-1
+ # note that Windows-1252 is a proper superset of ISO-8859-1
+ return ($enc_w1252||$enc_latin1)->decode($str);
} else { # work around bugs in Encode
untaint_inplace($str);
eval { $chars = $enc_utf8->decode($str,1|8); 1; } # try strict UTF-8
and return $enc_tainted . $chars;
- return $enc_tainted . $enc_latin1->decode($str); # assumed Latin1
+ return $enc_tainted . ($enc_w1252||$enc_latin1)->decode($str);
}
}
@@ -3152,7 +3351,7 @@ sub q_encode($$$) {
#
sub xtext_encode($) { # RFC 3461
my $str = $_[0]; local($1);
- $str = safe_encode_utf8($str); # to octets (if not already)
+ safe_encode_utf8_inplace($str); # to octets (if not already)
$str =~ s/([^\041-\052\054-\074\076-\176])/sprintf('+%02X',ord($1))/gse;
$str;
}
@@ -3198,7 +3397,7 @@ sub proto_decode($) {
sub mail_addr_decode($;$) {
my($addr, $result_as_octets) = @_;
return undef if !defined $addr;
- $addr = safe_encode_utf8($addr); # to octets (if not already)
+ safe_encode_utf8_inplace($addr); # to octets (if not already)
local($1); my $domain;
my $bracketed = $addr =~ s/^<(.*)>\z/$1/s;
if ($addr =~ s{ \@ ( [^\@]* ) \z}{}xs) {
@@ -3233,7 +3432,7 @@ sub mail_addr_decode($;$) {
sub mail_addr_idn_to_ascii($) {
my $addr = $_[0];
return undef if !defined $addr;
- $addr = safe_encode_utf8($addr); # to octets (if not already)
+ safe_encode_utf8_inplace($addr); # to octets (if not already)
local($1);
my $bracketed = $addr =~ s/^<(.*)>\z/$1/s;
$addr =~ s{ (\@ [^\@]*) \z }{ idn_to_ascii($1) }xse;
@@ -3267,10 +3466,10 @@ sub orcpt_encode($;$$) {
$addr_type, $str,
$smtputf8 ? ', smtputf8' : '',
$encode_for_smtp ? ', encode_for_smtp' : '',
- Encode::is_utf8($str) ? ', is_utf8' : '');
+ utf8::is_utf8($str) ? ', is_utf8' : '');
$str = $1 if $str =~ /^<(.*)>\z/s;
- if ($smtputf8 && Encode::is_utf8($str) &&
+ if ($smtputf8 && utf8::is_utf8($str) &&
($addr_type eq 'utf-8' || $str =~ tr/\x00-\x7F//c)) {
# for use in SMTPUTF8 (RCPT TO) or in message/global-delivery-status
if ($encode_for_smtp && $str =~ tr{\x00-\x20+=\\}{}) {
@@ -3289,23 +3488,23 @@ sub orcpt_encode($;$$) {
# "Original-Recipient:" header field [RFC3798] if the message is a
# SMTPUTF8 message.
}
- $str = safe_encode_utf8($str); # to octets (if not already)
+ safe_encode_utf8_inplace($str); # to octets (if not already)
$addr_type = 'utf-8';
} else {
# RFC 6533: utf-8-addr-xtext MUST be used in the ORCPT parameter
# when the SMTP server doesn't advertise support for SMTPUTF8
- if ($str =~ tr/\x00-\x7F//c && Encode::is_utf8($str)) {
+ if ($str =~ tr/\x00-\x7F//c && utf8::is_utf8($str)) {
# non-ASCII UTF-8, encode as utf-8-addr-xtext
# RFC 6533: QCHAR = %x21-2a / %x2c-3c / %x3e-5b / %x5d-7e
# HEXPOINT in EmbeddedUnicodeChar is 2 to 6 hexadecimal digits.
$str =~ s{ ( [^\x21-\x2A\x2C-\x3C\x3E-\x5B\x5D-\x7E] ) }
{ sprintf('\\x{%02X}', ord($1)) }xgse; # 2..6 uppercase hex!
- $str = safe_encode_utf8($str); # to octets (if not already)
+ safe_encode_utf8_inplace($str); # to octets (if not already)
$addr_type = 'utf-8';
} else { # encode as legacy RFC 3461 xtext
# encode +, =, \, SP, controls
- $str = safe_encode_utf8($str); # encode to octets first!
+ safe_encode_utf8_inplace($str); # encode to octets first!
$str =~ s{ ( [^\x21-\x2A\x2C-\x3C\x3E-\x5B\x5D-\x7E] ) }
{ sprintf('+%02X', ord($1)) }xgse; # exactly two uppercase hex
$addr_type = 'rfc822';
@@ -3402,7 +3601,7 @@ BEGIN {
sub sanitize_str {
my($str, $keep_eol) = @_;
return '' if !defined $str;
- $str = safe_encode_utf8($str);
+ safe_encode_utf8_inplace($str); # to octets (if not already)
# $str is now in octets, UTF8 flag is off
local($1);
if ($keep_eol) {
@@ -3446,7 +3645,7 @@ use vars qw($entropy); # MD5 ctx (128 bits, 32 hex digits or 22 base64 chars)
sub add_entropy(@) { # arguments may be strings or array references
$entropy = Digest::MD5->new if !defined $entropy;
my $s = join(',', map((!defined $_ ? 'U' : ref eq 'ARRAY' ? @$_ : $_), @_));
- $s = $enc_utf8->encode($s) if Encode::is_utf8($s);
+ utf8::encode($s) if utf8::is_utf8($s);
# do_log(5,'add_entropy: %s',$s);
$entropy->add($s);
}
@@ -3671,22 +3870,26 @@ sub do_log($$;@) {
( ($DEBUG || $debug_oneshot) && $level > 0
&& 0 <= $current_config_log_level ) ||
$dbg_log ) {
- my $errmsg; # the $_[1] is expected to be all-ASCII (for now)
- if (@_ <= 2) {
+ my $errmsg; # the $_[1] is expected to be ASCII or UTF-8 octets (not char)
+ if (@_ <= 2) { # no arguments to sprintf
$errmsg = $_[1];
- } elsif (@_ == 3) { # optimized common case
- $errmsg = sprintf($_[1], Encode::is_utf8($_[2])? $enc_utf8->encode($_[2])
- : $_[2]);
+ } elsif (@_ == 3) { # a single argument to sprintf, optimized common case
+ if (utf8::is_utf8($_[2])) {
+ my $arg1 = $_[2]; utf8::encode($arg1);
+ $errmsg = sprintf($_[1], $arg1);
+ } else {
+ $errmsg = sprintf($_[1], $_[2]);
+ }
} else {
# treat $errmsg as sprintf format string if additional args are provided;
# encode arguments individually to avoid mojibake when UTF8-flagged and
# non- UTF8-flagged strings are concatenated;
- # inlined safe_encode_utf8() call for speed, don't care for taint bugs
- $errmsg = sprintf($_[1], map(Encode::is_utf8($_) ? $enc_utf8->encode($_)
- : $_, @_[2..$#_]));
+ my @args = @_[2..$#_];
+ for (@args) { utf8::encode($_) if utf8::is_utf8($_) }
+ $errmsg = sprintf($_[1], @args);
}
local($1);
- # protect controls, DEL, and backslash
+ # protect controls, DEL, and backslash; make sure to leave UTF-8 untouched
$errmsg =~ s/([\x00-\x1F\x7F\\])/
$quote_controls_map{$1} || sprintf('\\x%02X', ord($1))/gse;
$dbg_log->write_dbg_log($level,$errmsg) if $dbg_log;
@@ -4068,7 +4271,7 @@ sub read_file($$) {
}
$$strref = '';
#*** handle EINTR
- while (($nbytes = sysread($fh, $$strref, 32768, length $$strref)) > 0) { }
+ while ( $nbytes=sysread($fh, $$strref, 32768, length $$strref) ) { }
defined $nbytes or die "Error reading from $fname: $!";
if (!ref $fname) { $fh->close or die "Error closing $fname: $!" }
$strref;
@@ -4109,7 +4312,7 @@ sub read_l10n_templates($;$) {
my $file_chset = Amavis::Util::read_text("$dir/charset");
local($1,$2);
if ($file_chset =~ m{^(?:\#[^\n]*\n)*([^./\n\s]+)(\s*[\#\n].*)?$}s) {
- $file_chset = untaint($1);
+ $file_chset = untaint("$1");
} else {
die "Invalid charset $file_chset\n";
}
@@ -4402,72 +4605,6 @@ sub collect_equal_delivery_recips($$$) {
1;
#
-package Amavis::JSON;
-use strict;
-use re 'taint';
-
-# serialize a data structure to JSON, RFC 7159
-
-BEGIN {
- require Exporter;
- use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
- @ISA = qw(Exporter);
- @EXPORT_OK = qw(&boolean &numeric);
-}
-use subs @EXPORT_OK;
-
-our %jesc = ( # JSON escaping
- "\x22" => '\\"', "\x5C" => '\\\\',
- "\x08" => '\\b', "\x09" => '\\t',
- "\x0A" => '\\n', "\x0C" => '\\f', "\x0D" => '\\r',
- "\x{2028}" => '\\u2028', "\x{2029}" => '\\u2029' );
- # escape also the Line Separator (U+2028) and Paragraph Separator (U+2029)
- # http://timelessrepo.com/json-isnt-a-javascript-subset
-
-our($FALSE, $TRUE) = ('false', 'true');
-sub boolean { bless($_[0] ? \$TRUE : \$FALSE) }
-sub numeric { my $value = $_[0]; bless(\$value) }
-
-# serialize a data structure to JSON, RFC 7159
-# expects logical characters in scalars, returns a string of logical chars
-#
-sub encode($); # prototype
-sub encode($) {
- my $val = $_[0];
- my $ref = ref $val;
- local $1;
- if ($ref) {
- if ($ref eq 'ARRAY') {
- return '[' . join(',', map(encode($_), @$val)) . ']';
- } elsif ($ref eq 'HASH') {
- return '{' .
- join(',',
- map {
- my $k = $_;
- $k =~ s{ ([\x00-\x1F\x7F\x{2028}\x{2029}"\\]) }
- { $jesc{$1} || sprintf('\\u%04X',ord($1)) }xgse;
- '"' . $k . '":' . encode($val->{$_});
- } sort keys %$val
- ) . '}';
- } elsif ($ref->isa('Amavis::JSON')) { # numeric or boolean type
- return defined $$val ? $$val : 'null';
- }
- # fall through, encode other refs as strings, helps debugging
- }
- return 'null' if !defined $val;
- { # concession on a perl 5.20.0 bug [perl #122148] (fixed in 5.20.1)
- # - just warn, do not abort
- use warnings NONFATAL => qw(utf8);
- $val =~ s{ ([\x00-\x1F\x7F\x{2028}\x{2029}"\\]) }
- { $jesc{$1} || sprintf('\\u%04X',ord($1)) }xgse;
- };
- '"' . $val . '"';
-}
-
-1;
-
-#
package Amavis::ProcControl;
use strict;
use re 'taint';
@@ -4475,7 +4612,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&exit_status_str &proc_status_ok &kill_proc &cloexec
&run_command &run_command_consumer &run_as_subprocess
@@ -5025,7 +5162,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT = qw(
&rfc2822_timestamp &rfc2822_utc_timestamp
@@ -5040,7 +5177,8 @@ BEGIN {
&wrap_string &wrap_smtp_resp &one_response_for_all
&EX_OK &EX_NOUSER &EX_UNAVAILABLE &EX_TEMPFAIL &EX_NOPERM);
import Amavis::Conf qw(:platform c cr ca $myproduct_name);
- import Amavis::Util qw(ll do_log unique_ref unique_list safe_encode_utf8
+ import Amavis::Util qw(ll do_log unique_ref unique_list
+ safe_encode_utf8_inplace
idn_to_ascii idn_to_utf8 mail_addr_idn_to_ascii);
}
use subs @EXPORT;
@@ -5108,6 +5246,7 @@ sub rfc2822_utc_timestamp($) {
# Given a Unix numeric time (seconds since 1970-01-01T00:00Z),
# provide date-time timestamp (local time) as specified in ISO 8601 (EN 28601)
+# RFC 3339 is a subset of ISO 8601 and requires field separators "-" and ":".
#
sub iso8601_timestamp($;$$$) {
my($t, $suppress_zone, $dtseparator, $with_field_separators) = @_;
@@ -5314,8 +5453,8 @@ sub parse_received($) {
\] /xi) {}
# elsif (/ (?: ^ | \D ) ( \d{1,3} (?: \. \d{1,3}){3}) (?! [0-9.] ) /x) {}
elsif (/^(?: localhost |
- (?: [\x80-\xF4a-zA-Z0-9_\/+-]{1,63} \. )+
- [\x80-\xF4a-zA-Z0-9-]{2,} ) \b/xs) {}
+ (?: [\x{80}-\x{F4}a-zA-Z0-9_\/+-]{1,63} \. )+
+ [\x{80}-\x{F4}a-zA-Z0-9-]{2,} ) \b/xs) {}
else {
my $fc = $f; $fc =~ s/-tcp\z/-com/;
$fld{$fc} = '' if !defined $fld{$fc};
@@ -5491,7 +5630,7 @@ my %query_keys_cache;
sub clear_query_keys_cache() { %query_keys_cache = () }
sub make_query_keys($$$;$) {
my($addr, $at_with_user, $include_bare_user, $append_string) = @_;
- $addr = safe_encode_utf8($addr); # make sure it's in octets
+ safe_encode_utf8_inplace($addr); # to octets (if not already)
my $query_keys_slot = join("\x00",
$at_with_user?1:0, $include_bare_user?1:0,
$append_string, $addr);
@@ -5642,11 +5781,11 @@ sub parse_quoted_rfc2821($$) {
# A-d-l = At-domain *( "," A-d-l )
# At-domain = "@" domain
if (index($addr,':') >= 0 && # triage before more testing for source route
- $addr =~ m{^( [ \t]* \@ (?: [\x80-\xF4A-Za-z0-9.!\#\$%&*/^{}=_+-]* |
- \[ (?: \\. | [^\]\\] ){0,999} \] ) [ \t]*
- (?: ,[ \t]* \@ (?: [\x80-\xF4A-Za-z0-9.!\#\$%&*/^{}=_+-]* |
- \[ (?: \\. | [^\]\\] ){0,999} \] ) [ \t]*
- )* : [ \t]* ) (.*) \z }xs)
+ $addr=~m{^( [ \t]* \@ (?: [\x{80}-\x{F4}A-Za-z0-9.!\#\$%&*/^{}=_+-]* |
+ \[ (?: \\. | [^\]\\] ){0,999} \] ) [ \t]*
+ (?: ,[ \t]* \@ (?: [\x{80}-\x{F4}A-Za-z0-9.!\#\$%&*/^{}=_+-]* |
+ \[ (?: \\. | [^\]\\] ){0,999} \] ) [ \t]*
+ )* : [ \t]* ) (.*) \z }xs)
{ # NOTE: we are quite liberal on allowing whitespace around , and : here,
# and liberal in allowed character set and syntax of domain names,
# we mainly avoid stop-characters in the domain names of source route
@@ -6048,7 +6187,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Util qw(ll do_log fmt_struct);
}
@@ -6167,7 +6306,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $have_patricia);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&lookup_ip_acl &ip_to_vec &normalize_ip_addr);
import Amavis::Util qw(ll do_log);
@@ -6366,7 +6505,8 @@ sub normalize_ip_addr($) {
# whether the result is true (yes, permit, pass) or false (no, deny, drop).
# Falling through without a match produces a false (undef).
#
-# The presence of a character '!' prepended to a list member decides
+# For lookup tables which are a ref to a an array (a traditional ACL),
+# the presence of a character '!' prepended to a list member decides
# whether the result will be true (without a '!') or false (with a '!')
# in case this list member matches and terminates the search.
#
@@ -6408,7 +6548,7 @@ sub lookup_ip_acl($@) {
or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
my($label,$fullkey,$result,$lookup_type); my $found = 0;
for my $tb (@nets_ref) {
- my $t = ref($tb) eq 'REF' ? $$tb : $tb; # allow one level of indirection
+ my $t = ref($tb) eq 'REF' ? $$tb : $tb; # allow one level of indirection
if (!ref($t) || ref($t) eq 'SCALAR') { # a scalar always matches
my $r = ref($t) ? $$t : $t; # allow direct or indirect reference
$result = $r; $fullkey = "(constant:$r)"; $lookup_type = 'const';
@@ -6485,6 +6625,10 @@ sub lookup_ip_acl($@) {
elsif (($ip_vec & $acl_mask) eq ($acl_ip_vec & $acl_mask)) { $found=1 }
last if $found;
}
+ } elsif ($t->isa('Amavis::Lookup::DNSxL')) { # DNSxL lookup obj, RFC 5782
+ $lookup_type = 'dns';
+ ($result, $fullkey) = $t->lookup_ip($ip);
+ $found = $result;
} elsif ($t->isa('Amavis::Lookup::Label')) { # logging label
# just a convenience for logging purposes, not a real lookup method
$label = $t->display; # grab the name, and proceed with the next table
@@ -6647,6 +6791,128 @@ sub new($$$;$) {
1;
#
+package Amavis::Lookup::DNSxL;
+use strict;
+use re 'taint';
+
+BEGIN {
+ import Amavis::Conf qw(:platform);
+ import Amavis::Util qw(ll do_log);
+ use vars qw($dns_resolver); # implicit persistent Net::DNS::Resolver object
+}
+
+sub new {
+ my($class, $zone, $expected, $resolver) = @_;
+ # $zone is either a DNSxL zone name, or a template where an %a is a
+ # place-holder for the IP address to be queried.
+ # The result of a type-A DNS query is matched against $expected, which is
+ # either a scalar string, or a ref to an array of strings, or a regexp obj.
+ require NetAddr::IP or die "Can't load module NetAddr::IP";
+ NetAddr::IP->VERSION(4.010); # need a method full6()
+ if ($resolver) {
+ # DNS resolver object provided by a caller, use that
+ } elsif ($dns_resolver) {
+ # reuse previously created internal resolver object
+ $resolver = $dns_resolver;
+ } else { # create a new internal resolver object with some sensible defaults
+ require Net::DNS or die "Can't load module Net::DNS";
+ $dns_resolver = Net::DNS::Resolver->new(
+ config_file => '/etc/resolv.conf', force_v4 => !$have_inet6,
+ defnames => 0, retry => 1, persistent_udp => 1,
+ tcp_timeout => 2, udp_timeout => 2, retrans => 1); # seconds
+ $dns_resolver or die "Failed to create a Net::DNS::Resolver object";
+ $dns_resolver->udppacketsize(1220);
+ $resolver = $dns_resolver;
+ }
+ defined $zone && $zone ne ''
+ or die "DNS zone name must not be empty, in Amavis::Lookup::DNSxL";
+ $expected = '127.0.0.2' if !defined $expected; # an RFC 5782 convention
+ my $self = {
+ zone => $zone, # DNSxL zone name (a base DNS domain name)
+ resolver => $resolver, # a Net::DNS::Resolver object or equivalent
+ expected => $expected, # a set of replies that qualify as a match
+ };
+ bless $self, $class;
+}
+
+# Query a DNSxL list given an IPv4 or IPv6 address, according to RFC 5782.
+# Returns an IPv4 address in the 127.0.0.0/8 subnet as returned by a DNS
+# type-A query when the result matches the provided expected value, or a
+# zero when a query succeeded (NOERROR or NXDOMAIN) but there was no match.
+# The argument $expected may be a string, a ref to array, or a regexp object.
+# Returns undef on DNS failures (like a timeout, or no Net::DNS module).
+#
+sub lookup_ip {
+ my($self, $ipaddr) = @_;
+ my $result; # result of a DNS query, undef indicates a lookup failure
+ my $fullkey; # matching (expected) key
+ return ($result,$fullkey) if !$self->{resolver};
+ my $revip;
+ local($1,$2,$3,$4);
+ if ($ipaddr =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\z/) {
+ $revip = "$4.$3.$2.$1";
+ } elsif ($ipaddr =~ /:[0-9a-f]*:/i) { # triage
+ # looks like an IPv6 address, let NetAddr::IP check the details
+ my $ip_obj = NetAddr::IP->new6($ipaddr);
+ if (defined $ip_obj) { # a valid IPv6 address, apply RFC 5782 section 2.4
+ $revip = lc $ip_obj->network->full6; # string in a canonical form
+ $revip =~ s/://gs; $revip = join('.', reverse split(//,$revip));
+ }
+ }
+ if (!defined $revip) {
+ do_log(4,'invalid IP address for a DNSxL query: %s', $ipaddr);
+ return ($result,$fullkey);
+ }
+ my $query = $self->{zone};
+ $query =~ s/%a/$revip/gs or ($query = $revip . '.' .$query);
+ my $pkt = $self->{resolver}->send($query, 'A');
+
+ my $ll5 = ll(5);
+ $result = 0; # defined but false
+ if (!$pkt || !$pkt->header) {
+ undef $result;
+ $ll5 && do_log(5,'DNSxL query %s, no result', $query);
+ } elsif ($pkt->header->rcode eq 'NXDOMAIN') {
+ $ll5 && do_log(5,'DNSxL query %s, domain does not exist', $query);
+ } elsif ($pkt->header->rcode ne 'NOERROR') {
+ $ll5 && do_log(5,'DNSxL query %s, rcode %s', $query, $pkt->header->rcode);
+ } elsif ($pkt->header->ancount) {
+ my $expected = $self->{expected};
+ $expected = [ $expected ] if !ref $expected;
+ for my $rr ($pkt->answer) {
+ next if $rr->type ne 'A';
+ my $returned_addr = $rr->address;
+ $ll5 && do_log(5,'DNSxL query %s, DNS answer: %s',$query,$returned_addr);
+ # RFC 5782 section 2.3: values SHOULD be in the 127.0.0.0/8 range
+ next if $returned_addr !~ /^127\.\d{1,3}\.\d{1,3}\.\d{1,3}\z/s;
+ if (ref $expected eq 'ARRAY') {
+ # $expected is an array of strings: IPv4 addresses in dotted-quad
+ # form, with bytes possibly omitted from the left
+ for (@$expected) {
+ if ( ( /^\d+\z/ ? "127.0.0.$_"
+ : /^\d+\.\d+\z/ ? "127.0.$_"
+ : /^\d+\.\d+\.\d+\z/ ? "127.$_" : $_) eq $returned_addr) {
+ $fullkey = $_; $result = $returned_addr;
+ last;
+ }
+ }
+ last if defined $result;
+ } elsif (ref $expected eq 'Regexp') {
+ # $expected is a regular expresion
+ if ($returned_addr =~ /$expected/s) {
+ $fullkey = "$expected"; # stringified regexp object
+ $result = $returned_addr; last;
+ }
+ }
+ }
+ }
+ do_log(5,'DNSxL result: %s, matches %s',$result,$fullkey) if $ll5 && $result;
+ ($result, $fullkey);
+}
+
+1;
+
+#
package Amavis::Lookup;
use strict;
use re 'taint';
@@ -6654,11 +6920,11 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&lookup &lookup2 &lookup_hash &lookup_acl);
- import Amavis::Util qw(ll do_log fmt_struct unique_list
- safe_encode_utf8 idn_to_ascii);
+ import Amavis::Util qw(ll do_log fmt_struct unique_list idn_to_ascii
+ safe_encode_utf8_inplace);
import Amavis::Conf qw(:platform c cr ca);
import Amavis::Timing qw(section_time);
import Amavis::rfc2821_2822_Tools qw(split_address make_query_keys);
@@ -6785,7 +7051,7 @@ sub lookup_acl($$%) {
ref($acl_ref) eq 'ARRAY'
or die "lookup_acl: arg2 must be a list ref: $acl_ref";
return if !@$acl_ref; # empty list can't match anything
- $addr = safe_encode_utf8($addr); # make sure it's in octets
+ safe_encode_utf8_inplace($addr); # to octets (if not already)
my $lpcs = c('localpart_is_case_sensitive');
my($localpart,$domain) = split_address($addr);
$localpart = lc $localpart if !$lpcs;
@@ -6959,7 +7225,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&expand &tokenize);
import Amavis::Util qw(ll do_log);
@@ -7261,7 +7527,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform :confvars c cr ca);
import Amavis::Timing qw(section_time);
@@ -7796,7 +8062,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
}
use Errno qw(EIO);
@@ -7932,7 +8198,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform);
import Amavis::Util qw(ll do_log min max minmax idn_to_ascii);
@@ -8117,7 +8383,7 @@ sub internal_close {
my $status = 1; # ok
if (!defined($sock)) {
# nothing to do
- } elsif (!defined(fileno($sock))) { # not really open
+ } elsif (!defined fileno($sock)) { # not really open
$sock->close; # ignoring errors
} else {
my $flush_status = 1; # ok
@@ -8127,16 +8393,16 @@ sub internal_close {
undef $flush_status; # false, indicates a signalled failure
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
do_log($destroying ? 5 : 1,
- "Error flushing socket on Amavis::IO::RW::%s: %s",
+ "closing: Error flushing socket in Amavis::IO::RW::%s: %s",
$destroying?'DESTROY':'close', $eval_stat);
};
$self->{last_event} = 'close';
$self->{last_event_time} = $self->{last_event_tx_time} = Time::HiRes::time;
$! = 0; $status = $sock->close;
- $status or do_log($destroying ? 5 : 1,
- "Error closing socket on Amavis::IO::RW::%s: %s",
- $destroying?'DESTROY':'close',
- !$self->{ssl_active} ? $! : $sock->errstr.", $!" );
+ $status or do_log($destroying ? 5 : 1,
+ "closing: Error closing socket in Amavis::IO::RW::%s: %s",
+ $destroying?'DESTROY':'close',
+ !$self->{ssl_active} ? $! : $sock->errstr.", $!" );
$status = $flush_status if $status && !$flush_status;
}
$status;
@@ -8301,10 +8567,13 @@ sub last_io_event_tx_timestamp
{ my($self,$keyword) = @_; $self->{last_event_tx_time} }
sub flush
- { my $self=shift; $self->rw_loop(0,1) if $self->{out} ne ''; 1 }
+ { my $self = $_[0]; $self->rw_loop(0,1) if $self->{out} ne ''; 1 }
+
+sub discard_pending_output
+ { my $self = $_[0]; my $len = length $self->{out}; $self->{out} = ''; $len }
sub out_buff_large
- { my $self=shift; length $self->{out} > 40000 }
+ { my $self = $_[0]; length $self->{out} > 40000 }
sub print {
my $self = shift;
@@ -8381,16 +8650,19 @@ sub read { # SCALAR,LENGTH,OFFSET
use vars qw($ssl_cache);
sub ssl_upgrade {
- my($self,%params) = @_;
+ my($self, %tls_options) = @_;
$self->flush;
IO::Socket::SSL->VERSION(1.05); # required minimal version
$ssl_cache = IO::Socket::SSL::Session_Cache->new(2) if !defined $ssl_cache;
my $sock = $self->{socket};
- IO::Socket::SSL->start_SSL($sock, SSL_session_cache => $ssl_cache,
- SSL_error_trap =>
- sub { my($sock,$msg)=@_; do_log(-2,"Error on socket: %s",$msg) },
- %params,
- ) or die "Error upgrading socket to SSL: ".IO::Socket::SSL::errstr();
+ IO::Socket::SSL->start_SSL($sock,
+ SSL_session_cache => $ssl_cache,
+ SSL_error_trap => sub {
+ my($sock,$msg) = @_;
+ do_log(-2,"Upgrading socket to TLS failed (in ssl_upgrade): %s", $msg);
+ },
+ %tls_options,
+ ) or die "Error upgrading output socket to TLS: ".IO::Socket::SSL::errstr();
$self->{last_event} = 'ssl-upgrade';
$self->{last_event_time} = $self->{last_event_tx_time} = Time::HiRes::time;
$self->{ssl_active} = 1;
@@ -8413,7 +8685,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
}
@@ -8449,7 +8721,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform);
import Amavis::Util qw(setting_by_given_contents_category_all
@@ -8640,7 +8912,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform);
import Amavis::rfc2821_2822_Tools qw(rfc2822_timestamp quote_rfc2821_local
@@ -8963,14 +9235,14 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&hdr);
import Amavis::Conf qw(:platform c cr ca);
import Amavis::Timing qw(section_time);
import Amavis::rfc2821_2822_Tools qw(wrap_string);
import Amavis::Util qw(ll do_log min max q_encode
- safe_encode safe_encode_ascii safe_encode_utf8);
+ safe_encode safe_encode_utf8_inplace);
}
use Errno qw(EBADF);
use Encode ();
@@ -9069,20 +9341,21 @@ sub inherit_header_edits($$) {
sub hdr {
my($field_name, $field_body, $structured, $wrap_char, $smtputf8) = @_;
$wrap_char = "\t" if !defined $wrap_char;
- $field_name = safe_encode_ascii($field_name); # must be all-ASCII
- my $field_body_is_utf8 = Encode::is_utf8($field_body);
+ safe_encode_utf8_inplace($field_name); # to octets (if not already)
+ $field_name =~ tr/\x21-\x39\x3B-\x7E/?/c; # printable ASCII except ':'
+ my $field_body_is_utf8 = utf8::is_utf8($field_body);
local($1);
if ($field_body !~ tr/\x00-\x7F//c) { # is all-ASCII
# no encoding necessary, just clear the utf8 flag if set
if ($field_body_is_utf8) {
do_log(5,'header encoded (utf8:Y) (all-ASCII): %s: %s',
$field_name, $field_body);
- $field_body = safe_encode_utf8($field_body);
+ safe_encode_utf8_inplace($field_body); # to octets (if not already)
} else {
do_log(5,'header encoded (all-ASCII): %s: %s', $field_name, $field_body);
}
} elsif ($smtputf8) { # UTF-8 in header field bodies is allowed
- $field_body = safe_encode_utf8($field_body) if $field_body_is_utf8;
+ safe_encode_utf8_inplace($field_body) if $field_body_is_utf8;
ll(5) && do_log(5,'header encoded (utf8:%s) to UTF-8 (SMTPUTF8): %s: %s',
$field_body_is_utf8?'Y':'N', $field_name, $field_body);
} elsif ($field_name =~ /^(?: Subject | Comments |
@@ -9108,7 +9381,7 @@ sub hdr {
: &$encoder_func($_,$qb,$chset) }
split(/\n/, $field_body_octets, -1));
} else { # should have been all-ASCII, or UTF-8 with SMTPUTF8 - but anyway:
- $field_body = safe_encode_utf8($field_body) if $field_body_is_utf8;
+ safe_encode_utf8_inplace($field_body) if $field_body_is_utf8;
ll(5) && do_log(5,'header encoded (utf8:%s) to UTF-8: %s: %s',
$field_body_is_utf8?'Y':'N', $field_name, $field_body);
}
@@ -9296,7 +9569,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT = qw(&mail_dispatch);
import Amavis::Conf qw(:platform :confvars c cr ca);
@@ -9450,7 +9723,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&first_received_from &oldest_public_ip_addr_from_received);
import Amavis::Conf qw(:platform c cr ca);
@@ -9502,7 +9775,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&consumed_bytes);
import Amavis::Conf qw(c cr ca
@@ -9591,7 +9864,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Util qw(ll do_log);
}
@@ -9639,8 +9912,10 @@ sub name_declared # string or a ref to a list of strings
{ @_<2 ? shift->{nm_decl} : ($_[0]->{nm_decl} = $_[1]) };
sub report_type # a string, e.g. 'delivery-status', RFC 6522
{ @_<2 ? shift->{rep_typ} : ($_[0]->{rep_typ} = $_[1]) };
-sub size
+sub size # size in bytes
{ @_<2 ? shift->{size} : ($_[0]->{size} = $_[1]) };
+sub digest # digest of a mime part contents (typically SHA1, hex)
+ { @_<2 ? shift->{digest} : ($_[0]->{digest} = $_[1]) };
sub exists
{ @_<2 ? shift->{exists} : ($_[0]->{exists} = $_[1]) };
sub attributes # a string of characters representing attributes
@@ -9679,7 +9954,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter MIME::Parser::Filer); # subclass of MIME::Parser::Filer
}
# This package will be used by mime_decode().
@@ -9721,7 +9996,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&check_header_validity &check_for_banned_names);
import Amavis::Util qw(ll do_log min max minmax untaint untaint_inplace
@@ -10056,22 +10331,24 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&mime_decode);
import Amavis::Conf qw(:platform c cr ca $TEMPBASE $MAXFILES);
import Amavis::Timing qw(section_time);
import Amavis::Util qw(snmp_count untaint ll do_log
safe_decode safe_decode_latin1
- safe_encode safe_encode_utf8);
+ safe_encode safe_encode_utf8_inplace);
import Amavis::Unpackers::NewFilename qw(consumed_bytes);
}
use subs @EXPORT_OK;
use Errno qw(ENOENT EACCES);
-use IO::File qw(O_CREAT O_EXCL O_WRONLY);
+use IO::File qw(O_RDONLY O_WRONLY O_CREAT O_EXCL);
use MIME::Parser;
use MIME::Words;
+use Digest::MD5;
+use Digest::SHA;
# use Scalar::Util qw(tainted);
# save MIME preamble and epilogue (if nontrivial) as extra (pseudo)parts
@@ -10119,11 +10396,41 @@ sub mime_traverse($$$$$) {
$part = Amavis::Unpackers::Part->new(undef,$parent_obj,1);
# $part->type_short('no-file');
do_log(2, "%s %s Content-Type: %s", $part->base_name, $placement, $mt);
+
} else { # does have a body part (i.e. not a MIME container)
- my $fn = $body->path; my $size;
- if (!defined($fn)) {
- $size = length($body->as_string);
+ # base64 encoding represents line-endings in a canonical CRLF form, so it
+ # must be converted to a local representation for text parts when decoding;
+ # RFC 2045 explicitly prohibits encoding CR and LF of a canonical CRLF pair
+ # in quoted-printable encoding of textual parts, but some mail generating
+ # software ignores this requirement, so we have to normalize line endings
+ # (turn CRLF to \n) for both the base64 and the quoted-printable encodings
+ my $encoding = $head->mime_encoding;
+ my $normalize_line_endings =
+ $mt =~ m{^(?:text|message)(?:/|\z)}i &&
+ ($encoding eq 'base64' || $encoding eq 'quoted-printable');
+
+ my $digest_ctx; # body-part digester context object, or undef
+ # choose a message digest: MD5: 128 bits, SHA family: 160..512 bits
+ # Use SHA1 for SpamAssassin bayes compatibility!
+ my $digest_algorithm = c('mail_part_digest_algorithm');
+ if (defined $digest_algorithm) {
+ $digest_ctx = uc $digest_algorithm eq 'MD5' ? Digest::MD5->new
+ : Digest::SHA->new($digest_algorithm);
+ }
+ my $size;
+ my $fn = $body->path;
+ if (!defined $fn) {
+ # body part resides in memory only
+ if (!$digest_ctx) {
+ $size = length($body->as_string);
+ } else {
+ my $buff = $body->as_string;
+ $size = length $buff;
+ $buff =~ s{\015(?=\012|\z)}{}gs if $normalize_line_endings;
+ $digest_ctx->add($buff);
+ }
} else {
+ # body part resides on a file
my $msg; my $errn = lstat($fn) ? 0 : 0+$!;
if ($errn == ENOENT) { $msg = "does not exist" }
elsif ($errn) { $msg = "is inaccessible: $!" }
@@ -10131,7 +10438,20 @@ sub mime_traverse($$$$$) {
elsif (!-f _) { $msg = "is not a regular file" }
else {
$size = -s _;
- do_log(4,"mime_traverse: file %s is empty", $fn) if $size==0;
+ if ($size == 0) {
+ do_log(4,"mime_traverse: file %s is empty", $fn);
+ } elsif ($digest_ctx) {
+ my $fh = IO::File->new;
+ $fh->open($fn,O_RDONLY) # does a sysopen
+ or die "Can't open file $fn for reading: $!";
+ $fh->binmode or die "Can't set file $fn to binmode: $!";
+ my($nbytes,$buff);
+ while ($nbytes=sysread($fh,$buff,32768)) {
+ $buff =~ s{\015(?=\012|\z)}{}gs if $normalize_line_endings;
+ $digest_ctx->add($buff);
+ }
+ defined $nbytes or die "Error reading file $fn: $!";
+ }
}
do_log(-1,"WARN: mime_traverse: file %s %s", $fn,$msg) if defined $msg;
}
@@ -10140,11 +10460,23 @@ sub mime_traverse($$$$$) {
$part = Amavis::Unpackers::OurFiler::get_amavisd_part($head);
if (defined $part) {
$part->size($size);
- if (defined($size) && $size==0)
- { $part->type_short('empty'); $part->type_long('empty') }
- ll(2) && do_log(2, "%s %s Content-Type: %s, size: %d B, name: %s",
- $part->base_name, $placement, $mt, $size,
- $entity->head->recommended_filename);
+ if (defined($size) && $size==0) {
+ $part->type_short('empty'); $part->type_long('empty');
+ }
+ my $digest;
+ if ($digest_ctx) {
+ $digest = $digest_ctx->hexdigest;
+ # store as a hex digest, followed by Content-Type
+ $part->digest($digest . ':' . lc($mt||''));
+ }
+ if (ll(2)) { # pretty logging
+ my $filename = $head->recommended_filename;
+ $encoding = 'QP' if $encoding eq 'quoted-printable';
+ do_log(2, "%s %s Content-Type: %s, %s, size: %d%s%s",
+ $part->base_name, $placement, $mt, $encoding, $size,
+ defined $digest ? ", $digest_algorithm digest: $digest" : '',
+ defined $filename ? ", name: $filename" : '');
+ }
my $old_parent_obj = $part->parent;
if ($parent_obj ne $old_parent_obj) { # reparent if necessary
ll(5) && do_log(5,"reparenting %s from %s to %s", $part->base_name,
@@ -10192,14 +10524,15 @@ sub mime_traverse($$$$$) {
}
$part->name_declared(@rn==1 ? $rn[0] : \@rn) if @rn;
my $val = $head->mime_attr('content-type.report-type');
- $part->report_type(safe_encode_utf8($val)) if defined $val && $val ne '';
+ safe_encode_utf8_inplace($val);
+ $part->report_type($val) if defined $val && $val ne '';
}
mime_decode_pre_epi('epilogue', $entity->epilogue,
$tempdir, $parent_obj, $placement);
my $item_num = 0;
for my $e ($entity->parts) { # recursive descent
$item_num++;
- mime_traverse($e,$tempdir,$part,$depth+1,"$placement/$item_num");
+ mime_traverse($e, $tempdir, $part, $depth+1, "$placement/$item_num");
}
}
@@ -10281,7 +10614,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter MIME::Body); # subclass of MIME::Body
import Amavis::Util qw(ll do_log);
}
@@ -10346,7 +10679,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&delivery_status_notification &delivery_short_report
&build_mime_entity &defanged_mime_entity
@@ -10354,7 +10687,8 @@ BEGIN {
import Amavis::Util qw(ll do_log sanitize_str min max minmax
untaint untaint_inplace
idn_to_ascii idn_to_utf8 mail_addr_idn_to_ascii
- is_valid_utf_8 safe_encode safe_encode_utf8 safe_decode_utf8
+ is_valid_utf_8 safe_decode_utf8
+ safe_encode safe_encode_utf8 safe_encode_utf8_inplace
orcpt_encode orcpt_decode xtext_decode safe_decode_mime
make_password ccat_split ccat_maj generate_mail_id);
import Amavis::Timing qw(section_time);
@@ -10536,7 +10870,7 @@ sub build_mime_entity($$$$$$$) {
$m_body = substr($$mail_as_string_ref, $ind+2);
}
}
- $m_hdr = safe_encode_utf8($m_hdr) if defined $m_hdr;
+ safe_encode_utf8_inplace($m_hdr);
$m_body = safe_encode(c('bdy_encoding'), $m_body) if defined $m_body;
# make sure _our_ source line number is reported in case of failure
my $multipart_cnt = 0;
@@ -11596,7 +11930,7 @@ sub msg_from_quarantine($$$) {
} else {
# collect more information from a quarantined message, making it available
# to a report generator and to macros during template expansion
- Amavis::get_body_digest($msginfo, $Amavis::Conf::mail_digest_algorithm);
+ Amavis::get_body_digest($msginfo, c('mail_digest_algorithm'));
Amavis::collect_some_info($msginfo);
if (defined($recips_data_override) && ll(5)) {
do_log(5, 'overriding recips %s by %s',
@@ -11649,13 +11983,21 @@ sub msg_from_quarantine($$$) {
my $bcc = $msginfo->setting_by_contents_category(cr('always_bcc_by_ccat'));
if (defined $bcc && $bcc ne '' && $request_type ne 'report') {
my $recip_obj = Amavis::In::Message::PerRecip->new;
- # leave recip_addr and recip_addr_smtp undefined!
$recip_obj->recip_addr_modified($bcc);
+
+ # leave recip_addr and recip_addr_smtp undefined to hide it from the log?
+ $recip_obj->recip_addr($bcc);
+ $recip_obj->recip_addr_smtp(qquote_rfc2821_local($bcc)); #****
+
+ $recip_obj->recip_is_local(
+ lookup2(0, $bcc, ca('local_domains_maps')) ? 1 : 0);
$recip_obj->recip_destiny(D_PASS);
$recip_obj->dsn_notify(['NEVER']);
+ $recip_obj->delivery_method(c('notify_method'));
$recip_obj->add_contents_category(CC_CLEAN,0);
$msginfo->per_recip_data([@{$msginfo->per_recip_data}, $recip_obj]);
- do_log(2,"adding recipient - always_bcc: %s", $bcc);
+ do_log(2,"adding recipient - always_bcc: %s, delivery method %s",
+ $bcc, $recip_obj->delivery_method);
}
$msginfo;
}
@@ -11695,22 +12037,23 @@ sub mail_done { my($self,$conn,$msginfo) = @_; undef }
#
package Amavis;
-require 5.005; # need qr operator and \z in regexp
-require 5.008; # need basic Unicode support
+require 5.005; # need qr operator and \z in regexp
+require 5.008; # need basic Unicode support
+require 5.008001; # need utf8::is_utf8()
use strict;
use re 'taint';
BEGIN {
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
import Amavis::Conf qw(:platform :sa :confvars c cr ca);
import Amavis::Util qw(untaint untaint_inplace
min max minmax unique_list unique_ref
ll do_log do_log_safe update_current_log_level
dump_captured_log log_capture_enabled am_id
sanitize_str debug_oneshot proto_decode
- truncate_utf_8 is_valid_utf_8
- safe_encode safe_encode_utf8 safe_decode_mime
+ truncate_utf_8 is_valid_utf_8 safe_decode_mime
+ safe_encode safe_encode_utf8 safe_encode_utf8_inplace
safe_decode safe_decode_utf8 safe_decode_latin1
clear_idn_cache idn_to_utf8 idn_to_ascii
mail_addr_idn_to_ascii mail_addr_decode
@@ -11745,14 +12088,16 @@ BEGIN {
import Amavis::In::Message;
}
-use Errno qw(ENOENT EACCES EAGAIN ESRCH EBADF);
+use Errno qw(ENOENT EACCES EAGAIN ESRCH EBADF EINVAL);
use POSIX qw(locale_h);
+use Fcntl qw(:flock F_GETFL F_SETFL FD_CLOEXEC);
use IO::Handle;
use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL);
+use IO::Socket::UNIX;
use Time::HiRes ();
# body digest, either MD5 or SHA-1 (or perhaps SHA-256)
-#use Digest::SHA;
use Digest::MD5;
+use Digest::SHA;
use Net::Server 0.87; # need Net::Server::PreForkSimple::done
use MIME::Base64;
@@ -11850,8 +12195,9 @@ sub macro_score {
my($msginfo,$recip_index,$name,$arg) = @_;
my $per_recip_data = $msginfo->per_recip_data;
my($result, $sl_min, $sl_max, $w); $w = '';
- if ($name eq 'SCORE' && defined($arg) && $arg=~/^(0+| +)\z/)
- { $w = length($arg)+4; $w = $arg=~/^0/ ? "0$w" : "$w" } # SA style padding
+ if ($name eq 'SCORE' && defined($arg) && $arg=~/^(0+| +)\z/) {
+ $w = length($arg)+4; $w = $arg=~/^0/ ? "0$w" : "$w"; # SA style padding
+ }
my $fmt = "%$w.3f"; my $fmts = "%+$w.3f"; # padding, sign
if (defined $recip_index) { # return info on one particular recipient
my $r;
@@ -11862,7 +12208,8 @@ sub macro_score {
}
if ($name eq 'STARS') {
my $slc = $arg ne '' ? $arg : c('sa_spam_level_char');
- $result = $slc eq '' || !defined $sl_min ? '' : $slc x min(50,$sl_min);
+ $result = !defined $slc || $slc eq '' || !defined $sl_min || $sl_min<1 ? ''
+ : $slc x min(50, int $sl_min);
} elsif (!defined $sl_min) {
$result = '-';
# } elsif ($name eq 'SCORE' || abs($sl_min-$sl_max) < 0.1) {
@@ -11907,7 +12254,7 @@ sub macro_header_field {
sub dkim_test {
my($name,$which) = @_;
- my $w = lc($which);
+ my $w = lc $which;
my $sigs_ref = $MSGINFO->dkim_signatures_valid;
$sigs_ref = [] if !$sigs_ref;
$w eq 'any' || $w eq '' ? (!@$sigs_ref ? undef : scalar(@$sigs_ref))
@@ -12383,6 +12730,26 @@ sub init_builtin_macros() {
structured_report_update_time($report_ref);
return Amavis::JSON::encode($report_ref); # as a string of characters
},
+ report_json => sub {
+ return if !$report_ref; # ugly globals
+ structured_report_update_time($report_ref);
+ my $macro_name = shift;
+ if (!@_) { # all fields, no filtering
+ return Amavis::JSON::encode($report_ref); # as a string of characters
+ } else { # filtering by field names
+ my @keys = @_ == 1 ? split(' ',$_[0]) : @_; # whitespace-separated?
+ my(@negated_keys) = map(/^!(.*)\z/s ? $1 : (), @keys);
+ my %filtered;
+ if (@negated_keys) { # take all but negated fields
+ %filtered = %$report_ref;
+ delete @filtered{@negated_keys};
+ } else { # take only listed fields
+ %filtered =
+ map(exists $report_ref->{$_} ? ($_,$report_ref->{$_}) : (), @keys);
+ }
+ return Amavis::JSON::encode(\%filtered); # as a string of characters
+ }
+ },
# macros f, T, C, B will be defined for each notification as appropriate
# (representing From:, To:, Cc:, and Bcc: respectively)
# remaining free letters: wxEGIJKLMYZ
@@ -12459,7 +12826,7 @@ sub init_tokenize_templates() {
$s = $$s if ref($s) eq 'SCALAR';
if (defined $s) {
# encode log templates to UTF-8, leave the rest as character strings
- $s = safe_encode_utf8($s) if $n eq 'log_templ' || 'log_recip_templ';
+ safe_encode_utf8_inplace($s) if $n eq 'log_templ' || 'log_recip_templ';
$policy_bank{$bank_name}{$n} = tokenize(\$s);
}
}
@@ -12504,10 +12871,14 @@ sub after_chroot_init() {
my $euid = $>; # effective UID
$> = 0; # try to become root
POSIX::setuid(0) if $> != 0; # and try some more
- if ($> == 0 || $euid == 0) { # succeeded? panic!
+ if ($euid == 0) {
+ @msg = ('Running as EUID 0 (root), ABORTING!',
+ 'Please start as non-root, e.g. by su(1) or using option -u user,',
+ 'or configure the $daemon_user setting.');
+ } elsif ($> == 0) { # succeeded? panic!
@msg = ("It is possible to change EUID from $euid to root, ABORTING!",
- "Please use a recent version of Net::Server",
- "or start as non-root, e.g. by su(1) or using option -u user");
+ 'Please start as non-root, e.g. by su(1) or using option -u user,',
+ 'or configure the $daemon_user setting.');
} elsif ($daemon_chroot_dir eq '') {
# A quick check on vulnerability/protection of a config file
# (non-exhaustive: doesn't test for symlink tricks and higher directories).
@@ -12568,33 +12939,33 @@ sub after_chroot_init() {
Mail::ClamAV Mail::SPF Mail::SPF::Query URI Razor2::Client::Version
DBI DBD::mysql DBD::Pg DBD::SQLite BerkeleyDB DB_File
ZMQ ZMQ::LibZMQ2 ZMQ::LibZMQ3 ZeroMQ SAVI Anomy::Sanitizer));
- do_log(0, "Module %-19s %s", $m, eval{$m->VERSION} || '?');
- }
- do_log(0,"Amavis::ZMQ code %s loaded", $extra_code_zmq ?'':" NOT");
- do_log(0,"Amavis::DB code %s loaded", $extra_code_db ?'':" NOT");
- do_log(0,"SQL base code %s loaded", $extra_code_sql_base ?'':" NOT");
- do_log(0,"SQL::Log code %s loaded", $extra_code_sql_log ?'':" NOT");
- do_log(0,"SQL::Quarantine %s loaded", $extra_code_sql_quar ?'':" NOT");
- do_log(0,"Lookup::SQL code %s loaded", $extra_code_sql_lookup ?'':" NOT");
- do_log(0,"Lookup::LDAP code %s loaded", $extra_code_ldap ?'':" NOT");
- do_log(0,"AM.PDP-in proto code%s loaded", $extra_code_in_ampdp ?'':" NOT");
- do_log(0,"SMTP-in proto code %s loaded", $extra_code_in_smtp ?'':" NOT");
- do_log(0,"Courier proto code %s loaded", $extra_code_in_courier ?'':" NOT");
- do_log(0,"SMTP-out proto code %s loaded", $extra_code_out_smtp ?'':" NOT");
- do_log(0,"Pipe-out proto code %s loaded", $extra_code_out_pipe ?'':" NOT");
- do_log(0,"BSMTP-out proto code%s loaded", $extra_code_out_bsmtp ?'':" NOT");
- do_log(0,"Local-out proto code%s loaded", $extra_code_out_local ?'':" NOT");
- do_log(0,"OS_Fingerprint code %s loaded", $extra_code_p0f ?'':" NOT");
- do_log(0,"ANTI-VIRUS code %s loaded", $extra_code_antivirus ?'':" NOT");
- do_log(0,"ANTI-SPAM code %s loaded", $extra_code_antispam ?'':" NOT");
- do_log(0,"ANTI-SPAM-EXT code %s loaded",
+ do_log(1, "Module %-19s %s", $m, eval{$m->VERSION} || '?');
+ }
+ do_log(1,"Amavis::ZMQ code %s loaded", $extra_code_zmq ?'':" NOT");
+ do_log(1,"Amavis::DB code %s loaded", $extra_code_db ?'':" NOT");
+ do_log(1,"SQL base code %s loaded", $extra_code_sql_base ?'':" NOT");
+ do_log(1,"SQL::Log code %s loaded", $extra_code_sql_log ?'':" NOT");
+ do_log(1,"SQL::Quarantine %s loaded", $extra_code_sql_quar ?'':" NOT");
+ do_log(1,"Lookup::SQL code %s loaded", $extra_code_sql_lookup ?'':" NOT");
+ do_log(1,"Lookup::LDAP code %s loaded", $extra_code_ldap ?'':" NOT");
+ do_log(1,"AM.PDP-in proto code%s loaded", $extra_code_in_ampdp ?'':" NOT");
+ do_log(1,"SMTP-in proto code %s loaded", $extra_code_in_smtp ?'':" NOT");
+ do_log(1,"Courier proto code %s loaded", $extra_code_in_courier ?'':" NOT");
+ do_log(1,"SMTP-out proto code %s loaded", $extra_code_out_smtp ?'':" NOT");
+ do_log(1,"Pipe-out proto code %s loaded", $extra_code_out_pipe ?'':" NOT");
+ do_log(1,"BSMTP-out proto code%s loaded", $extra_code_out_bsmtp ?'':" NOT");
+ do_log(1,"Local-out proto code%s loaded", $extra_code_out_local ?'':" NOT");
+ do_log(1,"OS_Fingerprint code %s loaded", $extra_code_p0f ?'':" NOT");
+ do_log(1,"ANTI-VIRUS code %s loaded", $extra_code_antivirus ?'':" NOT");
+ do_log(1,"ANTI-SPAM code %s loaded", $extra_code_antispam ?'':" NOT");
+ do_log(1,"ANTI-SPAM-EXT code %s loaded",
$extra_code_antispam_extprog ?'':" NOT");
- do_log(0,"ANTI-SPAM-C code %s loaded",
+ do_log(1,"ANTI-SPAM-C code %s loaded",
$extra_code_antispam_spamc ?'':" NOT");
- do_log(0,"ANTI-SPAM-SA code %s loaded", $extra_code_antispam_sa?'':" NOT");
- do_log(0,"Unpackers code %s loaded", $extra_code_unpackers ?'':" NOT");
- do_log(0,"DKIM code %s loaded", $extra_code_dkim ?'':" NOT");
- do_log(0,"Tools code %s loaded", $extra_code_tools ?'':" NOT");
+ do_log(1,"ANTI-SPAM-SA code %s loaded", $extra_code_antispam_sa?'':" NOT");
+ do_log(1,"Unpackers code %s loaded", $extra_code_unpackers ?'':" NOT");
+ do_log(1,"DKIM code %s loaded", $extra_code_dkim ?'':" NOT");
+ do_log(1,"Tools code %s loaded", $extra_code_tools ?'':" NOT");
# store policy names into 'policy_bank_name' fields, if not explicitly set
for my $name (keys %policy_bank) {
@@ -12610,14 +12981,20 @@ sub after_chroot_init() {
# $policy_bank{$policy_bank_name}, or load the default policy bank (empty name)
#
sub load_policy_bank($;$) {
- my($policy_bank_name,$msginfo) = @_;
- if (!exists $policy_bank{$policy_bank_name}) {
- do_log(-1,'policy bank "%s" does not exist, ignored', $policy_bank_name);
- } elsif ($policy_bank_name eq '') {
+ my($policy_bank_name, $msginfo) = @_;
+ if (!defined $policy_bank_name) {
+ # silently ignore
+ } elsif (!exists $policy_bank{$policy_bank_name}) {
+ do_log(5,'policy bank "%s" does not exist, ignored', $policy_bank_name);
+ } elsif ($policy_bank_name eq '') { # special case
%current_policy_bank = %{$policy_bank{$policy_bank_name}}; # copy base
update_current_log_level();
do_log(4,'loaded base policy bank');
+ } elsif ($policy_bank_name eq c('policy_bank_name')) {
+ do_log(5,'policy bank "%s" just loaded, ignored', $policy_bank_name);
} else {
+ # compatibility: policy bank MYNETS implicitly pre-sets 'originating' flag
+ $current_policy_bank{'originating'} = 1 if $policy_bank_name eq 'MYNETS';
my $cpbp = c('policy_bank_path'); # currently loaded bank
my $new_bank_ref = $policy_bank{$policy_bank_name};
my $do_log5 = ll(5);
@@ -12664,10 +13041,59 @@ sub load_policy_bank($;$) {
}
$current_policy_bank{'policy_bank_path'} =
($cpbp eq '' ? '' : $cpbp.'/') . $policy_bank_name;
- update_current_log_level();
ll(3) && do_log(3,'loaded policy bank "%s"%s', $policy_bank_name,
$cpbp eq '' ? '' : " over \"$cpbp\"");
+ # update global settings which may have changed
+ update_current_log_level();
+ $msginfo->originating(c('originating')) if $msginfo;
+ }
+}
+
+# systemd notifier
+#
+sub sd_notify($@) {
+# my($unset_environment, @messages) = @_;
+ my $unset_environment = shift;
+ my $result; # undef=failure, 0=nothing to do, 1=success
+ my $socket_name = $ENV{NOTIFY_SOCKET};
+ if (!@_) { # no messages
+ $result = 0;
+ } elsif (!defined $socket_name || $socket_name eq '') {
+ $result = 0;
+ ll(2) && do_log(2, "sd_notify (no socket): %s", join("\n", at _));
+ } elsif ($socket_name !~ m{^[/@].}s) {
+ # must be an absolute path or an abstract socket
+ do_log(0, "sd_notify: NOTIFY_SOCKET env.var '%s' must be ".
+ "an absolute path or an abstract socket", $socket_name);
+ $! = EINVAL;
+ } else {
+ ll(1) && do_log(1, "sd_notify (%s): %s", $socket_name, join("\n", at _));
+ $socket_name =~ s{^\@}{\x{00}}s; # abstract socket (Linux specific)
+ eval {
+ my $sock = IO::Socket::UNIX->new(Type => SOCK_DGRAM);
+ $sock or die "Can't create a socket object of type AF_LOCAL: $!";
+ # should also send credentials, e.g. using IO::Handle::Record module
+ # FreeBSD: struct cmsgcred; send a SCM_CREDS message
+ # OpenBSD: struct sockpeercred; SO_PASSCRED
+ # Linux: struct ucred; send a SCM_CREDENTIALS msg; SO_PEERCRED; unix(7)
+ $sock->connect( pack_sockaddr_un(untaint($socket_name)) )
+ or die "Can't connect to NOTIFY_SOCKET $socket_name: $!";
+ defined $sock->send(join("\n", at _), MSG_NOSIGNAL)
+ or die "Error sending to NOTIFY_SOCKET $socket_name: $!";
+ $sock->close or die "Error closing NOTIFY_SOCKET: $!";
+ $result = 1;
+ } or do {
+ my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
+ do_log(-1, "sd_notify: %s", $eval_stat);
+ };
}
+ undef $ENV{NOTIFY_SOCKET} if $unset_environment;
+ $result;
+}
+
+sub sd_notifyf($$;@) {
+ my($unset_environment, $message, @args) = @_;
+ sd_notify($unset_environment, @args ? sprintf($message, at args) : $message);
}
### Net::Server hook
@@ -12676,7 +13102,14 @@ sub load_policy_bank($;$) {
### but before binding to sockets
#
sub post_configure_hook {
-# umask(0007); # affect protection of Unix sockets created by Net::Server
+ if ($warm_restart) {
+ sd_notify(0, "STATUS=Preparing to re-bind sockets.");
+ } elsif (!$daemonize) {
+ sd_notify(0, "STATUS=Preparing to bind sockets.");
+ } else {
+ sd_notify(0, "MAINPID=$$","STATUS=Daemonized, preparing to bind sockets.");
+ }
+# umask(0007); # affects protection of Unix sockets created by Net::Server
}
sub set_sockets_access() {
@@ -12700,6 +13133,7 @@ sub set_sockets_access() {
sub post_bind_hook {
umask(0027); # restore our preferred umask
set_sockets_access() if defined $warm_restart && !$warm_restart;
+ sd_notify(0, "STATUS=Sockets bound, checking user and group.");
}
### Net::Server hook
@@ -12712,6 +13146,7 @@ sub pre_loop_hook {
local $SIG{CHLD} = 'DEFAULT';
# do_log(5, "entered pre_loop_hook");
eval {
+ sd_notify(0, "STATUS=The rest of pre-fork init, finding helper programs.");
after_chroot_init(); # the rest of the top-level initialization
# this needs to be done after chroot, otherwise paths will be wrong
@@ -12768,11 +13203,14 @@ sub pre_loop_hook {
'$enable_dkim_verification to 1, or explicitly disable it by setting '.
'it to 0 to mute this warning.');
}
+ # systemd, Type=notify
+ sd_notify(0, "READY=1", "STATUS=Initialization done.");
1;
} or do {
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
my $msg = "TROUBLE in pre_loop_hook: $eval_stat";
do_log(-2,"%s",$msg);
+ sd_notify(0, "STOPPING=1", "STATUS=$msg");
die("Suicide (" . am_id() . ") " . $msg . "\n");
};
1;
@@ -12819,10 +13257,12 @@ sub write_to_log_hook {
}
### user customizable Net::Server hook (Net::Server 0.88 or later),
-### hook occurs in the master process !!!
+### This hook occurs in the master process at the top of run_n_children
+### which is called each time the server goes to start more child processes.
#
sub run_n_children_hook {
# do_log(5, "entered run_n_children_hook");
+ sd_notify(0, "STATUS=Starting child process(es), ready for work.");
Amavis::AV::sophos_savi_reload()
if $extra_code_antivirus && Amavis::AV::sophos_savi_stale();
add_entropy(Time::HiRes::gettimeofday);
@@ -12855,7 +13295,8 @@ sub child_init_hook {
# @SIG{@signames} = ($h) x @signames;
my $inherited_entropy;
eval {
-# if ($> == 0 || $< == 0) { # last resort, in case Net::Server didn't do it
+# if (defined $daemon_user && $daemon_user ne '' && ($> == 0 || $< == 0)) {
+# # last resort, in case Net::Server didn't do it
# do_log(2, "child_init_hook: dropping privileges, user=%s, group=%s",
# $daemon_user,$daemon_group);
# drop_priv($daemon_user,$daemon_group);
@@ -12962,47 +13403,34 @@ sub post_accept_hook {
load_policy_bank(''); # start with a builtin baseline policy bank
}
-### user customizable Net::Server hook, load a by-interface policy bank;
-### if this hook returns 1 the request is processed
-### if this hook returns 0 the request is denied
+# load policy banks according to my socket (destination),
+# then check for allowed access from the peer (client/source)
#
-sub allow_deny_hook {
- my $self = $_[0];
- local($1,$2,$3,$4); # Perl bug: $1 and $2 come tainted from Net::Server !
- local $SIG{CHLD} = 'DEFAULT';
-# do_log(5, "entered allow_deny_hook");
- my($prop, $sock, $is_ux, @bank_names);
- $prop = $self->{server}; $sock = $prop->{client};
- $is_ux = $sock && $sock->UNIVERSAL::can('NS_proto') &&
- $sock->NS_proto eq 'UNIX';
- if ($is_ux) {
+sub access_is_allowed($;$$$$) {
+ my($unix_socket_path, $src_addr, $src_port, $dst_addr, $dst_port) = @_;
+ my(@bank_names);
+ if (defined $unix_socket_path) {
push(@bank_names, $interface_policy{"SOCK"});
- my $path = Net::Server->VERSION >= 2 ? $sock->NS_port
- : $sock->NS_unix_path;
- push(@bank_names, $interface_policy{$path}) if defined $path;
- } else {
- my($myaddr,$myport) = ($prop->{sockaddr}, $prop->{sockport});
- $myaddr = '[' . lc($myaddr) . ']' if $myaddr =~ /:/; # IPv6?
- push(@bank_names, $interface_policy{$myport});
- push(@bank_names, $interface_policy{"$myaddr:$myport"});
- }
- for my $bank_name (@bank_names) {
- load_policy_bank($bank_name) if defined $bank_name &&
- $bank_name ne c('policy_bank_name');
+ push(@bank_names, $interface_policy{$unix_socket_path});
+ } elsif (defined $dst_addr && defined $dst_port) {
+ $dst_addr = '['.lc($dst_addr).']' if $dst_addr =~ /:[0-9a-f]*:/i; # IPv6?
+ push(@bank_names, $interface_policy{$dst_port});
+ push(@bank_names, $interface_policy{"$dst_addr:$dst_port"});
}
+ load_policy_bank($_) for @bank_names;
# note that the new policy bank may have replaced the inet_acl access table
- if ($is_ux) {
+ if (defined $unix_socket_path) {
# always permit access - unix sockets are immune to this check
- } else {
- my($permit,$fullkey,$err) = lookup_ip_acl($prop->{peeraddr},
+ } elsif (defined $src_addr) {
+ my($permit,$fullkey,$err) = lookup_ip_acl($src_addr,
Amavis::Lookup::Label->new('inet_acl'), ca('inet_acl'));
if ($err) {
do_log(-1, "DENIED ACCESS due to INVALID PEER IP ADDRESS %s: %s",
- $prop->{peeraddr}, $err);
+ $src_addr, $err);
return 0;
} elsif (!$permit) {
do_log(-1, "DENIED ACCESS from IP %s, policy bank '%s'%s",
- $prop->{peeraddr}, c('policy_bank_path'),
+ $src_addr, c('policy_bank_path'),
!defined $fullkey ? '' : ", blocked by rule $fullkey");
return 0;
}
@@ -13010,6 +13438,31 @@ sub allow_deny_hook {
1;
}
+### user customizable Net::Server hook, load a by-interface policy bank;
+### if this hook returns 1 the request is processed
+### if this hook returns 0 the request is denied
+#
+sub allow_deny_hook {
+ my $self = $_[0];
+ local($1,$2,$3,$4); # Perl bug: $1 and $2 come tainted from Net::Server !
+ local $SIG{CHLD} = 'DEFAULT';
+# do_log(5, "entered allow_deny_hook");
+ my $prop = $self->{server};
+ my $sock = $prop->{client};
+ my $is_ux = $sock && $sock->UNIVERSAL::can('NS_proto') &&
+ $sock->NS_proto eq 'UNIX';
+ if ($is_ux) {
+ my $unix_socket_path = Net::Server->VERSION >= 2 ? $sock->NS_port
+ : $sock->NS_unix_path;
+ $unix_socket_path = 'UNKNOWN' if !defined $unix_socket_path;
+ return access_is_allowed($unix_socket_path);
+ } else {
+ return access_is_allowed(undef,
+ $prop->{peeraddr}, $prop->{peerport},
+ $prop->{sockaddr}, $prop->{sockport});
+ }
+}
+
### The heart of the program
### user customizable Net::Server hook
#
@@ -13262,7 +13715,8 @@ sub process_request {
}
undef $smtp_in_obj; undef $ampdp_in_obj; undef $courier_in_obj;
$self->done(1);
- } elsif ($max_requests > 0 && $child_task_count >= $max_requests) {
+ } elsif (defined $max_requests && $max_requests > 0 &&
+ $child_task_count >= $max_requests) {
# in case of multiple-transaction protocols (e.g. SMTP, LMTP)
# we do not like to keep running indefinitely at the mercy of MTA
do_log(2, "Requesting process rundown after %d tasks (and %s sessions)",
@@ -13370,6 +13824,39 @@ sub child_finish_hook {
log_capture_enabled(0);
}
+### user customizable Net::Server hook,
+### hook occurs in the main process before the server begins shutting down
+#
+sub pre_server_close_hook {
+ sd_notify(0, "STOPPING=1",
+ "STATUS=Server rundown, notifying child processes.");
+}
+
+### user customizable Net::Server hook,
+### hook occurs in the main process after child proceses have been shut down
+#
+sub post_child_cleanup_hook {
+ sd_notify(0, "STATUS=Child processes have been stopped.");
+}
+
+### user customizable Net::Server hook,
+### hook occurs in the main process if a server has received a HUP signal.
+### It occurs just before restarting the server via exec.
+#
+sub restart_close_hook {
+ sd_notify(0, "RELOADING=1",
+ "STATUS=Reloading server, about to re-exec the program.");
+}
+
+### user customizable Net::Server hook,
+### hook occurs in the main process if a server has been restarted via the HUP
+### signal and re-exec'd. It occurs just before reopening to the filenos of
+### the sockets that were already opened.
+#
+sub restart_open_hook {
+ sd_notify(0, "STATUS=Warm restart, re-binding sockets.");
+}
+
sub END { # runs before exiting the module
local($@,$!);
# do_log_safe(5,"at the END handler: invoking DESTROY methods");
@@ -13802,7 +14289,7 @@ sub check_mail($$) {
chdir($cwd) or die "Can't chdir to $cwd: $!";
}
# compute body digest, measure mail size, check for 8-bit data, get entropy
- get_body_digest($msginfo, $Amavis::Conf::mail_digest_algorithm);
+ get_body_digest($msginfo, c('mail_digest_algorithm'));
$which_section = 'collect_info';
collect_some_info($msginfo);
@@ -14165,7 +14652,7 @@ sub check_mail($$) {
$which_section = "linking-to-MAIL";
my $tempdir = $msginfo->mail_tempdir;
my $newpart_obj =
- Amavis::Unpackers::Part->new("$tempdir/parts",$parts_root,1);
+ Amavis::Unpackers::Part->new("$tempdir/parts", $parts_root, 1);
my $newpart = $newpart_obj->full_name;
ll(3) && do_log(3,'presenting full original message to scanners '.
'as %s%s%s%s',
@@ -14273,39 +14760,26 @@ sub check_mail($$) {
my $vntpbm = ca('virus_name_to_policy_bank_maps');
if (@$vntpbm) {
- my(@bank_names, %bank_names);
+ my(@bank_names);
for my $vn (@virusname) {
my($result,$matchingkey) = lookup2(0,$vn,$vntpbm);
- 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 = 'VIRUS';
- }
- # $result is a list of policy banks as a comma-separated string
- my(@pbn); # collect list of newly encountered policy bank names
- for (map { my $s = $_; $s =~ s/^[ \t]+//; $s =~ s/[ \t]+\z//; $s }
- split(/,/, $result)) {
- next if $_ eq '' || $bank_names{$_};
- push(@pbn,$_); $bank_names{$_} = 1;
- }
- if (@pbn) {
- push(@bank_names, at pbn);
- ll(2) && do_log(2, "virus %s loads policy bank(s) %s, match: %s",
- $vn, join(',', at pbn), $matchingkey);
- }
+ 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 = 'VIRUS';
}
- }
- if (@bank_names) {
- # ignore nonexisting bank names, skip duplicates
- @bank_names = grep(defined $policy_bank{$_},
- unique_list(\@bank_names));
- if (@bank_names) {
- load_policy_bank($_,$msginfo) for @bank_names;
- $msginfo->originating(c('originating')); # may have changed
+ # $result is a list of policy bank names as a comma-separated string
+ local $1;
+ my(@pbn) = map(/^\s*(\S.*?)\s*\z/s ? $1 : (), split(/,/, $result));
+ if (@pbn) {
+ push(@bank_names, @pbn);
+ ll(2) && do_log(2, "virus %s loads policy bank(s) %s, match: %s",
+ $vn, join(',', at pbn), $matchingkey);
}
}
+ load_policy_bank($_) for @bank_names;
}
}
@@ -14728,6 +15202,7 @@ sub check_mail($$) {
}
}
$r->recip_destiny($final_destiny);
+
if (defined $blocking_ccat) { # save a blocking contents category
$r->blocking_ccat($blocking_ccat);
# summarize per-recipient blocking_ccat to a message level
@@ -14948,14 +15423,22 @@ sub check_mail($$) {
my $bcc = $msginfo->setting_by_contents_category(cr('always_bcc_by_ccat'));
if (defined $bcc && $bcc ne '') {
my $recip_obj = Amavis::In::Message::PerRecip->new;
- # leave recip_addr and recip_addr_smtp undefined!
$recip_obj->recip_addr_modified($bcc);
+
+ # leave recip_addr and recip_addr_smtp undefined to hide it from the log?
+ $recip_obj->recip_addr($bcc);
+ $recip_obj->recip_addr_smtp(qquote_rfc2821_local($bcc)); #****
+
+ $recip_obj->recip_is_local(
+ lookup2(0, $bcc, ca('local_domains_maps')) ? 1 : 0);
$recip_obj->recip_destiny(D_PASS);
$recip_obj->dsn_notify(['NEVER']);
+ $recip_obj->delivery_method(c('notify_method'));
$recip_obj->contents_category($msginfo->contents_category);
# $recip_obj->add_contents_category(CC_CLEAN,0);
$msginfo->per_recip_data([@{$msginfo->per_recip_data}, $recip_obj]);
- do_log(2,"adding recipient - always_bcc: %s", $bcc);
+ do_log(2,"adding recipient - always_bcc: %s, delivery method %s",
+ $bcc, $recip_obj->delivery_method);
}
my $hdr_edits = $msginfo->header_edits;
@@ -15344,10 +15827,10 @@ sub check_mail($$) {
$mybuiltins{'ccat'} =
sub {
my($name,$attr,$which) = @_;
- $attr = lc($attr); # name | major | minor | <empty>
+ $attr = lc $attr; # name | major | minor | <empty>
# | is_blocking | is_nonblocking
# | is_blocked_by_nonmain
- $which = lc($which); # main | blocking | auto
+ $which = lc $which; # main | blocking | auto
my $result = ''; my $blocking_ccat = $r->blocking_ccat;
if ($attr eq 'is_blocking') {
$result = defined($blocking_ccat) ? 1 : '';
@@ -16218,10 +16701,15 @@ sub parse_authentication_results($) {
while (!/\G \z/gcsx) {
if ( /\G \( /gcsx) { $comm_lvl++ }
elsif ($comm_lvl > 0 && /\G \) /gcsx) { $comm_lvl-- }
- elsif ($comm_lvl > 0 && /\G(?: \\. | [^()\\]+ )/gcsx) {}
+ elsif ($comm_lvl > 0 && /\G(?: \\ . | [^()\\]+ )/gcsx) {}
elsif (!$comm_lvl && /\G [ \t]+ /gcsx) {}
- elsif (!$comm_lvl && /\G ([^\000-\040\177-\377:;,"()<>\[\]\@\\]+)/gcsx)
- { $authservid = $1; last }
+ elsif (!$comm_lvl && m{\G ( [^\x00-\x20\x7F()<>,;:"/?=\[\]\@\\]+ ) }gcsx)
+ { $authservid = $1; last } # token
+ elsif (!$comm_lvl && m{\G " ( (?: \\ [\t\x20-\x7E] |
+ [\t\x20\x21\x23-\x5B\x5D-\x7E] |
+ [\xC0-\xF4][\x80-\xBF]{1,3}
+ )* ) " }gcsx) # qcontent (relaxed for UTF-8)
+ { $authservid = $1; $authservid =~ s{\\(.)}{$1}gsx; last }
else { last }; # syntax error
}
$authservid;
@@ -16242,14 +16730,16 @@ sub add_forwarding_header_edits_common($$$$$$) {
}
if (c('enable_dkim_verification') &&
$allowed_hdrs && $allowed_hdrs->{lc('Authentication-Results')}) {
- # RFC 5451: For security reasons, any MTA conforming to this specification
- # MUST delete any discovered instance of this header field that claims to
- # have been added within its trust boundary and that did not come from
- # another trusted MTA. [...] For simplicity and maximum security, a border
- # MTA MAY remove all instances of this header field on mail crossing into
+
+ # RFC 7601: For security reasons, any MTA conforming to this specification
+ # MUST delete any discovered instance of this header field that claims,
+ # by virtue of its authentication service identifier, to have been added
+ # within its trust boundary but that did not come directly from another
+ # trusted MTA. [...] For simplicity and maximum security, a border MTA
+ # could remove all instances of this header field on mail crossing into
# its trust boundary. [...] (Hmmm...!?) However, an MTA MUST remove such
- # a header if the [SMTP] connection relaying the message is not from a
- # trusted internal MTA.
+ # a header field if the [SMTP] connection relaying the message is not from
+ # a trusted internal MTA.
my $authservid = c('myauthservid');
$authservid = c('myhostname') if !defined $authservid || $authservid eq '';
$authservid = idn_to_ascii($authservid);
@@ -16260,8 +16750,8 @@ sub add_forwarding_header_edits_common($$$$$$) {
if (defined $aid) { $aid =~ s{/.*}{}s; $authservid =~ s{/.*}{}s };
!defined $aid || lc($aid) eq lc($authservid) ? (undef,0) : ($b,1);
} );
- # [...] Border MTA MAY elect simply to remove all instances of this
- # header field on mail crossing into its trust boundary
+ # [...] For simplicity and maximum security, a border MTA could remove all
+ # instances of this header field on mail crossing into its trust boundary.
# $hdr_edits->delete_header('Authentication-Results');
}
@@ -16372,6 +16862,7 @@ sub add_forwarding_header_edits_per_recip($$$$$$$) {
$subject_tag = '' if !defined $subject_tag;
if ($subject_tag ne '') { # expand subject template
# just implement a small subset of macro-lookalikes, not true macro calls
+ # btw, the '0+' is there to trim trailing zeroes
$subject_tag =~
s{_(SCORE|REQD|YESNO|YESNOCAPS|HOSTNAME|DATE|U|LOGID|MAILID)_}
{ $1 eq 'SCORE' ? (0+sprintf("%.3f",$spam_level))
@@ -16405,9 +16896,12 @@ sub add_forwarding_header_edits_per_recip($$$$$$$) {
# (undefined tag level is treated as lower than any spam score).
my $autolearn_status = $msginfo->supplementary_info('AUTOLEARN');
my $slc = c('sa_spam_level_char');
- $spam_level_bar = $slc x min(64, $bypassed || $whitelisted ? 0
- : $blacklisted ? 64
- : 0+$spam_level) if $slc ne '';
+ if (defined $slc && $slc ne '') {
+ my $bar_len = $whitelisted || $bypassed ? 0 : $blacklisted ? 64
+ : !defined $spam_level ? 0
+ : $spam_level > 64 ? 64 : $spam_level;
+ $spam_level_bar = $bar_len < 1 ? '' : $slc x int $bar_len;
+ }
my $spam_tests = $r->spam_tests;
$spam_tests = !$spam_tests ? '' : join(',',map($$_,@$spam_tests));
# allow header field wrapping at any comma
@@ -16554,7 +17048,7 @@ sub add_forwarding_header_edits_per_recip($$$$$$$) {
local($1,$2);
if ($hf =~ /^([!-9;-\176]+)[ \t]*:(.*)\z/s) {
my($hf_name,$hf_body) = ($1,$2);
- my $hf_name_lc = lc($hf_name); chomp($hf_body);
+ my $hf_name_lc = lc $hf_name; chomp($hf_body);
if ($header_field_provided{$hf_name_lc}) {
do_log(5,'fwd: scanner provided a header field %s, but we '.
'preferred our own', $hf_name);
@@ -16634,8 +17128,8 @@ sub add_forwarding_header_edits_per_recip($$$$$$$) {
cr('addr_rewrite_maps_by_ccat'));
my $rewrite = !ref $rewrite_map ? undef : lookup2(0,$recip,$rewrite_map);
if ($rewrite ne '') {
- my(@replacements) = grep($_ ne '',
- map { /^ [ \t]* (.*?) [ \t]* \z/xs; $1 } split(/,/, $rewrite, -1));
+ my(@replacements) =
+ map(/^\s*(\S.*?)\s*\z/s ? $1 : (), split(/,/, $rewrite));
if (@replacements) {
my $repl_addr = shift @replacements;
my $modif_addr = replace_addr_fields($recip,$repl_addr,$delim);
@@ -16999,7 +17493,8 @@ sub do_quarantine($$$$;@) {
$quar_msg->sender($msginfo->sender); # original sender
$quar_msg->sender_smtp($msginfo->sender_smtp);
$orig_env_sender_retained = 1;
- } elsif (defined $mftq) { # have a replacement and smtp, lmtp, pipe, local
+ } elsif (defined $mftq) {
+ # have a replacement, and protocol is smtp, lmtp, pipe, local
$quar_msg->sender($mftq);
$mftq = qquote_rfc2821_local($mftq);
$quar_msg->sender_smtp($mftq);
@@ -17022,7 +17517,7 @@ sub do_quarantine($$$$;@) {
push(@recips,$recip_obj);
}
$orig_env_recips_retained = 1;
- } else { # have a replacement and smtp, lmtp, pipe, local
+ } else { # have a replacement, and protocol is smtp, lmtp, pipe, local
# with these quarantine methods the envelope information is used to
# determine where and how to store a quarantined message, and may not
# reflect original envelope sender and recipients addresses
@@ -17053,9 +17548,9 @@ sub do_quarantine($$$$;@) {
$hdr_edits->prepend_header('X-Envelope-To',
join(",\n ", map($_->recip_addr_smtp, @{$msginfo->per_recip_data})),1);
}
- if (!$orig_env_sender_retained) { # unless X-Envelope-* would be redundant
- $hdr_edits->prepend_header('X-Envelope-From', $msginfo->sender_smtp);
- }
+ # X-Envelope-* could be redundant with $orig_env_sender_retained, but
+ # let's provide this information unconditionally (for the benefit of SQL)
+ $hdr_edits->prepend_header('X-Envelope-From', $msginfo->sender_smtp);
$hdr_edits->add_header('Received',
make_received_header_field($msginfo,1), 1);
$quar_msg->header_edits($hdr_edits);
@@ -17216,11 +17711,11 @@ sub prepare_header_edits_for_quarantine($) {
if ($allowed_hdrs && $use_our_hdrs) {
my $spam_level_bar; my $slc = c('sa_spam_level_char');
- if ($slc ne '') {
- my $bar_len = $whitelisted_any ? 0
- : $blacklisted_any ? 64
- : min(64, 0+$max_spam_level);
- $spam_level_bar = $bar_len <= 0 ? '' : $slc x $bar_len;
+ if (defined $slc && $slc ne '') {
+ my $bar_len = $whitelisted_any ? 0 : $blacklisted_any ? 64
+ : !defined $max_spam_level ? 0
+ : $max_spam_level > 64 ? 64 : $max_spam_level;
+ $spam_level_bar = $bar_len < 1 ? '' : $slc x int $bar_len;
}
# allow header field wrapping at any comma
my $s = join(",\n ", sort keys %all_spam_tests);
@@ -17294,7 +17789,7 @@ sub prepare_header_edits_for_quarantine($) {
local($1,$2);
if ($hf =~ /^([!-9;-\176]+)[ \t]*:(.*)\z/s) {
my($hf_name,$hf_body) = ($1,$2);
- my $hf_name_lc = lc($hf_name); chomp($hf_body);
+ my $hf_name_lc = lc $hf_name; chomp($hf_body);
if ($header_field_provided{$hf_name_lc}) {
do_log(5,'quar: scanner provided a header field %s, but we '.
'preferred our own', $hf_name);
@@ -17349,8 +17844,8 @@ sub do_notify_and_quarantine($$) {
map(scalar $msginfo->setting_by_contents_category(cr($_)),
qw(mailfrom_notify_admin_by_ccat hdrfrom_notify_admin_by_ccat
notify_admin_templ_by_ccat));
- $mailfrom_admin = safe_encode_utf8($mailfrom_admin); # make sure it's octets
- $hdrfrom_admin = safe_encode_utf8($hdrfrom_admin); # make sure it's octets
+ safe_encode_utf8_inplace($mailfrom_admin); # to octets (if not already)
+ safe_encode_utf8_inplace($hdrfrom_admin); # to octets (if not already)
my $qar_method = c('archive_quarantine_method');
my(@ccat_names_pairs) =
$msginfo->setting_by_main_contents_category_all(\%ccat_display_names);
@@ -17565,7 +18060,7 @@ sub do_notify_and_quarantine($$) {
$notification->conn_obj($msginfo->conn_obj);
$notification->originating(1);
$notification->add_contents_category(CC_CLEAN,0);
- $_ = safe_encode_utf8($_) for @a_addr; # make sure addresses are in octets
+ safe_encode_utf8_inplace($_) for @a_addr; # make sure addrs are in octets
if (grep( / [^\x00-\x7F] .*? \@ [^@]* \z/sx && is_valid_utf_8($_),
($mailfrom_admin, @a_addr) )) {
# localpart is non-ASCII UTF-8, we must use SMTPUTF8
@@ -17648,8 +18143,9 @@ sub do_notify_and_quarantine($$) {
my $hdrfrom_recip =
$r->setting_by_contents_category(cr('hdrfrom_notify_recip_by_ccat'));
# make sure it's in octets
- $mailfrom_recip = safe_encode_utf8($mailfrom_recip);
- $hdrfrom_recip = expand_variables(safe_encode_utf8($hdrfrom_recip));
+ safe_encode_utf8_inplace($mailfrom_recip); # to octets (if not already)
+ safe_encode_utf8_inplace($hdrfrom_recip); # to octets (if not already)
+ $hdrfrom_recip = expand_variables($hdrfrom_recip);
if (!defined $mailfrom_recip) {
# defaults to email address in hdrfrom_notify_recip
$mailfrom_recip =
@@ -17744,19 +18240,21 @@ sub get_body_digest($$) {
# with each request, and allows us to turn on EDNS.
# The controversial need for 'config_file' option was debated in
# [rt.cpan.org #96608] https://rt.cpan.org/Ticket/Display.html?id=96608
+ # With Net::DNS 1.03 the semantics of a "retry" option has changed:
+ # [rt.cpan.org #109183] https://rt.cpan.org/Ticket/Display.html?id=109183
$dns_resolver = Net::DNS::Resolver->new(
config_file => '/etc/resolv.conf',
- force_v4 => !$have_inet6,
- defnames => 0,
+ defnames => 0, force_v4 => !$have_inet6,
retry => 2, # number of times to try the query (not REtries)
- retrans => 4, tcp_timeout => 4, udp_timeout => 4, # seconds
+ persistent_udp => 1,
+ tcp_timeout => 3, udp_timeout => 3, retrans => 2, # seconds
);
if (!$dns_resolver) {
do_log(-1, "Failed to create a Net::DNS::Resolver object");
$dns_resolver = 0; # defined but false
} else {
# RFC 2460 (for IPv6) requires that a minimal MTU is 1280 bytes,
- # less 40 bytes for a basic IP header = 1240;
+ # taking away 40 bytes for a basic IP header gives 1240;
# RFC 3226: minimum of 1220 for RFC 2535 compliant servers
# RFC 6891: choosing between 1280 and 1410 bytes for IP (v4 or v6)
# over Ethernet would be reasonable.
@@ -18137,7 +18635,7 @@ sub find_external_programs($) {
{ no strict 'refs'; $$g = $found } # NOTE: a symbolic reference
if (!defined $found) { do_log(0,"No %-19s not using it", "$f,") }
else {
- do_log(0,"Found %-16s at %s%s", $f,
+ do_log(1, "Found %-16s at %s%s", $f,
$daemon_chroot_dir ne '' ? "(chroot: $daemon_chroot_dir/) " : '',
$found);
}
@@ -18165,12 +18663,12 @@ sub find_external_programs($) {
my $any_in_use;
for my $short_type (ref $short_types ? @$short_types : $short_types) {
my $is_a_backup = $any_st{$short_type};
- my($ll,$tier) = !$is_a_backup ? (0,'') : (2,' (backup, not used)');
+ my($ll,$tier) = !$is_a_backup ? (1,'') : (2,' (backup, not used)');
if (@$f <= 2) { # no external programs specified
if (!$is_a_backup) { $any_in_use = 1; $any_st{$short_type} = 1 }
do_log($ll, "Internal decoder for .%-4s%s", $short_type,$tier);
} elsif (!$any) { # external programs specified but none found
- do_log($ll, "No ext program for .%s, tried: %s",
+ do_log(0, "No ext program for .%s, tried: %s",
$short_type, join('; ', at tried)) if @tried && !$is_a_backup;
} else {
if (!$is_a_backup) { $any_in_use = 1; $any_st{$short_type} = 1 }
@@ -18378,6 +18876,18 @@ stir_random();
add_entropy($], @INC, %ENV);
delete @ENV{'PATH', 'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+STDERR->autoflush(1);
+STDERR->fcntl(F_SETFL, O_APPEND)
+ or warn "Error setting O_APPEND on STDERR: $!";
+
+umask(0027); # set our preferred umask
+POSIX::setlocale(LC_TIME,'C'); # English dates required in syslog and RFC 5322
+
+# using Net::Server internal mechanism for a restart on HUP
+$warm_restart = defined $ENV{BOUND_SOCKETS} && $ENV{BOUND_SOCKETS} ne '' ?1:0;
+
+update_current_log_level();
+
# Read dynamic source code, and logging and notification message templates
# from the end of this file (pseudo file handle DATA)
#
@@ -18425,8 +18935,6 @@ close(\*Amavis::DATA) or die "Error closing *Amavis::DATA: $!";
# close(STDIN) or die "Error closing STDIN: $!";
# note: don't close STDIN just yet to prevent some other file taking up fd 0
-STDERR->autoflush(1);
-
{ local($1);
s/^(.*?)[\r\n]+\z/$1/s # discard trailing NL
for ($Amavis::Conf::log_short_templ,
@@ -18435,12 +18943,6 @@ STDERR->autoflush(1);
};
$Amavis::Conf::log_templ = $Amavis::Conf::log_short_templ;
-umask(0027); # set our preferred umask
-POSIX::setlocale(LC_TIME,'C'); # English dates required in syslog and RFC 5322
-
-# using Net::Server internal mechanism for a restart on HUP
-$warm_restart = defined $ENV{BOUND_SOCKETS} && $ENV{BOUND_SOCKETS} ne '' ?1:0;
-
# Consider dropping privileges early, before reading a config file.
# This is only possible if running under chroot will not be needed.
#
@@ -18495,7 +18997,7 @@ while (@argv >= 2 && $argv[0] =~ /^-[ugdimcpDHLPQRSTX]\z/ ||
} elsif ($opt eq '-L') { # -L lock_file
$lock_file_override = untaint($val) if $val ne '';
} elsif ($opt eq '-P') { # -P pid_file
- $pid_file_override = untaint($val) if $val ne '';
+ $pid_file_override = untaint($val); # empty disables pid_file
} elsif ($opt eq '-Q') { # -Q quarantine_dir, empty string disables quarant.
$quarantinedir_override = untaint($val);
} elsif ($opt eq '-R') { # -R chroot_dir, empty string or '/' avoids chroot
@@ -18528,9 +19030,9 @@ if (grep($_, values %i_know_what_i_am_doing)) {
# deal with debugging early, based on a command line arg
if ($cmd =~ /^(?:start|debug|debug-sa|foreground)?\z/) {
- $daemonize=0 if $cmd eq 'foreground';
- $daemonize=0, $DEBUG=1 if $cmd eq 'debug';
- $daemonize=0, $sa_debug=1 if $cmd eq 'debug-sa';
+ $daemonize=0 if $cmd eq 'foreground';
+ $daemonize=0, $DEBUG=1 if $cmd eq 'debug';
+ $daemonize=0, $sa_debug='all' if $cmd eq 'debug-sa';
}
if (!defined($desired_user)) {
@@ -18595,7 +19097,7 @@ add_entropy($Amavis::Conf::myhostname, $Amavis::Conf::myversion_date);
undef $Amavis::Conf::log_short_templ;
undef $Amavis::Conf::log_verbose_templ;
-if (defined $desired_user && $daemon_user ne '') {
+if (defined $desired_user && defined $daemon_user && $daemon_user ne '') {
local($1);
# compare the config file settings to current UID
my($username,$passwd,$uid,$gid) =
@@ -18610,11 +19112,13 @@ if ($> != 0 && $< != 0) {
# dropping of privs is not needed
} elsif (defined $daemon_chroot_dir && $daemon_chroot_dir ne '') {
# dropping of privs now would prevent later chroot and is to be skipped
-} else { # drop privileges, unless needed for chrooting
+} elsif (defined $daemon_user && $daemon_user ne '') {
+ # drop privileges, unless needed for chrooting
drop_priv($daemon_user,$daemon_group);
}
# override certain config file options by command line arguments
+$sa_debug='all' if $cmd eq 'debug-sa';
my(@sa_debug_fac); # list of SA debug facilities
if (defined $log_level_override) {
for my $item (split(/[ \t]*,[ \t]*/, $log_level_override, -1)) {
@@ -18923,11 +19427,12 @@ if ($enable_zmq && $extra_code_zmq && @zmq_sockets) {
Amavis::Log::init($do_syslog, $logfile); # initialize logging
Amavis::Log::log_to_stderr($cmd eq 'debug' || $cmd eq 'debug-sa' ? 1 : 0);
-do_log(2, 'logging initialized, log level %s, %s%s', c('log_level'),
+do_log(1, 'logging initialized, log level %s, %s%s', c('log_level'),
$do_syslog ? sprintf("syslog: %s.%s",c('syslog_ident'),c('syslog_facility')):
$logfile ne '' ? "logfile: $logfile" : "STDERR",
!$enable_log_capture ? '' : ', log capture enabled');
do_log(2, 'ZMQ enabled: %s', Amavis::ZMQ::zmq_version()) if $zmq_obj;
+sd_notify(0, "STATUS=Config files have been read, modules loaded.");
# insist on a FQDN in $myhostname
my $myhn = idn_to_utf8(c('myhostname'));
@@ -18944,96 +19449,122 @@ $mail_id_size_bits == int $mail_id_size_bits &&
$mail_id_size_bits % 24 == 0
or die "\$mail_id_size_bits ($mail_id_size_bits) must be a multiple of 24\n";
-eval {
- my $amavisd_pid; # PID of a currently running amavisd daemon (not our pid)
- # is amavisd daemon already running?
+my $amavisd_pid; # PID of the currently running amavisd daemon (not our pid)
+my $amavisd_pid_by_mainpid; # is $amavisd_pid provided by $ENV{MAINPID} ?
+eval { # is amavisd daemon already running?
+ if (defined $ENV{MAINPID}) { # provided by systemd.exec(5) ?
+ local($1);
+ if ($ENV{MAINPID} =~ /^\s* ( [0-9]{1,10} ) \s*\z/xs && $1 > 0) {
+ $amavisd_pid = untaint($1);
+ $amavisd_pid_by_mainpid = 1;
+ }
+ }
my $pidf = defined $pid_file_override ? $pid_file_override : $pid_file;
- defined $pidf && $pidf ne '' or die "Config parameter \$pid_file not set";
- my(@stat_list) = lstat($pidf); my $errn = @stat_list ? 0 : 0+$!;
- if ($warm_restart) {
+ if (defined $amavisd_pid) {
+ if (defined $pidf && $pidf ne '') {
+ do_log(2, 'Master PID [%s] provided by the MAINPID env.var, '.
+ 'not checking $pid_file', $amavisd_pid);
+ } else {
+ do_log(2, 'Master PID [%s] provided by the MAINPID env.var, '.
+ 'no $pid_file', $amavisd_pid);
+ }
+ } elsif (!defined $pidf || $pidf eq '') {
+ do_log(2, 'no $pid_file configured, not checking it');
+ } elsif ($warm_restart) {
# skip pid file checking, let Net::Server handle it
- } elsif ($errn == ENOENT) {
- die "The amavisd daemon is apparently not running, no PID file $pidf\n"
- if $cmd =~ /^(?:reload|restart|stop)\z/;
- } elsif ($errn != 0) {
- die "PID file $pidf is inaccessible: $!\n";
- } elsif (!-f _) {
- die "PID file $pidf is not a regular file\n";
- } else { # determine PID of the currently running amavisd daemon, validate it
- my $ln; my $lcnt = 0; my $pidf_h = IO::File->new;
- $pidf_h->open($pidf,'<') or die "Can't open PID file $pidf: $!";
- for ($! = 0; defined($ln=$pidf_h->getline); $! = 0) {
- chomp($ln); $lcnt++; last if $lcnt > 100;
- $amavisd_pid = $ln if $lcnt == 1 && $ln =~ /^\d{1,10}\z/;
- }
- defined $ln || $! == 0 or die "Error reading from file $pidf: $!";
- $pidf_h->close or die "Error closing file $pidf: $!";
- if ($lcnt <= 1 && !defined $amavisd_pid) {
- # treat empty or junk one-line pid file the same as nonexisting pid file
- die "The amavisd daemon is apparently not running, empty PID file $pidf\n"
+ } else {
+ my(@stat_list) = lstat($pidf);
+ my $errn = @stat_list ? 0 : 0+$!;
+ if ($errn == ENOENT) {
+ die "The amavisd daemon is apparently not running, no PID file $pidf\n"
if $cmd =~ /^(?:reload|restart|stop)\z/;
- # prevent Net::Server from seeing this crippled file
- do_log(-1, "removing empty or crippled PID file %s", $pidf);
- unlink($pidf) or die "Can't remove PID file $pidf: $!";
- undef $amavisd_pid;
- } else {
- $lcnt <= 1 or die "More than one line in file $pidf";
- defined $amavisd_pid or die "Missing process ID in file $pidf";
- $amavisd_pid > 1 or die "Invalid PID in file $pidf: [$amavisd_pid]";
- }
- my $mtime = $stat_list[9];
- if (defined $amavisd_pid && defined $mtime) { # got a PID from a file
- # Is pid file older than system uptime? If so, it should be disregarded,
- # it must not prevent starting up amavisd after unclean shutdown.
- my $now = int(time); my($uptime,$uptime_fmt); # sys uptime in seconds
- my(@prog_args); my(@progs) = ('/usr/bin/uptime','uptime');
- if (lc($^O) eq 'freebsd')
- { @progs = ('/sbin/sysctl','sysctl'); @prog_args = 'kern.boottime' }
- my $prog = find_program_path(\@progs, [split(/:/,$path,-1)] );
- if (!defined($prog)) {
- do_log(1,'No programs: %s',join(", ", at progs));
- } else { # obtain system uptime
- my($proc_fh,$uppid);
- eval {
- ($proc_fh,$uppid) = run_command(undef,'/dev/null',$prog, at prog_args);
- for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
- local($1,$2,$3,$4); chomp($ln);
- if (defined $uptime) {}
- elsif ($ln =~ /{[^}]*\bsec\s*=\s*(\d+)[^}]*}/) { $uptime= $now-$1 }
- # amazing how broken reports from uptime(1) soon after boot can be!
- elsif ($ln =~ /\b up \s+ (?: (\d{1,4}) \s* days? )? [,\s]*
- (\d{1,2}) : (\d{1,2}) (?: : (\d{1,2}))? (?! \d ) /ix
- || $ln =~ /\b up (?: \s* \b (\d{1,4}) \s* days? )?
- (?: [,\s]* \b (\d{1,2}) \s* hrs? )?
- (?: [,\s]* \b (\d{1,2}) \s* mins? )?
- (?: [,\s]* \b (\d{1,2}) \s* secs? )? /ix )
- { $uptime = (($1*24 + $2)*60 + $3)*60 + $4 }
- elsif ($ln =~ /\b (\d{1,2}) \s* secs?/ix) { $uptime = $1 } #OpenBSD
- $uptime_fmt = format_time_interval($uptime);
- do_log(5,"system uptime %s: %s", $uptime_fmt,$ln);
- }
- defined $ln || $! == 0 or die "Reading uptime: $!";
- my $err=0; $proc_fh->close or $err = $!;
- my $child_stat = defined $uppid && waitpid($uppid,0)>0 ? $? : undef;
- undef $proc_fh; undef $uppid;
- proc_status_ok($child_stat,$err) or die "Error running $prog: " .
- exit_status_str($child_stat,$err) . "\n";
- } or do {
- my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
- do_log(1,"uptime: %s", $eval_stat);
- };
- if (defined $proc_fh) { $proc_fh->close } # ignoring status
- if (defined $uppid) { waitpid($uppid,0) } # ignoring status
- }
- if (!defined($uptime)) {
- do_log(1,'Unable to determine system uptime, will trust PID file');
- } elsif ($now-$mtime <= $uptime+70) {
- do_log(1,'Valid PID file (younger than sys uptime %s)', $uptime_fmt);
- } else { # must not kill an unrelated process which happens to have the
- # same pid as amavisd had before a system shutdown or crash
+ } elsif ($errn != 0) {
+ die "PID file $pidf is inaccessible: $!\n";
+ } elsif (!-f _) {
+ die "PID file $pidf is not a regular file\n";
+ } else { # find and validate PID of the currently running amavisd daemon
+ my $ln; my $lcnt = 0; my $pidf_h = IO::File->new;
+ $pidf_h->open($pidf,'<') or die "Can't open PID file $pidf: $!";
+ for ($! = 0; defined($ln=$pidf_h->getline); $! = 0) {
+ chomp($ln); $lcnt++; last if $lcnt > 100;
+ $amavisd_pid = $ln if $lcnt == 1 && $ln =~ /^\d{1,10}\z/;
+ }
+ defined $ln || $! == 0 or die "Error reading from file $pidf: $!";
+ $pidf_h->close or die "Error closing file $pidf: $!";
+ if ($lcnt <= 1 && !defined $amavisd_pid) {
+ # empty or junk one-line pid file treated the same as nonexisting file
+ die "The amavisd daemon is apparently not running, ".
+ "empty PID file $pidf\n" if $cmd =~ /^(?:reload|restart|stop)\z/;
+ # prevent Net::Server from seeing this crippled file
+ do_log(-1, "removing empty or crippled PID file %s", $pidf);
+ unlink($pidf) or die "Can't remove PID file $pidf: $!";
undef $amavisd_pid;
- do_log(1,'Ignoring stale PID file %s, older than system uptime %s',
- $pidf,$uptime_fmt);
+ } else {
+ $lcnt <= 1 or die "More than one line in file $pidf";
+ defined $amavisd_pid or die "Missing process ID in file $pidf";
+ $amavisd_pid >= 1 or die "Invalid PID in file $pidf: [$amavisd_pid]";
+ # note that amavisd under Docker may run as PID #1
+ }
+ my $mtime = $stat_list[9];
+ if (defined $amavisd_pid && defined $mtime) { # got a PID from a file
+ # Is pid file older than system uptime? If so, it should be disregarded,
+ # it must not prevent starting up amavisd after unclean shutdown.
+ my $now = int(time); my($uptime,$uptime_fmt); # sys uptime in seconds
+ my(@prog_args); my(@progs) = ('/usr/bin/uptime','uptime');
+ if (lc($^O) eq 'freebsd')
+ { @progs = ('/sbin/sysctl','sysctl'); @prog_args = 'kern.boottime' }
+ my $prog = find_program_path(\@progs, [split(/:/,$path,-1)] );
+ if (!defined($prog)) {
+ do_log(1,'No programs: %s',join(", ", at progs));
+ } else { # obtain system uptime
+ my($proc_fh,$uppid);
+ eval {
+ ($proc_fh,$uppid) = run_command(undef,'/dev/null',$prog, at prog_args);
+ for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
+ local($1,$2,$3,$4); chomp($ln);
+ if (defined $uptime) {}
+ elsif ($ln =~ /{[^}]*\bsec\s*=\s*(\d+)[^}]*}/) {
+ $uptime = $now - $1;
+ # amazingly broken reports from uptime(1) soon after boot!
+ } elsif ($ln =~ /\b up \s+ (?: (\d{1,4}) \s* days? )? [,\s]*
+ (\d{1,2}) : (\d{1,2}) (?: : (\d{1,2}))? (?! \d ) /ix
+ || $ln =~ /\b up (?: \s* \b (\d{1,4}) \s* days? )?
+ (?: [,\s]* \b (\d{1,2}) \s* hrs? )?
+ (?: [,\s]* \b (\d{1,2}) \s* mins? )?
+ (?: [,\s]* \b (\d{1,2}) \s* secs? )? /ix ) {
+ $uptime = (($1*24 + $2)*60 + $3)*60 + $4;
+ } elsif ($ln =~ /\b (\d{1,2}) \s* secs?/ix) {
+ $uptime = $1; # OpenBSD
+ }
+ $uptime_fmt = format_time_interval($uptime);
+ do_log(5,"system uptime %s: %s", $uptime_fmt,$ln);
+ }
+ defined $ln || $! == 0 or die "Reading uptime: $!";
+ my $err=0; $proc_fh->close or $err = $!;
+ my $child_stat = defined $uppid && waitpid($uppid,0)>0 ? $? : undef;
+ undef $proc_fh; undef $uppid;
+ proc_status_ok($child_stat,$err)
+ or die "Error running $prog: " .
+ exit_status_str($child_stat,$err) . "\n";
+ } or do {
+ my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
+ do_log(1,"uptime: %s", $eval_stat);
+ };
+ if (defined $proc_fh) { $proc_fh->close } # ignoring status
+ if (defined $uppid) { waitpid($uppid,0) } # ignoring status
+ }
+ if (!defined $uptime) {
+ do_log(1,'Unable to determine system uptime, will trust PID file %s',
+ $pidf);
+ } elsif ($now-$mtime <= $uptime+70) {
+ do_log(1,'Valid PID file %s (younger than sys uptime %s)',
+ $pidf, $uptime_fmt);
+ } else { # must not kill an unrelated process which happens to have the
+ # same pid as amavisd had before a system shutdown or crash
+ undef $amavisd_pid;
+ do_log(1,'Ignoring stale PID file %s, older than system uptime %s',
+ $pidf, $uptime_fmt);
+ }
}
}
}
@@ -19041,6 +19572,8 @@ eval {
untaint_inplace($amavisd_pid);
if (!kill(0,$amavisd_pid)) { # does a process exist?
$! == ESRCH or die "Can't send SIG 0 to process [$amavisd_pid]: $!";
+ do_log(2, 'No such process [%s], supposedly the current amavisd '.
+ 'master process', $amavisd_pid);
undef $amavisd_pid; # process does not exist
};
}
@@ -19053,57 +19586,71 @@ eval {
!defined($amavisd_pid)
or die "The amavisd daemon is already running, PID: [$amavisd_pid]\n";
} elsif ($cmd eq 'reload') { # reload: send a HUP signal to a running daemon
- defined $amavisd_pid or die "The amavisd daemon is not running\n";
- kill('HUP',$amavisd_pid) or $! == ESRCH
- or die "Can't SIGHUP amavisd[$amavisd_pid]: $!";
- my $msg = "Signalling a SIGHUP to a running daemon [$amavisd_pid]";
- do_log(2,"%s",$msg);
- # print STDOUT "$msg\n";
- exit(0);
+ my $pidf = defined $pid_file_override ? $pid_file_override : $pid_file;
+ if (!defined $amavisd_pid && (!defined $pidf || $pidf eq '')) {
+ die "No PID file, cannot determine a process ID of a running daemon.\n" .
+ "To reload an existing amavisd daemon send it a SIGHUP signal.\n";
+ } elsif (!defined $amavisd_pid) {
+ die "The amavisd daemon is apparently not running, cannot reload it.\n";
+ } else {
+ kill('HUP',$amavisd_pid) or $! == ESRCH
+ or die "Can't SIGHUP amavisd[$amavisd_pid]: $!";
+ my $msg = "Signalling a SIGHUP to a running daemon [$amavisd_pid]";
+ do_log(2,"%s",$msg);
+ # print STDOUT "$msg\n";
+ exit(0);
+ }
} elsif ($cmd =~ /^(?:restart|stop)\z/) { # stop or restart
- defined $amavisd_pid or die "The amavisd daemon is not running\n";
- my($kill_sig_used, $killed_amavisd_pid);
- eval { # first stop a running daemon
- $kill_sig_used = 'TERM';
- kill($kill_sig_used,$amavisd_pid) or $! == ESRCH
- or die "Can't SIG$kill_sig_used amavisd[$amavisd_pid]: $!";
- my $waited = 0; my $sigkill_sent = 0; my $delay = 1; # seconds
- for (;;) { # wait for the old running daemon to go away
- sleep($delay); $waited += $delay; $delay = 5;
- if (!kill(0,$amavisd_pid)) { # is the old daemon still there?
- $! == ESRCH or die "Can't send SIG 0 to amavisd[$amavisd_pid]: $!";
- $killed_amavisd_pid = $amavisd_pid; # old process is gone, done
- last;
- }
- if ($waited < 60 || $sigkill_sent) {
- do_log(2,"Waiting for the process [%s] to terminate",$amavisd_pid);
- print STDOUT
- "Waiting for the process [$amavisd_pid] to terminate\n";
- } else { # use stronger hammer
- do_log(2,"Sending SIGKILL to amavisd[%s]",$amavisd_pid);
- print STDERR "Sending SIGKILL to amavisd[$amavisd_pid]\n";
- $kill_sig_used = 'KILL';
- kill($kill_sig_used,$amavisd_pid) or $! == ESRCH
- or warn "Can't SIGKILL amavisd[$amavisd_pid]: $!";
- $sigkill_sent = 1;
+ my $pidf = defined $pid_file_override ? $pid_file_override : $pid_file;
+ if (!defined $amavisd_pid && (!defined $pidf || $pidf eq '')) {
+ die "No PID file, cannot determine a process ID of a running daemon.\n" .
+ "To stop an existing amavisd daemon send it a SIGTERM signal.\n";
+ } elsif (!defined $amavisd_pid) {
+ die "The amavisd daemon is apparently not running, cannot stop it.\n";
+ } else {
+ my($kill_sig_used, $killed_amavisd_pid);
+ eval { # first stop a running daemon
+ $kill_sig_used = 'TERM';
+ kill($kill_sig_used,$amavisd_pid) or $! == ESRCH
+ or die "Can't SIG$kill_sig_used amavisd[$amavisd_pid]: $!";
+ my $waited = 0; my $sigkill_sent = 0; my $delay = 1; # seconds
+ for (;;) { # wait for the old running daemon to go away
+ sleep($delay); $waited += $delay; $delay = 5;
+ if (!kill(0,$amavisd_pid)) { # is the old daemon still there?
+ $! == ESRCH or die "Can't send SIG 0 to amavisd[$amavisd_pid]: $!";
+ $killed_amavisd_pid = $amavisd_pid; # old process is gone, done
+ last;
+ }
+ if ($waited < 60 || $sigkill_sent) {
+ do_log(2,"Waiting for the process [%s] to terminate",$amavisd_pid);
+ print STDOUT
+ "Waiting for the process [$amavisd_pid] to terminate\n";
+ } else { # use stronger hammer
+ do_log(2,"Sending SIGKILL to amavisd[%s]",$amavisd_pid);
+ print STDERR "Sending SIGKILL to amavisd[$amavisd_pid]\n";
+ $kill_sig_used = 'KILL';
+ kill($kill_sig_used,$amavisd_pid) or $! == ESRCH
+ or warn "Can't SIGKILL amavisd[$amavisd_pid]: $!";
+ $sigkill_sent = 1;
+ }
}
+ 1;
+ } or do {
+ my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
+ die "$eval_stat, can't $cmd the process\n";
+ };
+ my $msg = !defined($killed_amavisd_pid) ? undef :
+ "Daemon [$killed_amavisd_pid] terminated by SIG$kill_sig_used";
+ if ($cmd eq 'stop') {
+ if (defined $msg) { do_log(2,"%s",$msg); print STDOUT "$msg\n" }
+ exit(0);
}
- 1;
- } or do {
- my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
- die "$eval_stat, can't $cmd the process\n";
- };
- my $msg = !defined($killed_amavisd_pid) ? undef :
- "Daemon [$killed_amavisd_pid] terminated by SIG$kill_sig_used";
- if ($cmd eq 'stop') {
- if (defined $msg) { do_log(2,"%s",$msg); print STDOUT "$msg\n" }
- exit(0);
- }
- if (defined $killed_amavisd_pid) {
- print STDOUT "$msg, waiting for dust to settle...\n";
- sleep 5; # wait for the TCP socket to be released
+ if (defined $killed_amavisd_pid) {
+ print STDOUT "$msg, waiting for dust to settle...\n";
+ sleep 5; # wait for TCP sockets to be released
+ }
+ print STDOUT "becoming a new daemon...\n";
}
- print STDOUT "becoming a new daemon...\n";
} else {
die "$myversion: Unknown command line parameter: $cmd\n\n" . usage();
}
@@ -19149,16 +19696,15 @@ fetch_modules_extra(); # bring additional modules into memory and compile them
$spamcontrol_obj = Amavis::SpamControl->new if $extra_code_antispam;
$spamcontrol_obj->init_pre_chroot if $spamcontrol_obj;
-if ($daemonize) { # log warnings and uncaught errors
- $SIG{'__DIE__' } =
- sub { return if $^S || !defined $^S;
- my $m = $_[0]; chomp($m); do_log(-1,"_DIE: %s", $m);
- };
- $SIG{'__WARN__'} =
- sub { my $m = $_[0]; chomp($m); do_log(2,"_WARN: %s", $m) };
- # use Data::Dumper;
- # my $m2 = Carp::longmess(); do_log(2,"%s",Dumper($m2));
-}
+# log warnings and uncaught errors
+$SIG{'__DIE__' } =
+ sub { return if $^S || !defined $^S;
+ my $m = $_[0]; chomp($m); do_log(-1,"_DIE: %s", $m);
+ };
+$SIG{'__WARN__'} =
+ sub { my $m = $_[0]; chomp($m); do_log(2,"_WARN: %s", $m) };
+# use Data::Dumper;
+# my $m2 = Carp::longmess(); do_log(2,"%s",Dumper($m2));
if (!defined $io_socket_module_name) {
do_log(-1,"no INET or INET6 socket modules available");
@@ -19223,7 +19769,7 @@ my(@bind_to);
do_log(2,"ignored due to unsupported protocol family: %s",
join(', ', at ignored)) if @ignored;
@listen_sockets or die "No listen sockets specified, aborting\n";
- do_log(2,"bind to %s", join(', ', at listen_sockets));
+ do_log(2,"will bind to %s", join(', ', at listen_sockets));
}
# better catch and report potential Redis problems early before forking
@@ -19254,10 +19800,12 @@ my $server = Amavis->new({
: ( min_servers => $min_servers,
min_spare_servers => $min_spare_servers,
max_spare_servers => $max_spare_servers),
- max_requests => $max_requests > 0 ? $max_requests : 2E9, # avoid dflt 1000
+ max_requests => defined $max_requests && $max_requests > 0 ? $max_requests
+ : 2E9, # avoid default of 1000
user => ($> == 0 || $< == 0) ? $daemon_user : undef,
group => ($> == 0 || $< == 0) ? $daemon_group : undef,
- pid_file => defined $pid_file_override ? $pid_file_override : $pid_file,
+ pid_file => $amavisd_pid_by_mainpid ? undef
+ : defined $pid_file_override ? $pid_file_override : $pid_file,
# socket serialization lockfile
lock_file => defined $lock_file_override? $lock_file_override: $lock_file,
# serialize => 'flock', # flock, semaphore, pipe
@@ -19277,6 +19825,8 @@ my $server = Amavis->new({
});
$0 = c('myprogram_name') . ' (master)';
+sd_notify(0, "STATUS=Transferring control to Net::Server.");
+
$server->run; # transferring control to Net::Server
# shouldn't get here
@@ -19295,11 +19845,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform $myversion $nanny_details_level);
import Amavis::Util qw(ll do_log do_log_safe
@@ -19556,11 +20107,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform $myversion $nanny_details_level);
import Amavis::Util qw(ll do_log do_log_safe
@@ -19813,11 +20365,12 @@ use strict;
use re 'taint';
use warnings;
use warnings FATAL => qw(utf8 void);
+# 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw($db_home $daemon_chroot_dir);
import Amavis::Util qw(untaint ll do_log);
@@ -19840,9 +20393,9 @@ sub init($$) {
my($f, @rmfiles);
while (defined($f = readdir(DIR))) {
next if $f eq '.' || $f eq '..';
- if ($f eq 'nanny.db') {
+ if ($f =~ /^(__db\.)?nanny\.db\z/) {
push(@rmfiles, $f) if $predelete_nanny;
- } elsif ($f eq 'snmp.db') {
+ } elsif ($f =~ /^(__db\.)?snmp\.db\z/) {
push(@rmfiles, $f) if $predelete_snmp;
} elsif ($f =~ /^__db\.\d+\z/s) {
push(@rmfiles, $f) if $predelete_nanny && $predelete_snmp;
@@ -19851,7 +20404,7 @@ sub init($$) {
}
}
closedir(DIR) or die "db_init: Error closing directory $name: $!";
- do_log(0, 'Deleting db files %s in %s', join(',', at rmfiles), $name);
+ do_log(1, 'Deleting db files %s in %s', join(',', at rmfiles), $name);
for my $f (@rmfiles) {
my $fname = $db_home . '/' . untaint($f);
unlink($fname) or die "db_init: Can't delete file $fname: $!";
@@ -19862,7 +20415,7 @@ sub init($$) {
-Flags=> DB_CREATE | DB_INIT_CDB | DB_INIT_MPOOL);
defined $env
or die "BDB can't create db env. at $db_home: $BerkeleyDB::Error, $!.";
- do_log(0, 'Creating db in %s/; BerkeleyDB %s, libdb %s',
+ do_log(1, 'Creating db in %s/; BerkeleyDB %s, libdb %s',
$name, BerkeleyDB->VERSION, $BerkeleyDB::db_version);
$! = 0; my $dbs = BerkeleyDB::Hash->new(
-Filename=>'snmp.db', -Flags=>DB_CREATE, -Env=>$env );
@@ -19902,11 +20455,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Util qw(ll do_log);
import Amavis::Conf qw($trim_trailing_space_in_lookup_result_fields);
@@ -20027,11 +20581,12 @@ use strict;
use re 'taint';
use warnings;
use warnings FATAL => qw(utf8 void);
+# 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform :confvars c cr ca);
import Amavis::Timing qw(section_time);
@@ -20191,8 +20746,9 @@ sub lookup_sql($$$%) {
for (@pos_args)
{ $_->[1] = $datatype if ref($_) && $_->[1]==SQL_VARBINARY }
}
- for (@pos_args)
- { if (ref $_) { untaint_inplace($_->[0]) } else { untaint_inplace($_) } }
+ for (@pos_args) {
+ if (ref $_) { untaint_inplace($_->[0]) } else { untaint_inplace($_) }
+ }
eval {
snmp_count('OpsSqlSelect');
$conn_h->execute($sel, at pos_args); # do the query
@@ -20250,6 +20806,7 @@ 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';
use Net::LDAP;
use Net::LDAP::Util;
@@ -20258,7 +20815,7 @@ BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION
$have_sasl $ldap_sys_default);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
$have_sasl = eval { require Authen::SASL };
import Amavis::Conf qw(:platform :confvars c cr ca);
@@ -20480,7 +21037,7 @@ use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Util qw(ll do_log);
import Amavis::Conf qw($trim_trailing_space_in_lookup_result_fields);
@@ -20605,7 +21162,7 @@ BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION
$ldap_sys_default @ldap_attrs @mv_ldap_attrs);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform :confvars c cr ca);
import Amavis::Timing qw(section_time);
@@ -20761,7 +21318,7 @@ sub lookup_ldap($$$%) {
for my $attr (@ldap_attrs) {
my $value;
do_log(9,'lookup_ldap: reading attribute "%s" from object', $attr);
- $attr = lc($attr);
+ $attr = lc $attr;
if ($mv_ldap_attrs{$attr}) { # multivalued
$value = $entry->get_value($attr, asref => 1);
} else {
@@ -20821,11 +21378,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform :confvars c cr ca);
import Amavis::Util qw(ll do_log debug_oneshot dump_captured_log
@@ -21012,10 +21570,10 @@ sub preprocess_policy_query($$) {
exists $attr_ref->{'request'} or die "Missing 'request' field";
my $ampdp = $attr_ref->{'request'} =~
/^(?:AM\.CL|AM\.PDP|release|requeue|report)\z/i;
- @bank_names = grep($_ ne '',
- map { my $s = $_; $s =~ s/^[ \t]+//; $s =~ s/[ \t]+\z//; $s }
- split(/,/, $attr_ref->{'policy_bank'}))
- if exists $attr_ref->{'policy_bank'};
+ local $1;
+ @bank_names =
+ map(/^\s*(\S.*?)\s*\z/s ? $1 : (), split(/,/, $attr_ref->{'policy_bank'}))
+ if defined $attr_ref->{'policy_bank'};
my $d_co = $attr_ref->{'delivery_care_of'};
my $td_rm = $attr_ref->{'tempdir_removed_by'};
$msginfo->client_delete(defined($td_rm) && lc($td_rm) eq 'client' ? 1 : 0);
@@ -21252,44 +21810,35 @@ sub check_ampdp_policy($$$$) {
# interface/socket, client IP, SMTP session info, sender, ...
my $cl_ip = $msginfo->client_addr;
my $cl_src = $msginfo->client_source;
- my($cl_ip_mynets, $policy_name_requested);
- {
- my $cl_ip_tmp = $cl_ip;
+ my(@bank_names_cl);
+ { my $cl_ip_tmp = $cl_ip;
# treat unknown client IP addr as 0.0.0.0, from "This" Network, RFC 1700
$cl_ip_tmp = '0.0.0.0' if !defined($cl_ip) || $cl_ip eq '';
my(@cp) = @{ca('client_ipaddr_policy')};
do_log(-1,'@client_ipaddr_policy must contain pairs, '.
'number of elements is not even') if @cp % 2 != 0;
my $labeler = Amavis::Lookup::Label->new('client_ipaddr_policy');
- while (@cp) {
- my $lookup_table = shift(@cp); my $policy_name = shift(@cp);
+ while (@cp > 1) {
+ my $lookup_table = shift(@cp);
+ my $policy_names = shift(@cp); # comma-separated string of names
+ next if !defined $policy_names;
if (lookup_ip_acl($cl_ip_tmp, $labeler, $lookup_table)) {
- if (defined $policy_name && $policy_name ne '') {
- $policy_name_requested = $policy_name;
- $cl_ip_mynets = 1 if $policy_name eq 'MYNETS'; # compatibility
- }
- last;
+ local $1;
+ push(@bank_names_cl,
+ map(/^\s*(\S.*?)\s*\z/s ? $1 : (), split(/,/, $policy_names)));
+ last; # should we stop here or not?
}
}
}
- if (($cl_ip_mynets?1:0) > ($msginfo->originating?1:0)) {
- $current_policy_bank{'originating'} = $cl_ip_mynets; # compatibility
- }
- if (defined $policy_name_requested &&
- defined $policy_bank{$policy_name_requested}) {
- Amavis::load_policy_bank($policy_name_requested,$msginfo);
- }
- for my $bank_name (@$bank_names_ref) { # additional banks from the request
- if (defined $policy_bank{$bank_name})
- { Amavis::load_policy_bank(untaint($bank_name),$msginfo) }
- }
- $msginfo->originating(c('originating'));
+ # load policy banks from the 'client_ipaddr_policy' lookup
+ Amavis::load_policy_bank($_,$msginfo) for @bank_names_cl;
+ # additional banks from the request
+ Amavis::load_policy_bank(untaint($_),$msginfo) for @$bank_names_ref;
my $sender = $msginfo->sender;
if (defined $policy_bank{'MYUSERS'} &&
$sender ne '' && $msginfo->originating &&
lookup2(0,$sender, ca('local_domains_maps'))) {
Amavis::load_policy_bank('MYUSERS',$msginfo);
- $msginfo->originating(c('originating')); # may have changed by a p.b.load
}
my $debrecipm = ca('debug_recipient_maps');
if (lookup2(0, $sender, ca('debug_sender_maps')) ||
@@ -21500,17 +22049,18 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform :confvars c cr ca);
import Amavis::Util qw(ll do_log do_log_safe untaint
dump_captured_log log_capture_enabled
am_id new_am_id snmp_counters_init
- orcpt_decode xtext_decode safe_encode_utf8
+ orcpt_decode xtext_decode safe_encode_utf8_inplace
idn_to_ascii sanitize_str add_entropy
debug_oneshot waiting_for_client prolong_timer
switch_to_my_time switch_to_client_time
@@ -21530,16 +22080,27 @@ use Time::HiRes ();
#use IO::Socket::SSL;
BEGIN { # due to dynamic loading runs only after config files have been read
+
+ # for compatibility with 2.10 or earlier:
+ $smtpd_tls_server_options{SSL_key_file} = $smtpd_tls_key_file
+ if !exists $smtpd_tls_server_options{SSL_key_file} &&
+ defined $smtpd_tls_key_file;
+ $smtpd_tls_server_options{SSL_cert_file} = $smtpd_tls_cert_file
+ if !exists $smtpd_tls_server_options{SSL_cert_file} &&
+ defined $smtpd_tls_cert_file;
+
my $tls_security_level = c('tls_security_level_in');
$tls_security_level = 0 if !defined($tls_security_level) ||
lc($tls_security_level) eq 'none';
if ($tls_security_level) {
- defined $smtpd_tls_cert_file && $smtpd_tls_cert_file ne ''
- or die '$tls_security_level is enabled '.
- 'but $smtpd_tls_cert_file is not provided'."\n";
- defined $smtpd_tls_key_file && $smtpd_tls_key_file ne ''
- or die '$tls_security_level is enabled '.
- 'but $smtpd_tls_key_file is not provided'."\n";
+ ( defined $smtpd_tls_server_options{SSL_cert_file} &&
+ $smtpd_tls_server_options{SSL_cert_file} ne ''
+ ) or die '$tls_security_level is enabled '.
+ 'but $smtpd_tls_server_options{SSL_cert_file} is not provided'."\n";
+ ( defined $smtpd_tls_server_options{SSL_key_file} &&
+ $smtpd_tls_server_options{SSL_key_file} ne ''
+ ) or die '$tls_security_level is enabled '.
+ 'but $smtpd_tls_server_options{SSL_key_file} is not provided'."\n";
}
1;
}
@@ -21778,6 +22339,69 @@ sub authenticate($$$) {
($state,$result,$newchallenge);
}
+# Parse the "PROXY protocol header", which is a block of connection info
+# the connection initiator prepends at the beginning of a connection.
+# Recognizes the PROXY protocol Version 1 (V 2 is not supported here).
+# http://www.haproxy.org/download/1.5/doc/proxy-protocol.txt
+#
+sub haproxy_protocol_parse($) {
+ local($_) = $_[0]; # a "PROXY protocol header"
+ my($proto, $src_addr, $dst_addr, $src_port, $dst_port);
+ local($1,$2,$3,$4,$5);
+ if (/^PROXY\ (UNKNOWN)/) {
+ $proto = $1; # receiver must ignore anything presented before the CRLF
+ } elsif (/^PROXY\ ((?-i)TCP4)\ ((?:\d{1,3}\.){3}\d{1,3})
+ \ ((?:\d{1,3}\.){3}\d{1,3})
+ \ (\d{1,5})\ (\d{1,5})\x0D\x0A\z/xs) {
+ ($proto, $src_addr, $dst_addr, $src_port, $dst_port) = ($1,$2,$3,$4,$5);
+ } elsif (/^PROXY\ ((?-i)TCP6)\ ([0-9a-f]{0,4} (?: : [0-9a-f]{0,4}){2,7})
+ \ ([0-9a-f]{0,4} (?: : [0-9a-f]{0,4}){2,7})
+ \ (\d{1,5})\ (\d{1,5})\x0D\x0A\z/xsi) {
+ ($proto, $src_addr, $dst_addr, $src_port, $dst_port) = ($1,$2,$3,$4,$5);
+ }
+ return ($proto) if $proto !~ /^TCP[46]\z/;
+ return if $src_port && $src_port =~ /^0/; # leading zeroes not allowed
+ return if $dst_port && $dst_port =~ /^0/;
+ $src_port = 0+$src_port; $dst_port = 0+$dst_port; # turn to numeric
+ return if $src_port > 65535 || $dst_port > 65535;
+ ($proto, $src_addr, $dst_addr, $src_port, $dst_port);
+}
+
+# process the "PROXY protocol header" and pretend the claimed connection
+#
+sub haproxy_apply($$) {
+ my($conn, $line) = @_;
+ if (defined $line) {
+ ll(4) && do_log(4, 'HAProxy: < %s', $line);
+ my($proto, $src_addr, $dst_addr, $src_port, $dst_port) =
+ haproxy_protocol_parse($line);
+ if (!defined $src_addr || !defined $dst_addr ||
+ !$src_port || !$dst_port) {
+ do_log(0, "HAProxy: PROXY protocol header expected, got: %s", $line);
+ die "HAProxy: a PROXY protocol header expected";
+ } elsif (!Amavis::access_is_allowed(undef, $src_addr, $src_port,
+ $dst_addr, $dst_port)) {
+ do_log(0, "HAProxy, access denied: %s [%s]:%d -> [%s]:%d",
+ $proto, $src_addr, $src_port, $dst_addr, $dst_port);
+ die "HAProxy: access from client $src_addr denied\n";
+ } else {
+ if (ll(3)) {
+ do_log(3,
+ "HAProxy: accepted: (client) [%s]:%d -> [%s]:%d (HA Proxy/server)",
+ $src_addr, $src_port, $dst_addr, $dst_port);
+ do_log(3,
+ "HAProxy: (HA Proxy/initiator) [%s]:%d -> [%s]:%d (me/target)",
+ $conn->client_ip||'x', $conn->client_port||0,
+ $conn->socket_ip||'x', $conn->socket_port||0);
+ };
+ $conn->client_ip(untaint(normalize_ip_addr($src_addr)));
+ $conn->socket_ip(untaint(normalize_ip_addr($dst_addr)));
+ $conn->client_port(untaint($src_port));
+ $conn->socket_port(untaint($dst_port));
+ }
+ }
+}
+
# Accept an SMTP or LMTP connect (which can do any number of transactions)
# and call content checking for each message received
#
@@ -21827,6 +22451,15 @@ sub process_smtp_request($$$$) {
$message_size_limit && $message_size_limit < 65536) {
$message_size_limit = 65536; # RFC 5321 requires at least 64k
}
+
+ if (c('haproxy_target_enabled')) {
+ Amavis::Timing::go_idle(4);
+ my $line; { local($/) = "\012"; $line = $self->readline }
+ Amavis::Timing::go_busy(5);
+ defined $line or die "Error reading, expected a PROXY header: $!";
+ haproxy_apply($conn, $line);
+ }
+
my $smtpd_greeting_banner_tmp = c('smtpd_greeting_banner');
$smtpd_greeting_banner_tmp =~
s{ \$ (?: \{ ([^\}]+) \} |
@@ -21937,13 +22570,14 @@ sub process_smtp_request($$$$) {
$self->smtp_resp(1,"220 2.0.0 Ready to start TLS"); #flush!
%announced_ehlo_keywords = ();
IO::Socket::SSL->start_SSL($sock,
- SSL_server => 1, SSL_session_cache => 2,
- SSL_error_trap => sub { my($sock,$msg)=@_;
- do_log(-2,"Error on socket: %s",$msg) },
- SSL_passwd_cb => sub { 'example' },
- SSL_key_file => $smtpd_tls_key_file,
- SSL_cert_file => $smtpd_tls_cert_file,
- ) or die "Error upgrading socket to SSL: ".
+ SSL_server => 1,
+ SSL_hostname => idn_to_ascii(c('myhostname')),
+ SSL_error_trap => sub {
+ my($sock,$msg) = @_;
+ do_log(-2,"STARTTLS, upgrading socket to TLS failed: %s",$msg);
+ },
+ %smtpd_tls_server_options,
+ ) or die "Error upgrading input socket to TLS: ".
IO::Socket::SSL::errstr();
if ($self->{smtp_inpbuf} ne '') {
do_log(-1, "STARTTLS pipelining violation attempt, sanitized");
@@ -21974,7 +22608,9 @@ sub process_smtp_request($$$$) {
: 'STARTTLS', # RFC 3207 (ex RFC 2487)
!@{ca('auth_mech_avail')} ? () # RFC 4954 (ex RFC 2554)
: join(' ','AUTH',@{ca('auth_mech_avail')}),
- 'XFORWARD NAME ADDR PORT PROTO HELO IDENT SOURCE' );
+ 'XFORWARD NAME ADDR PORT PROTO HELO IDENT SOURCE',
+ # 'XCLIENT NAME ADDR PORT PROTO HELO LOGIN',
+ );
my(%smtpd_discard_ehlo_keywords) =
map((uc($_),1), @{ca('smtpd_discard_ehlo_keywords')});
# RFC 6531: Servers offering this extension MUST provide
@@ -21994,8 +22630,9 @@ sub process_smtp_request($$$$) {
};
/^XFORWARD\z/ && do { # Postfix extension
+ my $xcmd = $_;
if (defined $sender_unq) {
- $self->smtp_resp(1,"503 5.5.1 Error: XFORWARD not allowed ".
+ $self->smtp_resp(1,"503 5.5.1 Error: $xcmd not allowed ".
"within transaction",1,$cmd);
last;
}
@@ -22003,12 +22640,12 @@ sub process_smtp_request($$$$) {
for (split(' ',$args)) {
if (!/^ ( [A-Za-z0-9] [A-Za-z0-9-]* ) =
( [\x21-\x7E\x80-\xFF]{0,255} )\z/xs) {
- $self->smtp_resp(1,"501 5.5.4 Syntax error in XFORWARD parameters",
+ $self->smtp_resp(1,"501 5.5.4 Syntax error in $xcmd parameters",
1, $cmd);
$bad = 1; last;
} else {
my($name,$val) = (uc($1), $2);
- if ($name =~ /^(?:NAME|ADDR|PORT|PROTO|HELO|IDENT|SOURCE)\z/) {
+ if ($name=~/^(?:NAME|ADDR|PORT|PROTO|HELO|IDENT|SOURCE|LOGIN)\z/) {
$val = undef if uc($val) eq '[UNAVAILABLE]';
# Postfix since vers 2.3 (20060610) uses xtext-encoded (RFC 3461)
# strings in XCLIENT and XFORWARD attribute values, previous
@@ -22018,7 +22655,7 @@ sub process_smtp_request($$$$) {
$val =~ /\+([0-9a-fA-F]{2})/;
$xforward_args{$name} = $val;
} else {
- $self->smtp_resp(1,"501 5.5.4 XFORWARD command parameter ".
+ $self->smtp_resp(1,"501 5.5.4 $xcmd command parameter ".
"error: $name=$val",1,$cmd);
$bad = 1; last;
}
@@ -22140,38 +22777,36 @@ sub process_smtp_request($$$$) {
$msginfo->rx_time($now);
$msginfo->log_id(am_id());
$msginfo->conn_obj($conn);
+
my $cl_ip = normalize_ip_addr($xforward_args{'ADDR'});
my $cl_port = $xforward_args{'PORT'};
my $cl_src = $xforward_args{'SOURCE'}; # local_header_rewrite_clients
+ my $cl_login= $xforward_args{'LOGIN'}; # XCLIENT
$cl_port = undef if $cl_port !~ /^\d{1,9}\z/ || $cl_port > 65535;
- my($cl_ip_mynets, $policy_name_requested);
+ my(@bank_names_cl);
{ my $cl_ip_tmp = $cl_ip;
# treat unknown client IP address as 0.0.0.0,
# from "This" Network, RFC 1700
$cl_ip_tmp = '0.0.0.0' if !defined($cl_ip) || $cl_ip eq '';
my(@cp) = @{ca('client_ipaddr_policy')};
- do_log(-1,"\@client_ipaddr_policy must contain pairs, ".
- "number of elements is not even") if @cp % 2 != 0;
+ do_log(-1,'@client_ipaddr_policy must contain pairs, '.
+ 'number of elements is not even') if @cp % 2 != 0;
my $labeler = Amavis::Lookup::Label->new('client_ipaddr_policy');
- while (@cp) {
- my $lookup_table = shift(@cp); my $policy_name = shift(@cp);
+ while (@cp > 1) {
+ my $lookup_table = shift(@cp);
+ my $policy_names = shift(@cp); # comma-separated string of names
+ next if !defined $policy_names;
if (lookup_ip_acl($cl_ip_tmp, $labeler, $lookup_table)) {
- if (defined $policy_name && $policy_name ne '') {
- $policy_name_requested = $policy_name;
- $cl_ip_mynets = 1 if $policy_name eq 'MYNETS'; # compatibility
- }
- last;
+ local $1;
+ push(@bank_names_cl,
+ map(/^\s*(\S.*?)\s*\z/s ? $1 : (), split(/,/, $policy_names)));
+ last; # should we stop here or not?
}
}
}
- if (($cl_ip_mynets?1:0) > ($msginfo->originating?1:0)) {
- $current_policy_bank{'originating'} = $cl_ip_mynets; # compatibility
- }
- if (defined $policy_name_requested &&
- defined $policy_bank{$policy_name_requested}) {
- Amavis::load_policy_bank($policy_name_requested,$msginfo);
- }
- $msginfo->originating(c('originating'));
+ # load policy banks from the 'client_ipaddr_policy' lookup
+ Amavis::load_policy_bank($_,$msginfo) for @bank_names_cl;
+
$msginfo->client_addr($cl_ip); # ADDR
$msginfo->client_port($cl_port); # PORT
$msginfo->client_source($cl_src); # SOURCE
@@ -22200,8 +22835,8 @@ sub process_smtp_request($$$$) {
$msginfo->auth_user(c('amavis_auth_user'));
$msginfo->auth_pass(c('amavis_auth_pass'));
# $submitter = quote_rfc2821_local(c('mailfrom_notify_recip'));
- # $submitter = expand_variables(safe_encode_utf8($submitter))
- # if defined $submitter;
+ # safe_encode_utf8_inplace($submitter) # to octets (if not already)
+ # $submitter = expand_variables($submitter) if defined $submitter;
}
local($1,$2);
if ($args !~ /^FROM: [ \t]*
@@ -22321,7 +22956,6 @@ sub process_smtp_request($$$$) {
$sender_unq ne '' && $msginfo->originating &&
lookup2(0,$sender_unq, ca('local_domains_maps'))) {
Amavis::load_policy_bank('MYUSERS',$msginfo);
- $msginfo->originating(c('originating')); # may have changed
}
debug_oneshot(
lookup2(0,$sender_unq, ca('debug_sender_maps')) ? 1 : 0,
@@ -22341,6 +22975,7 @@ sub process_smtp_request($$$$) {
$msg = "250 2.1.0 Sender $sender_quo OK";
};
$self->smtp_resp(0,$msg, !$msg_nopenalize && $msg=~/^5/ ? 1 : 0, $cmd);
+ section_time('SMTP MAIL');
last;
};
@@ -22856,6 +23491,7 @@ 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 { die "Code not available for module Amavis::In::Courier" }
@@ -22869,11 +23505,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform);
import Amavis::Util qw(ll do_log min max minmax);
@@ -22893,10 +23530,13 @@ sub new {
my($class,$socket_specs,%arg) = @_;
my $self = bless {}, $class;
$self->{at_line_boundary} = 1;
- $self->{dotstuffing} = 1; # defaults to on
- $self->{dotstuffing} = 0 if defined $arg{DotStuffing} && !$arg{DotStuffing};
- $self->{strip_cr} = 1; # sanitizing bare CR defaults to on
- $self->{strip_cr} = 0 if defined $arg{StripCR} && !$arg{StripCR};
+ $self->{dotstuffing} = 1; # defaults to on
+ $self->{dotstuffing} = 0 if defined $arg{DotStuffing} && !$arg{DotStuffing};
+ $self->{strip_cr} = 1; # sanitizing bare CR enabled by default
+ $self->{strip_cr} = 0 if defined $arg{StripCR} && !$arg{StripCR};
+ $self->{sanitize_nul} = 1; # sanitizing NUL bytes enabled by default
+ $self->{sanitize_nul} = 0 if defined $arg{SanitizeNUL} && !$arg{SanitizeNUL};
+ $self->{null_cnt} = 0;
$self->{io} = Amavis::IO::RW->new($socket_specs, Eol => "\015\012", %arg);
$self->init;
$self;
@@ -22947,9 +23587,17 @@ sub datasend {
my $self = shift;
my $buff = @_ == 1 ? $_[0] : join('', at _);
do_log(-1,"WARN: Unicode string passed to datasend: %s", $buff)
- if Encode::is_utf8($buff); # always false on tainted, Perl 5.8 bug #32687
+ if utf8::is_utf8($buff); # always false on tainted, Perl 5.8 bug #32687
# ll(5) && do_log(5, 'smtp print %d bytes>', length($buff));
- $buff =~ tr/\r//d if $self->{strip_cr}; # sanitize bare CR if necessary
+ $buff =~ tr/\015//d if $self->{strip_cr}; # sanitize bare CR if necessary
+ if ($self->{sanitize_nul}) {
+ my $cnt = $buff =~ tr/\x00//; # quick triage
+ if ($cnt) {
+ # this will break DKIM signatures, but IMAP (cyrus) hates NULs in mail
+ $self->{null_cnt} += $cnt;
+ $buff =~ s{\x00}{\xC0\x80}gs; # turn to "Modified UTF-8" encoding of NUL
+ }
+ }
# CR/LF are never split across a buffer boundary
$buff =~ s{\n}{\015\012}gs; # quite fast, but still a bottleneck
if ($self->{dotstuffing}) {
@@ -22999,6 +23647,10 @@ sub dataend {
$self->datasend(".\n");
$self->{dotstuffing} = 1;
}
+ if ($self->{null_cnt}) {
+ do_log(0, 'smtp forwarding: SANITIZED %d NULL byte(s)', $self->{null_cnt});
+ $self->{null_cnt} = 0;
+ }
$self->{io}->out_buff_large ? $self->flush : 1;
}
@@ -23069,14 +23721,16 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&rundown_stale_sessions);
- import Amavis::Conf qw(:platform c cr ca $smtp_connection_cache_enable);
+ import Amavis::Conf qw(:platform c cr ca $smtp_connection_cache_enable
+ %smtp_tls_client_options);
import Amavis::Util qw(min max minmax ll do_log snmp_count idn_to_ascii);
}
use subs @EXPORT_OK;
@@ -23417,7 +24071,8 @@ sub establish_or_refresh {
(!$tls_security_level || lc($tls_security_level) eq 'may')
or die "Negative SMTP resp. to STARTTLS: $smtp_resp\n";
} else {
- $smtp_handle->ssl_upgrade or die "Error upgrading socket to SSL";
+ $smtp_handle->ssl_upgrade(%smtp_tls_client_options)
+ or die "Error upgrading socket to SSL";
$self->session_state('connected');
}
}
@@ -23434,11 +24089,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT = qw(&mail_via_smtp);
import Amavis::Conf qw(:platform c cr ca $smtp_connection_cache_enable);
@@ -23471,8 +24127,8 @@ sub print {
my $self = shift;
my $buff = @_ == 1 ? $_[0] : join('', at _);
do_log(-1,"WARN: Unicode string passed to Amavis::Out::SMTP::print : %s",
- $buff) if Encode::is_utf8($buff); # false on tainted, Perl 5.8 bug #32687
- $buff =~ tr/\r//d if $self->{strip_cr};
+ $buff) if utf8::is_utf8($buff); # false on tainted, Perl 5.8 bug #32687
+ $buff =~ tr/\015//d if $self->{strip_cr}; # sanitize bare CR
$buff =~ s{\n}{\015\012}gs;
$self->{handle}->PRINT($buff);
}
@@ -23752,7 +24408,7 @@ sub mail_via_smtp(@) {
section_time($which_section);
}
- $which_section = 'fwd-mail-from';
+ $which_section = 'fwd-pre-mail-from';
$smtp_session->timeout(max(60,min($smtp_mail_timeout,$deadline-time())));
my $fetched_mail_resp = 0; my $fetched_rcpt_resp = 0;
my $data_command_accepted = 0;
@@ -23763,21 +24419,6 @@ sub mail_via_smtp(@) {
iso8601_utc_timestamp(time),
idn_to_ascii(c('myhostname')) ));
}
- if ($smtputf8 && $smtputf8_capable) {
- $from_options{'SMTPUTF8'} = undef; # turn option *on*, no value
- }
- my $btype = $msginfo->body_type;
- if (defined $btype && $btype ne '') {
- $btype = uc $btype;
- if ($btype ne '7BIT' && $btype ne '8BITMIME') {
- do_log(-1,'requested BODY type %s is unknown/unsupported', $btype);
- } elsif ($mimetransport8bit_capable) {
- $from_options{'BODY'} = $btype;
- } elsif ($btype ne '7BIT') {
- do_log(0, 'requested BODY type is %s, but MTA does not announce '.
- '8bit-MIMEtransport capability', $btype); # RFC 6152
- }
- }
$from_options{'RET'} = $dsn_ret if $dsn_capable && defined $dsn_ret;
if ($dsn_capable && defined $dsn_envid) {
# check for proper encoding (RFC 3461), just in case
@@ -23787,11 +24428,38 @@ sub mail_via_smtp(@) {
$from_options{'ENVID'} = $dsn_envid;
}
}
+
my $submitter = $msginfo->auth_submitter;
$from_options{'AUTH'} = xtext_encode($submitter) # RFC 4954 (ex RFC 2554)
if $auth_capable &&
defined($submitter) && $submitter ne '' && $submitter ne '<>';
- if ($smtputf8 && !$smtputf8_capable && $sender_smtp =~ tr/\x00-\x7F//c) {
+
+ if ($smtputf8 && $smtputf8_capable) {
+ $from_options{'SMTPUTF8'} = undef; # turn option *on*, no value
+ }
+
+ my $btype = $msginfo->body_type;
+ if (defined $btype && $btype ne '') {
+ $btype = uc $btype;
+ if ($btype ne '7BIT' && $btype ne '8BITMIME') {
+ do_log(-1,'requested BODY type %s is unknown/unsupported', $btype);
+ } elsif ($mimetransport8bit_capable) {
+ $from_options{'BODY'} = $btype;
+ }
+ }
+ if (!$mimetransport8bit_capable &&
+ defined $btype && $btype ne '' && uc $btype ne '7BIT') {
+ do_log(-1,'requested BODY type is %s, but MTA does not announce '.
+ '8bit-MIMEtransport capability', $btype); # RFC 6152
+ for my $r (@per_recip_data) {
+ next if $r->recip_done;
+ $r->recip_smtp_response('550 5.6.3 Conversion to 7BIT required '.
+ 'but not supported');
+ $r->recip_remote_mta($relayhost); $r->recip_done(2);
+ }
+ $recips_done_by_early_fail = 1;
+ } elsif ($smtputf8 &&
+ !$smtputf8_capable && $sender_smtp =~ tr/\x00-\x7F//c) {
do_log(1,'SMTPUTF8 option requested, not offered by MTA, '.
'sender is non-ASCII: %s', $sender_smtp);
for my $r (@per_recip_data) {
@@ -23802,6 +24470,7 @@ sub mail_via_smtp(@) {
}
$recips_done_by_early_fail = 1;
} else {
+ $which_section = 'fwd-mail-from';
$smtp_handle->mail($sender_smtp, %from_options); # MAIL FROM
# consider the transaction state unknown until we see a response
$smtp_session->transaction_begins_unconfirmed; # also counts transactions
@@ -24299,11 +24968,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT = qw(&mail_via_pipe);
import Amavis::Conf qw(:platform c cr ca);
@@ -24503,11 +25173,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT = qw(&mail_via_bsmtp);
import Amavis::Conf qw(:platform $QUARANTINEDIR c cr ca);
@@ -24703,11 +25374,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&mail_to_local_mailbox);
import Amavis::Conf qw(:platform c cr ca
@@ -25071,11 +25743,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform);
import Amavis::Util qw(ll do_log idn_to_ascii);
@@ -25113,10 +25786,10 @@ sub new {
$sock or do_log(0,"Can't connect to a Unix socket %s: %s",
$service_path, $!);
} else { # assume an INET or INET6 protocol family
+ $service_host = idn_to_ascii($service_host);
$sock = $io_socket_module_name->new(
Type => SOCK_DGRAM, Proto => 'udp',
- PeerAddr => idn_to_ascii($service_host),
- PeerPort => $service_port);
+ PeerAddr => $service_host, PeerPort => $service_port);
$sock or do_log(0,"Can't create a socket [%s]:%s: %s",
$service_host, $service_port, $!);
}
@@ -25176,6 +25849,7 @@ package Amavis::TinyRedis;
use strict;
use re 'taint';
use warnings;
+# use warnings 'extra'; no warnings 'experimental::re_strict'; use re 'strict';
use Errno qw(EINTR EAGAIN EPIPE ENOTCONN ECONNRESET ECONNABORTED);
use IO::Socket::UNIX;
@@ -25219,9 +25893,12 @@ sub connect {
if ($server =~ m{^/}) {
$sock = IO::Socket::UNIX->new(
Peer => $server, Type => SOCK_STREAM);
- } else {
+ } elsif ($server =~ /^(?: \[ ([^\]]+) \] | ([^:]+) ) : ([^:]+) \z/xs) {
+ $server = defined $1 ? $1 : $2; my $port = $3;
$sock = $io_socket_module_name->new(
- PeerAddr => $server, Proto => 'tcp');
+ PeerAddr => $server, PeerPort => $port, Proto => 'tcp');
+ } else {
+ die "Invalid 'server:port' specification: $server";
}
if ($sock) {
$self->{sock} = $sock;
@@ -25378,11 +26055,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform :confvars c cr ca);
import Amavis::rfc2821_2822_Tools;
@@ -25411,16 +26089,20 @@ sub on_connect {
eval {
$r->call('SELECT', $db_id) eq 'OK' ? 1 : 0;
} or do {
- if ($@ =~ /\bNOAUTH\b/) {
+ if ($@ =~ /^NOAUTH\b/ || $@ =~ /^ERR operation not permitted/) {
defined $self->{password}
or die "Redis server requires authentication, no password provided";
$r->call('AUTH', $self->{password});
$r->call('SELECT', $db_id);
} else {
- chomp $@; die "Redis error: $@";
+ chomp $@; die "Command 'SELECT $db_id' failed: $@";
}
};
- $r->call('CLIENT', 'SETNAME', 'amavis['.$$.']');
+ eval {
+ $r->call('CLIENT', 'SETNAME', 'amavis['.$$.']') eq 'OK' ? 1 : 0;
+ } or do { # no big deal, just log
+ do_log(5, "redis: command 'CLIENT SETNAME' failed: %s", $@);
+ };
1;
}
@@ -25709,7 +26391,7 @@ sub save_structured_report {
# use safe_encode() instead of safe_encode_utf8() here, this way we ensure
# the resulting string of octets is always a valid UTF-8, even in case
# of a non-ASCII input string with utf8 flag off
- $report_json = safe_encode('UTF-8',$report_json); # convert to octets
+ $report_json = safe_encode('UTF-8', $report_json); # convert to octets
do_log(5, "redis: structured_report: %s %s", $log_key, $report_json);
$r->b_call("RPUSH", $log_key, $report_json);
# keep most recent - queue size limit in case noone is pulling events
@@ -26187,11 +26869,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform c cr ca);
import Amavis::Util qw(ll do_log do_log_safe);
@@ -26435,11 +27118,17 @@ sub connect_to_sql {
$dbh->{'RaiseError'} = 1;
# $dbh->{mysql_auto_reconnect} = 1; # questionable benefit
# $dbh->func(30000,'busy_timeout'); # milliseconds (SQLite)
+
+ # https://mathiasbynens.be/notes/mysql-utf8mb4
+ # Never use utf8 in MySQL — always use utf8mb4 instead.
+ # SET NAMES utf8mb4 COLLATE utf8mb4_unicode_ci
+ my $cmd = $self->driver_name eq 'mysql' ? "SET NAMES 'utf8mb4'"
+ : "SET NAMES 'utf8'";
eval {
- $dbh->do("SET NAMES 'utf8'"); 1;
+ $dbh->do($cmd); 1;
} or do {
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
- do_log(2,"connect_to_sql: SET NAMES 'utf8' failed: %s", $eval_stat);
+ do_log(2,"connect_to_sql: %s failed: %s", $cmd, $eval_stat);
};
section_time('sql-connect');
$self;
@@ -26468,11 +27157,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform :confvars c cr ca);
import Amavis::rfc2821_2822_Tools;
@@ -26508,7 +27198,7 @@ sub find_or_save_addr {
($localpart,$domain) = split_address($naddr);
$domain = idn_to_ascii($domain);
if (!$keep_localpart_case && !c('localpart_is_case_sensitive')) {
- $localpart = lc($localpart);
+ $localpart = lc $localpart;
}
local($1);
$domain = $1 if $domain=~/^\@?(.*?)\.*\z/s; # chop leading @ and tr. dots
@@ -26902,11 +27592,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Util qw(ll do_log untaint min max minmax);
}
@@ -27201,11 +27892,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT = qw(&mail_via_sql);
import Amavis::Conf qw(:platform c cr ca $sql_quarantine_chunksize_max);
@@ -27338,11 +28030,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform :confvars c cr ca);
import Amavis::Util qw(ll untaint min max minmax unique_list do_log
@@ -27716,7 +28409,7 @@ sub clamav_clamd_internal {
my($remaining_time, $deadline) = get_deadline('clamav_internal');
my $clamav_handle =
Amavis::IO::RW->new($socket_specs, Eol => "\000", Timeout => 10);
- defined $clamav_handle or die "Can't connect to a clamd daemon";
+ $clamav_handle or die "Can't connect to a clamd daemon";
# set a normal timeout
prolong_timer('clamav_scan');
@@ -27724,96 +28417,141 @@ sub clamav_clamd_internal {
$clamav_handle->print("zIDSESSION\0")
or die "Error writing 'zIDSESSION' to a clamd socket: $!";
- my(%requests, %requests_filename, %requests_timestamp, $end_sent);
+ my(@requests, @requests_filename, @requests_timestamp, $end_sent);
my($req_id, $requests_pending) = (0,0);
my $requests_remaining = !ref $query ? 1 : scalar @$query;
- my $keep_one_success; my $output = '';
+ my($keep_one_success, $aborted_id, $found_infected);
+ my $output = '';
while ($requests_remaining > 0 || $requests_pending > 0) {
my $throttling = $requests_pending >= 8;
if ($throttling) {
+ # wait first for some of the pending results before sending new requests
$clamav_handle->flush or die "Error flushing socket: $!";
- do_log(5,'clamav: throttling: pending %d, remaining %d',
+ do_log(5,'clamav: throttling: %d pending, %d remaining',
$requests_pending, $requests_remaining);
- } elsif ($requests_remaining > 0 && !$throttling) {
+ } elsif ($requests_remaining > 0) {
my $fname = !ref $query ? $query : $query->[$req_id];
- $req_id++; $requests_remaining--;
- $requests{$req_id} = 'INITIATING';
- $requests_filename{$req_id} = $fname;
- ll(5) && do_log(5,'clamav: sending contents of %s', $fname);
+ $req_id++;
+ $requests[$req_id] = 'INITIATING';
+ $requests_filename[$req_id] = $fname;
+ ll(5) && do_log(5,'clamav: sending contents of %s, req_id %d',
+ $fname, $req_id);
$clamav_handle->print("zINSTREAM\0")
or die "Error writing 'zINSTREAM' to a clamd socket: $!";
- $requests{$req_id} = 'OPEN';
+ $requests[$req_id] = 'OPEN';
my $fh = IO::File->new;
$fh->open($fname,'<') or die "Can't open file $fname: $!";
binmode($fh,':bytes') or die "Can't cancel :utf8 mode: $!";
- my($nbytes,$buff); $buff = pack('N',0);
- while (($nbytes=$fh->read($buff, 32768-4, 4)) > 0) {
- substr($buff,0,4) = pack('N',$nbytes); # 32 bits len -> 4 bytes
- $clamav_handle->print($buff)
- or die "Error writing $nbytes bytes to a clamd socket: $!";
- $requests{$req_id} = 'SENDING';
- }
- my $eod = pack('N',0); # length zero indicates end of data
- if ($requests_remaining <= 0) { $eod .= "zEND\0"; $end_sent = 1 }
- $clamav_handle->print($eod)
- or die "Error writing end-of-data to a clamd socket: $!";
- # $clamav_handle->flush or die "Error flushing socket: $!";
- $requests_timestamp{$req_id} = Time::HiRes::time;
- $requests{$req_id} = 'SENT'; $requests_pending++;
+ eval {
+ my($nbytes,$buff); $buff = pack('N',0);
+ while (($nbytes=$fh->read($buff, 32768-4, 4)) > 0) {
+ $requests[$req_id] = 'SENDING';
+ substr($buff,0,4) = pack('N',$nbytes); # 32 bits len -> 4 bytes
+ $clamav_handle->print($buff)
+ or die "Error writing $nbytes bytes to a clamd socket: $!";
+ }
+ defined $nbytes or die "Error reading from $fname: $!";
+ my $eod = pack('N',0); # length zero indicates end of data
+ if ($requests_remaining <= 0) { $eod .= "zEND\0"; $end_sent = 1 }
+ $clamav_handle->print($eod)
+ or die "Error writing end-of-data to a clamd socket: $!";
+ $clamav_handle->flush or die "Error flushing clamd socket: $!";
+ $requests[$req_id] = 'SENT';
+ 1;
+ } or do {
+ my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
+ $requests[$req_id] = 'ABORTED: '.$eval_stat;
+ $aborted_id = $req_id; # also boolean true, request IDs start with 1
+ do_log(-1,'clamav: while feeding req_id %d: %s', $req_id, $eval_stat);
+ my $disc_len = $clamav_handle->discard_pending_output;
+ do_log(2,'clamav: discarding %d bytes', $disc_len) if $disc_len;
+ };
+ $requests_timestamp[$req_id] = Time::HiRes::time;
+ $requests_remaining--; $requests_pending++;
$fh->close or die "Error closing file $fname: $!";
- # do_log(5,'clamav: finished sending %s', $fname);
+ do_log(5,'clamav: finished sending %s, req_id %d', $fname, $req_id);
}
- my $ln;
- while ($requests_pending > 0 &&
- ( !$requests_remaining || $throttling ||
- $clamav_handle->response_line_available ) &&
- defined($ln = $clamav_handle->get_response_line)) {
+ while ( ($requests_pending > 0 && !$aborted_id) ||
+ $clamav_handle->response_line_available ) {
+ my $ln = $clamav_handle->get_response_line;
+ last if !defined $ln;
my $rx_time = Time::HiRes::time;
- # do_log(5,'clamav: got response %s', $ln);
- local($1,$2);
- if ($ln !~ /^(\d+):\s*(.*?)\000\z/s) {
+ do_log(5,'clamav: got response %s', $ln);
+
+ my($id, $id_n, $resp); local($1,$2);
+ if ($ln =~ /^(\d+):\s*(.*?)\000\z/s) {
+ ($id,$resp) = ($1,$2); $id_n = 0+$id;
+ } elsif ($ln =~ / ERROR\000\z/) {
+ if ($aborted_id) {
+ $id = $aborted_id; $id_n = 0+$id;
+ do_log(-1,'clamav: (possibly id=%d) error response: %s', $id,$ln);
+ } else {
+ do_log(-1,'clamav: error response: %s', $ln);
+ }
+ } else {
do_log(-1,'clamav: unparseable response %s', $ln);
next;
}
- my($id,$resp) = ($1,$2);
- if (!defined $requests{$id}) {
- do_log(-1,'clamav: bogus id %s in response ignored: %s', $id, $ln);
- } elsif ($requests{$id} eq 'DONE') {
- do_log(-1,'clamav: duplicate result for id %s: %s', $id, $ln);
+ if (!defined $id) {
+ # failure already reported
+ } elsif (!defined $requests[$id_n]) {
+ do_log(-1,'clamav: bogus id %s in response ignored: %s', $id,$ln);
+ } elsif ($requests[$id_n] eq 'DONE') {
+ do_log(-1,'clamav: duplicate result for id %s: %s', $id,$ln);
} else {
ll(5) && do_log(5,'clamav: request id %s on %s took %.1f ms',
- $id, $requests_filename{$id},
- 1000 * ($rx_time - $requests_timestamp{$id}));
- if ($requests{$id} ne 'SENT') {
- do_log(2,'clamav: result based on partial data, state %s: %s',
- $requests{$id}, $ln);
+ $id, $requests_filename[$id_n],
+ 1000 * ($rx_time - $requests_timestamp[$id_n]));
+ if ($requests[$id_n] ne 'SENT') {
+ do_log(2,'clamav: result based on incomplete data, state %s: %s',
+ $requests[$id_n], $ln);
}
$ln =~ s/\000\z/\n/s;
- $ln =~ s/^\Q$id\E:\s*stream:\s*/$requests_filename{$id}: /s;
- if ($resp =~ /\bOK\z/) { # clean
+ $ln =~ s/^\Q$id\E:\s*stream:\s*/$requests_filename[$id_n]: /s;
+ if (defined $resp && $resp =~ /\bOK\z/) { # clean
$keep_one_success = $ln if !defined $keep_one_success;
} else {
$output .= $ln if length($output) < 10000; # sanity limit
}
- $requests{$id} = 'DONE';
+ $requests[$id_n] = 'DONE';
$requests_pending-- if $requests_pending > 0;
- delete $requests_filename{$id};
- delete $requests_timestamp{$id};
- if ($resp =~ /\bFOUND\z/ &&
- $requests_remaining > 0 && c('first_infected_stops_scan')) {
- do_log(2,'clamav: first infected stops scan');
- $requests_remaining = 0;
+ undef $requests_filename[$id_n];
+ undef $requests_timestamp[$id_n];
+ if ($resp =~ /\bFOUND\z/) {
+ $found_infected = 1;
+ if ($requests_remaining > 0 && c('first_infected_stops_scan')) {
+ do_log(2,'clamav: first infected stops scan');
+ $requests_remaining = 0;
+ }
}
}
}
+ if ($aborted_id) {
+ do_log(-1,'clamav: aborting: %d pending, %d remaining',
+ $requests_pending, $requests_remaining);
+ $clamav_handle->close
+ or do_log(5,'clamav: error closing session: %s', $!);
+ undef $clamav_handle;
+ if ($found_infected) {
+ # just normally return an infection report,
+ # even though not all content has been scanned
+ do_log(5,'clamav: result: %s', $output);
+ return (0,$output); # return synthesised status and a result string
+ } else {
+ die 'clamav: '.$requests[$aborted_id];
+ }
+ }
}
$output = $keep_one_success if $output eq '' && defined $keep_one_success;
do_log(5,'clamav: result: %s', $output);
- if (!$end_sent) {
- $clamav_handle->print("zEND\0")
- or die "Error writing 'zEND' to a clamd socket: $!";
+ if ($clamav_handle) {
+ if (!$end_sent) {
+ $clamav_handle->print("zEND\0")
+ or do_log(-1,"clamav: error writing 'zEND' to a clamd socket: %s", $!);
+ }
+ $clamav_handle->close
+ or do_log(-1,'clamav: error closing session: %s', $!);
}
- $clamav_handle->close or do_log(-1, "clamav - error closing session: $!");
(0,$output); # return synthesised status and a result string
}
@@ -27907,7 +28645,7 @@ sub ask_daemon_internal {
if ($multisession) {
# depends on TCP segment boundaries, unreliable
my $nread = $sock->read($output,16384);
- defined($nread) or die "Error reading from $socketname: $!\n";
+ defined $nread or die "Error reading from $socketname: $!\n";
# and keep the socket open
} else { # single request/response per connection
my $buff = '';
@@ -28299,7 +29037,7 @@ sub virus_scan($$) {
if (!defined $bare_fnames_ref) { # first time: collect file names to scan
my $parts_root = $msginfo->parts_root;
($bare_fnames_ref,$names_to_parts) =
- files_to_scan("$tempdir/parts",$parts_root);
+ files_to_scan("$tempdir/parts", $parts_root);
if (!@$bare_fnames_ref) {
do_log(2, "Not calling virus scanners, no files to scan in %s/parts",
$tempdir);
@@ -28503,6 +29241,7 @@ 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';
use Fcntl qw(:flock);
use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL);
@@ -28510,7 +29249,7 @@ use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL);
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
- $VERSION = '2.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform c cr ca);
import Amavis::Util qw(ll do_log min max minmax untaint untaint_inplace
@@ -28908,11 +29647,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform :confvars :sa c cr ca);
import Amavis::Util qw(ll do_log sanitize_str min max minmax
@@ -29059,34 +29799,24 @@ sub check_or_learn {
if (vec($rout,$resp_stderr_fd,1)) {
my $inbuf = ''; $! = 0;
my $nread = sysread($resp_stderr_fh, $inbuf, 16384);
- if (!defined($nread)) {
- if ($! == EAGAIN || $! == EINTR) {
- Time::HiRes::sleep(0.1); # slow down, just in case
- } else {
- do_log(0,"%s: error reading from pipe2: %s", $scanner_name,$!);
- }
- } elsif ($nread < 1) { # sysread returns 0 at eof
- } else { # successful read
- ll(5) && do_log(5, "rx stderr: %d %s [...]",
- length($inbuf), substr($inbuf,0,1000));
+ if ($nread) { # successful read
+ ll(5) && do_log(5, 'rx stderr: %d %s [...]',
+ $nread, substr($inbuf,0,1000));
$response_stderr .= $inbuf if length($response_stderr) < 10000;
+ } elsif (defined $nread) { # defined but zero: EOF
+ # sysread returns 0 at eof
+ } elsif ($! == EAGAIN || $! == EINTR) {
+ Time::HiRes::sleep(0.1); # slow down, just in case
+ } else { # read error
+ do_log(0,"%s: error reading from pipe2: %s", $scanner_name,$!);
}
}
if (vec($rout,$resp_stdout_fd,1)) {
my $inbuf = ''; $! = 0;
my $nread = sysread($resp_stdout_fh, $inbuf, 16384);
- if (!defined($nread)) {
- if ($! == EAGAIN || $! == EINTR) {
- Time::HiRes::sleep(0.1); # slow down, just in case
- } else {
- $eof_on_response = 1;
- die "$scanner_name: error reading from pipe1: $!";
- }
- } elsif ($nread < 1) { # sysread returns 0 at eof
- $eof_on_response = 1;
- } else { # successful read
- ll(5) && do_log(5, "rx: %d %s [...]",
- length($inbuf), substr($inbuf,0,30));
+ if ($nread) { # successful read
+ ll(5) && do_log(5, 'rx: %d %s [...]',
+ $nread, substr($inbuf,0,30));
my $response_l = length($response);
if ($response_chopped || $response_l >= 65536) {
# ignore the rest of input
@@ -29096,6 +29826,13 @@ sub check_or_learn {
# we only need a mail header from the returned text
$response_chopped = 1 if index($response,"\n\n",$j) >= 0;
}
+ } elsif (defined $nread) { # defined but zero: EOF
+ $eof_on_response = 1; # sysread returns 0 at eof
+ } elsif ($! == EAGAIN || $! == EINTR) {
+ Time::HiRes::sleep(0.1); # slow down, just in case
+ } else { # read error
+ $eof_on_response = 1;
+ die "$scanner_name: error reading from pipe1: $!";
}
}
if (vec($wout,$proc_fd,1)) { # subprocess is ready to receive more
@@ -29208,7 +29945,7 @@ sub check_or_learn {
local($1,$2);
if ($curr_head =~ /^ ( (?: X-DSPAM | X-CRM114 | X-Bogosity) [^:]*? )
[ \t]* : [ \t]* (.*) $/xs) {
- my($hn,$hb) = ($1,$2); my $hnlc = lc($hn);
+ my($hn,$hb) = ($1,$2); my $hnlc = lc $hn;
push(@header_field_name, $hn) if !exists($header_field{$hnlc});
$header_field{$hnlc} = $hb; # keep last
}
@@ -29235,7 +29972,7 @@ sub check_or_learn {
@header_field_name = qw(X-DSPAM-Result X-DSPAM-Class X-DSPAM-Confidence
X-DSPAM-Probability X-DSPAM-Signature);
for my $hn (@header_field_name) {
- my $hnlc = lc($hn); my $name = $hnlc; $name =~ s/^X-DSPAM-//i;
+ my $hnlc = lc $hn; my $name = $hnlc; $name =~ s/^X-DSPAM-//i;
$header_field{$hnlc} = $attribute{$name};
}
}
@@ -29325,7 +30062,7 @@ sub check_or_learn {
my $allowed_hdrs = cr('allowed_added_header_fields');
my $all_local = !grep(!$_->recip_is_local, @$per_recip_data);
for my $hn (@header_field_name) {
- my $hnlc = lc($hn); my $hb = $header_field{$hnlc};
+ my $hnlc = lc $hn; my $hb = $header_field{$hnlc};
if (defined $hb) {
$hb =~ s/[ \t\r\n]+\z//; # trim trailing whitespace and eol
do_log(5,"%s: suppl attr: %s = '%s'", $scanner_name,$hn,$hb);
@@ -29362,11 +30099,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform :confvars :sa c cr ca);
import Amavis::Util qw(ll do_log sanitize_str min max minmax get_deadline);
@@ -29482,7 +30220,7 @@ sub check {
} else {
$msg->seek($file_position,0) or die "Can't rewind mail file: $!";
my($nbytes,$buff,$done);
- while (($nbytes = $msg->sysread($buff,16384)) > 0) {
+ while ( $nbytes=$msg->sysread($buff,16384) ) {
$file_position += $nbytes;
$buff =~ s{\n}{\015\012}gs;
if (defined $size_limit &&
@@ -29574,11 +30312,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
# let a 'require' understand that this module is already loaded:
$INC{'Mail/SpamAssassin/Logger/Amavislog.pm'} = 'amavisd';
@@ -29611,16 +30350,17 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
import Amavis::Conf qw(:platform :confvars :sa $daemon_user c cr ca);
import Amavis::Util qw(ll do_log do_log_safe sanitize_str prolong_timer
add_entropy min max minmax get_deadline
- safe_encode_utf8);
+ safe_encode_utf8_inplace);
import Amavis::ProcControl qw(exit_status_str proc_status_ok
kill_proc run_command run_as_subprocess
collect_results collect_results_structured);
@@ -29721,9 +30461,6 @@ sub getSAPlugins {
if $mod_names{'Mail::SpamAssassin::Plugin::Razor2'};
# push(@modules, qw(IP::Country::Fast))
# if $mod_names{'Mail::SpamAssassin::Plugin::RelayCountry'};
-# push(@modules,
-# qw(Mail::DomainKeys Mail::DomainKeys::Message Mail::DomainKeys::Policy))
-# if $mod_names{'Mail::SpamAssassin::Plugin::DomainKeys'};
push(@modules, qw(Mail::DKIM Mail::DKIM::Verifier Net::DNS::Resolver))
if $mod_names{'Mail::SpamAssassin::Plugin::DKIM'};
push(@modules, qw(Image::Info Image::Info::GIF Image::Info::JPEG
@@ -29992,7 +30729,7 @@ sub call_spamassassin($$$$) {
my $file_position = $msginfo->skip_bytes;
$msg->seek($file_position, 0) or die "Can't rewind mail file: $!";
my $nbytes;
- while (($nbytes = $msg->sysread($data, 32768, length $data)) > 0) {
+ while ( $nbytes=$msg->sysread($data, 32768, length $data) ) {
$file_position += $nbytes;
last if defined $size_limit && length($data) > $size_limit;
}
@@ -30274,6 +31011,15 @@ sub call_spamassassin($$$$) {
$which_section = 'SA parse';
my($remaining_time, $deadline) = get_deadline('SA check', 1, 5);
+ my(@mimepart_digests);
+ for (my(@traversal_stack) = $msginfo->parts_root;
+ my $part = pop @traversal_stack; ) { # pre-order tree traversal
+ my $digest = $part->digest;
+ push(@mimepart_digests, $digest) if defined $digest;
+ push(@traversal_stack, reverse @{$part->children}) if $part->children;
+ }
+ do_log(5,'mimepart digest: %s', $_) for @mimepart_digests;
+
my(%suppl_attrib) = (
'skip_prng_reseed' => 1, # do not call srand(), we already did it
'return_path' => $msginfo->sender_smtp,
@@ -30282,6 +31028,8 @@ sub call_spamassassin($$$$) {
'originating' => $msginfo->originating ? 1 : 0,
'message_size' => $msginfo->msg_size,
'body_size' => $msginfo->orig_body_size,
+ !@mimepart_digests ? ()
+ : ('mimepart_digests' => \@mimepart_digests),
!c('enable_dkim_verification') ? ()
: ('dkim_signatures' => $msginfo->dkim_signatures_all),
!defined $deadline ? ()
@@ -30333,12 +31081,14 @@ sub call_spamassassin($$$$) {
AUTOLEARN AUTOLEARNSCORE SC SCRULE SCTYPE
LANGUAGES RELAYCOUNTRY ASN ASNCIDR DCCB DCCR DCCREP
DKIMDOMAIN DKIMIDENTITY AWLSIGNERMEAN
+ HAMMYTOKENS SPAMMYTOKENS
CRM114STATUS CRM114SCORE CRM114CACHEID)) {
my $tag_value = $per_msg_status->get_tag($t);
if (defined $tag_value) {
# for some reason tags ASN and ASNCIDR have UTF8 flag on;
# encode any character strings to UTF-8 octets for consistency
- $supplementary_info{$t} = safe_encode_utf8($tag_value);
+ safe_encode_utf8_inplace($tag_value); # to octets if not already
+ $supplementary_info{$t} = $tag_value;
}
}
}
@@ -30351,9 +31101,11 @@ sub call_spamassassin($$$$) {
}
}
# get_report() taints $1 and $2 !
- $spam_summary = safe_encode_utf8($per_msg_status->get_report);
- # $spam_summary = safe_encode_utf8($per_msg_status->get_tag('SUMMARY'));
- $spam_report = safe_encode_utf8($per_msg_status->get_tag('REPORT'));
+ $spam_summary = $per_msg_status->get_report;
+ # $spam_summary = $per_msg_status->get_tag('SUMMARY');
+ $spam_report = $per_msg_status->get_tag('REPORT');
+ safe_encode_utf8_inplace($spam_summary); # to octets (if not already)
+ safe_encode_utf8_inplace($spam_report); # to octets (if not already)
# fetch the TIMING tag last:
$supplementary_info{'TIMING'} = $per_msg_status->get_tag('TIMING');
$supplementary_info{'RUSAGE-SA'} = \@sa_cpu_usage; # filled-in later
@@ -30523,7 +31275,7 @@ sub check {
$sa_tests_h{$test_name} = $score;
}
}
- my $dkim_adsp_suppress = 0;
+ my $dkim_adsp_suppress;
if (exists $sa_tests_h{'DKIM_ADSP_DISCARD'}) {
# must honour ADSP 'discardable', suppress a bounce
do_log(2,"spam_scan: dsn_suppress_reason DKIM_ADSP_DISCARD");
@@ -30577,11 +31329,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&init &decompose_part &determine_file_types);
import Amavis::Util qw(untaint min max minmax ll do_log snmp_count
@@ -31399,28 +32152,53 @@ sub do_7zip($$$;$) {
ll(4) && do_log(4, "Expanding 7-Zip archive %s", $part->base_name);
my $decompressor_name = basename((split(' ',$archiver))[0]);
snmp_count("OpsDecBy\u${decompressor_name}Attempt");
- my $last_line; my $bytes = 0; my $mem_cnt = 0;
+ my $last_line; my $any_encrypted; my $bytes = 0; my $mem_cnt = 0;
my $retval = 1; my($proc_fh,$pid); my $fn = $part->full_name;
prolong_timer('do_7zip_pre'); # restart timer
my $eval_stat;
eval {
($proc_fh,$pid) = run_command(undef, '&1', $archiver,
'l', '-slt', "-w$tempdir/parts", '--', $fn);
- my $ln; my($name,$size,$attr); my $entries_cnt = 0;
+ my @list;
+ my $ln; my($name,$size,$attr,$enc); my $entries_cnt = 0;
for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
- $last_line = $ln if $ln !~ /^\s*$/; # keep last nonempty line
+ $last_line = $ln if $ln =~ /\S/; # keep last nonempty line
chomp($ln); local($1);
- if ($ln =~ /^\s*\z/) {
- if (defined $name || defined $size) {
- do_log(5,'do_7zip: member: %s "%s", %s bytes', $attr,$name,$size);
- if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES)
- { die "Maximum number of files ($MAXFILES) exceeded" }
- if (defined $size && $size > 0) { $bytes += $size; $mem_cnt++ }
- }
- undef $name; undef $size; undef $attr;
- } elsif ($ln =~ /^Path = (.*)\z/s) { $name = $1 }
+ if ($ln !~ /\S/) { # empty line separates members
+ if (defined $attr && $attr =~ /^D/) {
+ do_log(5,'do_7zip: member: %s "%s", (skipped directory)',
+ $attr,$name);
+ } elsif (defined $enc && defined $name) {
+ do_log(5,'do_7zip: member: %s "%s", %s bytes (skipped encrypted)',
+ $attr,$name,$size);
+ # make a phantom entry - carrying only name and attributes
+ my $parent_placement = $part->mime_placement;
+ my $newpart_obj =
+ Amavis::Unpackers::Part->new("$tempdir/parts",$part);
+ $newpart_obj->mime_placement("$parent_placement/$entries_cnt");
+ $newpart_obj->name_declared($name);
+ $newpart_obj->attributes_add('U','C');
+ } elsif (defined $name || defined $size) {
+ do_log(5,'do_7zip: member: %s "%s", %s bytes',
+ $attr, $name, defined $size ? $size : '?');
+ if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES) {
+ die "Maximum number of files ($MAXFILES) exceeded";
+ }
+ if (defined $size && $size > 0) {
+ push(@list, untaint($name));
+ $bytes += $size; $mem_cnt++;
+ }
+ }
+ undef $name; undef $size; undef $attr; undef $enc;
+ }
+ elsif ($ln =~ /^Path = (.*)\z/s) { $name = $1 }
elsif ($ln =~ /^Size = ([0-9]+)\z/s) { $size = $1 }
elsif ($ln =~ /^Attributes = (.*)\z/s) { $attr = $1 }
+ elsif ($ln =~ /^Encrypted = \+\z/s) { $enc = $any_encrypted = 1 }
+ elsif ($ln =~ /^ERROR:.* Can not open encrypted archive\. Wrong password\?\z/s) {
+ do_log(5,'do_7zip: archive is encrypted');
+ $part->attributes_add('U','C');
+ }
}
defined $ln || $! == 0 || $! == EAGAIN or die "Error reading (1): $!";
do_log(-1,"unexpected(do_7zip_1): %s",$!) if !defined($ln) && $! == EAGAIN;
@@ -31429,8 +32207,9 @@ sub do_7zip($$$;$) {
if (defined $size && $size > 0) { $bytes += $size; $mem_cnt++ }
}
# consume all remaining output to avoid broken pipe
- for ($! = 0; defined($ln=$proc_fh->getline); $! = 0)
- { $last_line = $ln if $ln !~ /^\s*$/ }
+ for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
+ $last_line = $ln if $ln =~ /\S/;
+ }
defined $ln || $! == 0 || $! == EAGAIN or die "Error reading (2): $!";
do_log(-1,"unexpected(do_7zip_2): %s",$!) if !defined($ln) && $! == EAGAIN;
my $err = 0; $proc_fh->close or $err = $!;
@@ -31445,8 +32224,15 @@ sub do_7zip($$$;$) {
if ($mem_cnt > 0 || $bytes > 0) {
consumed_bytes($bytes, 'do_7zip-pre', 1); # pre-check on estimated size
snmp_count("OpsDecBy\u${decompressor_name}");
+ if (!$any_encrypted) {
+ # supplying an empty list extracts all files, avoids exceeding the
+ # argv size limit as there is no need to exclude excrypted members
+ # (which would result in 7z returning a nonzero status)
+ @list = ();
+ }
($proc_fh,$pid) = run_command(undef, '&1', $archiver, 'x', '-bd', '-y',
- "-w$tempdir/parts", "-o$tempdir/parts/7zip", '--', $fn);
+ "-w$tempdir/parts", "-o$tempdir/parts/7zip", '--',
+ $fn, @list);
collect_results($proc_fh,$pid,$archiver,16384,[0,1]);
undef $proc_fh; undef $pid;
my $errn = lstat("$tempdir/parts/7zip") ? 0 : 0+$!;
@@ -32400,6 +33186,7 @@ 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';
sub new {
my($class,%params) = @_;
@@ -32420,11 +33207,12 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&dkim_key_postprocess &generate_authentication_results
&dkim_make_signatures &adjust_score_by_signer_reputation
@@ -33191,10 +33979,7 @@ sub dkim_make_signatures($$;$) {
@sane_signatures;
}
-# Prepare Authentication-Results header fields according to RFC 5451
-# and RFC 6008. The RFC 5617 (ADSP) added 'dkim-adsp' to the IANA
-# Authentication Method Name Registry as used with Authentication-Results,
-# but this is not yet implemented here.
+# Prepare Authentication-Results header fields according to RFC 7601.
#
sub generate_authentication_results($;$$) {
my($msginfo,$allow_none,$sigs_ref) = @_;
@@ -33202,7 +33987,7 @@ sub generate_authentication_results($;$$) {
my $authservid = c('myauthservid');
$authservid = c('myhostname') if !defined $authservid || $authservid eq '';
$authservid = idn_to_ascii($authservid);
- # note that RFC 5451 declares A-R header field as structured, which is why
+ # 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);
@@ -33239,17 +34024,17 @@ sub generate_authentication_results($;$$) {
}
}
- # RFC 5451 result: none, pass, fail, policy, neutral, temperror, permerror
+ # 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 5451 result value
+ 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 5451 result value
+ # 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';
@@ -33398,7 +34183,7 @@ sub collect_some_dkim_info($) {
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, %bank_names, %bn_auth_already_queried);
+ 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;
@@ -33469,7 +34254,7 @@ sub collect_some_dkim_info($) {
# my($f_ind,$fld) = $msginfo->get_header_field2(undef,$j);
# last if !defined $f_ind; # reached the top
# local $1;
- # my $f_name = lc($1) if $fld =~ /^([^:]*?)[ \t]*:/s;
+ # 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}--;
@@ -33505,34 +34290,29 @@ sub collect_some_dkim_info($) {
my($result,$matchingkey) = lookup2(0,$key_ace,$atpbm,
Label=>'AuthToPB', $opt eq '' ? () : (AppendStr=>$opt));
$bn_auth_already_queried{$key_ace.$opt} = 1;
- 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';
- }
- # $result is a list of policy banks as a comma-separated string
- my(@pbn); # collect list of newly encountered policy bank names
- for (map { my $s=$_; $s =~ s/^[ \t]+//; $s =~ s/[ \t]+\z//; $s }
- split(/,/, $result)) {
- next if $_ eq '' || $bank_names{$_};
- push(@pbn,$_); $bank_names{$_} = 1;
- }
- my $minimum_key_bits = c('dkim_minimum_key_bits');
- 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(',', at pbn), $matchingkey,
- $key_size, $minimum_key_bits);
- } else {
- push(@bank_names, at pbn);
- ll(2) && do_log(2, "dkim: policy bank %s by %s",
- join(',', at pbn), $matchingkey);
- }
+ 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(',', at pbn), $matchingkey,
+ $key_size, $minimum_key_bits);
+ } else {
+ push(@bank_names, @pbn);
+ ll(2) && do_log(2, "dkim: policy bank %s by %s",
+ join(',', at pbn), $matchingkey);
}
}
}
@@ -33557,15 +34337,7 @@ sub collect_some_dkim_info($) {
);
$sig_ind++;
}
- if (@bank_names) {
- # ignore nonexisting bank names
- @bank_names = grep(defined $Amavis::policy_bank{$_},
- unique_list(\@bank_names));
- if (@bank_names) {
- Amavis::load_policy_bank($_,$msginfo) for @bank_names;
- $msginfo->originating(c('originating')); # may have changed
- }
- }
+ Amavis::load_policy_bank($_,$msginfo) for @bank_names;
$msginfo->dkim_signatures_valid(\@signatures_valid) if @signatures_valid;
# if (ll(5) && $sig_ind > 0) {
# # show which header fields are covered by which signature
@@ -33589,18 +34361,19 @@ 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.404';
+ $VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&show_or_test_dkim_public_keys &generate_dkim_private_key
&convert_dkim_keys_file);
import Amavis::Conf qw(:platform c cr ca
@dkim_signing_keys_list @dkim_signing_keys_storage);
import Amavis::Util qw(untaint ll do_log
- safe_encode_utf8 idn_to_ascii idn_to_utf8);
+ safe_encode_utf8_inplace idn_to_ascii idn_to_utf8);
import Amavis::rfc2821_2822_Tools qw(rfc2822_timestamp);
}
use subs @EXPORT_OK;
@@ -33634,7 +34407,7 @@ sub show_or_test_dkim_public_keys($$) {
my $any = 0;
for my $e (@sort_list) {
my($j,$domain,$domain_re) = @$e; local($1);
- $domain = safe_encode_utf8($domain);
+ safe_encode_utf8_inplace($domain); # to octets (if not already)
my $domain_ace = idn_to_ascii($domain);
next if @seek_domains &&
!grep { defined $domain_re ? lc($_) =~ /$domain_re/
@@ -33647,7 +34420,8 @@ sub show_or_test_dkim_public_keys($$) {
if ($cmd eq 'testkeys' || $cmd eq 'testkey') {
test_dkim_key(%$key_opts);
} else {
- my $selector = safe_encode_utf8($key_opts->{selector});
+ my $selector = $key_opts->{selector};
+ safe_encode_utf8_inplace($selector); # to octets (if not already)
my $selector_ace = idn_to_ascii($selector);
my $key_storage_ind = $key_opts->{key_storage_ind};
my($key,$dev,$inode,$fname) =
@@ -33793,7 +34567,7 @@ sub convert_dkim_keys_file($) {
} elsif ($ln =~ m{^/}) {
$basedir = $ln; $basedir .= '/' if $basedir !~ m{/\z};
} else {
- my($sender_pattern,$signing_domain,$keypath) =
+ my($sender_pattern, $signing_domain, $keypath) =
map { my $s = $_; $s =~ s/^\s+//; $s =~ s/\s+\z//; $s }
split(/:/, $ln, 3);
defined $sender_pattern && $sender_pattern ne ''
@@ -34148,13 +34922,13 @@ WHAT IS AN INVALID CHARACTER IN A MAIL HEADER SECTION?
mailer (RFC 6532), or these characters need to be properly encoded
according to RFC 2047.
- Necessary encoding is often done transparently by a mail reader,
- but if automatic encoding is not available (e.g. by some older MUA)
- it is a user's responsibility to avoid using such characters in
- a header section, or to encode them manually. Typically offending
- header fields in this category are 'Subject', 'Organization', and
- comment fields or display names in e-mail addresses of 'From',
- 'To', or 'Cc'.
+ Necessary encoding is normally done transparently by a mail reader
+ or other mail generating software. If automatic encoding is not
+ available (e.g. by some old MUA) it is a user's responsibility
+ to avoid using such characters in a header section, or to encode
+ them manually. Typically offending header fields in this category
+ are 'Subject', 'Organization', and comment fields or display names
+ in e-mail addresses of 'From', 'To', or 'Cc'.
Sometimes such invalid header fields are inserted automatically
by some MUA, MTA, content filter, or other mail handling service.
@@ -34290,12 +35064,12 @@ for recipient's convenience.
We are sorry for inconvenience if the contents was not malicious.
-The purpose of these restrictions is to cut the most common propagation
-methods used by viruses and other malware. These often exploit automatic
-mechanisms and security holes in more popular mail readers (Microsoft
-mail readers and browsers are a common target). By requiring an explicit
-and decisive action from the recipient to decode mail, the danger of
-automatic malware propagation is largely reduced.
+The purpose of these restrictions is to avoid the most common
+propagation methods used by viruses and other malware. These often
+exploit automatic mechanisms and security holes in more popular
+mail readers. By requiring an explicit and decisive action from a
+recipient to decode mail, a danger of automatic malware propagation
+is largely reduced.
#
# Details of our mail restrictions policy are available at ...
diff --git a/amavisd-new-courier.patch b/amavisd-new-courier.patch
index 81823c5..2882be3 100644
--- a/amavisd-new-courier.patch
+++ b/amavisd-new-courier.patch
@@ -1,5 +1,5 @@
---- amavisd.ori 2014-10-26 01:03:34.407616245 +0200
-+++ amavisd 2014-10-26 01:03:53.168614917 +0200
+--- amavisd.ori 2016-04-26 21:22:13.525445000 +0200
++++ amavisd 2016-04-26 21:22:48.446878000 +0200
@@ -108,5 +108,5 @@
# Amavis::In::AMPDP
# Amavis::In::SMTP
@@ -7,14 +7,14 @@
+# Amavis::In::Courier
# Amavis::Out::SMTP::Protocol
# Amavis::Out::SMTP::Session
-@@ -230,5 +230,5 @@
+@@ -231,5 +231,5 @@
fetch_modules('REQUIRED BASIC MODULES', 1, qw(
Exporter POSIX Fcntl Socket Errno Carp Time::HiRes
- IO::Handle IO::File IO::Socket IO::Socket::UNIX
+ IO::Handle IO::File IO::Socket IO::Socket::UNIX IO::Select
IO::Stringy Digest::MD5 Unix::Syslog File::Basename
Compress::Zlib MIME::Base64 MIME::QuotedPrint MIME::Words
-@@ -12672,4 +12672,18 @@
+@@ -13098,4 +13098,18 @@
### Net::Server hook
+### This hook takes place immediately after the "->run()" method is called.
@@ -33,14 +33,14 @@
+### Net::Server hook
### Occurs in the parent (master) process after (possibly) opening a log file,
### creating pid file, reopening STDIN/STDOUT to /dev/null and daemonizing;
-@@ -12677,5 +12691,5 @@
- #
- sub post_configure_hook {
--# umask(0007); # affect protection of Unix sockets created by Net::Server
-+ umask(0007); # affect protection of Unix sockets created by Net::Server
+@@ -13110,5 +13124,5 @@
+ sd_notify(0, "MAINPID=$$","STATUS=Daemonized, preparing to bind sockets.");
+ }
+-# umask(0007); # affects protection of Unix sockets created by Net::Server
++ umask(0007); # affects protection of Unix sockets created by Net::Server
}
-@@ -12696,9 +12710,18 @@
+@@ -13129,9 +13143,18 @@
### Net::Server hook
### Occurs in the parent (master) process after binding to sockets,
-### but before chrooting and dropping privileges
@@ -59,9 +59,9 @@
+ # Watch for courierfilter telling us to shut down
+ $self->{server}->{select}->add($self->{courierfilter_pipe});
+ }
+ sd_notify(0, "STATUS=Sockets bound, checking user and group.");
}
-
-@@ -12756,4 +12779,15 @@
+@@ -13191,4 +13214,15 @@
}
$spamcontrol_obj->init_pre_fork if $spamcontrol_obj;
+ if ($courierfilter_shutdown) {
@@ -77,7 +77,7 @@
+ }
my(@modules_extra) = grep(!exists $modules_basic{$_}, keys %INC);
if (@modules_extra) {
-@@ -13230,5 +13264,7 @@
+@@ -13683,5 +13717,7 @@
$ampdp_in_obj->process_policy_request($sock, $conn, \&check_mail, 0);
} elsif ($suggested_protocol eq 'COURIER') {
- die "unavailable support for protocol: $suggested_protocol";
@@ -86,7 +86,7 @@
+ $courier_in_obj->process_courier_request($sock, $conn, \&check_mail);
} elsif ($suggested_protocol eq 'QMQPqq') {
die "unavailable support for protocol: $suggested_protocol";
-@@ -13338,4 +13374,24 @@
+@@ -13792,4 +13828,24 @@
}
+### Net::Server hook
@@ -111,25 +111,25 @@
+
### Child is about to be terminated
### user customizable Net::Server hook
-@@ -18596,4 +18652,9 @@
- undef $Amavis::Conf::log_verbose_templ;
-
+@@ -19017,4 +19073,9 @@
+ } elsif (@argv > 0 &&
+ $cmd !~ /^(:?showkeys?|testkeys?|genrsa|convert_keysfile)/xs) {
+# courierfilter shutdown needs can_read_hook, added in Net::Server 0.90
+if ($courierfilter_shutdown && Net::Server->VERSION < 0.90) {
+ die "courierfilter shutdown needs Net::Server 0.90 or better";
+}
+
- if (defined $desired_user && $daemon_user ne '') {
- local($1);
-@@ -19250,4 +19311,6 @@
+ die sprintf("%s:\n Only one command line parameter allowed: %s\n\n%s\n",
+ $myversion, join(' ', at argv), usage());
+@@ -19796,4 +19857,6 @@
host => $bind_to[0], # default bind, redundant, merged to @listen_sockets
listen => $listen_queue_size, # undef for a default
+ # need to set multi_port for can_read_hook
+ multi_port => $courierfilter_shutdown ? 1 : undef,
max_servers => $max_servers, # number of pre-forked children
!defined($min_servers) ? ()
-@@ -22858,5 +22921,424 @@
- no warnings 'uninitialized';
+@@ -23494,5 +23557,424 @@
+ # use warnings 'extra'; no warnings 'experimental::re_strict'; use re 'strict';
-BEGIN { die "Code not available for module Amavis::In::Courier" }
+BEGIN {
diff --git a/amavisd-new-qmqpqq.patch b/amavisd-new-qmqpqq.patch
index 6d547b9..7c2b6ef 100644
--- a/amavisd-new-qmqpqq.patch
+++ b/amavisd-new-qmqpqq.patch
@@ -1,36 +1,36 @@
---- amavisd.ori 2014-10-26 01:03:34.407616245 +0200
-+++ amavisd 2014-10-26 01:04:44.543611588 +0200
+--- amavisd.ori 2016-04-26 21:22:13.525445000 +0200
++++ amavisd 2016-04-26 21:23:36.586286000 +0200
@@ -109,4 +109,5 @@
# Amavis::In::SMTP
#( Amavis::In::Courier )
+# Amavis::In::QMQPqq
# Amavis::Out::SMTP::Protocol
# Amavis::Out::SMTP::Session
-@@ -5206,4 +5207,5 @@
+@@ -5345,4 +5346,5 @@
# RFC 3848, RFC 6531
# http://www.iana.org/assignments/mail-parameters/mail-parameters.xhtml
+ # must not use proto name QMQPqq in 'with'
$s .= "\n with $smtp_proto"
if $smtp_proto =~ /^ (?: SMTP | (?: ES|L|UTF8S|UTF8L) MTP S? A? ) \z/xsi;
-@@ -11762,4 +11764,5 @@
+@@ -12107,4 +12109,5 @@
$extra_code_sql_lookup $extra_code_ldap
$extra_code_in_ampdp $extra_code_in_smtp $extra_code_in_courier
+ $extra_code_in_qmqpqq
$extra_code_out_smtp $extra_code_out_pipe
$extra_code_out_bsmtp $extra_code_out_local $extra_code_p0f
-@@ -11789,4 +11792,5 @@
+@@ -12134,4 +12137,5 @@
# Amavis::In::AMPDP, Amavis::In::SMTP and In::Courier objects
use vars qw($ampdp_in_obj $smtp_in_obj $courier_in_obj);
+use vars qw($qmqpqq_in_obj); # Amavis::In::QMQPqq object
use vars qw($sql_dataset_conn_lookups); # Amavis::Out::SQL::Connection object
-@@ -12581,4 +12585,5 @@
- do_log(0,"SMTP-in proto code %s loaded", $extra_code_in_smtp ?'':" NOT");
- do_log(0,"Courier proto code %s loaded", $extra_code_in_courier ?'':" NOT");
+@@ -12870,4 +12874,5 @@
+ my(@msg);
+ my $euid = $>; # effective UID
+ do_log(0,"QMQPqq-in proto code %s loaded", $extra_code_in_qmqpqq ?'':" NOT");
- do_log(0,"SMTP-out proto code %s loaded", $extra_code_out_smtp ?'':" NOT");
- do_log(0,"Pipe-out proto code %s loaded", $extra_code_out_pipe ?'':" NOT");
-@@ -13232,5 +13237,9 @@
+ $> = 0; # try to become root
+ POSIX::setuid(0) if $> != 0; # and try some more
+@@ -13685,5 +13690,9 @@
die "unavailable support for protocol: $suggested_protocol";
} elsif ($suggested_protocol eq 'QMQPqq') {
- die "unavailable support for protocol: $suggested_protocol";
@@ -41,19 +41,19 @@
+ $qmqpqq_in_obj->process_qmqpqq_request($sock,$conn,\&check_mail);
} elsif ($suggested_protocol eq 'TCP-LOOKUP') { #postfix maps, experimental
process_tcp_lookup_request($sock, $conn);
-@@ -13355,4 +13364,5 @@
+@@ -13809,4 +13818,5 @@
do_log_safe(5,"child_finish_hook: invoking DESTROY methods");
undef $smtp_in_obj; undef $ampdp_in_obj; undef $courier_in_obj;
+ undef $qmqpqq_in_obj;
undef $sql_storage; undef $sql_wblist; undef $sql_lookups;
undef $sql_dataset_conn_lookups; undef $sql_dataset_conn_storage;
-@@ -18390,4 +18400,5 @@
+@@ -18900,4 +18910,5 @@
$extra_code_sql_lookup, $extra_code_ldap,
$extra_code_in_ampdp, $extra_code_in_smtp, $extra_code_in_courier,
+ $extra_code_in_qmqpqq,
$extra_code_out_smtp, $extra_code_out_pipe,
$extra_code_out_bsmtp, $extra_code_out_local,
-@@ -18747,5 +18758,11 @@
+@@ -19251,5 +19262,11 @@
undef $extra_code_in_courier;
}
- if ($needed_protocols_in{'QMQPqq'}) { die "In::QMQPqq code not available" }
@@ -66,7 +66,7 @@
+ }
}
-@@ -22864,4 +22881,276 @@
+@@ -23500,4 +23517,276 @@
__DATA__
#
+package Amavis::In::QMQPqq;
@@ -343,8 +343,8 @@
+#
package Amavis::Out::SMTP::Protocol;
use strict;
---- amavisd.conf.ori 2014-10-26 01:03:40.235615903 +0200
-+++ amavisd.conf 2014-10-26 01:04:44.544610916 +0200
+--- amavisd.conf.ori 2016-04-26 21:22:22.992355000 +0200
++++ amavisd.conf 2016-04-26 21:23:36.586961000 +0200
@@ -56,6 +56,6 @@
# option(s) -p overrides $inet_socket_port and $unix_socketname
diff --git a/amavisd-release b/amavisd-release
index c185730..55e76b3 100755
--- a/amavisd-release
+++ b/amavisd-release
@@ -86,6 +86,7 @@ BEGIN {
$log_level = 1;
# $socketname = '127.0.0.1:9998';
+# $socketname = '[::1]:9998';
$socketname = '/var/amavis/amavisd.sock';
### END OF USER CONFIGURABLE
diff --git a/amavisd-status b/amavisd-status
index cefbf38..44b9c4d 100755
--- a/amavisd-status
+++ b/amavisd-status
@@ -6,7 +6,7 @@
#
# Author: Mark Martinec <Mark.Martinec at ijs.si>
#
-# Copyright (c) 2012-2014, Mark Martinec
+# Copyright (c) 2012-2016, Mark Martinec
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -52,12 +52,12 @@ use Errno qw(ESRCH ENOENT);
use POSIX qw(strftime);
use Time::HiRes ();
-use vars qw($VERSION); $VERSION = 2.008002;
+use vars qw($VERSION); $VERSION = 2.011000;
use vars qw($myversion $myproduct_name $myversion_id $myversion_date);
use vars qw($outer_sock_specs);
$myproduct_name = 'amavisd-status';
-$myversion_id = '2.9.0'; $myversion_date = '20140506';
+$myversion_id = '2.11.0'; $myversion_date = '20150720';
$myversion = "$myproduct_name-$myversion_id ($myversion_date)";
### USER CONFIGURABLE:
@@ -295,10 +295,10 @@ sub display_state() {
my $bar = ('*' x $num_active) . ('.' x $num_idling);
my $ipeak_active = int($peak_active+0.5);
if ($ipeak_active > $num_active) {
- $bar .= ' ' x ($ipeak_active - ($num_active + $num_idling));
- # substr($bar, $ipeak_active-1, 1) = '|';
+ my $padding = $ipeak_active - ($num_active + $num_idling);
+ $bar .= ' ' x $padding if $padding > 0;
substr($bar, $num_active, $ipeak_active-$num_active) =
- ':' x ($ipeak_active-$num_active) if $ipeak_active > $num_active;
+ ':' x ($ipeak_active-$num_active);
}
printf STDERR ("%d active, %d idling processes\n", $num_active, $num_idling);
printf STDERR ("%s\n", $bar);
diff --git a/amavisd.conf b/amavisd.conf
index d023e10..02794d8 100644
--- a/amavisd.conf
+++ b/amavisd.conf
@@ -694,9 +694,12 @@ $banned_filename_re = new_RE(
# sub {$ENV{VSTK_HOME}='/usr/lib/vstk'},
],
+# ### http://www.avast.com/ (old)
+# ['avast! Antivirus', ['/usr/bin/avastcmd','avastcmd'],
+# '-a -i -n -t=A {}', [0], [1], qr/\binfected by:\s+([^ \t\n\[\]]+)/m ],
+
### http://www.avast.com/
- ['avast! Antivirus', ['/usr/bin/avastcmd','avastcmd'],
- '-a -i -n -t=A {}', [0], [1], qr/\binfected by:\s+([^ \t\n\[\]]+)/m ],
+ ['avast! Antivirus', '/bin/scan', '{}', [0], [1], qr/\t(.+)/m ],
### http://www.ikarus-software.com/
['Ikarus AntiVirus for Linux', 'ikarus',
diff --git a/amavisd.conf-default b/amavisd.conf-default
index aabcf68..716bcd0 100644
--- a/amavisd.conf-default
+++ b/amavisd.conf-default
@@ -41,6 +41,8 @@ use strict;
# 10.0.0.0/8 172.16.0.0/12 192.168.0.0/16 [fc00::]/7 );
# @mynetworks_maps = (\@mynetworks);
# @client_ipaddr_policy = map { $_ => 'MYNETS' } @mynetworks_maps;
+# $mail_digest_algorithm = 'MD5';
+# $mail_part_digest_algorithm = 'SHA1';
## LOGGING AND DEBUGGING
@@ -122,14 +124,21 @@ use strict;
# $auth_required_inp = undef;
# $auth_required_release = 1;
# @auth_mech_avail=(); # empty list disables incoming AUTH; or: qw(PLAIN LOGIN)
-# $tls_security_level_in = undef; # undef, 'may', 'encrypt', ...
-# $smtpd_tls_cert_file = undef;
-# $smtpd_tls_key_file = undef;
# $smtp_connection_cache_on_demand = 1;
# $smtp_connection_cache_enable = 1;
# $enforce_smtpd_message_size_limit_64kb_min = 1;
# @smtpd_discard_ehlo_keywords = ();
+# $tls_security_level_in = undef; # undef, 'may', 'encrypt', ...
+# $smtpd_tls_key_file = undef; # deprecated, use 'SSL_key_file' below
+# $smtpd_tls_cert_file = undef; # deprecated, use 'SSL_cert_file' below
+# %smtpd_tls_server_options = (
+# SSL_verifycn_scheme => 'smtp',
+# SSL_session_cache => 2,
+# # SSL_key_file => "...", # default taken from $smtpd_tls_key_file
+# # SSL_cert_file => "...", # default taken from $smtpd_tls_cert_file
+# );
+
## MTA INTERFACE - OUTPUT
@@ -141,7 +150,11 @@ use strict;
# $amavis_auth_user = undef; # for submitting notifications and quarantine
# $amavis_auth_pass = undef;
# $auth_reauthenticate_forwarded = undef; # our credentials for forwarding too
+
# $tls_security_level_out = undef; # undef, 'may', 'encrypt', ...
+# %smtp_tls_client_options = (
+# SSL_verifycn_scheme => 'smtp',
+# );
## MAIL FORWARDING
@@ -324,7 +337,7 @@ use strict;
# $keep_decoded_original_re = undef;
# @keep_decoded_original_maps = (\$keep_decoded_original_re);
-# $map_full_type_to_short_type_re = ... predefined regexp lookup table
+# $map_full_type_to_short_type_re = ... predefined lookup table, see source
# @map_full_type_to_short_type_maps = (\$map_full_type_to_short_type_re);
# $MAXLEVELS = undef;
@@ -401,35 +414,37 @@ use strict;
# @virus_name_to_policy_bank_maps = ();
#
# @virus_name_to_spam_score_maps =
-# (new_RE( # the order matters, first match wins
-# [ qr'^Structured\.(SSN|CreditCardNumber)\b' => 0.1 ],
-# [ qr'^(Heuristics\.)?Phishing\.' => 0.1 ],
-# [ qr'^(Email|HTML)\.Phishing\.(?!.*Sanesecurity)' => 0.1 ],
-# [ qr'^Sanesecurity\.(Malware|Rogue|Trojan)\.' => undef ],# keep as infected
-# [ qr'^Sanesecurity\.Foxhole\.' => undef ],# keep as infected
-# [ qr'^Sanesecurity\.' => 0.1 ],
-# [ qr'^Sanesecurity_PhishBar_' => 0 ],
-# [ qr'^Sanesecurity.TestSig_' => 0 ],
-# [ qr'^Email\.Spam\.Bounce(\.[^., ]*)*\.Sanesecurity\.' => 0 ],
-# [ qr'^Email\.Spammail\b' => 0.1 ],
-# [ qr'^MSRBL-(Images|SPAM)\b' => 0.1 ],
-# [ qr'^VX\.Honeypot-SecuriteInfo\.com\.Joke' => 0.1 ],
-# [ qr'^VX\.not-virus_(Hoax|Joke)\..*-SecuriteInfo\.com(\.|\z)' => 0.1 ],
-# [ qr'^Email\.Spam.*-SecuriteInfo\.com(\.|\z)' => 0.1 ],
-# [ qr'^Safebrowsing\.' => 0.1 ],
-# [ qr'^winnow\.(phish|spam)\.' => 0.1 ],
-# [ qr'^INetMsg\.SpamDomain' => 0.1 ],
-# [ qr'^Doppelstern\.(Spam|Scam|Phishing|Junk|Lott|Loan)'=> 0.1 ],
-# [ qr'^Bofhland\.Phishing' => 0.1 ],
-# [ qr'^ScamNailer\.' => 0.1 ],
-# [ qr'^HTML/Bankish' => 0.1 ], # F-Prot
-# [ qr'^PORCUPINE_JUNK' => 0.1 ],
-# [ qr'^PORCUPINE_PHISHING' => 0.1 ],
-# [ qr'^Porcupine\.Junk' => 0.1 ],
-# [ qr'-SecuriteInfo\.com(\.|\z)' => undef ], # keep as infected
-# [ qr'^MBL_NA\.UNOFFICIAL' => 0.1 ], # false positives
-# [ qr'^MBL_' => undef ], # keep as infected
-# ));
+# (new_RE( # the order matters, first match wins
+# [ qr'^Structured\.(SSN|CreditCardNumber)\b' => 0.1 ],
+# [ qr'^(Heuristics\.)?Phishing\.' => 0.1 ],
+# [ qr'^(Email|HTML)\.Phishing\.(?!.*Sanesecurity)' => 0.1 ],
+# [ qr'^Sanesecurity\.(Malware|Rogue|Trojan)\.' => undef ],# keep as infected
+# [ qr'^Sanesecurity\.Foxhole\.Zip_exe' => 0.1 ], # F.P.
+# [ qr'^Sanesecurity\.Foxhole\.' => undef ],# keep as infected
+# [ qr'^Sanesecurity\.' => 0.1 ],
+# [ qr'^Sanesecurity_PhishBar_' => 0 ],
+# [ qr'^Sanesecurity.TestSig_' => 0 ],
+# [ qr'^Email\.Spam\.Bounce(\.[^., ]*)*\.Sanesecurity\.' => 0 ],
+# [ qr'^Email\.Spammail\b' => 0.1 ],
+# [ qr'^MSRBL-(Images|SPAM)\b' => 0.1 ],
+# [ qr'^VX\.Honeypot-SecuriteInfo\.com\.Joke' => 0.1 ],
+# [ qr'^VX\.not-virus_(Hoax|Joke)\..*-SecuriteInfo\.com(\.|\z)' => 0.1 ],
+# [ qr'^Email\.Spam.*-SecuriteInfo\.com(\.|\z)' => 0.1 ],
+# [ qr'^Safebrowsing\.' => 0.1 ],
+# [ qr'^winnow\.(phish|spam)\.' => 0.1 ],
+# [ qr'^INetMsg\.SpamDomain' => 0.1 ],
+# [ qr'^Doppelstern\.(Spam|Scam|Phishing|Junk|Lott|Loan)'=> 0.1 ],
+# [ qr'^Bofhland\.Phishing' => 0.1 ],
+# [ qr'^ScamNailer\.' => 0.1 ],
+# [ qr'^HTML/Bankish' => 0.1 ], # F-Prot
+# [ qr'^PORCUPINE_JUNK' => 0.1 ],
+# [ qr'^PORCUPINE_PHISHING' => 0.1 ],
+# [ qr'^Porcupine\.Junk' => 0.1 ],
+# [ qr'^PhishTank\.Phishing\.' => 0.1 ],
+# [ qr'-SecuriteInfo\.com(\.|\z)' => undef ], # keep as infected
+# [ qr'^MBL_NA\.UNOFFICIAL' => 0.1 ], # false positives
+# [ qr'^MBL_' => undef ], # keep as infected
+# ));
# @banned_filename_maps = ( 'DEFAULT' );
# %banned_rules = ( 'DEFAULT' => $banned_filename_re); # after-default
@@ -815,13 +830,14 @@ use strict;
## (e.g. { log_level => \$log_level, inet_acl => \@inet_acl, ...} )
##
## $child_timeout $smtpd_timeout
- ## $policy_bank_name $protocol @inet_acl
+ ## $policy_bank_name $protocol $haproxy_target_enabled @inet_acl
## $myhostname $myauthservid $snmp_contact $snmp_location
## $myprogram_name $syslog_ident $syslog_facility
## $log_level $log_templ $log_recip_templ $enable_log_capture_dump
## $forward_method $notify_method $resend_method $report_format
## $release_method $requeue_method $release_format
## $attachment_password $attachment_email_name $attachment_outer_name
+ ## $mail_digest_algorithm $mail_part_digest_algorithm
## $os_fingerprint_method $os_fingerprint_dst_ip_and_port
## $originating @smtpd_discard_ehlo_keywords $soft_bounce
## $propagate_dsn_if_possible $terminate_dsn_on_notify_success
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/amavisd-new/pkg-amavisd-new.git
More information about the Amavisd-new-commits
mailing list