root/fwknop/tags/fwknop-1.9.3/fwknopd

#!/usr/bin/perl -w
#
#############################################################################
#
# File: fwknopd (/usr/sbin/fwknopd)
#
# URL: http://www.cipherdyne.org/fwknop
#
# Purpose: fwknopd implements the server portion of an authorization scheme
#          known as Single Packet Authorization (SPA) that requires only a
#          single encrypted packet to communicate various pieces of
#          information including desired access through an iptables policy
#          and/or specific commands to execute on the target system.  The
#          main application of this program is to protect services such as
#          SSH with an additional layer of security in order to make the
#          exploitation of vulnerabilities (both 0-day and unpatched code)
#          much more difficult.  For more information, see the fwknop(8) man
#          page.
#
# Author: Michael Rash (mbr@cipherdyne.org)
#
# Version: 1.9.3
#
# 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$
#

use lib '/usr/lib/fwknop';
use Crypt::CBC;
use Unix::Syslog qw(:subs :macros);
use Net::IPv4Addr qw(ipv4_in_network);
use Net::Pcap;
use NetPacket::IP;
use NetPacket::UDP;
use NetPacket::TCP;
use NetPacket::ICMP;
use NetPacket::Ethernet;
use IO::Socket;
use IO::Handle;
use MIME::Base64;
use Data::Dumper;
use POSIX;
use Getopt::Long;
use strict;

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

my $version = '1.9.3';
my $revision_svn = '$Revision$';
my $rev_num = '1';
($rev_num) = $revision_svn =~ m|\$Rev.*:\s+(\S+)|;

my %config = ();
my %cmds   = ();
my %p0f    = ();
my @access = ();
my $blacklist_ar = [];
my $blacklist_exclude_ar = [];
my %p0f_sigs = ();
my %pid_files = ();
my %ip_sequences  = ();
my %digest_store = ();
my %ipt_input   = ();
my %ipt_forward = ();
my %ipt_prerouting = ();
my %ipt_postrouting = ();
my %ipt_output  = ();  ### optional
my @ipt_config  = ();

my $os_fprint_only = 0;
my $print_version  = 0;
my $print_help     = 0;
my $kill           = 0;
my $restart        = 0;
my $status         = 0;
my $debug          = 0;
my $packet_ctr     = 0;
my $packet_limit   = 0;
my $fw_list        = 0;
my $fw_type        = '';
my $ipt_flush      = 0;
my $ipt_del_chains = 0;
my $fw_del_ip      = '';
my $test_mode      = 0;
my $verbose        = 0;
my $use_gpg        = 0;
my $os_ipt_log     = '';
my $cmdline_intf   = '';
my $warn_msg       = '';
my $die_msg        = '';
my $cmdline_knoptm = '';
my $err_wait_timer = 30;  ### seconds
my $gpg_agent_info = '';
my $build_ipt_config = 0;
my $skipped_first_loop = 0;
my $pcap_sleep_interval = 1;  ### seconds
my $imported_iptables_modules = 0;
my $include_all_config_data   = 0;
my $voluntary_exit_timestamp  = 0;

### SPA message types from fwknop clients

### ACCESS message:
###     random data :user : client_timestamp : client_version : \
###     type (1) : access_request : digest
my $SPA_ACCESS_MODE  = 1;  ### default

### COMMAND message:
###     random data :user : client_timestamp : client_version : \
###     type (0) : command : digest
my $SPA_COMMAND_MODE = 0;

### FORWARD ACCESS message:
###     random data :user : client_timestamp : client_version : \
###     type (2) : access_request : NAT_info : digest
my $SPA_FORWARD_ACCESS_MODE = 2;

### ACCESS message with client-defined firewall timeout:
###     random data :user : client_timestamp : client_version : \
###     type (3) : access_request : timeout : digest
my $SPA_CLIENT_TIMEOUT_ACCESS_MODE = 3;

### FORWARD ACCESS message with client-defined firewall timeout:
###     random data :user : client_timestamp : client_version : \
###     type (4) : access_request : NAT_info : timeout : digest
my $SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE = 4;

