#!/usr/bin/perl -w
#
#############################################################################
#
# File: knoptm
#
# Purpose: This daemon will remove entries from the iptables chain(s) to
#          which fwknop has added access for certain IP addresses.  It uses
#          the file /var/log/fwknop/knoptm.cache file in order to determine
#          when access should be removed.  The format of the entries in this
#          file are as follows:
#
#   <rule timestamp> <timeout> <ip> <proto> <port> <table> <chain> <target>
#
# Author: Michael Rash (mbr@cipherdyne.org)
#
# Version: 1.8.2-pre9
#
# Copyright (C) 2004-2007 Michael Rash (mbr@cipherdyne.org)
#
# License (GNU Public License):
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
#    USA
#
#############################################################################
#
# $Id: knoptm 771 2007-09-15 13:52:22Z mbr $
#

use lib '/usr/lib64/fwknop';
use Unix::Syslog qw(:subs :macros);
use Net::IPv4Addr qw(ipv4_in_network);
use IO::Socket;
use IO::Handle;
use File::Copy;
use Data::Dumper;
use POSIX;
use Getopt::Long;
use strict;

my $config_file  = '/etc/fwknop/fwknop.conf';
my $user_rc_file = '';

my $version = '1.8.2';
my $print_help = 0;
my $print_ver  = 0;
my $debug      = 0;
my $die_msg    = '';
my $warn_msg   = '';
my $timeout_sock = '';
my $max_timeout_tries = 20;
my $imported_iptables_modules = 0;

my %config = ();
my %cmds   = ();
my %timeout_cache = ();

my $ip_re = qr|(?:[0-2]?\d{1,2}\.){3}[0-2]?\d{1,2}|;

my $SEND_MAIL = 1;
my $NO_MAIL   = 0;

### make Getopts case sensitive
Getopt::Long::Configure('no_ignore_case');
&usage(1) unless (GetOptions(
    'config=s' => \$config_file,
    'Version'  => \$print_ver,
    'help'     => \$print_help
));

### Print the version number and exit if -V given on the command line.
if ($print_ver) {
    print
"[+] knoptm v$version (part of the fwknop project), by Michael Rash\n",
"    <mbr\@cipherdyne.org>\n";
    exit 0;
}

&usage(0) if $print_help;

### set things up, deal with pid's, and import config
&knoptm_init();

print STDERR "[+] Opening $config{'KNOPTM_IP_TIMEOUT_SOCK'} socket, ",
    "and entering main loop.\n" if $debug;

$timeout_sock = IO::Socket::UNIX->new(
    Type    => SOCK_STREAM,
    Local   => $config{'KNOPTM_IP_TIMEOUT_SOCK'},
    Listen  => SOMAXCONN,
    Timeout => .1
) or die "[*] Could not acquire auto-response domain socket: $!";

for (;;) {
    my @fw_cache_entries = ();

    my $fwknop_connection = $timeout_sock->accept();
    if ($fwknop_connection) {
        @fw_cache_entries = <$fwknop_connection>;

        ### add new entries to the cache
        &build_timeout_cache(\@fw_cache_entries) if @fw_cache_entries;
    }

    ### always check to see if any fw rules need to be removed
    &timeout_cache_entries();

    &append_die_msg()  if $die_msg;
    &append_warn_msg() if $warn_msg;

    sleep 1;
}
close $timeout_sock;
exit 0;
#============================ end main ==============================

sub build_timeout_cache() {
    my $cache_entries_aref = shift;
    LINE: for my $line (@$cache_entries_aref) {
        if ($line =~ /^\s*\d+\s+\d+\s+$ip_re
                \s+\S+\s+\d+\s+\S+\s+\S+\s+\S+/x) {

            ### the number represents the number of times we attempt to
            ### delete the rule
            $timeout_cache{$line} = 0;
        }
    }
    return;
}

