#!/usr/bin/perl -T
# Copyright (c) 2007, 2008, 2009
#     Jeremie Le Hen <jeremie@le-hen.org>.  All rights reserved.
# Copyright (c) 2003, 2004, 2005
#     Stephan Schmieder <ssc@unix-geek.info>.  All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY STEPHAN SCHMIEDER AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL STEPHAN SCHMIEDER OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# $Id: snort2pf,v 1.23 2011/01/16 21:50:28 jlh Exp $

#
# AccessList class -- used to handle whitelist and blacklist
##############################################################################
package AccessList;

use strict;
use warnings;
use Sys::Syslog qw(:macros);

my $radix  = 0;

eval 'use Net::Patricia';
if ($@ eq '') {
    $radix = 1;
}

sub new {
    my ($classname, $name, $file) = @_;
    my $self;

    $self = {};
    bless $self, $classname;

    $self->{name} = $name;
    $self->init();
    $self->load($file);

    return $self;
}

sub init {
    my ($self) = @_;

    if ($radix) {
	$self->{acl} = Net::Patricia->new();
    } else {
	$self->{acl} = {};
    }
    $self->{count} = 0;
}

sub add {
    my ($self, $host) = @_;

    defined $self->{acl} or return;
    if ($radix) {
	$self->{acl}->add_string($host, 1);
    } else {
	$self->{acl}->{$host} = 1;
    }
}

sub get {
    my ($self, $host) = @_;

    defined $self->{acl} or return undef;
    if ($radix) {
	return $self->{acl}->match_string($host);
    } else {
	return $self->{acl}->{$host};
    }
}

sub radixed {
    return $radix;
}

sub count {
    my ($self) = @_;

    return $self->{count};
}

sub load {
    my ($self, $file) = @_;

    $self->{file} = $file;
    $self->{mtime} = 0;
    $self->check_and_reload();
}

sub check_and_reload {
    my ($self) = @_;
    my ($name, $file, $mtime) = ($self->{name}, $self->{file}, $self->{mtime});
    my $count;
    my $ACL;		    # File handle.
    my $needradix = 0;
    my @stat;

    defined $self->{file} or return;

    @stat = stat $file;
    if (@stat == 0) {
	&::log(LOG_ERR, "$name: Cannot stat '$file': $!");
	return;
    }
    $stat[9] == $mtime and return;

    if ($stat[9] < $mtime) {
	&::log(LOG_WARNING, "$name: mtime went backward by ".
	  ($mtime - $stat[9])." seconds, reloading it anyway)");
    }

    if (not defined open $ACL, '<', $file) {
	&::log(LOG_ERR, "$name: Cannot open '$file': $!");
	return;
    }

    $mtime = $stat[9];
    $self->init();

    &::log(LOG_NOTICE, "$name: Loading '$file'");

    $count = 0;
    while (my $line = <$ACL>) {
	    chomp $line;

	    if ($radix) {
		unless ($line =~ /^$::re_subnet$/ or $line =~ /^$::re_ip$/) {
		    &::log(LOG_WARNING, "$name: Skipping invalid entry $line");
		    next;
		}

	    } else {
		if ($line =~ /^$::re_subnet$/) {
		    $needradix++;
		    &::log(LOG_WARNING, "$name: Skipping unsupported CIDR ".
		      "entry: $line");
		    next;
		}
		unless ($line =~ /^$::re_ip$/) {
		    &::log(LOG_WARNING, "$name: Skipping invalid entry $line");
		    next;
		}
	    }

	    &::log(LOG_INFO, "$name: Adding $line");
	    $count++;
	    $self->add($line);
    }

    &::log(LOG_NOTICE, "$name: Loaded $count entries");
    if ($needradix) {
	&::log(LOG_WARNING, "$name: Can't handle subnet without ".
	  "Net::Patricia; $needradix entries have been skipped");
    }
    close $ACL;
    
    $self->{mtime} = $mtime;
    $self->{count} = $count;
}

1;

#
# Main program
##############################################################################
package main;

use strict;
use warnings;
#use diagnostics;
use Fcntl qw(:seek);
use Getopt::Std;
use Sys::Syslog qw(:standard :macros setlogsock);

my $name      = 'snort2pf';
my $version   = '4.5';
my $pfctl     = '/sbin/pfctl';

# <default>
my $alertfile = '/var/log/snort/alert';
my $pidfile   = "/var/run/$name.pid";
my $amnesty   = 3600;
# </default>

# $re_subnet and $re_ip are used in AccessList.
our $re_subnet = qr/\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\/\d{1,2}/o;
our $re_ip     = qr/\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/o;
my $re_port   = qr/\d{1,5}/o;