### minimum nummber of fields within a decrypted SPA packet
my $SPA_MIN_PACKET_FIELDS = 6;

### default time values
my $knock_interval = 60;
my $default_access_timeout = 300;

my $enc_port_offset   = 61000;  ### default offset
my $enc_key           = '';
my $enc_alg           = 'Rijndael';
my $enc_blocksize     = 32;

### there is a constant "RIJNDAEL_KEYSIZE" in the Crypt::Rijndael sources, but
### it is not used; a 16 byte key size is fine.
my $enc_keysize = 16;

my $ALG_RIJNDAEL = 1;
my $ALG_GNUPG    = 2;

my $PCAP      = 0;
my $FILE_PCAP = 1;
my $ULOG_PCAP = 2;
my $SHARED_SEQUENCE  = 3;
my $ENCRYPT_SEQUENCE = 4;

### Bool to detect Linux "Cooked" datalink layers
my $PCAP_COOKED_INTF = 0;

### digest constants
my $SHA256_DIGEST_LEN = 43;
my $SHA1_DIGEST_LEN   = 27;
my $MD5_DIGEST_LEN    = 22;

### logr constants
my $SEND_MAIL = 1;
my $NO_MAIL   = 0;
my $LOG_VERBOSE = 1;
my $LOG_QUIET   = 2;

### packet counters
my $tcp_ctr  = 0;
my $udp_ctr  = 0;
my $icmp_ctr = 0;

### tcp option types
my $tcp_nop_type       = 1;
my $tcp_mss_type       = 2;
my $tcp_win_scale_type = 3;
my $tcp_sack_type      = 4;
my $tcp_timestamp_type = 8;

my %tcp_p0f_opt_types = (
    'N' => $tcp_nop_type,
    'M' => $tcp_mss_type,
    'W' => $tcp_win_scale_type,
    'S' => $tcp_sack_type,
    'T' => $tcp_timestamp_type
);

my %access_keys = (
    'SOURCE' => [],
    'KEY'    => '',
    'OPEN_PORTS'     => '',
    'GPG_REMOTE_ID'  => '',
    'GPG_DECRYPT_ID' => '',
    'GPG_DECRYPT_PW' => '',
    'GPG_HOME_DIR'   => '',
    'ULOG_PCAP'      => '',
    'FILE_PCAP'      => '',
    'DATA_COLLECT_MODE' => '',
    'ENCRYPT_SEQUENCE'  => '',
    'SHARED_SEQUENCE'   => '',
    'PORT_OFFSET'       => '',
    'REQUIRE_AUTH_METHOD' => '',
    'SHADOW_FILE'    => '',
    'KNOCK_INTERVAL' => '',
    'KNOCK_LIMIT'    => '',
    'PERMIT_CLIENT_PORTS' => '',
    'PERMIT_CLIENT_TIMEOUT' => '',
    'ENABLE_FORWARD_ACCESS' => 0,
    'ENABLE_CMD_EXEC'     => '',
    'DISABLE_FW_ACCESS'   => '',
    'REQUIRE_SOURCE_ADDRESS' => [],
    'require_src_addr_exceptions' => [],
    'INTERNAL_NET_ACCESS' => [],  ### for --Forward-access IP restrictions
    'internal_net_exceptions' => [],
    'CMD_REGEX'         => '',
    'FW_ACCESS_TIMEOUT' => '',
    'REQUIRE_USERNAME'  => '',
    'MIN_TIME_DIFF' => '',
    'MAX_TIME_DIFF' => '',
    'RESTRICT_INTF' => '',
);

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

my @args_cp = @ARGV;

### run GetOpt() to get comand line args
&handle_command_line();

&usage(0) if $print_help;

if ($print_version) {
    print "[+] fwknopd v$version (file revision: $rev_num)\n",
        "      by Michael Rash <mbr\@cipherdyne.org>\n";
    exit 0;
}

if ($os_fprint_only) {
    print "[+] Entering OS fingerprinting mode.\n";
}

