--- bin/amavisd-snmp-subagent-zmq | 1260 ------------------------------------------ bin/amavisd-status | 396 ------------- t/Amavis/ZMQTest.pm | 63 -- t/Amavis/ZMQTest.t | 4 4 files changed, 1723 deletions(-) --- a/bin/amavisd-snmp-subagent-zmq +++ /dev/null @@ -1,1260 +0,0 @@ -#!/usr/bin/perl -T -# SPDX-License-Identifier: BSD-2-Clause - -#------------------------------------------------------------------------------ -# This program implements an SNMP AgentX (RFC 2741) subagent for amavis. -# -# Author: Mark Martinec -# -# Copyright (c) 2012-2014, Mark Martinec -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright notice, -# this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright notice, -# this list of conditions and the following disclaimer in the documentation -# and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS -# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -# POSSIBILITY OF SUCH DAMAGE. -# -# The views and conclusions contained in the software and documentation are -# those of the authors and should not be interpreted as representing official -# policies, either expressed or implied, of the Jozef Stefan Institute. - -# (the above license is the 2-clause BSD license, also known as -# a "Simplified BSD License", and pertains to this program only) -# -# Patches and problem reports are welcome. -# The latest version of this program is available at: -# http://www.ijs.si/software/amavisd/ -#------------------------------------------------------------------------------ - -package AmavisAgent; - -use strict; -use re 'taint'; -use warnings; -use warnings FATAL => qw(utf8 void); -no warnings 'uninitialized'; - -use Errno qw(ESRCH ENOENT EACCES EEXIST); -use POSIX (); -use Time::HiRes (); -use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_CREAT O_EXCL); -use Unix::Syslog qw(:macros :subs); - -use NetSNMP::OID; -use NetSNMP::ASN qw(:all); -use NetSNMP::default_store qw(:all); -use NetSNMP::agent qw(:all); -use NetSNMP::agent::default_store (':all'); - -use vars qw($VERSION); $VERSION = 2.008002; - -use vars qw($myversion $myproduct_name $myversion_id $myversion_date); -use vars qw($syslog_ident $syslog_facility $log_level); -use vars qw($zmq_ctx $zmq_sock $snmp_sock_specs $agentx_sock_specs); - -$myproduct_name = 'amavis-agentx'; -$myversion_id = '2.9.0'; $myversion_date = '20140506'; -$myversion = "$myproduct_name-$myversion_id ($myversion_date)"; -my $agent_name = $myproduct_name; - - -### USER CONFIGURABLE: - -$log_level = 0; # 0..5 -$syslog_facility = LOG_MAIL; -$syslog_ident = $myproduct_name; - -# The $snmp_sock_specs is a specification of a ZMQ socket to which -# this program will establish a ZMQ connection and receive data from. -# Syntax is whatever zmq_connect() accepts. Is should match a socket -# specification of the same name in amavis-services. -# -$snmp_sock_specs = "tcp://127.0.0.1:23233"; - -# The $agentx_sock_specs is a socket specification in a syntax accepted -# by net-snmp agentx library (the NETSNMP_DS_AGENT_X_SOCKET setting). -# It specifies a socket (typically listened to by a snmpd process) to -# which this program will connect to using AgentX protocol. When net-snmp -# is used as a SNMP server, $agentx_sock_specs should match the -# socket specification agentXSocket in snmpd.conf. Typical choices are -# '/var/agentx/master' or 'tcp:localhost:705' or 'tcp6:localhost:705'. -# An undefined value lets the agentx library pick a default. -# -$agentx_sock_specs = "tcp6:localhost:705"; - - -### END OF USER CONFIGURABLE - - -package AmavisVariable; - -sub new { my($class) = @_; bless [(undef) x 8], $class } -sub oid { my $self = shift; !@_ ? $self->[0] : ($self->[0]=shift) } -sub oidstr { my $self = shift; !@_ ? $self->[1] : ($self->[1]=shift) } -sub name { my $self = shift; !@_ ? $self->[2] : ($self->[2]=shift) } -sub type { my $self = shift; !@_ ? $self->[3] : ($self->[3]=shift) } -sub mytype { my $self = shift; !@_ ? $self->[4] : ($self->[4]=shift) } -sub suffix { my $self = shift; !@_ ? $self->[5] : ($self->[5]=shift) } -sub value { my $self = shift; !@_ ? $self->[6] : ($self->[6]=shift) } -sub next { my $self = shift; !@_ ? $self->[7] : ($self->[7]=shift) } - - -package AmavisAgent; - -use vars qw($mta_queue_dir @age_slots %variables); -use vars qw($top @databases %oidstr_to_obj @oid_sorted_list); -use vars qw(%asn_name_to_type %is_a_numeric_asn_type %asn_type_to_full_name); -use vars qw($syslog_open); - -BEGIN { - -# geometic progression, rounded, -# common ratio = exp((ln(60)-ln(1))/6) = 1.97860 - @age_slots = ( - 0.1, 0.2, 0.5, - 1, 2, 4, 8, 15, 30, # seconds - 1*60, 2*60, 4*60, 8*60, 15*60, 30*60, # minutes - 1*3600, 2*3600, 4*3600, 8*3600, 15*3600, 30*3600); # hours - - %asn_name_to_type = ( - 'C32' => ASN_COUNTER, - 'C64' => ASN_COUNTER64, - 'G32' => ASN_GAUGE, - 'INT' => ASN_INTEGER, - 'I64' => ASN_INTEGER64, - 'U32' => ASN_UNSIGNED, - 'U64' => ASN_UNSIGNED64, - 'STR' => ASN_OCTET_STR, - 'OID' => ASN_OBJECT_ID, - 'TIM' => ASN_TIMETICKS, - ); - - %is_a_numeric_asn_type = ( - ASN_COUNTER, 1, - ASN_COUNTER64, 1, - ASN_GAUGE, 1, - ASN_INTEGER, 1, - ASN_INTEGER64, 1, - ASN_UNSIGNED, 1, - ASN_UNSIGNED64, 1, - ASN_TIMETICKS, 1, - ); - - %asn_type_to_full_name = ( - ASN_COUNTER, 'Counter32', - ASN_COUNTER64, 'Counter64', - ASN_GAUGE, 'Gauge32', - ASN_INTEGER, 'Integer32', - # 'IpAddress', - ASN_INTEGER64, 'Integer64', - ASN_UNSIGNED, 'Unsigned32', - ASN_UNSIGNED64, 'Unsigned64', - ASN_OCTET_STR, 'DisplayString', - ASN_OBJECT_ID, 'OBJECT IDENTIFIER', - ASN_TIMETICKS, 'TimeTicks', - ); - - $top = '1.3.6.1.4.1.15312.2.1'; - @databases = ( - { root_oid_str => "$top.1", name => 'am.snmp', ttl => 4 }, - { root_oid_str => "$top.2", name => 'am.nanny', ttl => 4 }, - { root_oid_str => "$top.3.1.1", name => 'pf.maildrop', - file => 'maildrop', ttl => 18 }, - { root_oid_str => "$top.3.1.2", name => 'pf.incoming', - file => 'incoming', ttl => 18 }, - { root_oid_str => "$top.3.1.3", name => 'pf.active', - file => 'active', ttl => 18 }, - { root_oid_str => "$top.3.1.4", name => 'pf.deferred', - file => 'deferred', ttl => 18 }, - ); - # 1.3.6.1.4.1.15312 enterprises . Jozef Stefan Institute - # 1.3.6.1.4.1.15312.2 amavis - # 1.3.6.1.4.1.15312.2.1 amavis SNMP - # 1.3.6.1.4.1.15312.2.1.1 amavis Statistics - # 1.3.6.1.4.1.15312.2.1.2 amavis Process status - # 1.3.6.1.4.1.15312.2.1.3 amavis (a view into MTA queue sizes) - # 1.3.6.1.4.1.15312.2.2 amavis LDAP Elements - -} # BEGIN - -sub declare_variable($$;$$$) { - my($oid_str,$name, $typename,$instance_lo,$instance_hi) = @_; - $typename = 'C32' if !defined $typename; - $instance_lo = 0 if !defined $instance_lo; - $instance_hi = $instance_lo if !defined $instance_hi; - $instance_hi = $instance_lo if $instance_hi < $instance_lo; - my $type = $asn_name_to_type{$typename}; - for my $ind ($instance_lo .. $instance_hi) { - my $full_oid_str = sprintf("%s.%d", $oid_str,$ind); - # do_log(5, "declaring variable %s, %s", $full_oid_str, $name); - my $var = AmavisVariable->new; - $var->oidstr($full_oid_str); - # $var->oid(NetSNMP::OID->new($full_oid_str)); # later - $var->type($type); - $var->mytype($typename); - # $var->suffix($suffix); - $var->name("$name.$ind"); - if (!exists $variables{"$name.$ind"}) { - $variables{"$name.$ind"} = $var; - } else { - # allow a variable name to map to multiple SNMP variables - if (ref $variables{"$name.$ind"} ne 'ARRAY') { - $variables{"$name.$ind"} = [ $variables{"$name.$ind"} ]; - } - push(@{$variables{"$name.$ind"}}, $var); - } - } -} - -BEGIN { - - { # amavisd statistics MIB - my $r = $databases[0]->{root_oid_str}; - declare_variable("$r.1.1", 'sysDescr', 'STR'); - declare_variable("$r.1.2", 'sysObjectID', 'OID'); - declare_variable("$r.1.3", 'sysUpTime', 'TIM'); - declare_variable("$r.1.4", 'sysContact', 'STR'); - declare_variable("$r.1.5", 'sysName', 'STR'); - declare_variable("$r.1.6", 'sysLocation', 'STR'); - declare_variable("$r.1.7", 'sysServices', 'INT'); - - declare_variable("$r.2.1", 'InMsgs'); # orig=x locl=x - declare_variable("$r.2.2", 'InMsgsInbound'); # orig=0 locl=1 - declare_variable("$r.2.3", 'InMsgsOutbound'); # orig=1 locl=0 - declare_variable("$r.2.4", 'InMsgsInternal'); # orig=1 locl=1 - declare_variable("$r.2.5", 'InMsgsOriginating'); # orig=1 locl=x - declare_variable("$r.2.6", 'InMsgsOpenRelay'); # orig=0 locl=0 - - # these have duplicates at $r.{19..26}.1, except InMsgsStatusRelayed - declare_variable("$r.2.7", 'InMsgsStatusAccepted'); # 2xx, AM.PDP - declare_variable("$r.2.8", 'InMsgsStatusRelayed'); # 2xx, forward - declare_variable("$r.2.9", 'InMsgsStatusDiscarded'); # 2xx, no DSN - declare_variable("$r.2.10", 'InMsgsStatusNoBounce'); # 2xx, no DSN - declare_variable("$r.2.11", 'InMsgsStatusBounced'); # 2xx, DSN sent - declare_variable("$r.2.12", 'InMsgsStatusRejected'); # 5xx - declare_variable("$r.2.13", 'InMsgsStatusTempFailed'); # 4xx - - declare_variable("$r.3.1", 'InMsgsSize', 'C64'); - declare_variable("$r.3.2", 'InMsgsSizeInbound', 'C64'); - declare_variable("$r.3.3", 'InMsgsSizeOutbound', 'C64'); - declare_variable("$r.3.4", 'InMsgsSizeInternal', 'C64'); - declare_variable("$r.3.5", 'InMsgsSizeOriginating', 'C64'); - declare_variable("$r.3.6", 'InMsgsSizeOpenRelay', 'C64'); - - declare_variable("$r.4.1", 'InMsgsRecips'); # orig=x locl=x - declare_variable("$r.4.2", 'InMsgsRecipsInbound'); # orig=0 locl=1 - declare_variable("$r.4.3", 'InMsgsRecipsOutbound'); # orig=1 locl=0 - declare_variable("$r.4.4", 'InMsgsRecipsInternal'); # orig=1 locl=1 - declare_variable("$r.4.5", 'InMsgsRecipsOriginating'); # orig=1 locl=x - declare_variable("$r.4.6", 'InMsgsRecipsOpenRelay'); # orig=0 locl=0 - declare_variable("$r.4.7", 'InMsgsRecipsLocal'); # orig=x locl=1 - - declare_variable("$r.5.1", 'InMsgsBounce'); - declare_variable("$r.5.2", 'InMsgsBounceNullRPath'); - declare_variable("$r.5.3", 'InMsgsBounceKilled'); - declare_variable("$r.5.4", 'InMsgsBounceUnverifiable'); - declare_variable("$r.5.5", 'InMsgsBounceRescuedByDomain'); - declare_variable("$r.5.6", 'InMsgsBounceRescuedByOriginating'); - declare_variable("$r.5.7", 'InMsgsBounceRescuedByPenPals'); - - declare_variable("$r.6.1", 'OutMsgs'); - declare_variable("$r.6.2", 'OutMsgsRelay'); - declare_variable("$r.6.3", 'OutMsgsSubmit'); - declare_variable("$r.6.4", 'OutMsgsSubmitQuar'); - declare_variable("$r.6.5", 'OutMsgsSubmitDsn'); - declare_variable("$r.6.6", 'OutMsgsSubmitNotif'); - declare_variable("$r.6.7", 'OutMsgsSubmitAV'); - declare_variable("$r.6.8", 'OutMsgsSubmitArf'); - declare_variable("$r.6.9", 'OutMsgsProtoLocal'); - declare_variable("$r.6.10", 'OutMsgsProtoLocalRelay'); - declare_variable("$r.6.11", 'OutMsgsProtoLocalSubmit'); - declare_variable("$r.6.12", 'OutMsgsProtoSMTP'); - declare_variable("$r.6.13", 'OutMsgsProtoSMTPRelay'); - declare_variable("$r.6.14", 'OutMsgsProtoSMTPSubmit'); - declare_variable("$r.6.15", 'OutMsgsProtoLMTP'); - declare_variable("$r.6.16", 'OutMsgsProtoLMTPRelay'); - declare_variable("$r.6.17", 'OutMsgsProtoLMTPSubmit'); - declare_variable("$r.6.18", 'OutMsgsProtoBSMTP'); - declare_variable("$r.6.19", 'OutMsgsProtoBSMTPRelay'); - declare_variable("$r.6.20", 'OutMsgsProtoBSMTPSubmit'); - declare_variable("$r.6.21", 'OutMsgsProtoPipe'); - declare_variable("$r.6.22", 'OutMsgsProtoPipeRelay'); - declare_variable("$r.6.23", 'OutMsgsProtoPipeSubmit'); - declare_variable("$r.6.24", 'OutMsgsProtoSQL'); - declare_variable("$r.6.25", 'OutMsgsProtoSQLRelay'); - declare_variable("$r.6.26", 'OutMsgsProtoSQLSubmit'); - declare_variable("$r.6.27", 'OutMsgsDelivers'); # 2xx - declare_variable("$r.6.28", 'OutMsgsAttemptFails'); # 4xx - declare_variable("$r.6.29", 'OutMsgsRejects'); # 5xx - - declare_variable("$r.7.1", 'OutMsgsSize', 'C64'); - declare_variable("$r.7.2", 'OutMsgsSizeRelay', 'C64'); - declare_variable("$r.7.3", 'OutMsgsSizeSubmit', 'C64'); - declare_variable("$r.7.4", 'OutMsgsSizeSubmitQuar', 'C64'); - declare_variable("$r.7.5", 'OutMsgsSizeSubmitDsn', 'C64'); - declare_variable("$r.7.6", 'OutMsgsSizeSubmitNotif', 'C64'); - declare_variable("$r.7.7", 'OutMsgsSizeSubmitAV', 'C64'); - declare_variable("$r.7.8", 'OutMsgsSizeSubmitArf', 'C64'); - declare_variable("$r.7.9", 'OutMsgsSizeProtoLocal', 'C64'); - declare_variable("$r.7.10", 'OutMsgsSizeProtoLocalRelay', 'C64'); - declare_variable("$r.7.11", 'OutMsgsSizeProtoLocalSubmit','C64'); - declare_variable("$r.7.12", 'OutMsgsSizeProtoSMTP', 'C64'); - declare_variable("$r.7.13", 'OutMsgsSizeProtoSMTPRelay', 'C64'); - declare_variable("$r.7.14", 'OutMsgsSizeProtoSMTPSubmit', 'C64'); - declare_variable("$r.7.15", 'OutMsgsSizeProtoLMTP', 'C64'); - declare_variable("$r.7.16", 'OutMsgsSizeProtoLMTPRelay', 'C64'); - declare_variable("$r.7.17", 'OutMsgsSizeProtoLMTPSubmit', 'C64'); - declare_variable("$r.7.18", 'OutMsgsSizeProtoBSMTP', 'C64'); - declare_variable("$r.7.19", 'OutMsgsSizeProtoBSMTPRelay', 'C64'); - declare_variable("$r.7.20", 'OutMsgsSizeProtoBSMTPSubmit','C64'); - declare_variable("$r.7.21", 'OutMsgsSizeProtoPipe', 'C64'); - declare_variable("$r.7.22", 'OutMsgsSizeProtoPipeRelay', 'C64'); - declare_variable("$r.7.23", 'OutMsgsSizeProtoPipeSubmit', 'C64'); - declare_variable("$r.7.24", 'OutMsgsSizeProtoSQL', 'C64'); - declare_variable("$r.7.25", 'OutMsgsSizeProtoSQLRelay', 'C64'); - declare_variable("$r.7.26", 'OutMsgsSizeProtoSQLSubmit', 'C64'); - - declare_variable("$r.8.1", 'QuarMsgs'); - declare_variable("$r.8.2", 'QuarMsgsArch'); - declare_variable("$r.8.3", 'QuarMsgsClean'); - declare_variable("$r.8.4", 'QuarMsgsMtaFailed'); - declare_variable("$r.8.5", 'QuarMsgsOversized'); - declare_variable("$r.8.6", 'QuarMsgsBadHdr'); - declare_variable("$r.8.7", 'QuarMsgsSpammy'); - declare_variable("$r.8.8", 'QuarMsgsSpam'); - declare_variable("$r.8.9", 'QuarMsgsUnchecked'); - declare_variable("$r.8.10", 'QuarMsgsBanned'); - declare_variable("$r.8.11", 'QuarMsgsVirus'); - declare_variable("$r.8.12", 'QuarAttemptTempFails'); - declare_variable("$r.8.13", 'QuarAttemptFails'); - - declare_variable("$r.9.1", 'QuarMsgsSize', 'C64'); - declare_variable("$r.9.2", 'QuarMsgsSizeArch', 'C64'); - declare_variable("$r.9.3", 'QuarMsgsSizeClean', 'C64'); - declare_variable("$r.9.4", 'QuarMsgsSizeMtaFailed', 'C64'); - declare_variable("$r.9.5", 'QuarMsgsSizeOversized', 'C64'); - declare_variable("$r.9.6", 'QuarMsgsSizeBadHdr', 'C64'); - declare_variable("$r.9.7", 'QuarMsgsSizeSpammy', 'C64'); - declare_variable("$r.9.8", 'QuarMsgsSizeSpam', 'C64'); - declare_variable("$r.9.9", 'QuarMsgsSizeUnchecked', 'C64'); - declare_variable("$r.9.10", 'QuarMsgsSizeBanned', 'C64'); - declare_variable("$r.9.11", 'QuarMsgsSizeVirus', 'C64'); - - declare_variable("$r.10.1.1", 'ContentCleanMsgs'); - declare_variable("$r.10.1.2", 'ContentCleanMsgsInbound'); - declare_variable("$r.10.1.3", 'ContentCleanMsgsOutbound'); - declare_variable("$r.10.1.4", 'ContentCleanMsgsInternal'); - declare_variable("$r.10.1.5", 'ContentCleanMsgsOriginating'); - declare_variable("$r.10.1.6", 'ContentCleanMsgsOpenRelay'); - - declare_variable("$r.10.2.1", 'ContentMtaFailedMsgs'); - declare_variable("$r.10.2.2", 'ContentMtaFailedMsgsInbound'); - declare_variable("$r.10.2.3", 'ContentMtaFailedMsgsOutbound'); - declare_variable("$r.10.2.4", 'ContentMtaFailedMsgsInternal'); - declare_variable("$r.10.2.5", 'ContentMtaFailedMsgsOriginating'); - declare_variable("$r.10.2.6", 'ContentMtaFailedMsgsOpenRelay'); - - declare_variable("$r.10.3.1", 'ContentOversizedMsgs'); - declare_variable("$r.10.3.2", 'ContentOversizedMsgsInbound'); - declare_variable("$r.10.3.3", 'ContentOversizedMsgsOutbound'); - declare_variable("$r.10.3.4", 'ContentOversizedMsgsInternal'); - declare_variable("$r.10.3.5", 'ContentOversizedMsgsOriginating'); - declare_variable("$r.10.3.6", 'ContentOversizedMsgsOpenRelay'); - - declare_variable("$r.10.4.1", 'ContentBadHdrMsgs'); - declare_variable("$r.10.4.2", 'ContentBadHdrMsgsInbound'); - declare_variable("$r.10.4.3", 'ContentBadHdrMsgsOutbound'); - declare_variable("$r.10.4.4", 'ContentBadHdrMsgsInternal'); - declare_variable("$r.10.4.5", 'ContentBadHdrMsgsOriginating'); - declare_variable("$r.10.4.6", 'ContentBadHdrMsgsOpenRelay'); - - declare_variable("$r.10.5.1", 'ContentSpammyMsgs'); - declare_variable("$r.10.5.2", 'ContentSpammyMsgsInbound'); - declare_variable("$r.10.5.3", 'ContentSpammyMsgsOutbound'); - declare_variable("$r.10.5.4", 'ContentSpammyMsgsInternal'); - declare_variable("$r.10.5.5", 'ContentSpammyMsgsOriginating'); - declare_variable("$r.10.5.6", 'ContentSpammyMsgsOpenRelay'); - - declare_variable("$r.10.6.1", 'ContentSpamMsgs'); - declare_variable("$r.10.6.2", 'ContentSpamMsgsInbound'); - declare_variable("$r.10.6.3", 'ContentSpamMsgsOutbound'); - declare_variable("$r.10.6.4", 'ContentSpamMsgsInternal'); - declare_variable("$r.10.6.5", 'ContentSpamMsgsOriginating'); - declare_variable("$r.10.6.6", 'ContentSpamMsgsOpenRelay'); - - declare_variable("$r.10.7.1", 'ContentUncheckedMsgs'); - declare_variable("$r.10.7.2", 'ContentUncheckedMsgsInbound'); - declare_variable("$r.10.7.3", 'ContentUncheckedMsgsOutbound'); - declare_variable("$r.10.7.4", 'ContentUncheckedMsgsInternal'); - declare_variable("$r.10.7.5", 'ContentUncheckedMsgsOriginating'); - declare_variable("$r.10.7.6", 'ContentUncheckedMsgsOpenRelay'); - - declare_variable("$r.10.8.1", 'ContentBannedMsgs'); - declare_variable("$r.10.8.2", 'ContentBannedMsgsInbound'); - declare_variable("$r.10.8.3", 'ContentBannedMsgsOutbound'); - declare_variable("$r.10.8.4", 'ContentBannedMsgsInternal'); - declare_variable("$r.10.8.5", 'ContentBannedMsgsOriginating'); - declare_variable("$r.10.8.6", 'ContentBannedMsgsOpenRelay'); - - declare_variable("$r.10.9.1", 'ContentVirusMsgs'); - declare_variable("$r.10.9.2", 'ContentVirusMsgsInbound'); - declare_variable("$r.10.9.3", 'ContentVirusMsgsOutbound'); - declare_variable("$r.10.9.4", 'ContentVirusMsgsInternal'); - declare_variable("$r.10.9.5", 'ContentVirusMsgsOriginating'); - declare_variable("$r.10.9.6", 'ContentVirusMsgsOpenRelay'); - - declare_variable("$r.11.1", 'CacheAttempts'); - declare_variable("$r.11.2", 'CacheMisses'); - declare_variable("$r.11.3", 'CacheHits'); - declare_variable("$r.11.4", 'CacheHitsVirusCheck'); - declare_variable("$r.11.5", 'CacheHitsVirusMsgs'); - declare_variable("$r.11.6", 'OutConnNew'); - declare_variable("$r.11.7", 'OutConnQuit'); - declare_variable("$r.11.8", 'OutConnTransact'); - declare_variable("$r.11.9", 'OutConnReuseFail'); - declare_variable("$r.11.10", 'OutConnReuseRecent'); - declare_variable("$r.11.11", 'OutConnReuseRefreshed'); - - declare_variable("$r.12.1", 'OpsDec'); - declare_variable("$r.12.2", 'OpsSpamCheck'); - declare_variable("$r.12.3", 'OpsVirusCheck'); - - declare_variable("$r.13.1", 'PenPalsAttempts'); - declare_variable("$r.13.2", 'PenPalsAttemptsRid'); - declare_variable("$r.13.3", 'PenPalsAttemptsMid'); - declare_variable("$r.13.4", 'PenPalsMisses'); - declare_variable("$r.13.5", 'PenPalsHits'); - declare_variable("$r.13.6", 'PenPalsHitsRid'); - declare_variable("$r.13.7", 'PenPalsHitsMid'); - declare_variable("$r.13.8", 'PenPalsHitsMidRid'); - declare_variable("$r.13.9", 'PenPalsSavedFromTag2'); - declare_variable("$r.13.10", 'PenPalsSavedFromTag3'); - declare_variable("$r.13.11", 'PenPalsSavedFromKill'); - - declare_variable("$r.14.1", 'SqlAddrSenderAttempts'); - declare_variable("$r.14.2", 'SqlAddrSenderMisses'); - declare_variable("$r.14.3", 'SqlAddrSenderHits'); - declare_variable("$r.14.4", 'SqlAddrRecipAttempts'); - declare_variable("$r.14.5", 'SqlAddrRecipMisses'); - declare_variable("$r.14.6", 'SqlAddrRecipHits'); - - declare_variable("$r.15.1", 'LogEntries', 'C64'); - declare_variable("$r.15.2", 'LogEntriesEmerg', 'C64'); - declare_variable("$r.15.3", 'LogEntriesAlert', 'C64'); - declare_variable("$r.15.4", 'LogEntriesCrit', 'C64'); # lvl le -3 - declare_variable("$r.15.5", 'LogEntriesErr', 'C64'); # lvl le -2 - declare_variable("$r.15.6", 'LogEntriesWarning', 'C64'); # lvl le -1 - declare_variable("$r.15.7", 'LogEntriesNotice', 'C64'); # lvl le 0 - declare_variable("$r.15.8", 'LogEntriesInfo', 'C64'); # lvl le 1 - declare_variable("$r.15.9", 'LogEntriesDebug', 'C64'); # lvl le 2 - declare_variable("$r.15.10", 'LogEntriesLevel0', 'C64'); # le 0 - declare_variable("$r.15.11", 'LogEntriesLevel1', 'C64'); # eq 1 - declare_variable("$r.15.12", 'LogEntriesLevel2', 'C64'); # eq 2 - declare_variable("$r.15.13", 'LogEntriesLevel3', 'C64'); # eq 3 - declare_variable("$r.15.14", 'LogEntriesLevel4', 'C64'); # eq 4 - declare_variable("$r.15.15", 'LogEntriesLevel5', 'C64'); # ge 5 - declare_variable("$r.15.16", 'LogLines', 'C64'); - declare_variable("$r.15.17", 'LogRetries', 'C64'); - - declare_variable("$r.16.1", 'TimeElapsedTotal', 'INT'); - declare_variable("$r.16.2", 'TimeElapsedReceiving', 'INT'); - declare_variable("$r.16.3", 'TimeElapsedSending', 'INT'); - declare_variable("$r.16.4", 'TimeElapsedDecoding', 'INT'); - declare_variable("$r.16.5", 'TimeElapsedPenPals', 'INT'); - declare_variable("$r.16.6", 'TimeElapsedVirusCheck','INT'); - declare_variable("$r.16.7", 'TimeElapsedSpamCheck', 'INT'); - - declare_variable("$r.17.1", 'UserCounter1', 'C64'); - declare_variable("$r.17.2", 'UserCounter2', 'C64'); - declare_variable("$r.17.3", 'UserCounter3', 'C64'); - declare_variable("$r.17.4", 'UserCounter4', 'C64'); - declare_variable("$r.17.5", 'UserCounter5', 'C64'); - declare_variable("$r.17.6", 'UserCounter6', 'C64'); - declare_variable("$r.17.7", 'UserCounter7', 'C64'); - declare_variable("$r.17.8", 'UserCounter8', 'C64'); - declare_variable("$r.17.9", 'UserCounter9', 'C64'); - declare_variable("$r.17.10", 'UserCounter10', 'C64'); - - declare_variable("$r.18.1", 'UserGauge1', 'G32'); - declare_variable("$r.18.2", 'UserGauge2', 'G32'); - declare_variable("$r.18.3", 'UserGauge3', 'G32'); - declare_variable("$r.18.4", 'UserGauge4', 'G32'); - declare_variable("$r.18.5", 'UserGauge5', 'G32'); - declare_variable("$r.18.6", 'UserGauge6', 'G32'); - declare_variable("$r.18.7", 'UserGauge7', 'G32'); - declare_variable("$r.18.8", 'UserGauge8', 'G32'); - declare_variable("$r.18.9", 'UserGauge9', 'G32'); - declare_variable("$r.18.10", 'UserGauge10', 'G32'); - - declare_variable("$r.19.1", 'InMsgsStatusAccepted'); # 2xx, AM.PDP - declare_variable("$r.19.2", 'InMsgsStatusAcceptedInbound'); - declare_variable("$r.19.3", 'InMsgsStatusAcceptedOutbound'); - declare_variable("$r.19.4", 'InMsgsStatusAcceptedInternal'); - declare_variable("$r.19.5", 'InMsgsStatusAcceptedOriginating'); - declare_variable("$r.19.6", 'InMsgsStatusAcceptedOpenRelay'); - - declare_variable("$r.20.1", 'InMsgsStatusRelayedUntagged'); # 2xx, fwd - declare_variable("$r.20.2", 'InMsgsStatusRelayedUntaggedInbound'); - declare_variable("$r.20.3", 'InMsgsStatusRelayedUntaggedOutbound'); - declare_variable("$r.20.4", 'InMsgsStatusRelayedUntaggedInternal'); - declare_variable("$r.20.5", 'InMsgsStatusRelayedUntaggedOriginating'); - declare_variable("$r.20.6", 'InMsgsStatusRelayedUntaggedOpenRelay'); - - declare_variable("$r.21.1", 'InMsgsStatusRelayedTagged'); # 2xx, forward - declare_variable("$r.21.2", 'InMsgsStatusRelayedTaggedInbound'); - declare_variable("$r.21.3", 'InMsgsStatusRelayedTaggedOutbound'); - declare_variable("$r.21.4", 'InMsgsStatusRelayedTaggedInternal'); - declare_variable("$r.21.5", 'InMsgsStatusRelayedTaggedOriginating'); - declare_variable("$r.21.6", 'InMsgsStatusRelayedTaggedOpenRelay'); - - declare_variable("$r.22.1", 'InMsgsStatusDiscarded'); # 2xx, no DSN - declare_variable("$r.22.2", 'InMsgsStatusDiscardedInbound'); - declare_variable("$r.22.3", 'InMsgsStatusDiscardedOutbound'); - declare_variable("$r.22.4", 'InMsgsStatusDiscardedInternal'); - declare_variable("$r.22.5", 'InMsgsStatusDiscardedOriginating'); - declare_variable("$r.22.6", 'InMsgsStatusDiscardedOpenRelay'); - - declare_variable("$r.23.1", 'InMsgsStatusNoBounce'); # 2xx, no DSN - declare_variable("$r.23.2", 'InMsgsStatusNoBounceInbound'); - declare_variable("$r.23.3", 'InMsgsStatusNoBounceOutbound'); - declare_variable("$r.23.4", 'InMsgsStatusNoBounceInternal'); - declare_variable("$r.23.5", 'InMsgsStatusNoBounceOriginating'); - declare_variable("$r.23.6", 'InMsgsStatusNoBounceOpenRelay'); - - declare_variable("$r.24.1", 'InMsgsStatusBounced'); # 2xx, DSN sent - declare_variable("$r.24.2", 'InMsgsStatusBouncedInbound'); - declare_variable("$r.24.3", 'InMsgsStatusBouncedOutbound'); - declare_variable("$r.24.4", 'InMsgsStatusBouncedInternal'); - declare_variable("$r.24.5", 'InMsgsStatusBouncedOriginating'); - declare_variable("$r.24.6", 'InMsgsStatusBouncedOpenRelay'); - - declare_variable("$r.25.1", 'InMsgsStatusRejected'); # 5xx - declare_variable("$r.25.2", 'InMsgsStatusRejectedInbound'); - declare_variable("$r.25.3", 'InMsgsStatusRejectedOutbound'); - declare_variable("$r.25.4", 'InMsgsStatusRejectedInternal'); - declare_variable("$r.25.5", 'InMsgsStatusRejectedOriginating'); - declare_variable("$r.25.6", 'InMsgsStatusRejectedOpenRelay'); - - declare_variable("$r.26.1", 'InMsgsStatusTempFailed'); # 4xx - declare_variable("$r.26.2", 'InMsgsStatusTempFailedInbound'); - declare_variable("$r.26.3", 'InMsgsStatusTempFailedOutbound'); - declare_variable("$r.26.4", 'InMsgsStatusTempFailedInternal'); - declare_variable("$r.26.5", 'InMsgsStatusTempFailedOriginating'); - declare_variable("$r.26.6", 'InMsgsStatusTempFailedOpenRelay'); - } - - { # amavisd child processes MIB - my $r = $databases[1]->{root_oid_str}; - declare_variable("$r.1.1", 'ProcGone'); # counter! - declare_variable("$r.1.2", 'ProcAll', 'G32'); - declare_variable("$r.1.3", 'ProcIdle', 'G32'); - declare_variable("$r.1.4", 'ProcBusy', 'G32'); - declare_variable("$r.1.5", 'ProcBusyTransfer', 'G32'); - declare_variable("$r.1.6", 'ProcBusyDecode', 'G32'); - declare_variable("$r.1.7", 'ProcBusyVirus', 'G32'); - declare_variable("$r.1.8", 'ProcBusySpam', 'G32'); - declare_variable("$r.1.9", 'ProcBusyOther', 'G32'); - declare_variable(sprintf("%s.2.%d", $r,$_+1), - 'ProcBusy'.$_, 'G32') for (0..@age_slots); - } -} # BEGIN - -use vars qw($zmq_mod_name $zmq_mod_version $zmq_lib_version); -BEGIN { - my($zmq_major, $zmq_minor, $zmq_patch); - if (eval { require ZMQ::LibZMQ3 && require ZMQ::Constants }) { - $zmq_mod_name = 'ZMQ::LibZMQ3'; # new interface module to zmq v3 or libxs - import ZMQ::LibZMQ3; import ZMQ::Constants qw(:all); - ($zmq_major, $zmq_minor, $zmq_patch) = ZMQ::LibZMQ3::zmq_version(); - # *zmq_sendmsg [native] # (socket,msgobj,flags) - # *zmq_recvmsg [native] # (socket,flags) -> msgobj - *zmq_sendstr = sub { # (socket,string,flags) - my $rv = zmq_send($_[0], $_[1], length $_[1], $_[2]||0); - $rv == -1 ? undef : $rv; - }; - } elsif (eval { require ZMQ::LibZMQ2 && require ZMQ::Constants }) { - $zmq_mod_name = 'ZMQ::LibZMQ2'; # new interface module to zmq v2 - import ZMQ::LibZMQ2; import ZMQ::Constants qw(:all); - ($zmq_major, $zmq_minor, $zmq_patch) = ZMQ::LibZMQ2::zmq_version(); - # zmq v2/v3 incompatibile renaming - *zmq_sendmsg = \&ZMQ::LibZMQ2::zmq_send; # (socket,msgobj,flags) - *zmq_recvmsg = \&ZMQ::LibZMQ2::zmq_recv; # (socket,flags) -> msgobj - *zmq_sendstr = sub { # (socket,string,flags) - my $rv = zmq_send(@_); $rv == -1 ? undef : $rv; - }; - } elsif (eval { require ZeroMQ::Constants && require ZeroMQ::Raw }) { - $zmq_mod_name = 'ZeroMQ'; # old interface module to zmq v2 - import ZeroMQ::Raw; import ZeroMQ::Constants qw(:all); - ($zmq_major, $zmq_minor, $zmq_patch) = ZeroMQ::version(); - # zmq v2/v3 incompatibile renaming - *zmq_sendmsg = \&ZeroMQ::Raw::zmq_send; # (socket,msgobj,flags) - *zmq_recvmsg = \&ZeroMQ::Raw::zmq_recv; # (socket,flags) -> msgobj - *zmq_sendstr = sub { # (socket,string,flags) - my $rv = zmq_send(@_); $rv == -1 ? undef : $rv; - }; - } else { - die "Perl modules ZMQ::LibZMQ3 or ZMQ::LibZMQ2 or ZeroMQ not available\n"; - } - $zmq_mod_version = $zmq_mod_name->VERSION; - $zmq_lib_version = join('.', $zmq_major, $zmq_minor, $zmq_patch); - 1; -} - -sub zmq_version { - sprintf("%s %s, lib %s", - $zmq_mod_name, $zmq_mod_version, $zmq_lib_version); -}; - -sub zmq_recvstr { # (socket,buffer,offset) -> (len,more) - my $sock = $_[0]; - my $offset = $_[2] || 0; - my $zm = zmq_recvmsg($sock); # a copy of a received msg obj - if (!$zm) { substr($_[1],$offset) = ''; return } - ($offset ? substr($_[1],$offset) : $_[1]) = zmq_msg_data($zm); - my $len = length($_[1]) - $offset; - zmq_msg_close($zm); - return $len if !wantarray; - my $more = zmq_getsockopt($sock, ZMQ_RCVMORE); - if ($more == -1) { substr($_[1],$offset) = ''; return } - ($len, $more); -}; - - -sub do_log($$;@) { -# my($level,$errmsg,@args) = @_; - my $level = shift; - if ($level <= $log_level) { - my $errmsg = shift; - # treat $errmsg as sprintf format string if additional arguments provided - $errmsg = sprintf($errmsg,@_) if @_; - if (!$syslog_open) { - $errmsg .= "\n"; - print STDERR $errmsg; # print ignoring I/O status, except SIGPIPE - } else { - my $prio = $level >= 3 ? LOG_DEBUG # most frequent first - : $level >= 1 ? LOG_INFO - : $level >= 0 ? LOG_NOTICE - : $level >= -1 ? LOG_WARNING - : LOG_ERR; - syslog($prio, "%s", $errmsg); - } - } -} - -# Returns the smallest defined number from the list, or undef -sub min(@) { - my $r = @_ == 1 && ref($_[0]) ? $_[0] : \@_; # accept list, or a list ref - my $m; defined $_ && (!defined $m || $_ < $m) && ($m = $_) for @$r; - $m; -} - -# Returns the largest defined number from the list, or undef -sub max(@) { - my $r = @_ == 1 && ref($_[0]) ? $_[0] : \@_; # accept list, or a list ref - my $m; defined $_ && (!defined $m || $_ > $m) && ($m = $_) for @$r; - $m; -} - -# Return untainted copy of a string (argument can be a string or a string ref) -sub untaint($) { - return undef if !defined $_[0]; # must return undef even in a list context! - no re 'taint'; - local $1; # avoid Perl taint bug: tainted global $1 propagates taintedness - (ref($_[0]) ? ${$_[0]} : $_[0]) =~ /^(.*)\z/s; - $1; -} - -# Send a query to 'amavis-services snmp-responder' and collect a value -# of a queried SNMP variable -# -sub query_zmq_responder_bulk($) { - my($chan) = @_; - do_log(5, "query_zmq_responder_bulk %s", $chan); - defined zmq_sendstr($zmq_sock, $chan.'?') - or die "Error sending a ZMQ message: $!"; - for (;;) { - my($msgstr,$msgstr_l,$more); - ($msgstr_l,$more) = zmq_recvstr($zmq_sock,$msgstr); - if (!defined $msgstr_l) { - do_log(0, "zmq_recvstr failed: %s", $!); - last; - } - my($chan, $key, $type, $val) = split(' ',$msgstr,4); - if ($chan ne 'am.snmp' && $chan ne 'am.nanny') { - do_log(2, "zmq response, wrong channel, got: %s", $msgstr); - last; - } - do_log(5, "query_zmq_responder_bulk: %s got %s", $more?'M':' ', $msgstr); - $val = undef if $val eq '?'; - $type = undef if $type eq '?'; - if (!defined $type) { - do_log(5, "query_zmq_responder NO DATA for %s", $key); - $val = undef; - } else { - $type = 'INT' if $key =~ /^TimeElapsed/ && $type eq 'C32'; - $type = 'TIM' if $key eq 'sysUpTime' && $type eq 'INT'; - } - if ($type eq 'C32' || $type eq 'C64') { # counters - $val = !defined $val ? 0 : 0+$val; - } elsif ($type eq 'STR' || $type eq 'OID') { - $val = '' if !defined $val; - } elsif ($key eq 'sysUpTime') { - if (defined $val) { - my $uptime = Time::HiRes::time - $val; - $val = int($uptime*100); # ticks - } - } elsif ($type =~ /^(?:G32|INT|I64|U32|U64|TIM)\z/) { - $val = !defined $val ? 0 : 0+$val; - } - set_variable_value($key, $val); - last if !$more; - } -} - -sub set_variable_value($$) { - my($name, $value) = @_; - my $instance; local($1,$2); - if ($name =~ /^(.*)\.(\d+)/s) { $name = $1; $instance = $2 } - $instance = "0" if !defined $instance; - my $v = $variables{"$name.$instance"}; - if (!defined($v)) { - do_log(5, "No such variable %s.%s", $name,$instance); - } else { - my(@var) = ref $v eq 'ARRAY' ? @$v : $v; - for my $var (@var) { - my $type = $var->type; - if ($name =~ /^TimeElapsed/) { - $value = int(($value+5)/10); # ms -> 0.01s ticks - } elsif ($type == ASN_COUNTER || $type == ASN_GAUGE || - $type == ASN_INTEGER || $type == ASN_UNSIGNED || - $type == ASN_TIMETICKS) { - $value = 0+$value; - } elsif ($type == ASN_COUNTER64 || $type == ASN_INTEGER64 || - $type == ASN_UNSIGNED64) { - $value = sprintf("%1.0f",$value); - } elsif ($type == ASN_OCTET_STR) { - $value = "$value"; - } - $var->value($value); - } - } -} - -sub reset_all_variable_values($) { - my($root_oid_str) = @_; - while (my($key,$v) = each(%variables)) { - my(@var) = ref $v eq 'ARRAY' ? @$v : $v; - for my $var (@var) { - if (!defined($root_oid_str) || $var->oidstr =~ /^\Q$root_oid_str\E\./) { - $var->value(undef); - } - } - } -} - -sub dump_variables() { - for my $oid (@oid_sorted_list) { - my(@oidlist) = $oid->to_array; - my $oidstr = join('.', @oidlist); - my $descr = ""; - my $suffix_sp = join(' ', @oidlist[9 .. ($#oidlist-1)]); - my $var = $oidstr_to_obj{$oidstr}; - my $mib_type_name = $asn_type_to_full_name{$var->type}; - my $name = $var->name; - $name =~ s/\.0\z//; - printf STDERR (<<'END', $name, $mib_type_name, $descr, $suffix_sp); -%s OBJECT-TYPE - SYNTAX %s - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "%s" - ::= { amavis %s } - -END - } -} - -sub init_data() { - while (my($name,$v) = each(%variables)) { - my(@var) = ref $v eq 'ARRAY' ? @$v : $v; - for my $var (@var) { - my $oidstr = $var->oidstr; - $var->oid(NetSNMP::OID->new($oidstr)); - $oidstr_to_obj{$oidstr} = $var; - } - } - @oid_sorted_list = sort { snmp_oid_compare($a,$b) } - map { $_->oid } - map { ref $_ eq 'ARRAY' ? @$_ : $_ } values(%variables); - # build a linked list of variable objects in OID sorted order - # to speed up sequential MIB traversal by getnext - my $prev_var; - for my $oid (@oid_sorted_list) { - my $oidstr = join('.', $oid->to_array); - my $var = $oidstr_to_obj{$oidstr}; - $prev_var->next($var) if defined $prev_var; - $prev_var = $var; - } -} - -sub count_files_in_postfix_dir($$); # prototype -sub count_files_in_postfix_dir($$) { - my($dir,$deadline) = @_; - local(*DIR); my $f; my $cnt = 0; my $aborted = 0; - if (!opendir(DIR,$dir)) { - do_log(-1, "Can't open directory %s: %s", $dir,$!); - } else { - while (defined($f = readdir(DIR))) { - next if $f eq '.' || $f eq '..'; - # Postfix uses one-character subdirs - if (length($f) == 1 && -d "$dir/$f") { - my($n,$abt) = count_files_in_postfix_dir("$dir/$f", $deadline); - $cnt += $n; - if ($abt) { $aborted = 1; last } - } else { - $cnt++; - } - if (defined $deadline && Time::HiRes::time > $deadline) { - $aborted = 1; last; - } - } - closedir(DIR) or die "Error closing directory $dir: $!"; - } - ($cnt,$aborted); -} - -sub update_data($) { - my($database) = @_; - do_log(3, "updating variables from %s", $database->{name}); - my $start_time = Time::HiRes::time; - if ($database->{name} =~ /^pf/) { - # not really a database, just a 'view' into an MTA spool directory - my $dir = $database->{file}; - my($cnt,$aborted) = - count_files_in_postfix_dir("$mta_queue_dir/$dir", $start_time + 5); - my $var_name = "MtaQueueEntries\u$dir"; - set_variable_value($var_name, $cnt); - do_log(3, "mta queue: %s %d", $var_name,$cnt); - do_log(-1,"exceeded time limit on dir %s, aborted after %.1f s, ". - "count so far: %d", - $var_name, Time::HiRes::time - $start_time, $cnt) if $aborted; - } else { - query_zmq_responder_bulk($database->{name}); - } - - my $now = Time::HiRes::time; - my $elapsed = $now - $start_time; - $elapsed = 0 if $elapsed < 0; # clock jump? - my $ll = $elapsed >= 30 ? -1 : $elapsed >= 5 ? 0 : $elapsed >= 1 ? 2 : 3; - do_log($ll, "updating %s took %.3f s", $database->{name}, $elapsed); - - my $ttl = $database->{ttl}; - $ttl = 1 if !defined $ttl || $ttl < 1; - - if ($database->{name} =~ /^pf/) { - my $ttl_lower_bound = 8*$elapsed; # don't be a hog! - my $since_query = $database->{last_query_timestamp}; - $since_query = $now - $since_query if defined $since_query; - if (defined $since_query && $elapsed > 4) { - # there is a chance that a SNMP client timed out on this query; - # stretch the next update period to allow one quick next response - # from cached data, assuming queries are at about regular intervals - $ttl_lower_bound = max($ttl_lower_bound, 1.5 * $since_query); - } - $ttl_lower_bound = min($ttl_lower_bound, 20*60); # cap at 20 minutes - if ($ttl < $ttl_lower_bound) { - $ttl = $ttl_lower_bound; - do_log(3, "postponing refresh on %s for another %.1f s%s", - $database->{name}, $ttl, - !defined $since_query ? '' - : sprintf(", %.1f s since query", $since_query) ); - } - } - - $database->{last_refreshed} = $now; - $database->{update_due_at} = $now + $ttl; -} - -sub find_next_gt($$) { - my($x, $a_ref) = @_; - my($l, $u) = (0, $#$a_ref); - my $j; - while ($l <= $u) { - $j = $l + int(($u - $l)/2); # good practices: avoids integer overflow - if ($a_ref->[$j] > $x) { $u = $j-1 } else { $l = $j+1 } - } - $l > $#$a_ref ? -1 : $l; -} - -my $fast_poll = 0; -my $last_query_timestamp = 0; -sub snmp_handler($$$$) { - my($handler, $registration_info, $request_info, $requests) = @_; - - my $now = Time::HiRes::time; - my $dt = $now - $last_query_timestamp; - if ($dt < 1.5) { $fast_poll = 1 } elsif ($dt > 4) { $fast_poll = 0 } - $last_query_timestamp = $now; - - my $mode = $request_info->getMode; - for (my $req=$requests; $req; $req=$req->next) { - my $oid_in_request = $req->getOID; # OID from a request - my $actual_oid; my $err; my $eom = 0; - if ($mode == MODE_GET) { - $actual_oid = $oid_in_request; - do_log(5, "Get %s", $oid_in_request); - } elsif ($mode == MODE_GETBULK) { - # never happens, not registered for getbulk - do_log(2, "GetBulk %s", $oid_in_request); - } elsif ($mode == MODE_GETNEXT) { - if (!@oid_sorted_list) { - $eom = 1; # end of MIB - } elsif ($oid_in_request < $oid_sorted_list[0]) { - $actual_oid = $oid_sorted_list[0]; - $req->setOID($actual_oid); - do_log(4, "First: %s -> %s", $oid_in_request,$actual_oid); - } elsif ($oid_in_request > $oid_sorted_list[-1]) { - $eom = 1; # end of MIB - do_log(4, "Last: %s", $oid_in_request); - } else { - # check first for a sequential traversal, likely faster - my $var = $oidstr_to_obj{join('.', $oid_in_request->to_array)}; - if ($var) { - my $next_var = $var->next; - if (!$next_var) { - $eom = 1; # end of MIB - } else { - $actual_oid = $next_var->oid; - $req->setOID($actual_oid); - } - } - if (!$err && !$eom && !defined $actual_oid) { - # fall back to a binary search - do_log(5, "Using a binary search for %s", $oid_in_request); - my $ind = find_next_gt($oid_in_request, \@oid_sorted_list); - if ($ind < 0) { - $eom = 1; # end of MIB - } else { - $actual_oid = $oid_sorted_list[$ind]; - $req->setOID($actual_oid); - } - } - } - do_log(5, "GetNext %s -> %s", $oid_in_request, - !defined $actual_oid ? 'undef' : $actual_oid); - } else { - do_log(0, "Unknown request %s", $oid_in_request); - $req->setError($request_info, SNMP_ERR_NOTWRITABLE); $err = 1; - } - if ($err) { - # already dealt with - } elsif ($eom || !defined $actual_oid) { # end of MIB - # just silently not provide a value - do_log(5, "No more MIB beyond %s", $oid_in_request); - } else { - my $oid_str = join('.', $actual_oid->to_array); - my $var = $oidstr_to_obj{$oid_str}; - if (!$var) { - $req->setError($request_info, SNMP_ERR_NOSUCHNAME); - } else { - my $value; - my($name,$type,$mytype) = ($var->name, $var->type, $var->mytype); - - # find out under which OID root the query falls - for my $database (@databases) { - next if !$database->{registered}; - my $root_oid_str = $database->{root_oid_str}; - if ($oid_str =~ /^\Q$root_oid_str\E\./) { - my $db_name = $database->{name}; - $database->{last_query_timestamp} = $now; - if (!defined($database->{update_due_at}) || - Time::HiRes::time >= - $database->{update_due_at} + ($fast_poll ? 4 : 0) ) { - # fast polling stretches time-to-update a bit, increasing - # chances of collecting consistent data from the same moment - update_data($database); # stale MIB, needs updating - } - $value = $var->value; - } - } - - if (!defined $type) { - $req->setError($request_info, SNMP_ERR_BADVALUE); - } else { - $value = $is_a_numeric_asn_type{$type} ? 0 : "" if !defined $value; - # the NetSNMP::agent agent.xs is too finicky and does not like a - # SVt_PVIV data type for an integer or counter, it only takes SVt_IV - # or a string; work around this limitation - my $status = $req->setValue($type, - $is_a_numeric_asn_type{$type} ? int(0+$value) - : "$value"); - if (!$status) { - do_log(0, "setValue error: %s, %s, %s", $type,$name,$value); - $req->setError($request_info, SNMP_ERR_BADVALUE); - } - } - } - } - } - 1; -} - -sub daemonize() { - closelog() if $syslog_open; - $syslog_open = 0; - - STDOUT->autoflush(1); - STDERR->autoflush(1); - close(STDIN) or die "Can't close STDIN: $!"; - - my $pid; - # the first fork allows the shell to return and allows doing a setsid - eval { $pid = fork(); 1 } - or do { - my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; - die "Error forking #1: $eval_stat"; - }; - defined $pid or die "Can't fork #1: $!"; - if ($pid) { # parent process terminates here - POSIX::_exit(0); # avoid END and destructor processing - } - - # disassociate from a controlling terminal - my $pgid = POSIX::setsid(); - defined $pgid && $pgid >= 0 or die "Can't start a new session: $!"; - - # We are now a session leader. As a session leader, opening a file - # descriptor that is a terminal will make it our controlling terminal. - # The second fork makes us NOT a session leader. Only session leaders - # can acquire a controlling terminal, so we may now open up any file - # we wish without worrying that it will become a controlling terminal. - - # second fork prevents from accidentally reacquiring a controlling terminal - eval { $pid = fork(); 1 } - or do { - my($eval_stat) = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; - die "Error forking #2: $eval_stat"; - }; - defined $pid or die "Can't fork #2: $!"; - if ($pid) { # parent process terminates here - POSIX::_exit(0); # avoid END and destructor processing - } - - chdir('/') or die "Can't chdir to '/': $!"; - - # a daemonized child process, live long and prosper... - do_log(2, "Daemonized as process [%s]", $$); - - openlog($syslog_ident, LOG_PID | LOG_NDELAY, $syslog_facility); - $syslog_open = 1; - - close(STDOUT) or die "Can't close STDOUT: $!"; - open(STDOUT, '>/dev/null') or die "Can't open /dev/null: $!"; - close(STDERR) or die "Can't close STDERR: $!"; - open(STDERR, '>&STDOUT') or die "Can't dup STDOUT: $!"; -} - -sub usage() { - return <<"EOD"; -Usage: - $0 [options] - - Options: - -V show version, then exit - -h show help, then exit - -f stay in foreground - -d log_level debugging level, 0..5, default 0 - -P pid_file a file name to receive a PID of a damonized process -EOD -} - - -# main program starts here - -my $foreground = 0; -my $pid_filename; # e.g. "/var/run/amavisd-snmp-subagent.pid"; -my $pid_file_created = 0; -my $keep_running = 1; - - delete @ENV{'PATH', 'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; - $SIG{INT} = sub { die "interrupted\n" }; # do the END code block - $SIG{TERM} = sub { die "terminated\n" }; # do the END code block - $SIG{PIPE} = 'IGNORE'; # don't signal on a write to a widowed pipe - - while (@ARGV >= 2 && $ARGV[0] =~ /^-[dP]\z/ || - @ARGV >= 1 && $ARGV[0] =~ /^-[hVf-]\z/) { - my($opt,$val); - $opt = shift @ARGV; - $val = shift @ARGV if $opt =~ /^-[dP]\z/; # these take arguments - if ($opt eq '--') { - last; - } elsif ($opt eq '-h') { # -h (help) - die "$myversion\n\n" . usage(); - } elsif ($opt eq '-V') { # -V (version) - die "$myversion\n"; - } elsif ($opt eq '-f') { # -f (foreground) - $foreground = 1; - } elsif ($opt eq '-d') { # -d log_level - $log_level = 0+$val; - } elsif ($opt eq '-P') { # -P pid_file - $pid_filename = untaint($val) if $val ne ''; - } else { - die "Error in parsing command line options: $opt\n\n" . usage(); - } - } - !@ARGV or die "Unprocessed command line options: $ARGV[0]\n\n" . usage(); - - if (!defined $mta_queue_dir) { # test for access to Postfix queue directory - local($ENV{PATH}) = '/usr/sbin:/usr/local/sbin:/opt/postfix/sbin'; - $! = 0; - $mta_queue_dir = qx(postconf -h queue_directory); - if (!defined $mta_queue_dir) { - if ($! != 0) { - do_log(1, "no postfix (unable to run postconf command): $!"); - } else { - do_log(1, "failed to execute \"postconf queue_directory\": $?"); - } - } else { - chomp $mta_queue_dir; - if ($mta_queue_dir =~ /^\s*\z/) { - do_log(1, "unknown Postfix queue directory"); - undef $mta_queue_dir; - } else { - do_log(2, "got a Postfix queue directory: %s", $mta_queue_dir); - my $dir = "$mta_queue_dir/active"; - local(*DIR); - if (!opendir(DIR,$dir)) { # testing access - do_log(1, "can't open directory %s: %s", $dir,$!); - undef $mta_queue_dir; - } else { - closedir(DIR) or die "Error closing directory $dir: $!"; - } - } - } - } - - if (defined $mta_queue_dir) { - # Postfix queue size MIB - declare_variable($databases[2]->{root_oid_str}, - 'MtaQueueEntriesMaildrop', 'G32'); - declare_variable($databases[3]->{root_oid_str}, - 'MtaQueueEntriesIncoming', 'G32'); - declare_variable($databases[4]->{root_oid_str}, - 'MtaQueueEntriesActive', 'G32'); - declare_variable($databases[5]->{root_oid_str}, - 'MtaQueueEntriesDeferred', 'G32'); - } - - $SIG{'__WARN__'} = # log warnings - sub { my($m) = @_; chomp($m); do_log(-1,"_WARN: %s",$m) }; - $SIG{'__DIE__' } = # log uncaught errors - sub { if (!$^S) { my($m) = @_; chomp($m); do_log(-2,"_DIE: %s",$m) } }; - - if ($foreground) { - do_log(0,"%s starting in foreground, perl %s", $myversion,$]); - } else { # daemonize - openlog($syslog_ident, LOG_PID | LOG_NDELAY, $syslog_facility); - $syslog_open = 1; - do_log(2,"to be daemonized"); - daemonize(); - srand(); - do_log(0,"%s starting. daemonized as PID [%s], perl %s", $myversion,$$,$]); - if (defined $pid_filename && $pid_filename ne '') { - my $pidf = IO::File->new; - my $stat = $pidf->open($pid_filename, O_CREAT|O_EXCL|O_RDWR, 0640); - if (!$stat && $! == EEXIST) { - do_log(0,"PID file %s exists, overwriting", $pid_filename); - $stat = $pidf->open($pid_filename, O_CREAT|O_RDWR, 0640); - } - $stat or die "Can't create file $pid_filename: $!"; - $pid_file_created = 1; - $pidf->print("$$\n") or die "Can't write to $pid_filename: $!"; - $pidf->close or die "Can't close $pid_filename: $!"; - } - } - - do_log(5, "zmq_init"); - $zmq_ctx = zmq_init(); - $zmq_ctx or die "Can't create ZMQ context: $!"; - - do_log(5, "creating ZMQ_REQ socket"); - $zmq_sock = zmq_socket($zmq_ctx,ZMQ_REQ); - $zmq_sock or die "Can't create ZMQ socket: $!"; - - do_log(5, "zmq_setsockopt on socket"); - my $sock_ipv4only = 1; # a ZMQ default - if (defined &ZMQ_IPV4ONLY && $snmp_sock_specs =~ /:[0-9a-f]*:/i) { - zmq_setsockopt($zmq_sock, ZMQ_IPV4ONLY(), 0) != -1 - or die "Error turning off ZMQ_IPV4ONLY on a ZMQ socket: $!"; - $sock_ipv4only = 0; - } - do_log(5, "connecting to zmq socket %s%s", $snmp_sock_specs, - $sock_ipv4only ? '' : ', IPv6 enabled'); - zmq_connect($zmq_sock, $snmp_sock_specs) != -1 - or die "zmq_connect to $snmp_sock_specs failed: $!"; - -# netsnmp_ds_set_boolean(NETSNMP_DS_APPLICATION_ID, -# NETSNMP_DS_LIB_DONT_READ_CONFIGS, 1); - - netsnmp_ds_set_string( NETSNMP_DS_APPLICATION_ID, - NETSNMP_DS_AGENT_X_SOCKET, $agentx_sock_specs - ) if defined $agentx_sock_specs; - - my $agent = NetSNMP::agent->new('Name' => $agent_name, 'AgentX' => 1) - or die "Can't create a SNMP agent $agent_name"; - - init_data(); # must come *after* NetSNMP::agent->new -# dump_variables(); - - for my $database (@databases) { - my $root_oid_str = $database->{root_oid_str}; - my $db_name = $database->{name}; - if ($db_name =~ /^pf/ && !defined $mta_queue_dir) { - do_log(2, "not registering root OID %s for %s", $root_oid_str,$db_name); - } else { - do_log(2, "registering root OID %s for %s", $root_oid_str,$db_name); - $root_oid_str = '.' . $root_oid_str; - $agent->register($agent_name, $root_oid_str, \&snmp_handler) - or die "Can't register a SNMP agent $agent_name under $root_oid_str"; - $database->{registered} = 1; - } - } - - while ($keep_running) { - $agent->agent_check_and_process(1); - } - exit; - -END { - eval { do_log(2, "%s shutting down", $myproduct_name) }; - if (defined $agent) { - eval { $agent->shutdown }; # ignoring status - } - if ($pid_file_created) { - unlink($pid_filename) - or eval { do_log(0, "Can't remove file %s: %s", $pid_filename,$!) }; - } - if ($zmq_sock) { - zmq_setsockopt($zmq_sock, ZMQ_LINGER, 0); # ignoring status - zmq_close($zmq_sock); # ignoring status - } - if ($syslog_open) { eval { closelog() }; $syslog_open = 0 } - zmq_term($zmq_ctx) if $zmq_ctx; # ignoring status -} --- a/bin/amavisd-status +++ /dev/null @@ -1,396 +0,0 @@ -#!/usr/bin/perl -T -# SPDX-License-Identifier: BSD-2-Clause - -#------------------------------------------------------------------------------ -# This is amavisd-status, a program to show status of child processes -# in amavis. -# -# Author: Mark Martinec -# -# Copyright (c) 2012-2016, Mark Martinec -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright notice, -# this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright notice, -# this list of conditions and the following disclaimer in the documentation -# and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS -# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -# POSSIBILITY OF SUCH DAMAGE. -# -# The views and conclusions contained in the software and documentation are -# those of the authors and should not be interpreted as representing official -# policies, either expressed or implied, of the Jozef Stefan Institute. - -# (the above license is the 2-clause BSD license, also known as -# a "Simplified BSD License", and pertains to this program only) -# -# Patches and problem reports are welcome. -# The latest version of this program is available at: -# http://www.ijs.si/software/amavisd/ -#------------------------------------------------------------------------------ - -use strict; -use re 'taint'; -use warnings; -use warnings FATAL => qw(utf8 void); -no warnings 'uninitialized'; - -use Errno qw(ESRCH ENOENT); -use POSIX qw(strftime); -use Time::HiRes (); - -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.11.0'; $myversion_date = '20150720'; -$myversion = "$myproduct_name-$myversion_id ($myversion_date)"; - -### USER CONFIGURABLE: - -# should match a socket of the same name in amavis-services -$outer_sock_specs = "tcp://127.0.0.1:23232"; - -### END OF USER CONFIGURABLE - - -use vars qw($zmq_mod_name $zmq_mod_version $zmq_lib_version); -BEGIN { - my($zmq_major, $zmq_minor, $zmq_patch); - if (eval { require ZMQ::LibZMQ3 && require ZMQ::Constants }) { - $zmq_mod_name = 'ZMQ::LibZMQ3'; # new interface module to zmq v3 or libxs - import ZMQ::LibZMQ3; import ZMQ::Constants qw(:all); - ($zmq_major, $zmq_minor, $zmq_patch) = ZMQ::LibZMQ3::zmq_version(); - # *zmq_sendmsg [native] # (socket,msgobj,flags) - # *zmq_recvmsg [native] # (socket,flags) -> msgobj - *zmq_sendstr = sub { # (socket,string,flags) - my $rv = zmq_send($_[0], $_[1], length $_[1], $_[2]||0); - $rv == -1 ? undef : $rv; - }; - } elsif (eval { require ZMQ::LibZMQ2 && require ZMQ::Constants }) { - $zmq_mod_name = 'ZMQ::LibZMQ2'; # new interface module to zmq v2 - import ZMQ::LibZMQ2; import ZMQ::Constants qw(:all); - ($zmq_major, $zmq_minor, $zmq_patch) = ZMQ::LibZMQ2::zmq_version(); - # zmq v2/v3 incompatibile renaming - *zmq_sendmsg = \&ZMQ::LibZMQ2::zmq_send; # (socket,msgobj,flags) - *zmq_recvmsg = \&ZMQ::LibZMQ2::zmq_recv; # (socket,flags) -> msgobj - *zmq_sendstr = sub { # (socket,string,flags) - my $rv = zmq_send(@_); $rv == -1 ? undef : $rv; - }; - } elsif (eval { require ZeroMQ::Constants && require ZeroMQ::Raw }) { - $zmq_mod_name = 'ZeroMQ'; # old interface module to zmq v2 - import ZeroMQ::Raw; import ZeroMQ::Constants qw(:all); - ($zmq_major, $zmq_minor, $zmq_patch) = ZeroMQ::version(); - # zmq v2/v3 incompatibile renaming - *zmq_sendmsg = \&ZeroMQ::Raw::zmq_send; # (socket,msgobj,flags) - *zmq_recvmsg = \&ZeroMQ::Raw::zmq_recv; # (socket,flags) -> msgobj - *zmq_sendstr = sub { # (socket,string,flags) - my $rv = zmq_send(@_); $rv == -1 ? undef : $rv; - }; - } else { - die "Perl modules ZMQ::LibZMQ3 or ZMQ::LibZMQ2 or ZeroMQ not available\n"; - } - $zmq_mod_version = $zmq_mod_name->VERSION; - $zmq_lib_version = join('.', $zmq_major, $zmq_minor, $zmq_patch); - 1; -} - -sub zmq_version { - sprintf("%s %s, lib %s", - $zmq_mod_name, $zmq_mod_version, $zmq_lib_version); -}; - -sub zmq_recvstr { # (socket,buffer,offset) -> (len,more) - my $sock = $_[0]; - my $offset = $_[2] || 0; - my $zm = zmq_recvmsg($sock); # a copy of a received msg obj - if (!$zm) { substr($_[1],$offset) = ''; return } - ($offset ? substr($_[1],$offset) : $_[1]) = zmq_msg_data($zm); - my $len = length($_[1]) - $offset; - zmq_msg_close($zm); - return $len if !wantarray; - my $more = zmq_getsockopt($sock, ZMQ_RCVMORE); - if ($more == -1) { substr($_[1],$offset) = ''; return } - ($len, $more); -}; - - -my $wakeuptime = 1; # -w, sleep time in seconds, may be fractional -my $repeatcount; # -c, repeat count (when defined) - -my $zmq_poll_units = 1000; # milliseconds since zmq v3 -$zmq_poll_units *= 1000 if $zmq_lib_version =~ /^[012]\./; # microseconds - -sub fmt_age($$$) { - my($t,$state_bar,$idling) = @_; - $t = int($t); - my $char = $idling ? '.' : '='; - my $bar_l = $idling ? $t : length($state_bar); - my $bar = substr( ($char x 9 . ':') x 3 . $char x 5, 0,$bar_l); - if (!$idling) { - $state_bar = substr($state_bar,0,length($bar)-2) . substr($state_bar,-1,1) - . '>' if length($state_bar) > length($bar); - for my $j (0 .. length($bar)-1) { - substr($bar,$j,1) = substr($state_bar,$j,1) - if substr($bar,$j,1) eq '=' && substr($state_bar,$j,1) ne ' '; - } - } - my $s = $t % 60; $t = int($t/60); - my $m = $t % 60; $t = int($t/60); - my $h = $t % 24; $t = int($t/24); - my $d = $t; - my $str = sprintf("%d:%02d:%02d", $h,$m,$s); - $str = (!$d ? " " : sprintf("%dd",$d)) . $str; - $str . ' ' . $bar; -}; - -sub usage() { - print <<'EOD'; -States legend: - A accepted a connection - b begin with a protocol for accepting a request - m 'MAIL FROM' smtp command started a new transaction in the same session - d transferring data from MTA to amavisd - = content checking just started - G generating and verifying unique mail_id - D decoding of mail parts - V virus scanning - S spam scanning - P pen pals database lookup and updates - r preparing results - Q quarantining and preparing/sending notifications - F forwarding mail to MTA - . content checking just finished - sp space indicates idle (elapsed time bar is showing dots) - -EOD - print "Usage: $0 [-c ] [-w ]\n"; -} - -my($zmq_ctx, $zmq_sock); -my %process; # associative array on pid -my $any_events = 0; - -sub process_message { - my($msgstr, $msgstr_l, $more, $val, $p); - for (;;) { - ($msgstr_l,$more) = zmq_recvstr($zmq_sock,$msgstr); - defined $msgstr_l or die "zmq_recvstr failed: $!"; - $any_events = 1; - local($1); - if (!defined $msgstr) { - # should not happen (except on a failure of zmq_recvmsg) - } elsif ($msgstr =~ /^am\.st \d+\s+/s) { - my($subscription_chan, $pid, $time, $state, $task_id) = - split(' ',$msgstr); - if ($state eq 'FLUSH') { - %process = (); # flush all kept state (e.g. on a restart) - printf STDERR ("state flushed (restart)\n"); - } elsif ($state eq 'exiting' || $state eq 'purged') { - delete $process{$pid}; # may or may not exist - } else { - $state = ' ' if $state eq '-'; - $p = $process{$pid}; - if ($p) { - $p->{state} = $state; - $p->{task_id} = $task_id; - } else { # new process appeared - $process{$pid} = $p = { - state => $state, - task_id => $task_id, - timestamp => undef, - base_timestamp => undef, - last_displ_timestamp => undef, - state_bars => undef, - }; - } - my $now = Time::HiRes::time; - if ($time > 1e9) { # Unix time in seconds with fraction (> Y2000) - $p->{base_timestamp} = $p->{timestamp} = $time; - $p->{state_bars} = ''; # reset for a new task - } elsif (!$p->{base_timestamp}) { # delta time but no base - $p->{timestamp} = $now; - $p->{base_timestamp} = $p->{timestamp} - $time/1000; # estimate - } else { # delta time in ms since base_timestamp - $p->{timestamp} = $p->{base_timestamp} + $time/1000; - } - $p->{tick} = $now; - } - } elsif ($msgstr =~ /^am\.proc\.(busy|idle) /) { - my($subscription_chan, @pid_list) = split(' ',$msgstr); - my $now = Time::HiRes::time; - for my $pid (@pid_list) { - if ($process{$pid}) { - $p->{tick} = $now; - } else { - $process{$pid} = $p = { - state => $1 eq 'busy' ? '?' : ' ', - base_timestamp => $now, timestamp => $now, tick => $now, - }; - } - } - } else { - print STDERR "Unrecognized message received: $msgstr\n"; - } - last if !$more; - } - 1; -} - -use vars qw($peak_active $last_peak_reading_time); -BEGIN { $peak_active = 0 } -sub display_state() { - my $num_idling = 0; - my $num_active = 0; - my $now = Time::HiRes::time; - for my $pid (sort { $a <=> $b } keys %process) { - my $p = $process{$pid}; - my $idling = !defined $p->{task_id} && $p->{state} =~ /^[. ]\z/s; - my $age = $now - $p->{base_timestamp}; - if ($idling) { - $num_idling++; - $p->{state_bars} = ''; - next; # suppress reporting idle processes (or comment-out) - } else { - $num_active++; - my $len = int($age + 0.5); - $len = 1 if $len < 1; - my $str = $p->{state_bars}; - $str = '' if !defined $str; - if ($len > length $str) { # replicate last character to desired size - my $ch = $str eq '' ? '=' : substr($str,-1,1); - $str .= $ch x ($len - length $str); - } - substr($str,$len-1,1) = $p->{state}; - $p->{state_bars} = $str; - } - printf STDERR ("PID %5d: %-11s %s\n", - $pid, $p->{task_id} || $p->{state}, - fmt_age($age, $p->{state_bars}, $idling) ); - } - $now = Time::HiRes::time; - if ($num_active > $peak_active) { - $peak_active = $num_active; - } elsif ($peak_active >= 0.1) { # exponential decay of a peak indicator - my $halflife = 8; # seconds - my $weight = exp(-(($now - $last_peak_reading_time) / $halflife) * log(2)); - $peak_active *= $weight; - $peak_active = $num_active if $num_active > $peak_active; - } - $last_peak_reading_time = $now; - my $bar = ('*' x $num_active) . ('.' x $num_idling); - my $ipeak_active = int($peak_active+0.5); - if ($ipeak_active > $num_active) { - 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); - } - printf STDERR ("%d active, %d idling processes\n", $num_active, $num_idling); - printf STDERR ("%s\n", $bar); -} - -# main program starts here - - my $normal_termination = 0; - $SIG{INT} = sub { die "\n" }; # do the END code block when interrupted - $SIG{TERM} = sub { die "\n" }; # do the END code block when killed - - while (@ARGV) { - my $opt = shift @ARGV; - my $val = shift @ARGV; - if ($opt eq '-w' && $val =~ /^\+?\d+(?:\.\d*)?\z/) { $wakeuptime = $val } - elsif ($opt eq '-c' && $val =~ /^[+-]?\d+\z/) { $repeatcount = $val } - else { usage(); exit 1 } - } - - $zmq_ctx = zmq_init(); - $zmq_ctx or die "Can't create ZMQ context: $!"; - $zmq_sock = zmq_socket($zmq_ctx,ZMQ_SUB); - $zmq_sock or die "Can't create ZMQ socket: $!"; - - my $sock_ipv4only = 1; # a ZMQ default - if (defined &ZMQ_IPV4ONLY && $outer_sock_specs =~ /:[0-9a-f]*:/i) { - zmq_setsockopt($zmq_sock, ZMQ_IPV4ONLY(), 0) != -1 - or die "zmq_setsockopt failed: $!"; - $sock_ipv4only = 0; - } - zmq_setsockopt($zmq_sock, ZMQ_SUBSCRIBE, 'am.st ') != -1 - or die "zmq_setsockopt SUBSCRIBE failed: $!"; - zmq_setsockopt($zmq_sock, ZMQ_SUBSCRIBE, 'am.proc.') != -1 - or die "zmq_setsockopt SUBSCRIBE failed: $!"; - - zmq_connect($zmq_sock, $outer_sock_specs) != -1 - or die "zmq_connect to $outer_sock_specs failed: $!"; - - print <<'EOD'; -process-id task-id elapsed in elapsed-bar (dots indicate idle) - or state idle or busy -EOD - - my $last_display_time; - for (;;) { - if (defined $repeatcount) { - last if $repeatcount <= 0; - $repeatcount--; - } - $| = 0; - print "\n"; - - my $now = Time::HiRes::time; - my $redraw_at = - defined $last_display_time ? $last_display_time + $wakeuptime - : $now + 0.2; - for (;;) { - my $timeout = $redraw_at - $now; - $timeout = 0 if $timeout < 0; - $any_events = 0; - zmq_poll( - [ - { socket => $zmq_sock, - events => ZMQ_POLLIN, - callback => \&process_message, - }, - ], - $timeout * $zmq_poll_units - ) != -1 or die "zmq_poll failed: $!"; - $now = Time::HiRes::time; - last if $now >= $redraw_at; - last if $any_events && $now > $last_display_time + 0.2; - } - - while (my($pid,$p) = each %process) { # remove stale entries - delete $process{$pid} if $p && $now - $p->{tick} > 10*60; - } - display_state(); - $last_display_time = Time::HiRes::time; - - $| = 1; # flush STDOUT - } # forever - - $normal_termination = 1; - -END { - # ignoring status - zmq_close($zmq_sock) if $zmq_sock; - zmq_term($zmq_ctx) if $zmq_ctx; - print "exited\n" if !$normal_termination; - - close(STDOUT) or die "Error closing STDOUT: $!"; - close(STDERR) or die "Error closing STDERR: $!"; -} --- a/t/Amavis/ZMQTest.pm +++ /dev/null @@ -1,63 +0,0 @@ -# SPDX-License-Identifier: GPL-2.0-or-later - -package Amavis::ZMQTest; - -use v5.20; -use Test::Most; -use base 'Test::Class'; - -use ZMQ::LibZMQ3; -use ZMQ::Constants qw(:all); - -sub class { 'Amavis::ZMQ' } - -sub startup : Tests(startup => 1) { - my $test = shift; - use_ok $test->class; -} - -sub messages : Tests(4) { - my $class = shift->class; - - my $sockname = 'tcp://127.0.0.1:9999'; - my $teststring = 'ZMQ_Test_String'; - my ($server_ctx, $server_sock); - if (eval { - $server_ctx = zmq_init(1) or die $!; - $server_sock = zmq_socket( $server_ctx, &ZMQ_SUB); - zmq_setsockopt($server_sock, &ZMQ_SUBSCRIBE, '') != -1 or die $!; - 1; - }){ - my $pid = open (my $from_child, '-|'); - if (defined $pid and $pid) { - ok 1, 'test forked'; - } - return unless defined($pid); - if ($pid) { - zmq_bind($server_sock, $sockname); - is <$from_child>, 'client initialized', 'client initialized'; - zmq_poll([{ - socket => $server_sock, - events => &ZMQ_POLLIN, - callback => sub { - ok zmq_msg_data(zmq_recvmsg($server_sock)) =~ /$teststring/, - 'server received teststring'; - } - }], - -1, - ); - ok waitpid($pid, 0), 'client terminated'; - } else { - my $zmq = $class->new($sockname); - print 'client initialized'; - close STDOUT; - sleep 1; - $zmq->register_proc(1, 0, $teststring); - exit; - } - } else { - is $@, undef, 'ZMQ initialized'; - } -} - -1; --- a/t/Amavis/ZMQTest.t +++ /dev/null @@ -1,4 +0,0 @@ -#!/usr/bin/env perl -T -use lib 't'; -use Amavis::ZMQTest; -Amavis::ZMQTest->runtests;