# %bad_hosts keys will be both amnesty ticks and hosts.  Their namespaces
# don't overlap so this doesn't matter.
# For each key being an amnesty tick, the corresponding value is a hash
# containing the host(s) being blocked.
# For each key being a host, the corresponding value is its amnesty tick,
# so it can be doubled for recidivists.
my %bad_hosts;

my $nblocked  = 0;	# Number of currently blocked hosts*.
my $tick      = 1;
my $ALERTFILE;
my $alertsize;
my $alertino;
my $dumpfile;
my $usepf    = 1;
# pfctl(8) wrappers.
my $pfctl_block;
my $pfctl_unblock;
my $pfctl_resume;
# Additional commands.
my $blockcmd;
my $unblockcmd;
my $wl;			# Whitelist;


sub log {
    my ($level, $msg) = @_;
    # Compat with older Sys::Syslog modules.
    syslog($level, "%s", $msg);
}


sub fatal {
    &log(@_);
    exit 1;
}


sub dumpinfo {
    if (defined $dumpfile) {
	my $DUMPFILE;

	unless (defined open $DUMPFILE, '>', $dumpfile) {
	  &log(LOG_ERR, "Can't write dumpfile '$dumpfile': $!");
	  return;
	}
	print $DUMPFILE "On tick $tick, $nblocked blocked hosts:\n";
	foreach my $k (keys %bad_hosts) {
		next unless $k =~ m/^$re_ip$/;
		print $DUMPFILE "  $k (unblocked at $bad_hosts{$k})\n";
	}
	close $DUMPFILE;
    } else {
	&log(LOG_DEBUG, "On tick $tick, $nblocked blocked hosts:");
	foreach my $k (keys %bad_hosts) {
		next unless $k =~ m/^$re_ip$/;
		&log(LOG_DEBUG, "  $k (unblocked at $bad_hosts{$k})");
	}
    }
}


sub byebye {
    my ($sig) = @_;

    &log(LOG_NOTICE, "Received SIG$sig. Exiting with $nblocked blocked hosts.");
    unlink $pidfile;
    exit 0;
}