print STDERR localtime() . " [+] ** Starting fwknopd (debug mode) **\n",
    "    Command line: @args_cp\n" if $debug;

### setup to run
&fwknop_init();

if ($config{'AUTH_MODE'} eq 'KNOCK' or $os_fprint_only) {

    ### we are running in traditional port knocking mode
    &knock_loop();

} elsif ($config{'AUTH_MODE'} eq 'FILE_PCAP'
        or $config{'AUTH_MODE'} eq 'ULOG_PCAP'
        or $config{'AUTH_MODE'} eq 'PCAP') {

    ### we are parsing the pcap file created by the ulogd pcap
    ### writer, or in sniffing mode against an interface
    &pcap_loop();
}
exit 0;
#============================ end main ==============================

sub pcap_loop() {

    ### we use both a size and an inode check in the FILE_PCAP and
    ### ULOG_PCAP modes to check if the file has been rotated
    my $pcap_file_size  = 0;
    my $pcap_file_inode = 0;

    ### get pcap opject
    my $pcap_t = &get_pcap_obj();

    ### Check for "cooked" Linux datalink layers (i.e. rp-pppoe)
    eval {
        if (not $PCAP_COOKED_INTF and $Net::Pcap::VERSION > 0.05) {
            if (Net::Pcap::pcap_datalink_val_to_name(
                    Net::Pcap::pcap_datalink($pcap_t)) eq 'LINUX_SLL') {
                print STDERR "[+] Detected Linux Cooked Interface.\n" if $debug;
                $PCAP_COOKED_INTF = 1;
            }
        }
    };
    &collect_warn_die_msgs() if $@;

    if ($config{'AUTH_MODE'} eq 'FILE_PCAP'
            or $config{'AUTH_MODE'} eq 'ULOG_PCAP') {
        ### get file size (we don't need a -e check here because
        ### this is handled in get_pcap_obj()).
        $pcap_file_size = -s $config{'PCAP_PKT_FILE'};

        ### get inode associated with the sniffing file
        $pcap_file_inode = (stat($config{'PCAP_PKT_FILE'}))[1];
    }
    print STDERR localtime() . " [+] pcap_loop()\n" if $debug;

    my $check_file_ctr = 0;

    &collect_warn_die_msgs();

    for (;;) {

        Net::Pcap::loop($pcap_t, 1, \&pcap_process_pkt, 'fwknop_tag');

        if ($config{'AUTH_MODE'} eq 'FILE_PCAP'
                or $config{'AUTH_MODE'} eq 'ULOG_PCAP') {

            ### check to see if the pcap file has been rotated (we need to
            ### close and re-open)
            if ($check_file_ctr >= 10) {
                if (-e $config{'PCAP_PKT_FILE'}) {
                    my $size_tmp  = -s $config{'PCAP_PKT_FILE'};
                    my $inode_tmp = (stat($config{'PCAP_PKT_FILE'}))[1];
                    if ($inode_tmp != $pcap_file_inode
                            or $size_tmp < $pcap_file_size) {

                        ### the file was rotated or shrank, so get new
                        ### pcap_t object
                        Net::Pcap::close($pcap_t);

                        &logr('[+]', "pcap file $config{'PCAP_PKT_FILE'} " .
                            "shrank or was rotated, so re-opening", $NO_MAIL);
                        $pcap_t = &get_pcap_obj();

                        ### set file size and inode
                        $pcap_file_size  = $size_tmp;
                        $pcap_file_inode = $inode_tmp;
                    }
                } else {
                    Net::Pcap::close($pcap_t);
                    &logr('[+]', "pcap file $config{'PCAP_PKT_FILE'} " .
                        "was rotated, so re-opening", $NO_MAIL);
                    $pcap_t = &get_pcap_obj();

                    ### set file size and inode
                    $pcap_file_size  = -s $config{'PCAP_PKT_FILE'};
                    $pcap_file_inode = (stat($config{'PCAP_PKT_FILE'}))[1];
                }
                $check_file_ctr = 0;
            }
            $check_file_ctr++;
        }

        &collect_warn_die_msgs();
        sleep $pcap_sleep_interval;
    }

    Net::Pcap::close($pcap_t);

    return;
}

