#!/usr/bin/perl -T
#
# autofwd -- Auto-firewalling daemon
#
# (c) 2009, Arthur Corliss <corliss@digitalmages.com>
#
# $Id: autofwd.in,v 0.6 2011/05/03 05:00:00 acorliss Exp $
#
#    This software is licensed under the same terms as Perl, itself.
#    Please see http://dev.perl.org/licenses/ for more information.
#

#####################################################################
#
# Set up the environment
#
#####################################################################

use 5.006;

use strict;
use warnings;
use vars qw($VERSION);
use Paranoid;
use Paranoid::Args;
use Paranoid::BerkeleyDB;
use Paranoid::Debug;
use Paranoid::Input;
use Paranoid::Log;
use Paranoid::Glob;
use Paranoid::Module;
use Paranoid::Network;
use Paranoid::Process qw(:all);
use Parse::PlainConfig;
use POSIX qw(:sys_wait_h :fcntl_h);

($VERSION) = ( q$Revision: 0.6 $ =~ /(\d+(?:\.(\d+))+)/sm );

use constant AFDEBUG1  => 1;
use constant AFDEBUG2  => 2;
use constant AFDEBUG3  => 3;
use constant CONFFILE  => '/etc/autofw.conf';
use constant DATADIR   => '/var/lib/autofwd';
use constant PIDFILE   => '/var/run/autofwd.pid';
use constant REC_FSEEN => 0;
use constant REC_LSEEN => 1;
use constant REC_NATT  => 2;
use constant MINUTE    => 60;
use constant HOUR      => 3_600;
use constant DAY       => 86_400;
use constant WEEK      => 604_800;

use constant IP4_FAM   => 4;
use constant IP6_FAM   => 6;
use constant DEF_MAIL  => 300;
use constant DEF_TMOUT => 120;
use constant RNGBUFF   => 1000;

use constant PIDMODE => 0644;

