#!/usr/bin/perl

use v5.36;

use POSIX qw(:errno_h :sys_wait_h setsid _exit);
use Getopt::Long qw(:config posix_default no_ignore_case);
use List::Util qw(any all none sum);
use List::MoreUtils qw(firstidx);
use Time::Piece;
use Time::HiRes qw(gettimeofday);
use IPC::Cmd qw(can_run);
use Sys::Syslog qw(:standard :macros);
use IO::Socket::UNIX;
use URI::Escape;
use YAML::XS;
use XMLRPC::Lite;
use NGCP::Redis;
use DBI;
use NGCP::Gather::Exim;
use NGCP::Gather::TLSCerts;
use NGCP::Gather::SIPOption;
use NGCP::Service::Meta;

# Used by the Prometheus backend.
use Prometheus::Tiny;
use Mojo::Base 'Mojolicious';
use Mojo::Server::Daemon;

my $PROGNAME = 'ngcp-witnessd';
my $VERSION = '0.0.0';

use constant {
    CONF_NONE => 0,
    CONF_TEXT => 1,
    CONF_INT  => 2,
    CONF_BOOL => 3,
    CONF_LIST => 4,
    CONF_FILE => 5,
    CONF_HOST => 6,
    CONF_PORT => 7,
    CONF_LOGS => 8,
};

my %BOOL_VALUES = (
    false => 0,
    no => 0,
    off => 0,
    true => 1,
    yes => 1,
    on => 1,
);

my %config_schema = (
    debug => {
        type => CONF_BOOL,
        default => 'no',
    },
    daemonize => {
        type => CONF_BOOL,
        default => 'no',
    },
    interval => {
        type => CONF_INT,
        default => 10,
    },
    pidfile => {
        type => CONF_FILE,
        default => "/run/$PROGNAME.pid",
    },
    logfile => {
        type => CONF_LOGS,
        default => 'syslog',
    },
    'listen_host' => {
        type => CONF_LIST,
        sep => qr/\s+/,
        default => [ '127.0.0.1', '[::1]' ],
    },
    'listen_port' => {
        type => CONF_PORT,
        default => 9200,
    },

    # Storage credentials
    db_central_host => {
        type => CONF_HOST,
    },
    db_central_port => {
        type => CONF_PORT,
    },
    db_local_host => {
        type => CONF_HOST,
    },
    db_local_port => {
        type => CONF_PORT,
    },
    db_pair_host => {
        type => CONF_HOST,
    },
    db_pair_port => {
        type => CONF_PORT,
    },
    db_cred_file => {
        type => CONF_FILE,
    },
    redis_central_db_proxy_dialog => {
        type => CONF_INT,
    },
    redis_central_db_proxy_usrloc => {
        type => CONF_INT,
    },
    redis_central_host => {
        type => CONF_HOST,
    },
    redis_local_host => {
        type => CONF_HOST,
    },
    redis_local_db_proxy_kam_dialog => {
        type => CONF_INT,
    },
    kam_lb_host => {
        type => CONF_HOST,
        default => '127.0.0.1',
    },
    kam_lb_port => {
        type => CONF_PORT,
        default => 5060,
    },
    kam_proxy_host => {
        type => CONF_HOST,
        default => '127.0.0.1',
    },
    kam_proxy_port => {
        type => CONF_PORT,
        default => 5062
    },

    # Monitoring configuration.
    force_checks => {
        type => CONF_BOOL,
        default => 'no',
    },
    skip_unhandled_services => {
        type => CONF_BOOL,
        default => 'no',
    },
    sip_asr_ner_statistics => {
        type => CONF_BOOL,
        default => 'no',
    },
    license_client_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    mta_exim_spool_dir => {
        type => CONF_FILE,
        default => '/var/spool/exim4/input',
    },
    mta_queue_check_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    tls_certs_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    sip_concurrent_calls_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    sip_dialog_active_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    sip_dialog_early_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    sip_dialog_incoming_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    sip_dialog_local_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    sip_dialog_outgoing_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    sip_dialog_relay_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    kam_proxy_shmem_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    kam_proxy_pkgmem_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    sip_registered_devices_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    sip_registered_devices_server_ids => {
        type => CONF_LIST,
        sep => qr/\s+/,
        default => [],
    },
    sip_registered_subscribers_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    kam_peer_stats_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    kam_peer_probe_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    kam_proxy_stats_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    kam_lb_stats_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    kam_lb_shmem_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    kam_lb_pkgmem_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    cdr_total_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    cdr_rated_total_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    peering_groups_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    mysql_check_replication => {
        type => CONF_BOOL,
        default => 'no',
    },
    mysql_check_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    mysql_check_instances => {
        type => CONF_LIST,
        sep => qr/\s+/,
    },
    sip_provisioned_subscribers_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    sip_check_enable => {
        type => CONF_BOOL,
        default => 'no',
    },
    sip_check_ip => {
        type => CONF_HOST,
    },
    sip_check_port =>{
        type => CONF_PORT,
    },
    sip_uri => {
        type => CONF_HOST,
    },
    sip_port => {
        type => CONF_PORT,
    },
);

# XXX: Backwards compatibility mappings:
my %config_compat = (
    exim_queue_check_enable => 'mta_queue_check_enable',
    lb_shmem_enable => 'kam_lb_shmem_enable',
    kam_shmem_enable => 'kam_proxy_shmem_enable',
    asr_nsr_statistics => 'asr_ner_statistics',

    kam_concurrent_calls_enable => 'sip_concurrent_calls_enable',
    kam_dialog_active_enable => 'sip_dialog_active_enable',
    kam_dialog_early_enable => 'sip_dialog_early_enable',
    kam_dialog_type_local_enable => 'sip_dialog_local_enable',
    kam_dialog_type_relay_enable => 'sip_dialog_relay_enable',
    kam_dialog_type_incoming_enable => 'sip_dialog_incoming_enable',
    kam_dialog_type_outgoing_enable => 'sip_dialog_outgoing_enable',
    oss_provisioned_subscribers_enable => 'sip_provisioned_subscribers_enable',
    kam_usrloc_registered_subscribers_enable => 'sip_registered_subscribers_enable',
    kam_usrloc_registered_devices_enable => 'sip_registered_devices_enable',
    asr_ner_statistics => 'sip_asr_ner_statistics',
    monitor_peering_groups => 'peering_groups_enable',

    # Since mr13.1
    dbcentralhost => 'db_central_host',
    dbcentralport => 'db_central_port',
    dbcredfile => 'db_cred_file',
    dblocalhost => 'db_local_host',
    dblocalport => 'db_local_port',
    dbpairhost => 'db_pair_host',
    dbpairport => 'db_pair_port',
    rediscentraldb_proxydialog => 'redis_central_db_proxy_dialog',
    rediscentraldb_proxyusrloc => 'redis_central_db_proxy_usrloc',
    rediscentralhost => 'redis_central_host',
    redislocaldb_proxykamdialog => 'redis_local_db_proxy_kam_dialog',
    redislocalhost => 'redis_local_host',
    sipport => 'sip_port',
    sipuri => 'sip_uri',
    kam_host_lb => 'kam_lb_host',
    kam_port_lb => 'kam_lb_port',
    ham_host_proxy => 'kam_proxy_host',
    kam_port_proxy => 'kam_proxy_port',
);
my %config;

my $hostname_g = qx(ngcp-hostname);
chomp $hostname_g;
my $nodename_g = qx(ngcp-nodename);
chomp $nodename_g;

# These functions are defined in setup_logging() as aliases to anonymous
# subs depending on the implementation to use.
sub debug;
sub notice;
sub warning;
sub error;
sub stop_logging;