sub pcap_process_pkt() {
    my ($tag, $hdr, $pkt) = @_;

    &collect_warn_die_msgs();

    return unless $tag eq 'fwknop_tag';
    return unless defined $hdr;
    return unless defined $pkt;

    my $ether_data = '';
    my $ip         = '';
    my $src_ip     = '';
    my $proto      = '';
    my $transport_obj = '';

    if ($debug) {
        print STDERR localtime() . " [+] Received packet ***[" .
            localtime() . "]***\n";
        if ($verbose) {
            print STDERR localtime() .
                "     Complete raw packet data (hex dump, including ",
                    "packet headers):\n";
            &hex_dump($pkt);
        }
    }

    if ($config{'AUTH_MODE'} eq 'ULOG_PCAP') {
        ### The ulogd pcap writer does not include link layer information
        $ip = NetPacket::IP->decode($pkt) or return;
    } else {
        if ($config{'FIREWALL_TYPE'} eq 'ipfw' and $cmdline_intf eq 'lo0') {

            ### it seems that FreeBSD does not include an Ethernet header
            ### over loopback
            $pkt =~ s/^.{4}// if $pkt =~ /^[^\x45].{3}\x45/;

            $ip = NetPacket::IP->decode($pkt) or return;
        } else {
            if ($PCAP_COOKED_INTF) {
                $ether_data = unpack("x[16]a*", $pkt);
            } else {
                $ether_data = NetPacket::Ethernet::strip($pkt) or return;
            }
            $ip = NetPacket::IP->decode($ether_data) or return;
        }
    }

    ### get the source IP address from the IP header
    $src_ip = $ip->{'src_ip'} or return;

    ### get the protocol
    $proto = $ip->{'proto'} or return;

    if ($proto == 1) {
        $transport_obj = NetPacket::ICMP->decode($ip->{'data'});
    } elsif ($proto == 6) {
        $transport_obj = NetPacket::TCP->decode($ip->{'data'});
    } elsif ($proto == 17) {
        $transport_obj = NetPacket::UDP->decode($ip->{'data'});
    } else {
        return;
    }

    ### make sure we have _some_ data in the packet; in practice
    ### any valid SPA message will be longer than 10 bytes, but this
    ### check is better than nothing
    return unless defined $transport_obj->{'data'};

    my $enc_msg_len = 0;
    $enc_msg_len = length($transport_obj->{'data'});
    if (10 < $enc_msg_len and $enc_msg_len < 1500) {
        print STDERR localtime() . " [+] Data len: $enc_msg_len bytes\n"
            if $debug;
    } else {
        print STDERR localtime() . " [-] $enc_msg_len bytes, not ",
            "attempting decrypt)\n" if $debug;
        return;
    }

    if ($debug) {
        ### make sure not to print non-printable stuff
        my $data_tmp = $transport_obj->{'data'};
        $data_tmp =~ s/[^\x20-\x7e]/NA/g;
        print STDERR localtime() .
            " [+] Raw packet data (single line): $data_tmp\n";

        ### print packet data out in tcpdump -X format
        if ($verbose) {
            print STDERR localtime() .
                "     Raw packet data (hex dump, minus packet headers):\n";
            &hex_dump($transport_obj->{'data'});
        }
    }

    ### see if this packet is worthy of being granted access through
    ### the firewall
    &SPA_check_grant_access($src_ip, $enc_msg_len, $transport_obj->{'data'});

    &collect_warn_die_msgs();

    return;
}