sub timeout_cache_entries() {

    my @del_keys = ();
    for my $line (keys %timeout_cache) {
        if ($line =~ /^\s*(\d+)\s+(\d+)\s+($ip_re)
                \s+(\S+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\S+)/x) {

            my $rule_timestamp = $1;
            my $timeout        = $2;
            my $ip             = $3;
            my $proto          = $4;
            my $port           = $5;
            my $table          = $6;
            my $chain          = $7;
            my $target         = $8;

            if ((time() - $rule_timestamp) > $timeout) {

                ### see if the rule is still active, and remove if necessary
                if (&rm_fw_rule($rule_timestamp, $timeout, $ip, $proto,
                        $port, $table, $chain, $target)) {

                    ### delete the entry from the in-memory cache now that
                    ### the firewall rule has been removed
                    push @del_keys, $line;

                }
                $timeout_cache{$line}++;
                if ($timeout_cache{$line} > $max_timeout_tries) {
                    ### it seems the rule has been lost (perhaps manually
                    ### deleted) so remove it from the cache since it is
                    ### past the timeout anyway
                    &logr('[-]', "exceeded max removal tries for $ip -> " .
                        "$proto/$port, deleting from cache", $NO_MAIL);
                    push @del_keys, $line;
                }
            }
        }
    }
    if (@del_keys) {
        for my $key (@del_keys) {
            delete $timeout_cache{$key};
        }
    }
    return;
}

sub rm_fw_rule() {
    my ($rule_timestamp, $timeout, $ip, $proto,
        $port, $table, $chain, $target) = @_;

    if ($config{'FIREWALL_TYPE'} eq 'iptables') {

        return &rm_ipt_rule($timeout, $ip, $proto,
                    $port, $table, $chain, $target);

    } elsif ($config{'FIREWALL_TYPE'} eq 'ipfw') {

        return &rm_ipfw_rule($timeout, $ip, $proto, $port);
    }

    return 0;
}

sub rm_ipt_rule() {
    my ($timeout, $ip, $proto,
        $port, $table, $chain, $target) = @_;

    my $removed_rule = 0;

    my %ipt_opts = (
        'iptables' => $cmds{'iptables'},
        'iptout'   => $config{'KNOPTM_IPT_OUTPUT_FILE'},
        'ipterr'   => $config{'KNOPTM_IPT_ERROR_FILE'}
    );
    $ipt_opts{'debug'} = 1 if $debug;

    my $ipt = new IPTables::ChainMgr(%ipt_opts)
        or die '[*] Could not acquire IPTables::ChainMgr object.';

    if ($ipt->find_ip_rule($ip, '0.0.0.0/0', $table,
            $chain, $target, {'protocol' => $proto,
            'd_port' => $port})) {

        my ($rv, $out_aref, $err_aref) = $ipt->delete_ip_rule($ip,
            '0.0.0.0/0', $table, $chain, $target,
            {'protocol' => $proto, 'd_port' => $port});

        if ($rv) {
            &logr('[+]', "removed iptables $chain ACCEPT rule " .
                "for $ip -> $proto/$port, $timeout " .
                "second timeout exceeded", $SEND_MAIL);
            $removed_rule = 1;
        } else {
            my $msg = "could not delete ACCEPT rule for $ip -> $proto/$port";
            &logr('[-]', $msg, $NO_MAIL);
            &psyslog_errs($err_aref);
        }
    }
    return $removed_rule;
}

sub rm_ipfw_rule() {
    my ($timeout, $ip, $proto, $port) = @_;

    my $removed_rule = 0;

    my $rulenum = &ipfw_find_ip_rule($ip, 'any', $proto, $port);

    if ($rulenum) {
        if (&ipfw_delete_ip_rule($rulenum)) {

            &logr('[+]', "removed ipfw pass " .
                    "rule for $ip -> " .
                    "$proto/$port, $timeout " .
                    "second timeout exceeded", $SEND_MAIL);
            $removed_rule = 1;
        } else {
            my $msg = "could not delete ipfw pass rule for $ip " .
                "-> $proto/$port";
            &logr('[-]', $msg, $NO_MAIL);
        }
    }

    return $removed_rule;
}