# Set bootstrap definitions for essential logging functions:
*warning = sub { warn "$PROGNAME: warning: @_\n" };
*error = sub { die "$PROGNAME: error: @_\n" };

my @config_files = (
    '/etc/ngcp-witnessd/ngcp-witnessd.conf',
);

sub ngcp_config_var
{
    my $name = lc shift;

    return $config_compat{$name} // $name;
}

sub ngcp_parse_filename
{
    my $filename = shift;

    error("filename '$filename' is not an absolute pathname")
        unless $filename =~ m{^/};
    error("filename '$filename' is too short")
        unless length $filename > 2;

    return $filename;
}

sub ngcp_parse_logsname
{
    my $logsname = shift;

    return $logsname if $logsname eq 'console' or $logsname eq 'syslog';
    return ngcp_parse_filename($logsname);
}

sub ngcp_parse_bool
{
    my $bool = shift;

    return $BOOL_VALUES{$bool} // $bool;
}

sub ngcp_parse_int
{
    my $int = shift;

    error("invalid integer value '$int'") unless $int =~ m/^[-+]?\d+$/;

    return $int;
}

sub ngcp_parse_port
{
    my $port = shift;

    error("port $port out of range") if $port < 0 || $port > 65535;

    return $port;
}

# Parse config file.
foreach my $config_file (@config_files) {
    next unless -e $config_file;

    open my $CONFIG, '<', $config_file
        or error("cannot open the configuration file '$config_file'");

    while (<$CONFIG>) {
        chomp;                  # no newline
        s/#.*//;                # no comments
        s/^\s+//;               # no leading white
        s/\s+$//;               # no trailing white
        next unless length;     # anything left?

        my ($var, $value) = split(/\s*=\s*/, $_, 2);

        # Remove quotes.
        if ($value =~ m/^['"]([^'"]*)['"]$/) {
            $value = $1;
        }

        my $name = ngcp_config_var($var);
        if (not exists $config_schema{$name}) {
            warning("unknown configuration variable '$name'");
            next;
        }

        if ($config_schema{$name}{type} == CONF_LIST) {
            if (exists $config_schema{$name}{sep}) {
                push @{$config{$name}}, split /$config_schema{$name}{sep}/, $value;
            } else {
                push @{$config{$name}}, $value;
            }
        } elsif ($config_schema{$name}{type} == CONF_BOOL) {
            $config{$name} = ngcp_parse_bool($value);
        } elsif ($config_schema{$name}{type} == CONF_INT) {
            $config{$name} = ngcp_parse_int($value);
        } elsif ($config_schema{$name}{type} == CONF_PORT) {
            $config{$name} = ngcp_parse_port($value);
        } elsif ($config_schema{$name}{type} == CONF_FILE) {
            $config{$name} = ngcp_parse_filename($value);
        } elsif ($config_schema{$name}{type} == CONF_LOGS) {
            $config{$name} = ngcp_parse_logsname($value);
        } else {
            $config{$name} = $value;
        }
    }
    close $CONFIG;
}

# Set defaults for unset options.
foreach my $name (keys %config_schema) {
    next if exists $config{$name};

    if ($config_schema{$name}{type} == CONF_BOOL) {
        $config{$name} = ngcp_parse_bool($config_schema{$name}{default});
    } elsif (exists $config_schema{$name}{default}) {
        $config{$name} = $config_schema{$name}{default};
    }
}

sub ngcp_throttle_check {
    my ($state, $interval, $check) = @_;
    my $now = time;

    if (!$state->{modified} || !defined $state->{result} ||
        ($now - $state->{modified}) >= $interval) {
        $state->{result} = $check->();
        $state->{modified} = $now;
    }

    return $state->{result};
}

sub ngcp_system {
    my (@cmd) = @_;
    my (@frame) = caller(1);

    # Reset signal handler, as Mojolicious sets it up on module import.
    local $SIG{PIPE} = undef;

    debug("$frame[3]: @cmd");
    my $rc = system(@cmd);
    debug("  rc -> $rc");
    return $rc;
}

sub ngcp_checkpoint {
    my $name = shift;

    return unless $config{debug};

    my ($s, $ms) = gettimeofday;
    debug("checkpoint name=$name t=${s}s${ms}ms");
}

my $prom;
my $dbs;
my $kam_xmlrpc;

sub ngcp_get_dbh {
    my $ds = shift;

    # If we have already tried to connect before on this interval and failed,
    # do not try again until the next interval.
    return if $ds->{connection_failed};

    my $dbh = DBI->connect_cached($ds->{dsn}, q{}, q{});

    if (not defined $dbh and not defined $ds->{connection_failed}) {
        $ds->{connection_failed} = 1;
        warning("cannot connect to database $ds->{dsn}: " . DBI->errstr);
    }

    return $dbh;
}

sub ngcp_mysql_fetch_value {
    my ($ds, $query) = @_;

    my $dbh = ngcp_get_dbh($ds);
    return unless defined $dbh;

    my @row = $dbh->selectrow_array($query);

    warning("unexpected multivalue returned from query: $query") if @row > 1;
    return if @row == 0;
    return $row[0];
}

sub ngcp_mysql_fetch_value_int {
    my ($ds, $query) = @_;

    my $out = ngcp_mysql_fetch_value($ds, $query);

    return $1 if defined $out and $out =~ /^(\d+)/;
    return 0;
}

sub ngcp_ha_proc_state {
    my $rc = ngcp_system(qw(ngcp-ha-proc-state -q));
    return 1 if ($rc >> 8) == 0;
    return 0;
}

sub ngcp_ha_host_state {
    my ($node) = @_;

    my $rc = ngcp_system(qw(ngcp-ha-host-state -q), $node);
    return 1 if ($rc >> 8) == 0;
    return 0;
}

sub ngcp_ha_node_state {
    my $rc = ngcp_system('ngcp-check-active -q');
    return $rc >> 8;
}

sub ngcp_node_is_active {
    my $st = shift;

    return 1 if $st == 0; # active
    return 0 if $st == 1; # standby
    return -1; # error (unknown/transition)
}

sub ngcp_license_file_slurp {
    my $filename = shift;
    my $pathname = "/proc/ngcp/$filename";

    my $data;
    open my $fh, '<', $pathname
        or error("cannot open license client file '$pathname'");
    {
        local $/ = undef;
        $data = <$fh>;
    }
    close $fh;

    chomp $data;

    return $data;
}

sub ngcp_license_dir_slurp {
    my $type = shift;
    my $dirname = "/proc/ngcp/$type";

    my %data;

    opendir my $dh, $dirname
        or error("cannot open license client directory '$dirname'");
    while (readdir $dh) {
        next if m{^\.};
        next if not -f "$dirname/$_";

        $data{$_} = ngcp_license_file_slurp("$type/$_");
    }
    closedir $dh;

    return \%data;
}

sub ngcp_license_valid {
    my $status = ngcp_license_file_slurp('check');

    if ($status eq 'ok') {
        return 0;
    } elsif ($status =~ m{^warning}) {
        return 1;
    } elsif ($status =~ m{^error}) {
        return 2;
    } else {
        return -1;
    }
}

sub ngcp_mysql_global_status {
    my $ds = shift;
    my $dbh = ngcp_get_dbh($ds);
    return unless $dbh;

    my %data;
    my $sql = 'SHOW GLOBAL STATUS';
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    while (my $row = $sth->fetchrow_hashref) {
        $data{lc $row->{Variable_name}} = $row->{Value};
    }
    $sth->finish();

    return \%data;
}