sub SPA_check_grant_access() {
    my ($src_ip, $enc_msg_len, $pkt_data) = @_;

    ### first check to see if we have any matching access directives
    ### (in access.conf) for $src_ip, and if not we will do _nothing_
    ### with this packet.
    my $access_nums_aref = &check_src($src_ip);

    if ($#$access_nums_aref > -1) {

        ### See if the packet qualifies for any access
        SOURCE: for my $num (@$access_nums_aref) {
            my $access_hr = $access[$num];

            next SOURCE unless $access_hr->{'DATA_COLLECT_MODE'} == $PCAP
                or $access_hr->{'DATA_COLLECT_MODE'} == $FILE_PCAP
                or $access_hr->{'DATA_COLLECT_MODE'} == $ULOG_PCAP;

            &dump_access($access_hr, $num) if $debug and $verbose;

            ### keep track of which source block we are dealing with from
            ### access.conf
            my $source_block_num = $access_hr->{'block_num'};

            ### see if we can decrypt and base64-decode
            my ($decrypt_rv, $decrypted_msg, $gpg_sign_id, $decrypt_algo)
                = &SPA_decrypt($pkt_data, $enc_msg_len, $access_hr);
            next SOURCE unless $decrypt_rv;

            ### check for replay attacks
            my ($digest_rv, $digest)
                = &check_replay_attack($decrypted_msg, $src_ip);
            return if $digest_rv;

            ### see if we have a syntactically valid message
            my ($validate_rv, $msg_hr) = &pcap_validate_msg(
                $decrypted_msg, $source_block_num, $access_hr);
            if ($debug and not $validate_rv) {
                print STDERR localtime() . " [-] Decrypted message does not ",
                    "conform to a valid SPA packet.\n";
            }
            next SOURCE unless $validate_rv;

            ### check to see if client side time stamp is too old
            my $time_check_rv = &SPA_check_packet_age($msg_hr->{'remote_time'});
            next SOURCE unless $time_check_rv;

            ### dump packet to stderr for debugging purposes
            &SPA_dump_packet($msg_hr) if $debug;

            ### check username
            next SOURCE unless &SPA_check_user($access_hr, $src_ip, $msg_hr);

            ### check authentication method
            next SOURCE unless &SPA_check_auth_method(
                $access_hr, $src_ip, $msg_hr);

            if ($msg_hr->{'action_type'} == $SPA_ACCESS_MODE
                    or $msg_hr->{'action_type'} == $SPA_FORWARD_ACCESS_MODE
                    or $msg_hr->{'action_type'} == $SPA_FORWARD_ACCESS_MODE
                    or $msg_hr->{'action_type'}
                        == $SPA_CLIENT_TIMEOUT_ACCESS_MODE
                    or $msg_hr->{'action_type'}
                        == $SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE) {

                if (&SPA_access($msg_hr, $src_ip, $decrypt_algo,
                        $gpg_sign_id, $digest, $access_hr)) {
                    last SOURCE;
                } else {
                    next SOURCE;
                }
            } elsif ($msg_hr->{'action_type'} == $SPA_COMMAND_MODE) {
                if (&SPA_cmd($msg_hr, $src_ip, $decrypt_algo,
                        $gpg_sign_id, $digest, $access_hr)) {
                    last SOURCE;
                } else {
                    next SOURCE;
                }
            }
        }
    } else {
        print STDERR localtime() . " [-] Packet from $src_ip did not ",
            "match any SOURCE blocks in $config{'ACCESS_CONF'}\n" if $debug;
    }

    ### see if we need to exit if the packet limit (set with -C on the
    ### command line) has been reached
    if ($packet_limit) {
        $packet_ctr++;
        if ($packet_ctr >= $packet_limit) {
            &logr('[+]', "packet limit ($packet_limit) reached, exiting.",
                $NO_MAIL);
            exit 0;
        }
    }

    return;
}