my $ev          = 1;
my $mailEnabled = 0;
my $nxtCln      = time;
my ($pname) = ( $0 =~ m#^.*?([^/]+)$#sm );
my ( %options, $config, @files, @regex, $db, %ips, $bperiod );
my ( $rec_ip, $rec_fseen, $rec_lseen, $rec_n, $rec_b );
my @templates = ( {
        Short      => 'd',
        Long       => 'debug',
        Template   => '$',
        Multiple   => 1,
        CountShort => 1,
        CanBundle  => 1,
    },
    {   Short     => 'c',
        Long      => 'config',
        Template  => '$',
        CanBundle => 1,
    },
    {   Short     => 'h',
        Long      => 'help',
        Template  => '',
        CanBundle => 1,
    },
    {   Short     => 'v',
        Long      => 'version',
        Template  => '',
        CanBundle => 1,
    },
    {   Short     => 'D',
        Long      => 'dump',
        Template  => '',
        CanBundle => 1,
    },
    {   Short    => 'r',
        Long     => 'remove',
        Template => '@',
    },
    );

format DBREC_TOP =
IP Address          First Seen           Last Seen              # Att  Banned
-----------------------------------------------------------------------------
.

format DB4REC =
@<<<<<<<<<<<<<<<<<  @<<<<<<<<<<<<<<<<<<  @<<<<<<<<<<<<<<<<<<    @>>>>     @
$rec_ip,            $rec_fseen,          $rec_lseen,           $rec_n, $rec_b
.
format DB6REC =
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$rec_ip
                    @<<<<<<<<<<<<<<<<<<  @<<<<<<<<<<<<<<<<<<    @>>>>     @
                    $rec_fseen,          $rec_lseen,           $rec_n, $rec_b
.

$| = 1;

#####################################################################
#
# Subroutines follow here
#
#####################################################################

sub showHelp () {

    # Purpose:  Displays help text to STDERR
    # Returns:  True
    # Usage:    showHelp();

    print STDERR << "__EOF__";
autofwd, $VERSION: (c) 2010, Arthur Corliss <corliss\@digitalmages.com>
Usage: autofwd [-c {config file}] [-d {n}] [-hvD] [-r {ip} [{ip} ...]]

    -c  --config    Use this config file
    -d  --debug     Debug at this level
    -D  --dump      Dump contents of database
    -h  --help      Show this help text
    -r  --remove    Remove the IP from the database
    -v  --version   Show program version

Using debug mode will keep the process running in the foreground and attached
to the launching terminal.

__EOF__

    return 1;
}

sub showVersion () {

    # Purpose:  Shows program version
    # Returns:  True
    # Usage:    showVersion();

    print << "__EOF__";
autofwd, $VERSION: (c) 2010, Arthur Corliss <corliss\@digitalmages.com>
__EOF__

    return 1;
}

sub pidFile () {

    # Purpose:  Creates pid file
    # Returns:  True if successful
    # Usage:    $rv = pidFile();

    my $rv = 0;
    my ( $glob, $pfile, $fd );

    pdebug( 'entering', AFDEBUG1 );
    pIn();

    # Detaint PID File value
    $glob =
        Paranoid::Glob->new( literals => [ $config->parameter('PID File') ] );

    if ( defined $glob ) {

        $pfile = $$glob[0];
        if ( scalar $glob->exists ) {

            # File exists, so warn
            warn pdebug(
                "Daemon already running or stale PID file at $pfile.",
                AFDEBUG1 ),
                "\n";

        } else {

            # Open file
            $rv = sysopen $fd, $pfile, O_RDWR | O_CREAT | O_EXCL, PIDMODE;
            if ($rv) {

                # Store the PID
                print $fd $$;
                close $fd;
                pdebug( "created PID file at $pfile", AFDEBUG2 );

            } else {

                # Warn on failure to open file
                warn pdebug( "Failed to open $pfile: $!", AFDEBUG1 ), "\n";
                $rv = 0;
            }
        }
    } else {

        # Must be a bad entry in the config file
        warn pdebug( 'Invalid entry for \'PID File\'', AFDEBUG1 ), "\n";
    }

    pOut();
    pdebug( "leaving w/rv: $rv", AFDEBUG1 );

    return $rv;
}

sub delPID () {

    # Purpose:  Deletes the PID file
    # Returns:  True if successful
    # Usage:    $rv = delPID();

    my $glob;
    my $rv = 1;

    pdebug( 'entering', AFDEBUG2 );
    pIn();

    # Remove the pid file (if present)
    $glob =
        Paranoid::Glob->new( literals => [ $config->parameter('PID File') ] );
    if ( defined $glob and scalar $glob->exists ) {
        pdebug( "removing PID file $$glob[0]", AFDEBUG3 );
        $rv = unlink $$glob[0];
    } else {
        pdebug( 'PID file already gone or undefined', AFDEBUG3 );
    }

    pOut();
    pdebug( "leaving w/rv: $rv", AFDEBUG2 );

    return $rv;
}

sub closeDown () {

    # Purpose:  Does a clean closeDown and removes the PID file
    # Returns:  True.
    # Usage:    closeDown();

    my $glob;

    pdebug( 'closing files and shutting down', AFDEBUG1 );
    pIn();

    $0 = "$pname: shutting down";

    # Close the database
    if ( defined $db ) {
        pdebug( 'closing database', AFDEBUG2 );
        $db = undef;
    } else {
        pdebug( 'database already closed', AFDEBUG2 );
    }

    # Delete the PID file
    delPID();

    pOut();
    pdebug( 'leaving w/rv: 1', AFDEBUG1 );

    return 1;
}

sub loadConf (;$) {

    # Purpose:  Reads all of the config files in /etc/autofw.d/ and
    #           stores the config objects in %configs
    # Returns:  True if no errors were encountered
    # Usage:    $rv = loadConf();

    my $conf  = shift;
    my $oconf = defined $conf ? $conf : 'undef';
    my $rv    = 1;
    my ( @lines, $i, $n, $suffix, $glob );

    pdebug( "entering w/($oconf)", AFDEBUG1 );
    pIn();

    # Load config file
    $conf = CONFFILE unless defined $conf;
    pdebug( "loading $conf", AFDEBUG1 );
    $config = Parse::PlainConfig->new(
        FILE         => CONFFILE,
        SMART_PARSER => 1,
        ORDER        => [
            'PID File',
            'Files',
            'Triggers',
            'Ban Period',
            'Ban IPv4 Cmd',
            'Unban IPv4 Cmd',
            'List IPv4 Cmd',
            'Look For IPv4',
            'Ban IPv6 Cmd',
            'Unban IPv6 Cmd',
            'List IPv6 Cmd',
            'Look For IPv6',
            'Never Ban',
            'Threshold',
            'Mail Server',
            'Admin E-mail',
            'Daemon E-mail',
            'E-mail Subject',
            'E-mail Notications'
            ],
        COERCE => {
            'PID File'           => 'string',
            'Files'              => 'list',
            'Triggers'           => 'list',
            'Ban Period'         => 'string',
            'Ban IPv4 Cmd'       => 'string',
            'Unban IPv4 Cmd'     => 'string',
            'List IPv4 Cmd'      => 'string',
            'Look For IPv4'      => 'string',
            'Ban IPv6 Cmd'       => 'string',
            'Unban IPv6 Cmd'     => 'string',
            'List IPv6 Cmd'      => 'string',
            'Look For IPv6'      => 'string',
            'Never Ban'          => 'list',
            'Threshold'          => 'string',
            'Mail Server'        => 'string',
            'Admin E-mail'       => 'string',
            'Daemon E-mail'      => 'string',
            'E-mail Subject'     => 'string',
            'E-mail Notications' => 'string',
            },
        DEFAULTS => {
            'PID File'           => PIDFILE,
            'Ban Period'         => '7d',
            'Threshold'          => '20',
            'Mail Server'        => 'localhost',
            'Admin E-mail'       => 'root@localhost',
            'Daemon E-mail'      => 'autofwd@localhost',
            'E-mail Subject'     => '[SECURITY ALERT] IP firewalled',
            'E-mail Notications' => 0,
            },
            );

    if ( $config->read ) {

        # Get list of files and register them
        $glob =
            Paranoid::Glob->new( globs => [ $config->parameter('Files') ] );
        if ( defined $glob && scalar $glob->exists ) {
            @files = $glob->exists;
        } else {
            warn pdebug( 'Invalid or non-existant files to monitor in config',
                AFDEBUG1 ),
                "\n";
            $rv = 0;
        }

        # Open all of the files (just to make sure we have privileges to them)
        foreach (@files) {
            pdebug( "opening $_ for tailing", AFDEBUG2 );
            unless ( tail( $_, \@lines ) ) {
                warn pdebug(
                    "failed to open $_: @{[ Paranoid::ERROR ]}", AFDEBUG1
                    ),
                    "\n";
                $rv = 0;
            }
        }

        # Get the triggers
        @regex = $config->parameter('Triggers');
        if (@regex) {

            # Compile and save the regexes
            for ( $i = 0; $i <= $#regex; $i++ ) {
                pdebug( "compiling regex qr#$regex[$i]#smi", AFDEBUG3 );
                unless ( eval "\$regex[$i] = qr#\$regex[$i]#smi; 1;" ) {
                    warn pdebug(
                        "bad regular expression Triggers: $regex[$i]",
                        AFDEBUG1 ),
                        "\n";
                    $rv = 0;
                }
            }
        } else {
            warn pdebug( 'no triggers defined in config', AFDEBUG1 ), "\n";
            $rv = 0;
        }

        # Set the ban period
        $bperiod = lc $config->parameter('Ban Period');
        if ( defined $bperiod and length $bperiod ) {

            # Check if suffix notation was used
            ( $n, $suffix ) = ( $bperiod =~ /^(\d+)([smhdw])?$/sm );

            if ( defined $suffix and length $suffix ) {

                # Expand according to suffix
                $bperiod = $n * (
                      $suffix eq 'w' ? WEEK
                    : $suffix eq 'd' ? DAY
                    : $suffix eq 'h' ? HOUR
                    : $suffix eq 'm' ? MINUTE
                    : 1
                    );
            } elsif ( defined $n and length $n ) {

                # No suffix used, assume seconds
                $bperiod = $n;

            } else {

                # Warn about invalid values
                $rv = 0;
                warn pdebug(
                    "bad value passed for Ban Period: $bperiod", AFDEBUG1
                    ),
                    "\n";
                $bperiod = WEEK;
            }
        } else {

            # Set the default period of 1 week
            $bperiod = WEEK;
        }

        # Check mail setting
        if ( $config->parameter('E-mail Notifications') ) {

            if ( loadModule('Net::SMTP') ) {
                pdebug( 'enabling email notifications', AFDEBUG2 );
                $mailEnabled = 1;
                enableFacility( 'mail-buffer', 'buffer', 'notice', '+',
                    RNGBUFF );

            } else {
                pdebug( 'failed to enable email notifications', AFDEBUG1 );
                $rv = 0;
            }
        }

        # Check syslog
        if ( loadModule('Unix::Syslog') ) {
            pdebug( 'enabling syslog notifications', AFDEBUG1 );
            $rv = 0
                unless enableFacility( 'auth', 'syslog', 'info', '+',
                'autofwd' );
        } else {
            pdebug( 'failed to enable syslog notifications', AFDEBUG1 );
        }

    } else {

        # Couldn't read config
        warn pdebug(
            "failed to read @{[ CONFFILE ]}: @{[ Parse::PlainConfig::ERROR ]}",
            AFDEBUG1
            ) . "\n";
        $rv = 0;

    }

    pOut();
    pdebug( "leaving w/rv: $rv", AFDEBUG1 );

    return $rv;
}

sub background () {

    # Purpose:  Enter daemon-mode, respecting debug options
    # Returns:  True if successful
    # Usage:    $rv = background();

    my $rv;

    pdebug( 'entering', AFDEBUG1 );
    pIn();

    $rv = pidFile();
    if ( exists $options{debug} ) {
        pdebug( 'skipping fork since we\'re in debug mode', AFDEBUG1 );
    } else {

        if ($rv) {
            delPID();
            $rv = daemonize() && pidFile();
            warn "@{[ Paranoid::ERROR ]}\n" unless $rv;
        }
    }

    pOut();
    pdebug( "leaving w/rv: $rv", AFDEBUG1 );

    return $rv;
}

sub prepDb () {

    # Purpose:  Opens the database
    # Returns:  True unless problems occur
    # Usage:    prepDb();

    my $rv = 1;

    pdebug( 'entering', AFDEBUG1 );
    pIn();

    $db = Paranoid::BerkeleyDB->new(
        DbDir  => DATADIR,
        DbName => 'autofw.db',
        );

    unless ( defined $db ) {
        pdebug( "couldn't open the database in @{[ DATADIR ]}", AFDEBUG1 );
        plog( 'crit', "couldn't open database in @{[ DATADIR ]}." );
        plog( 'crit', 'continuing on with in-memory db only' );
        $rv = 0;
    }

    pOut();
    pdebug( "leaving w/rv: $rv", AFDEBUG1 );

    return $rv;
}

sub incrDb ($) {

    # Purpose:  Increments the IP record
    # Returns:  # of attempts on record (after updating)
    # Usage:    incrDb($ipAddr);

    my $ipAddr = shift;
    my $rv     = 0;
    my ( $rec, @hostrec );

    pdebug( "entering w/($ipAddr)", AFDEBUG2 );
    pIn();

    # Get the current IP record
    if ( defined $db ) {

        # Access the BerkeleyDB
        $rec = $db->getVal($ipAddr);
        @hostrec = split /#/sm, $rec if defined $rec;

    } else {

        # Access the in-memory db
        @hostrec = split /#/sm, $ips{$ipAddr} if exists $ips{$ipAddr};
    }

    if (@hostrec) {

        # Update the record
        $hostrec[REC_LSEEN] = time;
        $hostrec[REC_NATT] += 1;

    } else {

        # Create a record
        @hostrec = ( time, time, 1 );
    }

    # Save the new record
    if ( defined $db ) {

        # Write to the BerkeleyDB
        $db->setVal( $ipAddr, join '#', @hostrec );
    } else {

        # Write to the in-memory db
        $ips{$ipAddr} = join '#', @hostrec;
    }

    # Return the number of attempts on record
    $rv = $hostrec[REC_NATT];

    pOut();
    pdebug( "leaving w/rv: $rv", AFDEBUG2 );

    return $rv;
}

sub command ($$) {

    # Purpose:  Executes the requested command with the passed IP
    # Returns:  Result of pcapture
    # Usage:    $rv = command('Ban IPv4 Cmd', $ipAddr);

    my ( $cmd, $ipAddr ) = @_;
    my $rv = 1;
    my ( $string, $crv, $cout );

    pdebug( "entering w/($cmd)($ipAddr)", AFDEBUG1 );
    pIn();

    # Retrieve the command string
    $string = $config->parameter($cmd);

    if ( defined $string and defined $ipAddr ) {

        # Successful retrieval of command, so lets substitute the IP for the
        # marker and execute the command
        $string =~ s/__IP__/$ipAddr/smg;
        pdebug( "executing command: $string", AFDEBUG2 );
        $rv = pcapture( $string, \$crv, \$cout );

        unless ($rv) {
            pdebug( "failed to execute command ($string), crv: $crv",
                AFDEBUG1 );
            plog( 'crit',
                "failed to execute command:\n\t$string\n\noutput:\n\n$cout" );
        }

    } else {

        # Report errors
        plog(
            'crit',
            pdebug(
                "requested command '$cmd' isn't in the config", AFDEBUG1
                ) ) unless defined $string;
        plog(
            'crit',
            pdebug(
                "IP address passed ($ipAddr) fails validation", AFDEBUG1
                ) ) unless defined $ipAddr;
        $rv = 0;
    }

    pOut();
    pdebug( "leaving w/rv: $rv", AFDEBUG1 );

    return $rv;
}

sub verifyIP ($) {

    # Purpose:  Checks to see if the IP is already listed in the firewall
    # Returns:  True if IP is listed, false otherwise
    # Usage:    $rv = verifyIP($ipaddr);

    my $ipAddr = shift;
    my ( $cmd, $regex, $fam );
    my ( $crv, $out,   @lines );
    my $rv = 1;

    pdebug( "entering w/($ipAddr)", AFDEBUG1 );
    pIn();

    # Select the correct commands
    $fam   = $ipAddr =~ /:/sm ? IP6_FAM : IP4_FAM;
    $cmd   = $config->parameter("List IPv$fam Cmd");
    $regex = $config->parameter("Look For IPv$fam");

    unless ( defined $cmd and defined $regex ) {
        plog(
            'crit',
            pdebug(
                "\"List IPv$fam Cmd\" and/or \"Look For IPv$fam\" is not defined "
                    . 'in the config file',
                AFDEBUG1
                ) );
        $rv = 0;
    }

    if ($rv) {

        # Substitute IP for marker
        $regex =~ s/__IP__/$ipAddr/smg;

        # Execute the command
        $rv = pcapture( $cmd, \$crv, \$out );

        if ($rv) {

            # Split the lines and check for a match
            @lines = split /\n/sm, $out;
            $rv = grep m#$regex#sm, @lines;

        } else {

            # Report errors
            pdebug( "failed to execute command ($cmd), crv: $crv", AFDEBUG1 );
            plog( 'crit',
                "failed to execute command:\n\t$cmd\n\noutput:\n\n$out" );
        }
    }

    pOut();
    pdebug( "leaving w/rv: $rv", AFDEBUG1 );

    return $rv;
}

sub trigger ($) {

    # Purpose:  Updates database entry for IP
    # Returns:  True
    # Usage:    trigger($ipAddr);

    my $ipAddr = shift;
    my $rv     = 1;
    my ( $n, $w, $fam );

    pdebug( "entering w/($ipAddr)", AFDEBUG2 );
    pIn();

    $fam = $ipAddr =~ /:/sm ? IP6_FAM : IP4_FAM;
    $n = incrDb($ipAddr);

    plog( 'debug', "event #$n triggered on IP $ipAddr" );

    if ( $n >= $config->parameter('Threshold') ) {

        # Check if IP is on the Never Ban lists
        $w = ipInNetwork( $ipAddr, $config->parameter('Never Ban') );

        # Threshold met, ban IP
        if ($w) {
            pdebug(
                "ignoring event #$n since $ipAddr is on the Never Ban list",
                AFDEBUG2 );
            plog( 'notice',
                "IP $ipAddr has had $n events, but is on the Never Ban list"
                );
        } else {

            unless ( verifyIP($ipAddr) ) {
                pdebug( "banning $ipAddr after $n events", AFDEBUG2 );
                plog( 'notice', "Banning IP $ipAddr after $n events." );
                $rv = command( "Ban IPv$fam Cmd", $ipAddr );
            }
        }
    }

    pOut();
    pdebug( "leaving w/rv: $rv", AFDEBUG2 );

    return $rv;
}

sub cleanup () {

    # Purpose:  Periodically purges database and unbans IPs
    # Returns:  True.
    # Usage:    cleanup();

    my ( @ipAddrs, $ip, @hostrec, $fam );

    pdebug( 'entering', AFDEBUG1 );
    pIn();

    # Get what's in the database
    @ipAddrs = defined $db ? $db->getKeys : keys %ips;

    # Start retrieving values
    foreach $ip (@ipAddrs) {

        # Select the address family
        $fam = $ip =~ /:/sm ? IP6_FAM : IP4_FAM;

        pdebug( "Processing record for $ip", AFDEBUG2 );

        # Get the record
        @hostrec = split /#/sm, defined $db ? $db->getVal($ip) : $ips{$ip};

        # Check to see if the ban period has expired
        if ( $hostrec[REC_LSEEN] + $bperiod <= time ) {

            # Purge record
            pdebug( "deleting record for $ip", AFDEBUG2 );
            defined $db ? $db->setVal( $ip, undef ) : delete $ips{$ip};

            # Unban if the IP is currently banned
            if ( verifyIP($ip) ) {
                plog( 'info', pdebug( "removing ban for $ip", AFDEBUG2 ) );
                command( "Unban IPv$fam Cmd", $ip );
            }

        } else {

            # Set the next clean-up run
            if ( $hostrec[REC_LSEEN] + $bperiod < $nxtCln ) {
                $nxtCln = $hostrec[REC_LSEEN] + $bperiod;
            }
        }
    }

    pOut();
    pdebug( 'leaving w/rv: 1', AFDEBUG1 );

    return 1;
}

sub mailMsgs () {

    # Purpose:  Mails any messages in the mail buffer
    # Returns:  True if successful
    # Usage:    $rv = mailMsgs();

    my $rv    = 1;
    my $otime = time - DEF_MAIL;
    my ( $smtp, $mailhost, $admin, $daemon, $subject, $data, @buffer );
    my $cpid;

    pdebug( 'entering', AFDEBUG1 );
    pIn();

    # Db module isn't fork-safe at the moment...
    $db = undef;

    # Fork before mailing
    $cpid = fork;
    if ( defined $cpid and $cpid ) {

        # Parent process just returns
        prepDb();
        pOut();
        pdebug( 'leaving w/rv: 1', AFDEBUG1 );
        return 1;

    } elsif ( !defined $cpid ) {

        # log our failure to fork
        plog( 'crit',
            pdebug( 'failed to fork child for mail delivery', AFDEBUG1 ) );
    }

    $0 = "$pname: mailing alerts";

    # Get the relevant messages
    @buffer =
        grep { $$_[0] >= $otime } Paranoid::Log::Buffer::dump('mail-buffer');

    if (@buffer) {

        # Get the info
        $mailhost = $config->parameter('Mail Server');
        $admin    = $config->parameter('Admin E-mail');
        $daemon   = $config->parameter('Daemon E-mail');
        $subject  = $config->parameter('E-mail Subject');

        # Construct the message
        $data = << "__EOF__";
To: $admin
From: $daemon
Subject: $subject

The following events have occured in the last five minutes:

@{[ join "\n", map { $$_[1] } @buffer ]}
__EOF__

        # Make the connection and send the mail
        if ( $smtp = Net::SMTP->new( $mailhost, Timeout => DEF_TMOUT ) ) {
            if ( $smtp->mail($daemon) ) {
                if ( $smtp->to($admin) ) {
                    $rv = $smtp->data($data);
                    $smtp->quit;
                } else {
                    plog(
                        'crit',
                        pdebug(
                            'SMTP server rejected the recipient '
                                . "address $admin",
                            AFDEBUG1
                            ) );
                }
            } else {
                plog(
                    'crit',
                    pdebug(
                        'SMTP server rejected the sender '
                            . "address $daemon",
                        AFDEBUG1
                        ) );
            }
        } else {
            plog(
                'crit',
                pdebug(
                    "failed to make an SMTP connection to $mailhost", AFDEBUG1
                    ) );
        }
    }

    pOut();
    pdebug( "leaving w/rv: $rv", AFDEBUG1 );

    # If we're in a child process we'll exit, otherwise, we just return
    if ( defined $cpid ) {
        exit !$rv;
    } else {
        prepDb();
        $0 = "$pname: monitoring";
        return $rv;
    }
}

sub monitor () {

    # Purpose:  Main control loop for program
    # Returns:  True
    # Usage:    monitor();

    my $rv       = 1;
    my $nextMail = time + DEF_MAIL;
    my ( $file, $line, @lines, $regex, $ipAddr );
    my ( $bLines, $bMatch );    # boolean flags

    pdebug( 'beginning monitoring', AFDEBUG1 );
    pIn();

    plog( 'info', 'beginning monitoring' );

    while (1) {

        # Kill all zombies.... brains good....
        waitpid -1, WNOHANG;

        # Check for cleanup
        if ( time >= $nxtCln ) {
            $nxtCln += $bperiod;
            cleanup();
        }

        # Check for next e-mail
        if ( $mailEnabled and time >= $nextMail ) {
            mailMsgs();
            $nextMail = time + DEF_MAIL;
        }

        # Reset the boolean "got lines" flag
        $bLines = 0;

        foreach $file (@files) {

            # Tail the file
            if ( tail( $file, \@lines, 0, 1 ) ) {

                # Set our boolean flag if we got new content
                $bLines = 1 if @lines;

                foreach $line (@lines) {

                    # Reset our boolean "regex match" flag
                    $bMatch = 0;

                    # Test each regex
                    foreach $regex (@regex) {
                        if ( $line =~ m#$regex#smi ) {
                            pdebug(
                                "line matched against m#$regex#smi: $line",
                                AFDEBUG3 );
                            $bMatch = 1;

                            # We'll only skip out if we're not in debug mode.
                            # The user may be validating regexes...
                            last unless exists $options{debug};
                        }
                    }

                    if ($bMatch) {

                        # Extract IP and call trigger
                        $bMatch = scalar extractIPs($line);

                        if ($bMatch) {
                            foreach $ipAddr ( extractIPs($line) ) {
                                trigger($ipAddr);
                            }
                        } else {
                            plog(
                                'crit',
                                pdebug(
                                    "failed to extract an IP from: $line",
                                    AFDEBUG1
                                    ) );
                        }
                    }
                }
            } else {
                pdebug( Paranoid::ERROR, AFDEBUG1 );
            }
        }

        # We'll sleep for a second if our last poll got no new content at all.
        # Otherwise, we should immediately poll again until we drain the fire
        # hose.
        sleep 1 unless $bLines;
    }

    pOut();
    pdebug( "leaving w/rv: $rv", AFDEBUG1 );

    return $rv;
}

sub dumpDb () {

    # Purpose:  Prints out the contents of the database to STDOUT
    # Returns:  True
    # Usage:    dumpDb();

    my ( @keys, $threshold, @networks );

    pdebug( 'entering', AFDEBUG2 );
    pIn();

    if ( defined $db ) {

        # Get the threshold & never ban networks
        $threshold = $config->parameter('Threshold');
        @networks  = $config->parameter('Never Ban');

        # Assing the report format
        $^ = 'DBREC_TOP';

        # Get and sort the keys
        @keys = sort {
            sprintf( '%03d.%03d.%03d.%03d', split /\./sm, $a ) cmp
                sprintf( '%03d.%03d.%03d.%03d', split /\./sm, $b )
        } grep !/:/sm, $db->getKeys();
        push @keys, sort grep /:/sm, $db->getKeys();

        # Print the records
        foreach (@keys) {
            ( $rec_ip, $rec_fseen, $rec_lseen, $rec_n ) =
                ( $_, split /#/sm, $db->getVal($_) );
            $rec_fseen = scalar localtime $rec_fseen;
            $rec_lseen = scalar localtime $rec_lseen;
            $rec_b =
                ( $threshold <= $rec_n
                    and !ipInNetwork( $rec_ip, @networks ) )
                ? 'Y'
                : 'N';
            $~ = $rec_ip =~ /:/sm ? 'DB6REC' : 'DB4REC';
            write;
        }
    } else {
        warn pdebug( 'Can\'t dump in-memory databases.', AFDEBUG1 ), "\n";
    }

    pOut();
    pdebug( 'leaving w/rv: 1', AFDEBUG2 );

    return 1;
}

sub removeIP ($) {

    # Purpose:  Removes an IP address from the database
    # Returns:  True unless errors occur
    # Usage:    $rv = removeIP($ipAddr);

    my $ipAddr = shift;
    my $rv     = 1;
    my $fam;

    pdebug( "entering w/($ipAddr)", AFDEBUG2 );
    pIn();

    if ( defined $db ) {

        # Remove from the database
        $fam = $ipAddr =~ /:/sm ? IP6_FAM : IP4_FAM;
        $rv = $db->setVal( $ipAddr, undef );
        plog( 'info',
            pdebug( "CLI: deleting record for $ipAddr", AFDEBUG1 ) );

        # Make sure we remove any firewall rules
        if ( verifyIP($ipAddr) ) {
            command( "Unban IPv$fam Cmd", $ipAddr );
            plog( 'info',
                pdebug( "CLI: removing ban for $ipAddr", AFDEBUG1 ) );
        }

    } else {
        warn pdebug( 'Can\'t modify in-memory databases.', AFDEBUG1 ), "\n";
        $rv = 0;
    }

    pOut();
    pdebug( "leaving w/rv: $rv", AFDEBUG2 );

    return $rv;
}

#####################################################################
#
# Program Logic starts here
#
#####################################################################

$0 = "$pname: initializing";

psecureEnv('/sbin:/bin:/usr/sbin:/usr/bin');

# Parse command-line arguments
die join "\n", Paranoid::Args::listErrors(), "\n"
    unless parseArgs( \@templates, \%options );

# Set debug level
PDEBUG = $options{debug} if exists $options{debug};

# Print help if asked
if ( exists $options{help} ) {
    showHelp();
    exit 0;
}

# Print version if asked
if ( exists $options{version} ) {
    showVersion();
    exit 0;
}

die "Errors found while attempting to load configuration.\n"
    unless loadConf( $options{config} );

# Install signal handlers
$SIG{HUP} = sub {
    local $SIG{HUP} = sub { 1; };
    closeDown();
    exit $ev;
};
$SIG{INT} = sub {
    local $SIG{INT} = sub { 1; };
    closeDown();
    exit $ev;
};
$SIG{PIPE} = sub {
    local $SIG{PIPE} = sub { 1; };
    closeDown();
    exit $ev;
};
$SIG{TERM} = sub {
    local $SIG{TERM} = sub { 1; };
    closeDown();
    exit $ev;
};

# Take the appropriate action
if ( scalar grep /^(?:dump|remove)$/sm, keys %options ) {

    # Command mode
    $0 = "$pname: executing commands";

    warn "Failure to access database\n" unless prepDb();

    # Remove IPs if asked
    if ( exists $options{remove} ) {
        $ev = 1;
        foreach ( extractIPs( @{ $options{remove} } ) ) {
            $ev = 0 unless removeIP($_);
        }
        undef $db;
        exit $ev;
    }

    # Dump database if asked
    if ( exists $options{dump} ) {
        $ev = dumpDb();
        undef $db;
        exit $ev;
    }

} else {

    # Daemon mode
    $0 = "$pname: monitoring";
    die "Failure to fork daemon into the background\n"
        unless background();
    warn "Failure to access database\n" unless prepDb();
    $ev = monitor();

}

closeDown();

exit !$ev;

__END__

=head1 NAME

autofwd - Auto-firewalling daemon

=head1 VERSION

$Id: autofwd.in,v 0.6 2011/05/03 05:00:00 acorliss Exp $

=head1 USAGE

    autofwd [-c {config file}] [-d {n}] [-hvD] [-r {ip} [{ip} ...]]

=head1 DESCRIPTION

autofwd is a program which provides automatic firewalling of hosts performing
login attacks against various services.  It can monitor multiple files at a
time looking for multiple patterns.  If the pattern matches on a file
including an IP address it can extract that IP and use that for tracking and
firewalling.

Once an IP is banned it is automatically unbanned after the ban period passes
beyond the last logged event.

This script also supports syslogging and e-mail notifications of firewalling
events.

=head1 REQUIRED ARGUMENTS

None.

=head1 OPTIONS

    -c  --config    Use this config file
    -d  --debug     Debug at this level
    -D  --dump      Dump contents of database
    -h  --help      Show this help text
    -r  --remove    Remove the IP from the database
    -v  --version   Show program version

=head1 DIAGNOSTICS 

This program can be run in debug mode with foreground printing of internal
traces.

=head1 EXIT STATUS 

In command mode (dumping or modifying the IP database) it will return a
non-zero value if any errors are encountered.  In daemon mode it will return a
non-zero value if there are any problems accessing files and forking into the
background.

=head1 CONFIGURATION 

Configuration of this program is controlled by B</etc/autofw.conf> unless an
alternate file is specified via the B<--config> option.  Please see
L<autofw.conf(5)> for the appropriate options and syntax.

=head1 BUGS AND LIMITATIONS 

No attempt made to set individual thresholds per-file, per-service, regex,
etc.  Syslogging is enabled automatically if the Perl module B<Unix::Syslog>
is available.  E-mail support requires the presence of B<Net::SMTP>.

Only IPv4/IPv6 addresses are looked for and extracted.  No attempt was made 
to extract resolvable hostnames.

B<autofwd> keeps state in a database under B</var/lib/autofwd>.  If the
effective user lacks privileges to open that path or database it will default
to keeping a database in memory.  That database will be reset every time the
process is restarted.

When the database is dumped it displays IPv4 addresses first, sorted
numerically by address.  IPv6 addresses are displayed next, but are sorted
lexically.

=head1 SEE ALSO

L<autofw.conf(5)>

=head1 AUTHOR 

Arthur Corliss (corliss@digitalmages.com)

=head1 LICENSE AND COPYRIGHT

This software is licensed under the same terms as Perl, itself. 
Please see http://dev.perl.org/licenses/ for more information.

(c) 2009, Arthur Corliss (corliss@digitalmages.com)