sub ngcp_mysql_slave_status {
    my $ds = shift;
    my $dbh = ngcp_get_dbh($ds);
    return unless $dbh;

    my $sql = 'SHOW SLAVE STATUS';
    my $status = $dbh->selectrow_hashref($sql);

    return $status;
}

sub ngcp_mysql_parse_status_value {
    my $value = shift;

    return 0 unless defined $value;
    return 0 if $value eq 'No' or $value eq 'OFF';
    return 1 if $value eq 'Yes' or $value eq 'ON';
    return 0 if $value eq 'Connecting';
    return 1 if $value eq 'Primary';
    return $value;
}

sub ngcp_kamcmd {
    my ($xmlrpc, $rpc, @rpc_params) = @_;

    my $rpc_call;
    eval {
        $rpc_call = $xmlrpc->call($rpc, @rpc_params);
    };
    if ($@) {
        warning("kamcmd xmlrpc call '$rpc @rpc_params' failed: $@");
        return;
    }
    my $res = $rpc_call->result;

    if (!defined $res) {
        $res = $rpc_call->fault;
        my $error;
        foreach my $key (sort keys %{$res}) {
            $error .= "$key=$res->{$key} ";
        }
        warning("kamcmd xmlrpc call '$rpc @rpc_params' fault: $error");
        return;
    }

    return $res;
}

use constant DISPATCHER_SET_ID => 100;

# Fetch the peer host status from the kamailio peer probes.
sub ngcp_fetch_peer_probes {
    my $peer_probes = {};
    my $peers = ngcp_kamcmd($kam_xmlrpc->{proxy}, 'dispatcher.list');
    if (not defined $peers) {
        warning("cannot fetch xmlrpc 'dispatcher.list' from kamailio proxy");
        return $peer_probes;
    }

    foreach my $record (@{$peers->{RECORDS}}) {
        my $probe = $record->{SET};
        my $probe_id = $probe->{ID};

        next unless defined $probe_id and $probe_id == DISPATCHER_SET_ID;

        foreach my $target (@{$probe->{TARGETS}}) {
            # For witnessd, we currently do not need URI or check flags,
            # we still keep them here for future use.
            my $uri = $target->{DEST}->{URI};
            my $flags = $target->{DEST}->{FLAGS};
            my $attrs = $target->{DEST}->{ATTRS}->{BODY};

            my $peer_id = $attrs =~ s/^.*peerid=(\d+).*$/$1/r;
            my $peer_name = $attrs =~ s/^.*peername="([^"]+)".*$/$1/r;
            my $peer_gid = $attrs =~ s/^.*peergid=(\d+).*$/$1/r;

            my $peer_status = 0; # unknown
            if ($flags =~ /A/i) {
                $peer_status = 5; # up
            } elsif ($flags =~ /I/i) {
                $peer_status = 4; # down
            } elsif ($flags =~ /X/i) {
                $peer_status = 3; # pending
            }

            $peer_probes->{$peer_id} = {
                peer_name => $peer_name,
                peer_id => $peer_id,
                peer_gid => $peer_gid,
                peer_status => $peer_status,
            };
        }
    }

    return $peer_probes;
}

# Fetch and prepare measurements for peering groups and hosts.
sub ngcp_peering {
    my ($ds, $redis, $peer_probes, $active) = @_;

    my $dbh = ngcp_get_dbh($ds);
    return unless defined $dbh;

    my $sthg = $dbh->prepare('SELECT * FROM provisioning.voip_peer_groups');
    return unless defined $sthg;
    my $sthh = $dbh->prepare('SELECT * FROM provisioning.voip_peer_hosts');
    return unless defined $sthh;

    $sthg->execute();

    while (my $ref = $sthg->fetchrow_hashref()) {
        $ref->{$_} //= '' foreach keys %{$ref};

        $prom->set('ngcp_peer_group_info', $ref->{id}, {
            name => $ref->{name},
            priority => $ref->{priority},
            description => $ref->{description},
        });
    }

    $sthg->finish();

    $sthh->execute();

    while (my $ref = $sthh->fetchrow_hashref()) {
        my $probe_status = $active ? 0 : -1;

        # Do we have peer probes information available?
        if ($peer_probes->{$ref->{id}}) {
            $probe_status = $peer_probes->{$ref->{id}}{peer_status};
            $ref->{probe_status} = $probe_status;
        }

        my $peer_status = 0;
        if (not $ref->{enabled}) {
            $peer_status = 1; # admin-down
        } elsif (not $ref->{probe}) {
            $peer_status = 2; # admin-up
        } elsif ($probe_status) { # probed
            $peer_status = $probe_status;
        }

        $ref->{status} = $peer_status if $peer_status >= 0;

        # Fetch concurrent call counters per peer.
        $ref->{cc_inout} = $redis->get("peer:$ref->{id}") // 0;
        $ref->{cc_out} = $redis->get("peerout:$ref->{id}") // 0;

        $ref->{$_} //= '' foreach keys %{$ref};

        $prom->set('ngcp_peer_host_info', $ref->{id}, {
            name => $ref->{name},
            ip => $ref->{ip},
            group_id => $ref->{group_id},
        });
        $prom->set('ngcp_peer_host_status', $peer_status, {
            node_active => $active,
            id => $ref->{id},
            group_id => $ref->{group_id},
        });
        $prom->set('ngcp_peer_host_cc_in', $ref->{cc_inout} - $ref->{cc_out}, {
            id => $ref->{id},
            group_id => $ref->{group_id},
        });
        $prom->set('ngcp_peer_host_cc_out', $ref->{cc_out}, {
            id => $ref->{id},
            group_id => $ref->{group_id},
        });
        # XXX: Deprecated, but kept for backwards compatibility for now.
        $prom->set('ngcp_peer_host_cc_inout', $ref->{cc_inout}, {
            id => $ref->{id},
            group_id => $ref->{group_id},
        });
    }

    $sthh->finish();

    return;
}

sub ngcp_kamailio_peer_stats {
    my $stats = ngcp_kamcmd($kam_xmlrpc->{lb}, 'lcr.stats');
    if (not defined $stats) {
        warning("cannot fetch xmlrpc 'lcr.stats' from kamailio lb");
        return;
    }

    # No peer servers configured.
    return unless exists $stats->{gw};

    foreach my $peer (@{$stats->{gw}}) {
        my $peer_id = $peer->{gw_id};
        my $peer_name = $peer->{gw_name};

        next if not defined $peer_id or not defined $peer_name;

        my $attrs = {
            kamailio_role => 'lb',
            peer_id => $peer_id,
        };

        foreach my $metric (keys %{$peer}) {
            my ($name, %mattrs);

            %mattrs = %{$attrs};

            if ($metric =~ m/^(?:replies|requests)$/) {
                # Included as part of the accumulated codes.
                next;
            } elsif ($metric =~ m/^requests_([a-z]+)$/) {
                $name = 'requests_bymethod';
                $mattrs{method} = $1;
            } elsif ($metric =~ m/^replies_([0-9]xx)_([a-z]+)$/) {
                $name = 'replies_bymethod';
                $mattrs{code} = $1;
                $mattrs{method} = $2;
            } elsif ($metric =~ m/^replies_([a-z]+)$/) {
                # Included in more detail as part of the by-method metrics.
                next;
            } elsif ($metric =~ m/^replies_([0-9]xx)$/) {
                $name = "replies";
                $mattrs{code} = $1;
            } elsif ($metric =~ m/^replies_([0-9][0-9x][0-9x])$/) {
                # Give this their own name as they are specializations and
                # would otherwise generate totals greater than expected, when
                # summing up by code.
                $name = "replies_$1";
            } else {
                # Ignore unknown (perhaps warn to include them in the future?).
                next;
            }

            $prom->set("ngcp_kamailio_peer_$name", $peer->{$metric}, \%mattrs);
        }
    }

    return;
}