sub SPA_decrypt() {
    my ($pkt_data, $enc_msg_len, $access_hr) = @_;

    my $decrypted_msg = '';
    my $decrypt_algo  = $ALG_RIJNDAEL;
    my $gpg_sign_id   = '';
    my $decrypt_rv    = 0;

    if ($enc_msg_len > $config{'MIN_GNUPG_MSG_SIZE'}
            and defined $access_hr->{'GPG_REMOTE_ID'}) {
        ### attempt GPG decrypt (only if the length of the encrypted
        ### payload is greater than the minimum size for an SPA message
        ### encrypted with GnuPG; even encrypting a single byte of data
        ### with a 1024 bit GnuPG key results in 340 bytes of encrypted
        ### payload in my testing).
        ($decrypt_rv, $decrypted_msg, $gpg_sign_id) =
                &pcap_GPG_decrypt_msg($pkt_data, $access_hr);

        $decrypt_algo = $ALG_GNUPG if $decrypt_rv;
    }

    ### fall back to Rijndael if the GnuPG decrypt was not successful
    ### (and note that the GnuPG decryption is only attempted if the
    ### packet size is large enough).
    if (defined $access_hr->{'KEY'} and not $decrypt_rv) {

        ($decrypt_rv, $decrypted_msg) = &pcap_Rijndael_decrypt_msg(
                            $pkt_data, $access_hr->{'KEY'});
    }

    if ($decrypt_rv) {
        if ($debug) {
            ### make sure not to print non-printable stuff
            my $dec_tmp_msg = $decrypted_msg;
            $dec_tmp_msg =~ s/[^\x20-\x7e]/NA/g;
            print STDERR localtime() . " [+] Decrypted ",
                "message: $dec_tmp_msg\n";
            if ($verbose) {
                print STDERR localtime() . "     Decrypted message (hex dump):\n";
                &hex_dump($decrypted_msg);
            }
        }
    } else {
        print STDERR localtime() . " [-] Failed decrypt for SOURCE block ",
            "$access_hr->{'src_str'}\n" if $debug;
    }

    return $decrypt_rv, $decrypted_msg, $gpg_sign_id, $decrypt_algo;
}

sub SPA_check_packet_age() {
    my $remote_time = shift;

    if ($config{'ENABLE_SPA_PACKET_AGING'} eq 'Y') {
        if (abs((time() - $remote_time))
                > $config{'MAX_SPA_PACKET_AGE'}) {
            &logr('[-]', "remote time stamp is older than " .
                "$config{'MAX_SPA_PACKET_AGE'} second max age.", $SEND_MAIL);
            return 0;
        }
    }
    return 1;
}

sub SPA_dump_packet() {
    my $msg_hr = shift;

    print STDERR localtime() . " [+] Packet fields:\n";
    printf STDERR "    %-16s %s\n    %-16s %s\n    %-16s %s\n" .
                  "    %-16s %s\n    %-16s %s",
            'Random data:', $msg_hr->{'random_number'},
            'Username:',    $msg_hr->{'username'},
            'Remote time:', $msg_hr->{'remote_time'},
            'Remote ver:',  $msg_hr->{'remote_version'},
            'Action type:', $msg_hr->{'action_type'};

    if ($msg_hr->{'action_type'} == $SPA_ACCESS_MODE) {
        print STDERR " (SPA_ACCESS_MODE)\n";
    } elsif ($msg_hr->{'action_type'} == $SPA_COMMAND_MODE) {
        print STDERR " (SPA_COMMAND_MODE)\n";
    } elsif ($msg_hr->{'action_type'} == $SPA_FORWARD_ACCESS_MODE) {
        print STDERR " (SPA_FORWARD_ACCESS_MODE)\n";
    } elsif ($msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_ACCESS_MODE) {
        print STDERR " (SPA_CLIENT_TIMEOUT_ACCESS_MODE)\n";
    } elsif ($msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE) {
        print STDERR " (SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE)\n";
    }
    printf STDERR "    %-16s %s\n",
            'Action:', $msg_hr->{'action'};

    if ($msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_ACCESS_MODE
            or $msg_hr->{'action_type'}
                == $SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE) {
        printf STDERR "    %-16s %s\n",
                'Client timeout:', $msg_hr->{'client_timeout'};
    }

    if ($msg_hr->{'server_auth'}) {
        if ($msg_hr->{'server_auth'} =~ /^\s*(\w+),(.*)/) {
            my $server_auth_type = lc($1);
            my $server_auth_crypt_pw = $2;
            if ($debug) {
                printf STDERR "    %-16s %s", 'Server auth:', $server_auth_type;
                for (my $i=0; $i<length($server_auth_crypt_pw); $i++) {
                    print STDERR '*';
                }
                print STDERR "\n";
            }
        }
    }
    if ($msg_hr->{'forward_info'}) {
        printf STDERR "    %-16s %s\n", 'Forward info:',
            $msg_hr->{'forward_info'};
    }
    printf STDERR "    %-16s %s\n", "$msg_hr->{'digest_str'} digest:",
        $msg_hr->{'digest'};
    return;
}