sub ipfw_find_ip_rule() {
    my ($src, $dst, $proto, $port) = @_;

    my $rulenum = 0;

    open LIST, "$cmds{'ipfw'} list |" or
        die "[*] Could not execute 'ipfw list'";
    while (<LIST>) {
        if ($proto eq 'tcp' or $proto eq 'udp') {
            ### 00002 allow tcp from 1.1.1.1 to any dst-port 22 keep-state
            if (/^\s*(\d+)\s+allow\s+$proto\s+from\s+$src\s+to\s+
                        $dst\s+dst-port\s+$port\s+keep-state/x) {
                $rulenum = $1;
                last;
            }
        } else {  ### icmp
            if (/^\s*(\d+)\s+allow\s+$proto\s+from\s+$src\s+to\s+$dst/x) {
                $rulenum = $1;
                last;
            }
        }
    }
    close LIST;

    if ($rulenum) {
        ### remove any leading zeros from the rule number
        $rulenum =~ s/^0{1,4}//g;
    }

    return $rulenum;
}

sub ipfw_delete_ip_rule() {
    my $rulenum = shift;

    open IPFW, "| $cmds{'ipfw'} delete $rulenum" or die "[*] Could not ",
        "execute $cmds{'ipfw'} delete $rulenum";
    close IPFW;

    return 1;
}