sub ngcp_monit_size_to_bytes {
    my $size = shift;
    my @units = qw(B kB MB GB TB PB EB ZB);

    if ($size =~ m/([\d.]+) (\w+)/) {
        my ($float, $unit) = ($1, $2);
        my $unitidx = firstidx { $_ eq $unit } @units;

        return 0 if $unitidx < 0;
        return int($float * 2 ** ($unitidx * 10));
    } else {
        return 0;
    }
}

sub ngcp_monit_response_time_to_seconds {
    my ($response) = @_;
    my $unit = $response->{time_unit};

    if ($unit eq 's') {
        return;
    } elsif ($unit eq 'm') {
        $response->{time} *= 60;
    } elsif ($unit eq 'ms') {
        $response->{time} /= 1000;
    } else {
        error("unknown monit unit type '$unit'");
    }
}

sub ngcp_monit_procs {
    state $have_monit = can_run('monit');

    return unless $have_monit;

    my %procs;

    local $/ = '';
    open my $monit_fh, '-|', 'monit', 'status';
    while (<$monit_fh>) {
        my %proc;

        my ($procname) = m/^Process '(.*)'$/m;

        next unless $procname;

        ($proc{proc_status}) = m/^\s*status\s*(.*)$/m;
        ($proc{monit_status}) = m/^\s*monitoring status\s*(.*)$/m;
        ($proc{pid}) = m/^\s*pid\s*(\d*)$/m;
        ($proc{ppid}) = m/^\s*parent pid\s*(\d*)$/m;
        ($proc{children}) = m/^\s*children\s*(\d*)$/m;
        if (m/^\s*uptime\s*(?:(\d+)d\s*)?(?:(\d+)h\s*)?(\d+)m\s*$/m) {
            $proc{uptime} = $3 * 60;
            $proc{uptime} += $2 * 3600 if defined $2;
            $proc{uptime} += $1 * 86400 if defined $1;
        }
        if (m/^\s*memory\s*(.*)$/m) {
            ($proc{memory}) = ngcp_monit_size_to_bytes($1);
        }
        if (m/^\s*memory total\s*(.*)$/m) {
            ($proc{memory_total}) = ngcp_monit_size_to_bytes($1);
        }
        ($proc{memory_percent}) = m/^\s*memory(?: percent)?\s*(.*)%$/m;
        ($proc{memory_percent_total}) = m/^\s*memory(?: percent)? total\s*(.*)%$/m;
        ($proc{cpu_percent}) = m/^\s*cpu(?: percent)?\s*(.*)%$/m;
        ($proc{cpu_percent_total}) = m/^\s*cpu(?: percent)? total\s*(.*)%$/m;
        ($proc{port_response_time}) = m/^\s*port response time\s*(.*)$/m;
        ($proc{sock_response_time}) = m/^\s*unix socket response time\s*(.*)$/m;
        if (m/^\s*data collected\s*(.*)$/m) {
            my $timestamp = Time::Piece->strptime($1, '%a, %d %b %Y %T');
            $proc{data_collected} = $timestamp->epoch;
        }

        foreach my $field (keys %proc) {
            delete $proc{$field} unless defined $proc{$field};
        }

        $procs{$procname} = \%proc;
    }
    close $monit_fh;

    return \%procs;
}

sub ngcp_monit_servs {
    my (%host_attrs) = @_;
    my $host_init_system = host_get_init_system();

    # We cannot reliably fetch status information from services.
    return if $host_init_system ne 'systemd';

    my %services;

    my %meta_opts = (
        skip_unhandled_services => $config{skip_unhandled_services},
    );

    foreach my $servdesc (@{serv_meta_with_systemd_props(%meta_opts)}) {
        # We cannot handle services w/o a monit entry.
        next unless exists $servdesc->{monit};

        next if $servdesc->{props}{systemd}{Type} eq 'oneshot';

        # Check the expected status.
        my $exp_status = 'inactive';
        if ($servdesc->{enable} eq 'yes' and
            serv_in_ngcp_type($servdesc) and
            serv_in_role($servdesc))
        {
            if ($servdesc->{node} eq 'active') {
                $exp_status = $host_attrs{active} ? 'active' : 'inactive';
            } else {
                $exp_status = 'active';
            }
        }

        # Check the current status.
        my $cur_status = $servdesc->{props}{systemd}{ActiveState};

        $services{$servdesc->{monit}} = {
            exp_status => $exp_status,
            cur_status => $cur_status,
        };
    }

    return \%services;
}

sub ngcp_kamailio_stats {
    my $attrs = shift;
    my $role = $attrs->{kamailio_role};
    my $xmlrpc = $kam_xmlrpc->{$role};

    my $stats_list = ngcp_kamcmd($xmlrpc, 'stats.get_statistics', 'all');
    my $stats = {};
    foreach my $s (@{$stats_list}) {
        chomp $s;
        my ($k, $v) = split /\s*=\s*/, $s;
        $k =~ tr/:-/_/;
        $stats->{$k} = $1 if $v =~ m/^(\d+)$/;
    }

    foreach my $metric (keys %{$stats}) {
        my ($name, %mattrs);

        %mattrs = %{$attrs};

        if ($metric =~ m/^core_rcv_(?:replies|requests)$/) {
            # Included as part of the accumulated codes.
            next;
        } elsif ($metric =~ m/^core_rcv_replies_([0-9]xx)$/) {
            $name = 'core_rcv_replies';
            $mattrs{code} = $1;
        } elsif ($metric =~ m/^core_rcv_replies_([0-9]xx)_([a-z]+)$/) {
            $name = 'core_rcv_replies_bymethod';
            $mattrs{code} = $1;
            $mattrs{method} = $2;
        } elsif ($metric =~ m/^core_rcv_requests_([a-z]+)$/) {
            $name = 'core_rcv_requests_bymethod';
            $mattrs{method} = $1;
        } elsif ($metric =~ m/^sl_([0-9x]{3})_replies$/) {
            $name = 'sl_replies';
            $mattrs{code} = $1;
        } elsif ($metric =~ m/^tmx_([0-9x]{3})_transactions$/) {
            $name = 'tmx_transactions';
            $mattrs{code} = $1;
        } else {
            $name = $metric;
        }

        $prom->set("ngcp_kamailio_$name", $stats->{$metric}, \%mattrs);
    }

    return;
}

sub ngcp_kamailio_pkgmem {
    my $attrs = shift;
    my $role = $attrs->{kamailio_role};
    my $xmlrpc = $kam_xmlrpc->{$role};

    my %name_map = (
        rank => 'rank',
        used => 'used_bytes',
        free => 'free_bytes',
        real_used => 'real_used_bytes',
        total_size => 'size_bytes_total',
        total_frags => 'frags_total',
    );

    my $stats = ngcp_kamcmd($xmlrpc, 'pkg.stats');
    foreach my $proc (@{$stats}) {
        foreach my $name (keys %name_map) {
            next unless exists $proc->{$name};

            my $alias = $name_map{$name};

            $prom->set("ngcp_kamailio_pkgmem_$alias", $proc->{$name}, {
                %{$attrs},
                desc => $proc->{desc},
            });
        }
    }

    return;
}

sub ngcp_kamailio_dialogs {
    my $attrs = shift;
    my $role = $attrs->{kamailio_role};
    my $xmlrpc = $kam_xmlrpc->{$role};

    return unless $role eq 'proxy';

    my %dialog;
    my $profiles = ngcp_kamcmd($xmlrpc, 'dlg.profile_get_sizes');
    foreach my $profile (@{$profiles}) {
        my $name = $profile->{name};
        my $size = $profile->{size};

        $dialog{$name} = $size;
        $prom->set("ngcp_sip_dialog_$name", $size, $attrs);
    }

    return \%dialog;
}