sub SPA_check_user() {
    my ($access_hr, $src_ip, $msg_hr) = @_;

    if (defined $access_hr->{'REQUIRE_USERNAME'}) {
        my $found = 0;
        my $user  = '';
        for my $valid_user (@{$access_hr->{'VALID_USERS'}}) {
            if ($valid_user eq $msg_hr->{'username'}) {
                $found = 1;
                $user  = $valid_user;
            }
        }
        unless ($found) {
            &logr('[-]', "username mismatch from $src_ip, expecting " .
                "$access_hr->{'REQUIRE_USERNAME'}, got " .
                "$msg_hr->{'username'}", $SEND_MAIL);
            return 0;
        }
    }
    return 1;
}

sub SPA_check_auth_method() {
    my ($access_hr, $src_ip, $msg_hr) = @_;

    my $server_auth_type     = '';
    my $server_auth_crypt_pw = '';
    if ($msg_hr->{'server_auth'}) {
        if ($msg_hr->{'server_auth'} =~ /^\s*(\w+),(.*)/) {
            $server_auth_type = lc($1);
            $server_auth_crypt_pw = $2;
        }
    }

    if (defined $access_hr->{'REQUIRE_AUTH_METHOD'}) {
        if ($server_auth_type
                eq $access_hr->{'REQUIRE_AUTH_METHOD'}) {
            if ($server_auth_type eq 'crypt') {
                ### check the local UNIX crypt() password associated
                ### with the user
                unless (&server_auth_verify_crypt_pw(
                            $msg_hr->{'username'},
                            $server_auth_crypt_pw,
                            $access_hr->{'SHADOW_FILE'})) {
                    &logr('[-]', "IP: $src_ip failed server-auth UNIX " .
                        "crypt() password test", $NO_MAIL);
                    return 0;
                }
            }
        } else {
            &logr('[-]', "required server-auth method " .
                "\"$access_hr->{'REQUIRE_AUTH_METHOD'}\" " .
                "not supplied by $src_ip", $NO_MAIL);
            return 0;
        }
    }
    return 1;
}

sub SPA_access() {
    my ($msg_hr, $src_ip, $decrypt_algo, $gpg_sign_id,
        $digest, $access_hr) = @_;

    my $allow_src    = '';
    my %open_ports   = ();
    my %forward_info = ();

    if ($access_hr->{'DISABLE_FW_ACCESS'}) {
        &logr('[-]', "received fw access request from $src_ip, " .
            "but DISABLE_FW_ACCESS is set to a true value " .
            "(SOURCE line num: $access_hr->{'src_line_num'})", $NO_MAIL);
        return 0;
    }

    if ($msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_ACCESS_MODE
            or $msg_hr->{'action_type'}
                == $SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE) {

        if ($access_hr->{'PERMIT_CLIENT_TIMEOUT'}) {
            $access_hr->{'FW_ACCESS_TIMEOUT'} = $msg_hr->{'client_timeout'};
        } else {
            &logr('[-]', "received fw access request from $src_ip, " .
                "with client-defined timeout, but PERMIT_CLIENT_TIMEOUT is not " .
                "set (SOURCE line num: $access_hr->{'src_line_num'})", $NO_MAIL);
            return 0;
        }
    }

    $allow_src = $1 if $msg_hr->{'action'} =~ /($ip_re)/;

    unless ($allow_src) {
        &logr('[-]', "no valid IP address within action portion of SPA " .
            "packet from $src_ip (SOURCE line num: " .
            "$access_hr->{'src_line_num'})", $SEND_MAIL);
        return 0;
    }

    if ($allow_src eq '0.0.0.0') {
        if ($config{'REQUIRE_SOURCE_ADDRESS'} eq 'Y'