sub import_config() {
    open C, "< $config_file" or die "[*] Could not open ",
        "config file $config_file: $!";
    my @lines = <C>;
    close C;
    for my $line (@lines) {
        chomp $line;
        next if ($line =~ /^\s*#/);
        if ($line =~ /^(\S+)\s+(.*?)\;/) {
            my $varname = $1;
            my $val     = $2;
            if ($val =~ m|/.+| && $varname =~ /^(\w+)Cmd$/) {
                ### found a command
                $cmds{$1} = $val;
            } else {
                $config{$varname} = $val;
            }
        }
    }
    return;
}

sub expand_vars() {

    my $has_sub_var = 1;
    my $resolve_ctr = 0;

    while ($has_sub_var) {
        $resolve_ctr++;
        $has_sub_var = 0;
        if ($resolve_ctr >= 20) {
            die "[*] Exceeded maximum variable resolution counter.";
        }
        for my $hr (\%config, \%cmds) {
            for my $var (keys %$hr) {
                my $val = $hr->{$var};
                if ($val =~ m|\$(\w+)|) {
                    my $sub_var = $1;
                    die "[*] sub-ver $sub_var not allowed within same ",
                        "variable $var" if $sub_var eq $var;
                    if (defined $config{$sub_var}) {
                        $val =~ s|\$$sub_var|$config{$sub_var}|;
                        $hr->{$var} = $val;
                    } else {
                        die "[*] sub-var \"$sub_var\" not defined in ",
                            "config for var: $var."
                    }
                    $has_sub_var = 1;
                }
            }
        }
    }
    return;
}

### check paths to commands and attempt to correct if any are wrong.
sub check_commands() {
    my @path = qw(
        /bin
        /sbin
        /usr/bin
        /usr/sbin
        /usr/local/bin
        /usr/local/sbin
    );
    for my $cmd (keys %cmds) {

        if ($cmd eq 'iptables') {
            next unless $config{'FIREWALL_TYPE'} eq 'iptables';
        } elsif ($cmd eq 'ipfw') {
            next unless $config{'FIREWALL_TYPE'} eq 'ipfw';
        }
        unless (-x $cmds{$cmd}) {
            my $found = 0;
            PATH: for my $dir (@path) {
                if (-x "${dir}/${cmd}") {
                    $cmds{$cmd} = "${dir}/${cmd}";
                    $found = 1;
                    last PATH;
                }
            }
            unless ($found) {
                die "[*] Could not find $cmd anywhere!!!  Please edit the\n",
                    "config section in $config_file to include the path to\n",
                    "$cmd.";
            }
        }
        unless (-x $cmds{$cmd}) {
            die "[*] Command $cmd is located at $cmds{$cmd}, but ",
                "is not executable by uid: $<";
        }
    }
    return;
}

sub sendmail() {
    my $subject = shift;
    open MAIL, "| $cmds{'mail'} -s \"$subject\" $config{'EMAIL_ADDRESSES'} " .
        "> /dev/null" or die "[*] Could not send mail: $cmds{'mail'} -s " .
        "$subject\" $config{'EMAIL_ADDRESSES'}: $!";
    close MAIL;
    return;
}

sub uniquepid() {
    if (-e $config{'KNOPTM_PID_FILE'}) {
        my $caller = $0;
        open PIDFILE, "< $config{'KNOPTM_PID_FILE'}";
        my $pid = <PIDFILE>;
        close PIDFILE;
        chomp $pid;
        if (kill 0, $pid) {  # knoptm is already running
            die "[*] knoptm (pid: $pid) is already running!  Exiting.\n";
        }
    }
    return;
}

sub writepid() {
    open P, "> $config{'KNOPTM_PID_FILE'}" or die "[*] Could not open ",
        "$config{'KNOPTM_PID_FILE'}: $!";
    print P $$, "\n";
    close P;
    chmod 0600, $config{'KNOPTM_PID_FILE'};
    return;
}

sub knoptm_init() {

    ### import config
    &import_config();

    &expand_vars();

    ### make sure all the vars we need are actually in the config file.
    &required_vars();

    ### validate config
    &validate_config();

    &import_ipt_modules() if $config{'FIREWALL_TYPE'} eq 'iptables';

    ### make sure there is not another knoptm process already running.
    &uniquepid();

    ### make sure command paths are correct
    &check_commands();

    unless ($debug) {
        my $pid = fork();
        exit 0 if $pid;
        die "[*] $0: Couldn't fork: $!" unless defined $pid;
        POSIX::setsid() or die "[*] $0: Can't start a new session: $!";
    }

    ### write our pid out to disk
    &writepid();

    ### Install signal handlers for debugging and for reaping zombie
    ### whois processes.
    $SIG{'__WARN__'} = \&warn_handler;
    $SIG{'__DIE__'}  = \&die_handler;
    $SIG{'CHLD'}     = \&REAPER;

    unlink $config{'KNOPTM_IP_TIMEOUT_SOCK'}
        if -e $config{'KNOPTM_IP_TIMEOUT_SOCK'};

    return;
}

### write a message to syslog (leaves off $prefix, which assigns a
### "type" to the message, when writing syslog; might add it later
sub logr() {
    my ($prefix, $msg, $send_email) = @_;
    if ($debug) {
        print STDERR "$prefix $msg\n";
        return;
    }

    ### see if we need to send an email
    if ($send_email and $config{'ALERTING_METHODS'} !~ /noe?mail/i) {
        &sendmail("$prefix $config{'HOSTNAME'} knoptm: $msg");
    }

    return if $config{'ALERTING_METHODS'} =~ /no.?syslog/i;

    ### this is an ugly hack to avoid the 'can't use string as subroutine'
    ### error because of 'use strict'
    if ($config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL7/i) {
        openlog($config{'SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL7());
    } elsif ($config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL6/i) {
        openlog($config{'SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL6());
    } elsif ($config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL5/i) {
        openlog($config{'SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL5());
    } elsif ($config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL4/i) {
        openlog($config{'SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL4());
    } elsif ($config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL3/i) {
        openlog($config{'SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL3());
    } elsif ($config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL2/i) {
        openlog($config{'SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL2());
    } elsif ($config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL1/i) {
        openlog($config{'SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL1());
    } elsif ($config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL0/i) {
        openlog($config{'SYSLOG_IDENTITY'}, &LOG_DAEMON(), &LOG_LOCAL0());
    }

    if ($config{'SYSLOG_PRIORITY'} =~ /LOG_INFO/i) {
        syslog(&LOG_INFO(), $msg);
    } elsif ($config{'SYSLOG_PRIORITY'} =~ /LOG_DEBUG/i) {
        syslog(&LOG_DEBUG(), $msg);
    } elsif ($config{'SYSLOG_PRIORITY'} =~ /LOG_NOTICE/i) {
        syslog(&LOG_NOTICE(), $msg);
    } elsif ($config{'SYSLOG_PRIORITY'} =~ /LOG_WARNING/i) {
        syslog(&LOG_WARNING(), $msg);
    } elsif ($config{'SYSLOG_PRIORITY'} =~ /LOG_ERR/i) {
        syslog(&LOG_ERR(), $msg);
    } elsif ($config{'SYSLOG_PRIORITY'} =~ /LOG_CRIT/i) {
        syslog(&LOG_CRIT(), $msg);
    } elsif ($config{'SYSLOG_PRIORITY'} =~ /LOG_ALERT/i) {
        syslog(&LOG_ALERT(), $msg);
    } elsif ($config{'SYSLOG_PRIORITY'} =~ /LOG_EMERG/i) {
        syslog(&LOG_EMERG(), $msg);
    }

    closelog();

    return;
}

sub psyslog_errs() {
    my $aref = shift;
    return if $config{'ALERTING_METHODS'} =~ /no.?syslog/i;

    ### write a message to syslog
    openlog 'knoptm', LOG_DAEMON, LOG_LOCAL7;
    for (my $i=0; $i<5 && $i<=$#$aref; $i++) {
        syslog LOG_INFO, $aref->[$i];
    }
    closelog();
    return;
}

sub required_vars() {
    for my $var qw(KNOPTM_PID_FILE FWKNOP_DIR FWKNOP_ERR_DIR
            EMAIL_ADDRESSES AUTH_MODE KNOPTM_IP_TIMEOUT_SOCK
            ALERTING_METHODS FIREWALL_TYPE SYSLOG_IDENTITY
            SYSLOG_FACILITY SYSLOG_PRIORITY) {
        unless (defined $config{$var}) {
            die "[*] Variable $var is not defined in $config_file";
        }
    }
    return;
}

sub validate_config() {

    die qq([*] Invalid EMAIL_ADDRESSES value: "$config{'EMAIL_ADDRESSES'}")
        unless $config{'EMAIL_ADDRESSES'} =~ /\S+\@\S+/;

    ### translate commas into spaces
    $config{'EMAIL_ADDRESSES'} =~ s/\s*\,\s/ /g;

    unless ($config{'AUTH_MODE'} eq 'KNOCK'
            or $config{'AUTH_MODE'} eq 'ULOG_PCAP'
            or $config{'AUTH_MODE'} eq 'PCAP') {
        die "[*] AUTH_MODE must be either KNOCK, ULOG_PCAP, or PCAP";
    }
    return;
}

sub import_ipt_modules() {

    unless ($imported_iptables_modules) {

        require IPTables::Parse;
        require IPTables::ChainMgr;

        $imported_iptables_modules = 1;
    }

    return;
}

sub die_handler() {
    $die_msg = shift;
    return;
}

### write all warnings to a logfile
sub warn_handler() {
    $warn_msg = shift;
    return;
}

sub REAPER {
    my $pid;
    $pid = waitpid(-1, WNOHANG);
#   if (WIFEXITED($?)) {
#          print STDERR "[+] **  Process $pid exited.\n";
#      }
    $SIG{'CHLD'} = \&REAPER;
    return;
}

sub append_die_msg() {
    open D, ">> $config{'FWKNOP_ERR_DIR'}/knoptm.die" or
        die "[*] Could not open $config{'FWKNOP_DIR'}/knoptm.die: $!";
    print D scalar localtime(), " $die_msg";
    close D;
    $die_msg = '';
    return;
}

sub append_warn_msg() {
    open D, ">> $config{'FWKNOP_ERR_DIR'}/knoptm.warn" or
        die "[*] Could not open $config{'FWKNOP_DIR'}/knoptm.warn: $!";
    print D scalar localtime(), " $warn_msg";
    close D;
    $warn_msg = '';
    return;
}

sub usage() {
    my $exit_status = shift;
    print <<_HELP_;

knoptm; Access timeout daemon for fwknop

[+] Version: $version, by Michael Rash (mbr\@cipherdyne.org)
    URL: http://www.cipherdyne.org/fwknop/

Usage: knoptm [-c <config file>]

Options:
    -c, --config <file>        - Specify path to config file instead of using
                                 the default $config_file.  This
                                 file is used only when knoptm is run as a
                                 daemon.
_HELP_
    exit $exit_status;
}