sub usage {
    my ($basename) = ($0 =~ m#.*?([^/]*)$#);
    print STDERR <<EOF
Usage: $basename [-u blockcmd] [-d dumpfile] [-h] [-f alertfile] [-P]
	[-p pidfile] [-s amnesty] [-t] [-u unblockcmd] [-w whitelist]
Options:
    -b	block command (IP address appended)
    -d	set dump file (instead of dumping to syslog)
    -h	show this help message
    -f	change Snort's alert file
    -P	do not use pf(4) at all (useful with -b / -u)
    -p	change pidfile
    -s	change amnesty time
    -t	use table instead of anchor
    -u	unblock command (IP address appended)
    -v	show version
    -w	set whitelist file
Defaults:
    alertfile: /var/log/snort/alert
    pidfile: /var/run/$name.pid
    amnesty: 3600
    no whitelist
    use anchor
EOF
}


# register_host($host)
#   Register or extend amnesty.  Return 1 if the host has been registered, 0 if
#   its amnesty has been extended.
sub register_host {
    my ($host, $startup) = @_;
    my $ret;
    # Values for a newly blocked host.
    my $duration = $amnesty;		# Blocking duration.
    my $exptick = $tick + $duration;	# Blocking expiration tick.

    # Host was already blocked.
    if (exists $bad_hosts{$host}) {
	$ret = 0;

	# Double block duration.
	my $oldexptick = $bad_hosts{$host};
	$duration = $bad_hosts{$oldexptick}->{$host} * 2;
	$exptick = $tick + $duration;

	# Cleanup old expiration tick.
	delete $bad_hosts{$oldexptick}->{$host};
	(%{$bad_hosts{$oldexptick}} == 0) and delete $bad_hosts{$oldexptick};

	&log(LOG_INFO, "Host $host is already blocked; ".
	  "extending amnesty to $duration ticks");
    } else {
	$ret = 1;

	if (defined $startup) {
	    &log(LOG_INFO, "Recovering previously blocked host $host");
	} else {
	    &log(LOG_INFO, "Blocking host $host for $duration ticks");
	}
    }

    $bad_hosts{$host} = $exptick;

    $bad_hosts{$exptick} = {} unless exists $bad_hosts{$exptick};
    $bad_hosts{$exptick}->{$host} = $duration;

    return $ret;
}


# mysytem($cmd, $msg)
#   Execute command ($cmd) check the return value.
#   $msg is issued in case of failure.
#   Return 1 on success, 0 on failure.
sub mysystem {
    my ($cmd, $msg) = @_;
    my $status;

    $status = system ("$cmd >/dev/null 2>&1");

    if ($status == -1) {
	&log(LOG_WARNING, "$msg, system() failed: $!.".
	  " (command: $cmd)");
	return 0;
    }

    $status = $status >> 8;
    if ($status != 0) {
	&log(LOG_WARNING, "$msg, command returned: $status.".
	  " (command: $cmd)");
	return 0;
    }

    return 1;
}

sub nopf {

	return 1;
}

# anchor_block($host)
#   Block host using anchor.
sub anchor_block {
    my ($host) = @_;
    my $pfrule = "block in quick from $host";
    my $pfcmd = "$pfctl -a $name/$host -f -";

    return &mysystem("echo '$pfrule' | $pfcmd", "Can't block $host");
}


# anchor_unblock($host)
#   Unblock host using anchor.
sub anchor_unblock {
    my ($host) = @_;

    return &mysystem("$pfctl -a $name/$host -F rules", "Can't unblock $host");
}


# anchor_resume()
#   Retrieve previously blocked host using anchor.
#   Return the number of retrieved hosts.
sub anchor_resume {
    my $ANCHORS;
    my $nhosts;

    defined (open $ANCHORS, "$pfctl -a $name -s A -v 2>/dev/null |") or
      &fatal(LOG_ERR, "Can't retrieve previously blocked host: $!");
    $nhosts = 0;
    while (my $anchor = <$ANCHORS>) {
	chomp $anchor;
	$anchor =~ s{^\s*$name/}{};
	&register_host($anchor, "startup");
	$nhosts++;
    }
    close $ANCHORS;
    &log(LOG_NOTICE, "$nhosts hosts reloaded from anchor '$name'");

    return $nhosts;
}


# table_block($host)
#   Block host using table.
sub table_block {
    my ($host) = @_;

    return &mysystem("$pfctl -t $name -T add $host", "Can't block $host");
}


# table_unblock($host)
#   Unblock host using table.
sub table_unblock {
    my ($host) = @_;

    return &mysystem("$pfctl -t $name -T delete $host", "Can't unblock $host");
}


# table_resume()
#   Retrieve previously blocked host using table.
#   Return the number of retrieved hosts.
sub table_resume {
    my $ANCHORS;
    my $nhosts;

    defined (open $ANCHORS, "$pfctl -t $name -T show 2>/dev/null |") or
      &fatal(LOG_ERR, "Can't retrieve previously blocked host: $!");
    $nhosts = 0;
    while (my $anchor = <$ANCHORS>) {
	chomp $anchor;
	$anchor =~ s/^\s*//;
	&register_host($anchor, "startup");
	$nhosts++;
    }
    close $ANCHORS;
    &log(LOG_NOTICE, "$nhosts hosts reloaded from table '$name'");

    return $nhosts;
}


# initialize()
sub initalize {
    my %opts;
    my $PIDFILE;
    my $wlfile;
    my $startinfo = '';

    setlogsock('unix');
    openlog($name, 'pid,ndelay', LOG_DAEMON);

    $SIG{INT} = \&byebye;
    $SIG{TERM} = \&byebye;
    $SIG{USR1} = \&dumpinfo;

    #
    # Parse command-line.
    getopts('b:d:f:hPp:s:tu:vw:', \%opts);

    if (exists $opts{h}) {
	&usage();
	exit 0;
    }
    if (exists $opts{v}) {
	print STDERR "$name $version\n";
	exit 0;
    }
    if (exists $opts{P}) {
	$usepf = 0;
    }

    exists $opts{b} and $blockcmd = $opts{b};
    exists $opts{d} and ($dumpfile) = ($opts{d} =~ m/(.*)/);
    exists $opts{f} and $alertfile = $opts{f};
    exists $opts{p} and $pidfile = $opts{p};
    if (exists $opts{s}) {
	$opts{s} =~ m/^\d+$/ or &fatal(LOG_ERR, "$opts{s}: Not a number");
	$amnesty = $opts{s};
    }
    exists $opts{u} and $blockcmd = $opts{u};
    exists $opts{w} and $wlfile = $opts{w};

    if (not $usepf) {
	$startinfo .= ' without pf';
	$pfctl_block = \&nopf;
	$pfctl_unblock = \&nopf;
	$pfctl_resume = \&nopf;
    } elsif (exists $opts{t}) {
	$startinfo .= ' using table';
	$pfctl_block = \&table_block;
	$pfctl_unblock = \&table_unblock;
	$pfctl_resume = \&table_resume;
    } else {
	$startinfo .= ' using anchor';
	$pfctl_block = \&anchor_block;
	$pfctl_unblock = \&anchor_unblock;
	$pfctl_resume = \&anchor_resume;
    }

    #
    # Check and sanitize environment.
    delete @ENV{qw(PATH IFS CDPATH ENV)};
    -f $alertfile or &fatal(LOG_ERR, "$alertfile: No such file");
    -r $alertfile or &fatal(LOG_ERR, "$alertfile: Not readable");
    if (defined $wlfile) {
	    -f $wlfile or &fatal(LOG_ERR, "$wlfile: No such file");
	    -r $wlfile or &fatal(LOG_ERR, "$wlfile: Not readable");
    }
    -x $pfctl or &fatal(LOG_ERR, "$pfctl: Not executable");

    #
    # Handle pidfile.
    if (-f $pidfile) {
	defined (open $PIDFILE, '<', $pidfile) or
	  &fatal(LOG_ERR, "Can't read pidile '$pidfile': $!");
	my $pid = <$PIDFILE>;
	close $PIDFILE;
	chomp $pid;

	# Untaint $pid.
	$pid =~ m/^(\d+)$/;
	$pid = $1;

	kill (0, $pid) == 0 or
	  &fatal(LOG_ERR, "$name seems to be running as PID $pid");

	unlink $pidfile;
    }

    defined (open $PIDFILE, '>', $pidfile) or
      &fatal(LOG_ERR, "Can't write pidfile '$pidfile': $!");
    print $PIDFILE "$$\n";
    close $PIDFILE;

    #
    # Load whitelist.
    $wl = new AccessList('whitelist', $wlfile);
    $wl->radixed() and $startinfo .= ' with Net::Patricia';

    #
    # Issue startup message.
    &log(LOG_NOTICE, "Starting$startinfo...");

    #
    # And finally, check for previously blocked hosts.
    $nblocked = $pfctl_resume->();
    &update_title();
}


sub update_title {
    $0 = "$name $version :: blocking $nblocked hosts";
}


# open_alertfile()
#   (Re-)open the global $alertfile as $ALERTFILE.  Retry forever if needed.
#   Reset the global $alertsize variable.
sub open_alertfile {

    if (defined $ALERTFILE) {
	close $ALERTFILE;
	undef $ALERTFILE
    }

    while (1) {
	defined (open $ALERTFILE, '<', $alertfile) and last;
	print STDERR "Can't read alertfile '$alertfile': $!\n";
	sleep 10;
    }
    my @stat = stat $ALERTFILE;
    $alertino = $stat[1];
    $alertsize = $stat[7];
}


# check_for_attack($line)
#   Check the line is an attack are return the offending host if any.
sub check_for_attack {
    if ($_[0] =~ /($re_ip)\:$re_port -> $re_ip\:$re_port/o) {
        return $1;
    }
    return 0;
}


# check_for_portscan($line)
#   Check the line is a portscan are return the offending host if any.
sub check_for_portscan {
    if ($_[0] =~ /PORTSCAN DETECTED from ($re_ip)/io) {
        return $1;
    }
    return 0;
}


# block($host)
#   Block host.
sub block {
    my $host = $_[0];

    if (defined $wl->get($host)) {
	&log(LOG_INFO, "Skipping whitelisted host $host");
	return;
    }

    # Check if host is already blocked.
    if (&register_host($host) == 0) {
	goto KILL_STATES;
    }
    $nblocked++;

    if ($pfctl_block->($host) == 0) {
	$nblocked--;
	goto KILL_STATES;
    }
    if (defined $blockcmd) {
	mysystem("$blockcmd $host", "Block command for $host");
    }
    &update_title();

KILL_STATES:
    system("$pfctl -k $host >/dev/null 2>&1") == 0 or
      &log(LOG_WARNING, "Can't kill states for $host: $!");
}


# unblock()
#   Unblock all host for which we have reached the expiration tick.
sub unblock {
    my $hosts;

    return if not exists $bad_hosts{$tick};

    $hosts = $bad_hosts{$tick};
    delete $bad_hosts{$tick};

    foreach my $h (keys %$hosts) {
	&log(LOG_INFO, "Unblocking host $h");

	$pfctl_unblock->($h);
	if (defined $unblockcmd) {
	    mysystem("$unblockcmd $h", "Unblock command for $h");
	}

	delete $bad_hosts{$h};
	$nblocked--;
    }
    &update_title();
}


&initalize();
&open_alertfile();

while (1) {
    # unblock old hosts
    &unblock();

    $wl->check_and_reload();

    my @stat = stat $alertfile;
    while (my $line = <$ALERTFILE>) {
	chomp $line;
	my $blocked;

	$blocked = &check_for_attack($line);
	if ($blocked) {
	    &block($blocked);
	    next;
	}
	$blocked = &check_for_portscan($line);
	if ($blocked) {
	    &block($blocked);
	    next;
	}

	# Junk line.
    }

    if (@stat != 0 && ($stat[7] < $alertsize || $stat[1] != $alertino)) {
	# File has shrinked, probably because of rotation; reopen and process
	# it immediately.
	&open_alertfile();
	next;
    }
    $alertsize = $stat[7];

    seek $ALERTFILE, 0, SEEK_CUR;	# Reset EOF.  Won't fail.
    $tick++;
    sleep 1;
}