sub ngcp_fetch_call_info {
    my %calls = map { $_ => 0 } qw(answered rejects total);

    my $dbh = ngcp_get_dbh($dbs->{central});
    return %calls unless defined $dbh;

    my $sql = "SELECT sip_code, amount FROM stats.call_info " .
              "WHERE period = DATE_FORMAT(DATE_SUB(NOW(), INTERVAL 1 HOUR), '%Y-%m-%d %H:00:00')";

    my $sth = $dbh->prepare($sql);
    $sth->execute();
    while (my $row = $sth->fetchrow_hashref) {
        my ($sip_code, $amount) = ($row->{sip_code}, $row->{amount});

        next unless $sip_code && $amount;

        # We do not handle SIP code 204 here because that is for a
        # SUBSCRIBE message within an already established dialog.
        if ($sip_code == 200) {
            $calls{answered} += $amount;
        } elsif ($sip_code =~ /^4\d+/) {
            $calls{rejects} += $amount;
        }
        $calls{total} += $amount;
    }
    $sth->finish();

    return %calls;
}

sub ngcp_witness {
    my ($out, $val, $sql);

    ngcp_checkpoint('init');

    ## Setup data sources

    # Data source: MySQL/MariaDB
    ngcp_checkpoint('datasource-db');
    foreach my $ds (keys %{$dbs}) {
        # Reset the error flag per iteration, so that we will try to reconnect
        # in case the data source has been made available.
        $dbs->{$ds}{connection_failed} = undef;
    }

    # Data source: Redis
    ngcp_checkpoint('datasource-redis');
    my $redis = {};
    $redis->{proxy_dialog} = NGCP::Redis->new(server => $config{redis_central_host});
    $redis->{proxy_dialog}->select($config{redis_central_db_proxy_dialog});

    $redis->{proxy_usrloc} = NGCP::Redis->new(server => $config{redis_central_host});
    $redis->{proxy_usrloc}->select($config{redis_central_db_proxy_usrloc});

    $redis->{proxy_kam_dialog} = NGCP::Redis->new(server => $config{redis_local_host});
    $redis->{proxy_kam_dialog}->select($config{redis_local_db_proxy_kam_dialog});

    ## Cluster node information
    ngcp_checkpoint('cluster-node');
    my $ha_proc_state = ngcp_ha_proc_state();
    my $ha_host_state = ngcp_ha_host_state($hostname_g);
    my $ha_node_state = ngcp_ha_node_state();

    my ($active, $realactive);

    # Check if active node.
    ngcp_checkpoint('active-node');
    $realactive = ngcp_node_is_active($ha_node_state);
    if ($config{force_checks} == 1 or $realactive == 1) {
        $active = 1;
    } else {
        $active = 0;
    }

    my $ha_attrs = {
        node_active => $realactive,
    };

    $prom->set('ngcp_node_active', $realactive);
    $prom->set('ngcp_node_ha_proc_state', $ha_proc_state);
    $prom->set('ngcp_node_ha_host_state', $ha_host_state);
    $prom->set('ngcp_node_ha_node_state', $ha_node_state);

    # Collect license client data.
    if ($config{license_client_enable}) {
        ngcp_checkpoint('license-client');

        my $license_valid = ngcp_license_valid();
        my $license_valid_until = ngcp_license_file_slurp('valid_until');
        $prom->set('ngcp_license_valid', $license_valid);
        $prom->set('ngcp_license_valid_until', $license_valid_until);

        my %dir2feature = (
            errors => 'error',
            flags => 'flag',
            current => 'total',
        );

        foreach my $dir (qw(errors flags current)) {
            my $data = ngcp_license_dir_slurp($dir);
            my $name = $dir2feature{$dir};

            foreach my $item (keys %{$data}) {
                # An empty value means the feature is known but the check is
                # not implemented yet.
                $data->{$item} = -1 unless length $data->{$item};
                my $feature = $item =~ tr{-}{_}r;
                $prom->set("ngcp_license_feature_${feature}_${name}", $data->{$item});
            }
        }

        my $max = ngcp_license_dir_slurp('max');
        foreach my $item (keys %{$max}) {
            next unless length $max->{$item};
            $max->{$item} = -1 if $max->{$item} eq 'unlimited';
            $prom->set("ngcp_license_feature_${item}_max", $max->{$item});
        }
    }

    # Collect TLS certificate data.
    if ($config{tls_certs_enable}) {
        ngcp_checkpoint('tls-certs');
        # We throttle the check to at most once a day, given that the
        # certificate expiration granularity is on daily basis, so checking
        # more often is a pointless waste of resources.
        state $certs_state = {};
        my $certs = ngcp_throttle_check($certs_state, 86400, \&scan_tls_certs);

        foreach my $certfgr (sort keys %{$certs}) {
            $prom->set('ngcp_tls_certs_expires_on',
                       $certs->{$certfgr}->{expires_on}->epoch, {
                filename => $certs->{$certfgr}->{filename},
                fingerprint => $certs->{$certfgr}->{fingerprint},
            });
        }
    }

    # Collect process data from monit
    ngcp_checkpoint('monit');
    my $servs = ngcp_monit_servs(active => $realactive);
    my $procs = ngcp_monit_procs();
    foreach my $procname (keys %{$procs}) {
        my $serv = $servs->{$procname};
        my $proc = $procs->{$procname};
        my $proc_attrs = {
            name => $procname,
        };
        $proc_attrs->{pid} = $proc->{pid} if defined $proc->{pid};
        my $proc_info = {
            %{$proc_attrs},
            proc_status => $proc->{proc_status},
            monit_status => $proc->{monit_status},
            service_cur_status => $serv->{cur_status},
            service_exp_status => $serv->{exp_status},
        };
        $proc_info->{ppid} = $proc->{ppid} if defined $proc->{ppid};

        # Expose metrics.
        $prom->set('ngcp_monit_proc_info', 1, $proc_info);
        $prom->set('ngcp_monit_proc_uptime', $proc->{uptime}, $proc_attrs)
            if defined $proc->{uptime};
        $prom->set('ngcp_monit_proc_children', $proc->{children}, $proc_attrs)
            if defined $proc->{children};
        $prom->set('ngcp_monit_proc_memory_bytes', $proc->{memory}, $proc_attrs)
            if defined $proc->{memory};
        $prom->set('ngcp_monit_proc_memory_total_bytes', $proc->{memory_total}, $proc_attrs)
            if defined $proc->{memory_total};
        $prom->set('ngcp_monit_proc_cpu_ratio', $proc->{cpu_percent}, $proc_attrs)
            if defined $proc->{cpu_percent};
        $prom->set('ngcp_monit_proc_cpu_total_ratio', $proc->{cpu_percent_total}, $proc_attrs)
            if defined $proc->{cpu_percent_total};

        if (defined $proc->{port_response_time} &&
            $proc->{port_response_time} =~ m/^([0-9.]+) (ms|s|m) to (.*)$/m) {
            my %port;
            @port{qw(time time_unit target)} = ($1, $2, $3);

            ngcp_monit_response_time_to_seconds(\%port);
            $prom->set('ngcp_monit_proc_port_response_seconds', $port{time},
                       { %{$proc_attrs}, target => $port{target} });
        }
        if (defined $proc->{sock_response_time} &&
            $proc->{sock_response_time} =~ m/^([0-9.]+) (ms|s|m) to (.*)$/m) {
            my %sock;

            @sock{qw(time time_unit target)} = ($1, $2, $3);

            ngcp_monit_response_time_to_seconds(\%sock);
            $prom->set('ngcp_monit_proc_sock_response_seconds', $sock{time},
                       { %{$proc_attrs}, target => $sock{target} });
        }

        $prom->set('ngcp_monit_proc_data_collected', $proc->{data_collected}, $proc_attrs);
    }

    ## MySQL/MariaDB
    ngcp_checkpoint('mariadb');

    foreach my $ds_name (@{$config{mysql_check_instances}}) {
        my $ds = $dbs->{$ds_name};

        if (not defined $ds) {
            warning("unknown database instance name: $ds_name");
            next;
        }

        my $mysql_attrs = {
            server => "$ds->{host}:$ds->{port}",
        };

        # MySQL check plugin
        if ($config{mysql_check_enable}) {
            ngcp_checkpoint('mariadb-global-status');
            my $status = ngcp_mysql_global_status($ds);

            if (defined $status) {
                my $queries_per_sec;

                # If MySQL just started, consider we have a 0 average queries
                # per second.
                if ($status->{uptime} == 0) {
                    $queries_per_sec = 0;
                } else {
                    $queries_per_sec = $status->{queries} / $status->{uptime};
                }

                $prom->set('ngcp_mysql_queries_per_second_average',
                    $queries_per_sec, $mysql_attrs);

                foreach my $type (qw(total free dirty)) {
                    $prom->set("ngcp_mysql_global_status_innodb_buffer_pool_pages_$type",
                        $status->{"innodb_buffer_pool_pages_$type"},
                        $mysql_attrs,
                    );
                }

                foreach my $cmd (qw(delete insert select update)) {
                    $prom->set('ngcp_mysql_global_status_commands_total',
                        $status->{"com_$cmd"}, {
                            %{$mysql_attrs},
                            command => $cmd,
                        }
                    );
                }
            }
        }

        # MySQL slave status
        if ($config{mysql_check_replication}) {
            ngcp_checkpoint('mariadb-slave-status');
            my $slave_status = ngcp_mysql_slave_status($ds);

            if (defined $slave_status) {
                $prom->set("ngcp_mysql_slave_status_slave_io_running",
                           ngcp_mysql_parse_status_value($slave_status->{Slave_IO_Running}), $mysql_attrs);
                $prom->set("ngcp_mysql_slave_status_slave_sql_running",
                           ngcp_mysql_parse_status_value($slave_status->{Slave_SQL_Running}), $mysql_attrs);
                $prom->set("ngcp_mysql_slave_status_seconds_behind_master",
                           $slave_status->{Seconds_Behind_Master} // -1, $mysql_attrs);

                my %errno_attrs;

                %errno_attrs = %{$mysql_attrs};
                if (exists $slave_status->{Last_IO_Error}) {
                    $errno_attrs{error} = uri_escape($slave_status->{Last_IO_Error});
                }
                $prom->set("ngcp_mysql_slave_status_last_io_errno",
                           $slave_status->{Last_IO_Errno} // 0, {
                    %errno_attrs,
                });

                %errno_attrs = %{$mysql_attrs};
                if (exists $slave_status->{Last_SQL_Error}) {
                    $errno_attrs{error} = uri_escape($slave_status->{Last_SQL_Error});
                }
                $prom->set("ngcp_mysql_slave_status_last_sql_errno",
                           $slave_status->{Last_SQL_Errno} // 0, {
                    %errno_attrs,
                });
            }
        }
    }

    # MTA queue plugin
    if ($config{mta_queue_check_enable}) {
        ngcp_checkpoint('mta');
        my $mta_queue = get_exim_queue_count(
            spooldir => $config{mta_exim_spool_dir},
        );

        $prom->set('ngcp_mail_mta_queue', $mta_queue);
    }

    ## Kamailio

    # Kamailio LB
    my $kam_lb_attrs = {
        %{$ha_attrs},
        kamailio_role => 'lb',
    };

    $config{kam_lb_stats_enable} ||= $config{kam_lb_shmem_enable};

    if ($config{kam_lb_stats_enable} and $active) {
        ngcp_checkpoint('kam-stats-lb');
        ngcp_kamailio_stats($kam_lb_attrs);
    }
    if ($config{kam_peer_stats_enable} and $active) {
        ngcp_checkpoint('kam-peer-stats-lb');
        ngcp_kamailio_peer_stats();
    }

    # Kamailio package memory plugin
    if ($config{kam_lb_pkgmem_enable} and $active) {
        ngcp_checkpoint('kam-pkgmem-lb');
        ngcp_kamailio_pkgmem($kam_lb_attrs);
    }

    # Kamailio PROXY
    my $kam_dialog;
    my $kam_attrs = {
        %{$ha_attrs},
        kamailio_role => 'proxy',
    };

    $config{kam_proxy_stats_enable} ||= $config{kam_proxy_shmem_enable};

    if ($config{kam_proxy_stats_enable} and $active) {
        ngcp_checkpoint('kam-stats-proxy');
        ngcp_kamailio_stats($kam_attrs);
        ngcp_checkpoint('kam-dialogs-proxy');
        $kam_dialog = ngcp_kamailio_dialogs($kam_attrs);
    }

    # SIP current concurrent calls count
    if ($config{sip_concurrent_calls_enable}) {
        $val = 0;

        my @sip_attrs = qw(
            from_internal
            from_peer
            from_faxserver
        );
        if ($active && all { defined } @{$kam_dialog}{@sip_attrs}) {
            ngcp_checkpoint('sip-concurrent-calls');
            $val = sum @{$kam_dialog}{@sip_attrs};
        }

        $prom->set("ngcp_sip_concurrent_calls", $val, $kam_attrs);
    }

    # SIP active dialog plugin
    if ($config{sip_dialog_active_enable}) {
        $val = 0;
        if ($active) {
            ngcp_checkpoint('sip-dialog-active');
            $val = $redis->{proxy_kam_dialog}->scard('dialog:master') || 0;
        }

        $prom->set("ngcp_sip_dialog_active", $val, $kam_attrs);
    }

    # SIP early dialog plugin
    if ($config{sip_dialog_early_enable}) {
        $val = 0;
        if ($active) {
            ngcp_checkpoint('sip-dialog-early');
            my $dialogs = ngcp_kamcmd($kam_xmlrpc->{proxy}, 'stats.get_statistics', 'dialog', 'early_dialogs');
            foreach my $dialog (@{$dialogs}) {
                if ($dialog =~ /early_dialogs\ =\ (\d+)/) {
                    $val = $1;
                }
            }
        }

        $prom->set("ngcp_sip_dialog_early", $val, $kam_attrs);
    }

    # SIP local call count plugin
    if ($config{sip_dialog_local_enable}) {
        $val = 0;
        if ($active) {
            ngcp_checkpoint('sip-dialog-local');
            $val = $redis->{proxy_dialog}->get("local") || 0;
        }

        $prom->set("ngcp_sip_dialog_local", $val, $kam_attrs);
    }

    # SIP relay call count plugin
    if ($config{sip_dialog_relay_enable}) {
        $val = 0;
        if ($active) {
            ngcp_checkpoint('sip-dialog-relay');
            $val = $redis->{proxy_dialog}->get("relay") || 0;
        }

        $prom->set("ngcp_sip_dialog_relay", $val, $kam_attrs);
    }

    # SIP incoming call count plugin
    if ($config{sip_dialog_incoming_enable}) {
        $val = 0;
        if ($active) {
            ngcp_checkpoint('sip-dialog-incoming');
            $val = $redis->{proxy_dialog}->get("incoming") || 0;
        }

        $prom->set("ngcp_sip_dialog_incoming", $val, $kam_attrs);
    }

    # SIP outgoing call count plugin
    if ($config{sip_dialog_outgoing_enable}) {
        $val = 0;
        if ($active) {
            ngcp_checkpoint('sip-dialog-outgoing');
            $val = $redis->{proxy_dialog}->get("outgoing") || 0;
        }

        $prom->set("ngcp_sip_dialog_outgoing", $val, $kam_attrs);
    }

    # SIP registered subscriber count plugin
    if ($config{sip_registered_subscribers_enable}) {
        $val = 0;
        ngcp_checkpoint('sip-reg-subs');
        $val = $redis->{proxy_usrloc}->scard('1:location::index::usrdom') || 0;

        $prom->set("ngcp_sip_registered_subscribers", $val, $kam_attrs);
    }

    # SIP registered devices count plugin
    if ($config{sip_registered_devices_enable}) {
        $val = 0;
        ngcp_checkpoint('sip-reg-devs');
        $val = $redis->{proxy_usrloc}->scard('1:location:master') || 0;

        $prom->set("ngcp_sip_registered_devices", $val, $kam_attrs);

        foreach my $id (@{$config{sip_registered_devices_server_ids}}) {
            my %server_attrs = (
                %{$kam_attrs},
                server_id => $id,
        );

            $val = 0;
            $val = $redis->{proxy_usrloc}->scard("1:location:server::$id") || 0;

            $prom->set("ngcp_sip_registered_devices_byserver", $val, \%server_attrs);
        }
    }

    # Kamailio package memory plugin
    if ($config{kam_proxy_pkgmem_enable} and $active) {
        ngcp_checkpoint('kam-pkgmem-proxy');
        ngcp_kamailio_pkgmem($kam_attrs);
    }

    ## SIP stats

    # SIP check plugin
    if ($config{sip_check_enable} and $active) {
        ngcp_checkpoint('sip-option');
        my $sip = check_sip_option(
            uri => "$config{sip_uri}:$config{sip_port}",
            proxy => "$config{sip_check_ip}:$config{sip_check_port}",
        );

        if (defined $sip and exists $sip->{duration}) {
            $prom->set('ngcp_sip_responsiveness_seconds', $sip->{duration}, $ha_attrs);
        }
    }

    # SIP provisioned subscribers plugin
    if ($config{sip_provisioned_subscribers_enable}) {
        ngcp_checkpoint('sip-prov-subs');
        $sql = "SELECT COUNT(id) FROM billing.voip_subscribers " .
               "WHERE status != 'terminated'";
        $val = ngcp_mysql_fetch_value_int($dbs->{central}, $sql);

        $prom->set('ngcp_sip_provisioned_subscribers', $val, $ha_attrs);
    }

    # SIP ASR/NER statistics
    if ($config{sip_asr_ner_statistics}) {
        ngcp_checkpoint('sip-asr-ner');
        my %calls = ngcp_fetch_call_info();

        my $asr; # ASR ratio
        my $ner; # NER ratio

        if ($calls{total} > 0) {
            $asr = $calls{answered} / $calls{total};
            $ner = ($calls{answered} + $calls{rejects}) / $calls{total};
        } else {
            $asr = 0;
            $ner = 0;
        }

        $prom->set('ngcp_sip_answer_seizure_ratio', $asr, $ha_attrs);
        $prom->set('ngcp_sip_network_efficiency_ratio', $ner, $ha_attrs);
    }

    ## CDR statistics

    # CDR all time total
    if ($config{cdr_total_enable}) {
        $val = 0;
        if ($active) {
            ngcp_checkpoint('cdr-total');
            $sql = 'SELECT COALESCE(IF(@@auto_increment_increment = 2,' .
                                        "(MAX(id) - MIN(id))/2," .
                                        "MAX(id) - MIN(id)" .
                                     ") + 1,0) FROM accounting.cdr";
            $val = ngcp_mysql_fetch_value_int($dbs->{central}, $sql);
        }

        $prom->set('ngcp_cdr_total', $val, $ha_attrs);
    }

    # CDR all time rated
    if ($config{cdr_rated_total_enable}) {
        $val = 0;
        if ($active) {
            ngcp_checkpoint('cdr-rated-total');
            $sql = "SELECT SUM(cdr_count) FROM accounting.cdr_period_costs " .
                   "WHERE period = 'month'";
            $val = ngcp_mysql_fetch_value_int($dbs->{central}, $sql);
        }

        $prom->set('ngcp_cdr_rated_total', $val, $ha_attrs);
    }

    # Peering groups.

    if ($config{peering_groups_enable}) {
        my $peer_probes;

        # We might not always have probe status information, so the peering
        # monitoring sub needs to cope with that.
        if ($config{kam_peer_probe_enable} and $active) {
            ngcp_checkpoint('kam-peer-probes');
            $peer_probes = ngcp_fetch_peer_probes();
        }
        ngcp_checkpoint('kam-peering');
        ngcp_peering($dbs->{local}, $redis->{proxy_dialog}, $peer_probes,
                     $realactive);
    }

    ngcp_checkpoint('end');

    return 1;
}

