#!/usr/bin/perl

# $Id: check_rbls,v 1.1 2006/11/06 13:37:27 fany Exp $

use 5.006;
use strict;
use warnings;

use Getopt::Long qw(GetOptions);
use Net::RBLClient  ();
use noris::NetSaint ();
use Regexp::Common qw(net);

sub aufzaehlung {
    @_ < 2 ? "@_" : join ' und ', join( ', ', @_[ 0 .. $#_ - 1 ] ), $_[-1];
}

my %RBL;
GetOptions(
    'help|?' => sub {
        require Config;
        Config->import;
        $0 =~ /^(.*)/;
        delete $ENV{PATH};
        no warnings 'once';
        no strict 'vars';
        exec "$Config{bin}/perldoc" => -F => $1
          or die "Cannot exec perldoc: $!\n";
    },
    'rbl=s%' => sub {
        ( undef, my $key, my $value ) = @_;
        unless ( exists $RBL{$key} ) {
            $RBL{$key} = $key eq 'lists' ? [$value] : $value;
        }
        elsif ( ref $RBL{$key} ) { push @{ $RBL{$key} }, $value }
        else { $RBL{$key} = [ $RBL{$key}, $value ] }
    },
    'rbls=s' => sub {
        ( undef, my $rbls ) = @_;
        push @{ $RBL{lists} }, split /\s*,\s*/, $rbls;
    },
) or exit noris::NetSaint::Status->new('Unknown');

die "USAGE: $0 <IP>+\n" unless @ARGV;

my $NetSaint = noris::NetSaint->new;

for (@ARGV) {
    my $rbl = Net::RBLClient->new(%RBL)
      or die "Cannot create Net::RBLClient object.\n";
    $rbl->lookup($_) or die "Unknown error during lookup for $_.";
    my $txt = {};
    $txt = $rbl->txt_hash if $RBL{query_txt};
    my ( @warnings, @criticals );
    {
        my %listed_hash = $rbl->listed_hash;
        push @{  $listed_hash{$_} =~ /^$RE{net}{IPv4}\z/
              && $listed_hash{$_} !~ /^127\./ ? \@warnings : \@criticals }, $_
          for sort keys %listed_hash;
    }
    $NetSaint->update(
        Critical => "$_ steht auf "
          . aufzaehlung(
            map defined $txt->{$_} ? qq($_ ("$txt->{$_}")) : $_, @criticals
          )
    ) if @criticals;
    $NetSaint->update(
        Warning =>
          aufzaehlung( map defined $txt->{$_} ? qq($_ ("$txt->{$_}")) : $_,
            @warnings )
          . ' '
          . ( @warnings == 1 ? 'ist' : 'sind' )
          . ' offenbar defekt'
    ) if @warnings;
}

$NetSaint->update( OK => 'Keine RBL-Eintrge gefunden.' )
  unless $NetSaint->message;

=head1 NAME

check_rbls - Abfrage diverser RBLs

=head1 SYNOPSE

    check_rbls 1.2.3.4 5.6.7.8

=head1 BESCHREIBUNG

Fragt diverse RBLs nach allen angegebenen IP-Adressen; sobald eine IP-Adresse
irgendwo eingetragen ist, gibt's einen kritischen Status.

=head1 OPTIONEN

=over 4

=item -rbl NAME=WERT

Hiermit knnen ggf. direkt Parameter an den Konstruktur von L<Net::RBLClient>
bergeben werden.
Wird mehrfach derselbe NAME angegeben, werden die WERTe automatisch zu einer
Array-Referenz zusammengesetzt.
Fr den NAMEn C<lists> wird in jedem Fall eine Array-Referenz erzeugt.

=item -rbls DOMAINS

Hiermit kann man die Domains mehrerer RBLs auf einen Schwung als komma-getrennte
Liste bergeben (oder die Option mehrfach verwenden).
Folgende Varianten sind also quivalent:

  -rbl lists=list.dsbl.org -rbl lists=bl.csma.biz
  -rbls lists.dsbl.org -rbls bl.csma.biz
  -rbls lists.dsbl.org,bl.csma.biz

=item -help | -?

zeigt (nur) diese Dokumentation an

=back

=head1 AUTOR

 Martin H. Sluka <fany@noris.net>
 fr die noris network AG

=cut

