#!/usr/bin/perl
# nagios: -epn
package main;
# check_rbl is a Nagios plugin to check if an SMTP server is black- or
# white- listed
#
# See the INSTALL file for installation instructions
#
# Copyright (c) 2009-2019 Matteo Corti <matteo@corti.li>
# Copyright (c) 2009 ETH Zurich.
# Copyright (c) 2010 Elan Ruusamae <glen@delfi.ee>.
#
# This module is free software; you can redistribute it and/or modify it
# under the terms of GNU general public license (gpl) version 3.
# See the LICENSE file for details.
use strict;
use warnings;
our $VERSION = '1.5.3';
use Data::Validate::Domain qw(is_hostname);
use Data::Validate::IP qw(is_ipv4 is_ipv6);
use IO::Select;
use Net::DNS;
use Net::IP qw(ip_expand_address);
use Readonly;
use English qw(-no_match_vars);
my $plugin_module = load_module( 'Monitoring::Plugin', 'Nagios::Plugin' );
my $plugin_threshold_module =
load_module( 'Monitoring::Plugin::Threshold', 'Nagios::Plugin::Threshold' );
my $plugin_getopt_module =
load_module( 'Monitoring::Plugin::Getopt', 'Nagios::Plugin::Getopt' );
# Check which version of the monitoring plugins is available
sub load_module {
my @names = @_;
my $loaded_module;
for my $name (@names) {
my $file = $name;
# requires need either a bare word or a file name
$file =~ s{::}{/}gsxm;
$file .= '.pm';
eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
require $file;
$name->import();
};
if ( !$EVAL_ERROR ) {
$loaded_module = $name;
last;
}
}
if ( !$loaded_module ) {
#<<<
print 'CHECK_RBL: plugin not found: ' . join( ', ', @names ) . "\n"; ## no critic (RequireCheckedSyscall)
#>>>
exit 2;
}
return $loaded_module;
}
Readonly our $DEFAULT_TIMEOUT => 15;
Readonly our $DEFAULT_RETRIES => 4;
Readonly our $DEFAULT_WORKERS => 20;
Readonly our $DEFAULT_QUERY_TIMEOUT => 15;
Readonly our $DEFAULT_APPEND_STRING => q{};
# IMPORTANT: Nagios plugins could be executed using embedded perl in this case
# the main routine would be executed as a subroutine and all the
# declared subroutines would therefore be inner subroutines
# This will cause all the global lexical variables not to stay shared
# in the subroutines!
#
# All variables are therefore declared as package variables...
#
## no critic (ProhibitPackageVars)
our ( @listed, @timeouts, $options, $plugin, $threshold, $timeouts_string, );
##############################################################################
# Usage : debug("some message string")
# Purpose : write a message if the debugging option was specified
# Returns : n/a
# Arguments : message : message string
# Throws : n/a
# Comments : n/a
# See also : n/a
sub debug {
# arguments
my $message = shift;
if ( !defined $message ) {
$plugin->nagios_exit( $plugin_module->UNKNOWN,
q{Internal error: not enough parameters for 'debug'} );
}
if ( $options && $options->debug() ) {
## no critic (RequireCheckedSyscall)
print "[DBG] $message\n";
}
return;
}
##############################################################################
# Usage : verbose("some message string", $optional_verbosity_level);
# Purpose : write a message if the verbosity level is high enough
# Returns : n/a
# Arguments : message : message string
# level : options verbosity level
# Throws : n/a
# Comments : n/a
# See also : n/a
sub verbose {
# arguments
my $message = shift;
my $level = shift;
if ( !defined $message ) {
$plugin->nagios_exit( $plugin_module->UNKNOWN,
q{Internal error: not enough parameters for 'verbose'} );
}
if ( !defined $level ) {
$level = 0;
}
if ( $level < $options->verbose ) {
if ( !print $message ) {
$plugin->nagios_exit( $plugin_module->UNKNOWN,
'Error: cannot write to STDOUT' );
}
}
return;
}
# the script is declared as a package so that it can be unit tested
# but it should not be used as a module
if ( !caller ) {
run();
}
##############################################################################
# Usage : my $res = init_dns_resolver( $retries )
# Purpose : Initializes a new DNS resolver
# Arguments : retries : number of retries
# Returns : The newly created resolver
# See also : Perl Net::DNS
sub init_dns_resolver {
my $retries = shift;
my $res = Net::DNS::Resolver->new();
if ( $res->can('force_v4') ) {
$res->force_v4(1);
}
if ($retries) {
$res->retry($retries);
}
return $res;
}
##############################################################################
# Usage : mdns(\@addresses, $callback)
# Purpose : Perform multiple DNS lookups in parallel
# Returns : n/a
# See also : Perl Net::DNS module mresolv in examples
#
# Resolves all IPs in C<@addresses> in parallel.
# If answer is found C<$callback> is called with arguments as: $name, $host.
#
# Author: Elan Ruusamae <glen@delfi.ee>, (c) 1999-2010
## no critic (ProhibitExcessComplexity)
sub mdns {
my ( $data, $callback ) = @_;
# number of requests to have outstanding at any time
my $workers = $options ? $options->workers() : 1;
# timeout per query (seconds)
my $timeout = $options ? $options->get('query-timeout') : $DEFAULT_TIMEOUT;
my $res = init_dns_resolver( $options ? $options->retry() : 0 );
my $sel = IO::Select->new();
my $eof = 0;
my @addrs = @{$data};
my %addrs;
while (1) {
#----------------------------------------------------------------------
# Read names until we've filled our quota of outstanding requests.
#----------------------------------------------------------------------
while ( !$eof && $sel->count() < $workers ) {
my $name = shift @addrs;
if ( !defined $name ) {
debug('reading...EOF.');
$eof = 1;
last;
}
debug("reading...$name");
my $sock = $res->bgsend($name);
if ( !defined $sock ) {
verbose 'DNS query error: ' . $res->errorstring;
verbose "Skipping $name";
}
else {
# we store in a hash the query we made, as parsing it back from
# response gives different ip for ips with multiple hosts
$addrs{$sock} = $name;
$sel->add($sock);
debug( "name = $name, outstanding = " . $sel->count() );
}
}
#----------------------------------------------------------------------
# Wait for any replies. Remove any replies from the outstanding pool.
#----------------------------------------------------------------------
my @ready;
my $timed_out = 1;
debug('waiting for replies');
@ready = $sel->can_read($timeout);
while (@ready) {
$timed_out = 0;
debug( 'replies received: ' . scalar @ready );
foreach my $sock (@ready) {
debug('handling a reply');
my $addr = $addrs{$sock};
delete $addrs{$sock};
$sel->remove($sock);
my $ans = $res->bgread($sock);
my $host;
if ($ans) {
foreach my $rr ( $ans->answer ) {
debug('Processing answer');
## no critic(ProhibitDeepNests)
if ( !( $rr->type eq 'A' ) ) {
next;
}
$host = $rr->address;
debug("host = $host");
# take just the first answer
last;
}
}
else {
debug( 'no answer: ' . $res->errorstring() );
}
if ( defined $host ) {
debug("callback( $addr, $host )");
}
else {
debug("callback( $addr, <undefined> )");
}
&{$callback}( $addr, $host );
}
@ready = $sel->can_read(0);
}
#----------------------------------------------------------------------
# If we timed out waiting for replies, remove all entries from the
# outstanding pool.
#----------------------------------------------------------------------
if ($timed_out) {
debug('timeout: clearing the outstanding pool.');
foreach my $sock ( $sel->handles() ) {
my $addr = $addrs{$sock};
delete $addrs{$sock};
$sel->remove($sock);
# callback for hosts that timed out
&{$callback}( $addr, q{} );
}
}
debug( 'outstanding = ' . $sel->count() . ", eof = $eof" );
#----------------------------------------------------------------------
# We're done if there are no outstanding queries and we've read EOF.
#----------------------------------------------------------------------
last if ( $sel->count() == 0 ) && $eof;
}
return;
}
##############################################################################
# Usage : validate( $hostname );
# Purpose : check if an IP address or host name is valid
# Returns : the IP address corresponding to $hostname
# Arguments : n/a
# Throws : an UNKNOWN error if the argument is not valid
# Comments : n/a
# See also : n/a
sub validate {
my $hostname = shift;
my $ip = $hostname;
debug("validate($hostname, $ip)");
if ( !is_ipv4($hostname) && !is_ipv6($hostname) ) {
if ( is_hostname($hostname) ) {
mdns(
[$hostname],
sub {
my ( $addr, $host ) = @_;
$ip = $host;
}
);
if ( !$ip ) {
$plugin->nagios_exit( $plugin_module->UNKNOWN,
'Cannot resolve ' . $hostname );
}
}
if ( !$ip ) {
$plugin->nagios_exit( $plugin_module->UNKNOWN,
'Cannot resolve ' . $hostname );
}
}
if ( is_ipv6($ip) ) {
## no critic (ProhibitMagicNumbers)
$ip = Net::IP::ip_expand_address( $ip, 6 );
}
return $ip;
}
##############################################################################
# Usage : run();
# Purpose : main method
# Returns : n/a
# Arguments : n/a
# Throws : n/a
# Comments : n/a
# See also : n/a
## no critic (ProhibitExcessComplexity)
sub run {
################################################################################
# Initialization
$plugin = $plugin_module->new( shortname => 'CHECK_RBL' );
my $time = time;
########################
# Command line arguments
$options = $plugin_getopt_module->new(
usage => 'Usage: %s [OPTIONS]',
version => $VERSION,
url => 'http://matteocorti.github.io/check_rbl/',
blurb => 'Check SMTP black- or white- listing status',
);
$options->arg(
spec => 'critical|c=i',
help => 'Number of blacklisting servers for a critical warning',
required => 0,
default => 1,
);
$options->arg(
spec => 'warning|w=i',
help => 'Number of blacklisting servers for a warning',
required => 0,
default => 1,
);
$options->arg(
spec => 'debug|d',
help => 'Prints debugging information',
required => 0,
default => 0,
);
$options->arg(
spec => 'server|s=s@',
help => 'RBL server',
required => 1,
);
$options->arg(
spec => 'host|H=s',
help =>
'SMTP server to check. If hostname is given, it will be resolved to its IP first.',
required => 0,
);
$options->arg(
spec => 'url|U=s',
help => 'URL to check. Will be ignored if host is set.',
required => 0,
);
$options->arg(
spec => 'retry|r=i',
help => 'Number of times to try a DNS query (default is 4) ',
required => 0,
default => $DEFAULT_RETRIES,
);
$options->arg(
spec => 'workers=i',
help => 'Number of parallel checks',
required => 0,
default => $DEFAULT_WORKERS,
);
$options->arg(
spec => 'whitelistings|wl',
help => 'Check whitelistings instead of blacklistings',
required => 0,
default => 0,
);
$options->arg(
spec => 'query-timeout=i',
help => 'Timeout of the RBL queries',
required => 0,
default => $DEFAULT_QUERY_TIMEOUT,
);
$options->arg(
spec => 'append|a=s',
help => 'Append string at the end of the plugin output',
required => 0,
default => $DEFAULT_APPEND_STRING,
);
$options->getopts();
###############
# Sanity checks
if ( $options->critical < $options->warning ) {
$plugin->nagios_exit( $plugin_module->UNKNOWN,
'critical has to be greater or equal warning' );
}
if ( ( !defined $options->host || $options->host eq q{} )
&& ( !defined $options->url || $options->url eq q{} ) )
{
$plugin->nagios_exit( $plugin_module->UNKNOWN,
'host or url has to be set' );
}
my $check_prefix;
my $check_object;
if ( defined $options->host and $options->host ne q{} ) {
# if checking for host
# validate ip and resolve hostname if applicable
my $ip = validate( $options->host );
# reverse ip order
my $local_ip = $ip;
if ( is_ipv6($local_ip) ) {
$local_ip = reverse $local_ip;
$local_ip =~ s/://gmxs;
$local_ip =~ s/(.)/$1\./gmxs;
}
else {
$local_ip =~
s/(\d{1,3}) [.] (\d{1,3}) [.] (\d{1,3}) [.] (\d{1,3})/$4.$3.$2.$1/mxs;
}
$check_prefix = $local_ip;
$check_object = $options->host;
}
else {
# if checking for url, just set the prefix to the url name
$check_prefix = $options->url;
$check_object = $options->url;
}
my @servers = @{ $options->server };
verbose 'Using ' . $options->timeout . " as global script timeout\n";
alarm $options->timeout;
################
# Set the limits
# see https://nagios-plugins.org/doc/guidelines.html#THRESHOLDFORMAT
$threshold = $plugin_threshold_module->set_thresholds(
warning => $options->warning - 1,
critical => $options->critical - 1,
);
################################################################################
my $nservers = scalar @servers;
verbose 'Checking ' . $check_prefix . " on $nservers server(s)\n";
# build address lists
my @addrs;
foreach my $server (@servers) {
my $local_ip = $check_prefix . q{.} . $server;
push @addrs, $local_ip;
}
mdns(
\@addrs,
sub {
my ( $addr, $host ) = @_;
if ( defined $host ) {
debug("callback( $addr, $host )");
}
else {
debug("callback( $addr, <undefined> )");
}
# extract RBL we checked
$addr =~ s/^(?:[a-f\d][.]){32}//mxs;
$addr =~ s/^(?:\d+[.]){4}//mxs;
if ( defined $host ) {
if ( $host eq q{} ) {
push @timeouts, $addr;
}
else {
verbose "listed in $addr as $host\n";
if ( !$options->get('whitelistings') ) {
push @listed, $addr . ' (' . $host . ')';
}
}
}
else {
verbose "not listed in $addr\n";
if ( $options->get('whitelistings') ) {
push @listed, $addr;
}
}
}
);
my $total = scalar @listed;
my $status;
my $appendstring = $options->append;
if ( $options->get('whitelistings') ) {
$status =
$check_object
. " NOT WHITELISTED on $total "
. ( ( $total == 1 ) ? 'server' : 'servers' )
. " of $nservers";
}
else {
$status =
$check_object
. " BLACKLISTED on $total "
. ( ( $total == 1 ) ? 'server' : 'servers' )
. " of $nservers";
}
# append timeout info, but do not account these in status
if (@timeouts) {
$timeouts_string = scalar @timeouts;
$status =
" ($timeouts_string server"
. ( ( $timeouts_string > 1 ) ? 's' : q{} )
. ' timed out: '
. join( ', ', @timeouts ) . ')';
}
if ( $total > 0 ) {
$status .= " (@listed)";
}
$plugin->add_perfdata(
label => 'servers',
value => $total,
uom => q{},
threshold => $threshold,
);
$plugin->add_perfdata(
label => 'time',
value => time - $time,
uom => q{s},
);
# append string defined in append argument to status output
if ( $appendstring ne q{} ) {
$status .= " $appendstring";
}
$plugin->nagios_exit( $threshold->get_status($total), $status );
return;
}
1;
Copyright 2K16 - 2K18 Indonesian Hacker Rulez