##
## Generic daemon code.
##

sub notify_send {
    my $message = shift;

    if ($ENV{NOTIFY_SOCKET}) {
        my $addr = $ENV{NOTIFY_SOCKET} =~ s/^@/\0/r;
        my $sock = IO::Socket::UNIX->new(
            Type => SOCK_DGRAM(),
            Peer => $addr,
        ) or warning("cannot connect to socket $ENV{NOTIFY_SOCKET}: $!");
        if ($sock) {
            $sock->autoflush(1);
            print { $sock } $message
                or warning("cannot send to socket $ENV{NOTIFY_SOCKET}: $!");
            close $sock;
        }
    } else {
        warning("NOTIFY_SOCKET environment variable not set");
    }
}

sub notify_ready {
    notice('NGCP witnessd ready');
    notify_send("READY=1\n");
}

sub notify_stopping {
    notify_send("STOPPING=1\n");
    notice('NGCP witnessd stopping');
}

sub write_pidfile {
    my $pid = shift;

    open my $pidfh, '>', $config{pidfile}
        or error("cannot create pidfile $config{pidfile}");
    print { $pidfh } "$pid\n";
    close $pidfh or error("cannot close pidfile $config{pidfile}");

    return;
}

sub remove_pidfile {
    unlink $config{pidfile};

    return;
}

sub self_is_running {
    return 0 unless -e $config{pidfile};

    open my $pidfh, '<', $config{pidfile}
        or error("cannot open pidfile $config{pidfile}");
    my ($pid) = <$pidfh>;
    close $pidfh;

    return 1 if kill $pid, 0;
    unlink $config{pidfile};
    return 0;
}

sub wait_for_child {
    my $pid = shift;
    my $child;

    do {
        $child = waitpid $pid, 0;
    } while ($child < 0 && $! == EINTR);

    error("error waiting for child (PID $child)") if $child != $pid;

    if (WIFEXITED($?)) {
        my $rc = WEXITSTATUS($?);

        error("child returned error exit status $rc") if $rc;
    } elsif (WIFSIGNALED($?)) {
        my $signo = WTERMSIG($?);

        error("child was killed by signal $signo");
    } else {
        error("unexpected status $? waiting for child");
    }

    return;
}

sub daemonize {
    my $pid;

    $pid = fork;
    if ($pid < 0) {
        error("cannot do first fork");
    } elsif ($pid > 0) {
        # First parent.
        wait_for_child($pid);

        _exit(0);
    }

    if (setsid() < 0) {
        error("cannot set session ID");
    }

    $pid = fork;
    if ($pid < 0) {
        error("cannot do second fork");
    } elsif ($pid > 0) {
        # Second parent.
        write_pidfile($pid);
        _exit 0;
    }

    return;
}

sub setup_logfile {
    my $logfile = $config{logfile};

    return if $logfile eq 'console' or $logfile eq 'syslog';

    open my $logfilefh, '>>', $logfile
        or error("cannot open logfile $logfile");
    open STDOUT, '>&', $logfilefh
        or error("cannot redirect stdout to $logfile");
    open STDERR, '>&', $logfilefh
        or error("cannot redirect stderr to $logfile");

    return;
}

sub setup_logging {
    open my $devnullfh, '+<', '/dev/null' or error("cannot open /dev/null");
    open STDIN, '<&', $devnullfh or error("cannot quiesce stdin");

    # We need to undef these typeglobs, or we get redefinition warnings.
    undef *warning;
    undef *error;

    ## no critic (Variables::RequireLocalizedPunctuationVars)
    if ($config{logfile} eq 'syslog') {
        openlog($PROGNAME, 'pid', 'daemon');

        if (not $config{debug}) {
            setlogmask(LOG_UPTO(LOG_INFO));
        }
        *debug = sub { syslog('debug', @_) };
        *notice = sub { syslog('notice', @_) };
        *warning = sub { syslog('warning', @_) };
        *error = sub { syslog('err', @_); die "$PROGNAME: @_\n" };
        *stop_logging = sub { closelog() };

        open STDOUT, '>&', $devnullfh or error("cannot quiesce stdout");
        # XXX: Ideally we would redirect stderr to syslog too, but for now
        # we just rely on systemd sending it there.
    } else {
        if ($config{debug}) {
            *debug = sub { print { \*STDERR } "D: @_\n" };
        } else {
            *debug = sub { };
        }
        *notice = sub { print log_formatter(@_) };
        *warning = sub { warn log_formatter(@_) };
        *error = sub { die log_formatter(@_) };
        *stop_logging = sub { };

        setup_logfile();
    }

    ## no critic (Variables::RequireLocalizedPunctuationVars)
    $SIG{__WARN__} = \&warning;
    $SIG{__DIE__} = \&error;
    ## use critic

    return;
}

sub log_formatter {
    my $msg = shift;

    chomp $msg;
    return sprintf "%s: %s\n", POSIX::strftime('%F %T', localtime), $msg;
}

sub sig_reload {
    setup_logfile();

    return;
}

sub version {
    printf "%s version %s\n", $PROGNAME, $VERSION;
    return;
}

sub usage {
    printf <<'HELP', $PROGNAME;
Usage: %s [<option>...]

Options:
      --interval=N          Specify the check interval (default is 10).
      --[no-]daemonize      Specify whether to daemonize (default is yes).
      --pidfile=PATHNAME    Specify the PID file PATHNAME.
      --logfile=PATHNAME    Specify the log file PATHNAME.
      --debug[=VALUE]       Select debug LEVEL (default is 0).
  -?, --help                Show this help message.
      --version             Show the version.
HELP
    return;
}

sub usage_error {
    my $msg = shift;

    warning($msg);
    warning("Use --help for program usage information.");
    exit 1;
}

##
## Main loop
##


$0 = $PROGNAME; ## no critic (Variables::RequireLocalizedPunctuationVars)

my @options_spec = (
    'help|?' => sub { usage; exit 0; },
    'version' => sub { version; exit 0; },
    'debug:1' => \$config{debug},
    'pidfile=s' => \$config{pidfile},
    'logfile=s' => \$config{logfile},
    'daemonize!' => \$config{daemonize},
    'interval=i' => \$config{interval},
);

{
    local $SIG{__WARN__} = sub { usage_error($_[0]) };
    GetOptions(@options_spec);
}

if (self_is_running) {
    error("daemon is already running");
}

if ($config{daemonize}) {
    daemonize();
} else {
    write_pidfile($$);
}

setup_logging();

## no critic (Variables::RequireLocalizedPunctuationVars)
$SIG{'HUP'} = \&sig_reload;

notice("Initializing NGCP witnessd");

# Setup databases.
foreach my $db (qw(central local pair)) {
    my $dbhost = $config{"db_${db}_host"};
    my $dbport = $config{"db_${db}_port"};

    $dbs->{$db}{port} = $dbport;
    $dbs->{$db}{host} = $dbhost;
    $dbs->{$db}{dsn} = "DBI:mysql:host=$dbhost;port=$dbport;mysql_read_default_file=$config{db_cred_file}";
}

# Data source: kamailio
my $kam_addr_lb = "http://$config{kam_lb_host}:$config{kam_lb_port}";
my $kam_addr_proxy = "http://$config{kam_proxy_host}:$config{kam_proxy_port}";
$kam_xmlrpc->{lb} = XMLRPC::Lite->proxy($kam_addr_lb, timeout => 4);
$kam_xmlrpc->{proxy} = XMLRPC::Lite->proxy($kam_addr_proxy, timeout => 4);

my $app = Mojolicious->new(
    moniker => $PROGNAME,
    mode => $config{debug} ? 'development' : 'production',
);
my $r = $app->routes->namespaces([]);

$r->get('/metrics', sub {
    my $c = shift;

    $prom = Prometheus::Tiny->new();

    ngcp_witness();

    $c->render(text => $prom->format, format => 'txt');
});

my @listen_addr = map {
    "http://$_:$config{listen_port}"
} @{$config{listen_host}};

my $d = Mojo::Server::Daemon->new(
    app => $app,
    listen => [ @listen_addr ],
    keep_alive_timeout => 30,
);

notify_ready();

$d->run;

notify_stopping();

remove_pidfile();

stop_logging();

1;

__END__

=head1 NAME

ngcp-witnessd - Sipwise NGCP Witness daemon

=head1 SYNOPSIS

ngcp-witnessd [I<option>...]

=head1 DESCRIPTION

B<ngcp-witnessd> is a monitoring daemon that collects information from the
Sipwise NGCP. It exports the metrics via Prometheus endpoints, to be scrapped
or queried by other parts of the monitoring stack for reporting, checking or
alarm triggering.

=head1 OPTIONS

=over 4

=item --interval=I<SECS>

Specify the information fetch interval, in seconds. The default is B<10>.

=item --[no-]daemonize

Specifies whether the program should daemonize. The default is to daemonize.

=item --pidfile=I<PATHNAME>

Sets the PID file pathname. The default is F</run/ngcp-witnessd.pid>.

=item --logfile=I<LOCATION>

Sets the location where to log. I<LOCATION> can be either B<syslog> to log
to the system log daemon, B<console> to log to the console, or a pathname
to log a to a file. The default is B<syslog>.

=item --debug[=I<BOOL>]

Sets the debug mode. The supported values are B<false>, B<no>, B<0> and
B<true>, B<yes>, B<1>.
The default is B<false>.

=item -?, --help

Show the help message and exit.

=item --version

Show the version.

=back

=head1 EXIT STATUS

On success B<ngcp-witnessd> will exit with status 0. If there is any error
it will exit with a non-zero status.

=head1 CONFIGURATION

The daemon can be configured with F</etc/ngcp-witnessd/ngcp-witnessd.conf>.

The format of the file is a list of variables where their values are assigned
with B<=>, with one assignment per line. The variable names are
case-insensitive.

All variables are singletons, and multiple assignments will override previous
ones, except for B<listen_host> and B<mysql_check_instances> which
are arrays where multiple assignments will append the values into a list.

=head1 AUTHOR

Guillem Jover <gjover@sipwise.com>

=head1 LICENSE

GPL-3+, Sipwise GmbH, Austria.

=cut
