root/fwknop/tags/fwknop-1.8.4-pre2/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.8.4-pre2
#
# 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: fwknopd 583 2006-11-04 20:43:01Z mbr $
#

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 Digest::MD5 'md5_base64';
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 $version = '1.8.4-pre2';
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 %p0f_sigs = ();
my %fw_access = ();
my %ip_sequences  = ();
my %md5_msg_store = ();
my %ipt_input   = ();
my %ipt_forward = ();

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 $fw_list        = 0;
my $ipt_flush      = 0;
my $verbose        = 0;
my $use_gpg        = 0;
my $os_ipt_log     = '';
my $cmdline_intf   = '';
my $warn_msg       = '';
my $die_msg        = '';
my $err_wait_timer = 30;  ### seconds
my $gpg_agent_info = '';
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
my $SPA_COMMAND_MODE = 0;
my $SPA_ACCESS_MODE  = 1;  ### default
my $SPA_FORWARD_ACCESS_MODE = 2;

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

### default time values
my $knock_interval    = 60;
my $fw_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;

### logr constants
my $SEND_MAIL = 1;
my $NO_MAIL   = 0;

### 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' => '',
    'TYPE'   => '',
    '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' => '',
    'FORWARD_ACCESS' => 0, 
    'ENABLE_CMD_EXEC'     => '',
    'DISABLE_FW_ACCESS'   => '',
    'REQUIRE_SOURCE_ADDRESS' => '',
    '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 "[+] ** Starting fwknopd (debug mode) **\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();

    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 "[+] pcap_loop()\n" if $debug;

    my $check_file_ctr = 0;

    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++;

            ### always check to see if we need to timeout access for IPs
            ### (note that AUTH_MODE set to PCAP, knoptm will timeout access;
            ### knoptm is not run in either the FILE_PCAP or ULOG_PCAP
            ### modes).
            &timeout_access();
        }

        ### see if fwknopd should voluntarily exit so that it can be
        ### restarted by knopwatchd
        &check_voluntary_exits() unless $config{'AUTH_MODE'} eq 'PCAP';

        sleep $pcap_sleep_interval;
    }

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

    return;
}

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

    &write_die_msg() if $die_msg;
    &write_warn_msg() if $warn_msg;

    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 ($config{'AUTH_MODE'} eq 'ULOG_PCAP') {
        ### The ulogd pcap writer does not include link layer information
        $ip = NetPacket::IP->decode($pkt) or return;
    } else {
        $ether_data = NetPacket::Ethernet::strip($pkt) or return;
        $ip = NetPacket::IP->decode($ether_data) or return;
    }

    ### get the source IP address
    $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;
    }

    print STDERR "[+] Received packet ***[" .
        localtime() . "]*** (" if $debug;

    ### 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 "$enc_msg_len bytes)\n" if $debug;
    } else {
        print STDERR "$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 "[+] Raw packet data (single line): $data_tmp\n";

        ### print packet data out in tcpdump -X format
        if ($verbose) {
            print STDERR "    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'});

    &write_die_msg() if $die_msg;
    &write_warn_msg() if $warn_msg;

    ### see if fwknopd should voluntarily exit so that it can be
    ### restarted by knopwatchd
    &check_voluntary_exits();

    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);

    unless ($access_nums_aref) {
        print STDERR "[-] Packet from $src_ip did not match any ",
              "SOURCE blocks in $config{'ACCESS_CONF'}\n" if $debug;
        return;
    }

    ### 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 ($md5sum_rv, $md5sum)
            = &check_replay_attack($decrypted_msg, $src_ip);
        return if $md5sum_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 "[-] 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) {
            if (&SPA_access($msg_hr, $src_ip, $decrypt_algo,
                    $gpg_sign_id, $md5sum, $access_hr)) {
                last SOURCE;
            } else {
                next SOURCE;
            }
        } elsif ($msg_hr->{'action_type'} == $SPA_FORWARD_ACCESS_MODE) {
            if (&SPA_access($msg_hr, $src_ip, $decrypt_algo,
                    $gpg_sign_id, $md5sum, $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, $md5sum, $access_hr)) {
                last SOURCE;
            } else {
                next SOURCE;
            }
        }
    }
    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 "[+] Decrypted ",
                "message: $dec_tmp_msg\n";
            if ($verbose) {
                print STDERR "    Decrypted message (hex dump):\n";
                &hex_dump($decrypted_msg);
            }
        }
    } else {
        print STDERR "[-] Failed decrypt for SOURCE block ",
            "$access_hr->{'SOURCE'}\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 "[+] Packet fields:\n";
    printf STDERR "    %-14s %s\n    %-14s %s\n    %-14s %s\n".
                  "    %-14s %s\n    %-14s %s\n    %-14s %s\n",
            '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'},
            'Action:',      $msg_hr->{'action'};

    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 "    %-14s %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 "    %-14s %s\n", 'Forward info:', $msg_hr->{'forward_info'};
    }
    printf STDERR "    %-14s %s\n", 'MD5 sum:', $msg_hr->{'md5sum'};
    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,
        $md5sum, $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;
    }

    $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'
                or (defined $access_hr->{'REQUIRE_SOURCE_ADDRESS'}
                    and $access_hr->{'REQUIRE_SOURCE_ADDRESS'})) {
            &logr('[-]', "IP: $src_ip sent SPA packet that " .
                "contained 0.0.0.0 (-s on the client side) " .
                "but REQUIRE_SOURCE_ADDRESS is enabled " .
                "(SOURCE line num: $access_hr->{'src_line_num'})", $SEND_MAIL);
            return 0;
        } else {
            $allow_src = $src_ip;
        }
    }

    ### initialize to the OPEN_PORTS directives (if defined; we know that
    ### either OPEN_PORTS or PERMIT_CLIENT_PORTS was specified in the
    ### access.conf file)
    %open_ports = %{$access_hr->{'OPEN_PORTS'}}
        if defined $access_hr->{'OPEN_PORTS'};

    if ($access_hr->{'PERMIT_CLIENT_PORTS'}) {
        if ($msg_hr->{'action'}
                =~ /$ip_re,(tcp|udp|icmp),(\d+)/i) {
            ### single port access format (e.g. tcp,22)
            my $dec_allow_port  = $1;
            my $dec_allow_proto = $2;

            $open_ports{$dec_allow_proto}{$dec_allow_port} = '';

        } elsif ($msg_hr->{'action'}
                 =~ /$ip_re,(\S+)/) {
            ### multi-port access format (-A was specified by
            ### the client)
            my $access_str = $1;

            my @dec_allow_ports = split /,/, $access_str;

            for my $port_str (@dec_allow_ports) {
                if ($port_str =~ m|(\D+)/(\d+)|) {
                    my $proto = lc($1);
                    my $port  = $2;

                    next unless ($proto eq 'tcp'
                        or $proto eq 'udp'
                        or $proto eq 'icmp');
                    $port = 0 if $proto eq 'icmp';

                    $open_ports{$proto}{$port} = '';
                }
            }
        }
    }

    ### handle SPA access through iptables FORWARD chain for
    ### SPA_FORWARD_ACCESS_MODE messages
    ### iptables -t nat -A PREROUTING -p tcp --dport 80 -i eth0 -j DNAT --to 192.168.10.3:80
    if ($msg_hr->{'forward_info'}
                and $msg_hr->{'forward_info'} =~ /($ip_re),(\d+)/) {
        unless ($access_hr->{'FORWARD_ACCESS'}) {
            &logr('[-]', "FORWARD access requested through non-forward " .
                "access SOURCE block (SOURCE line num: ".
                "$access_hr->{'src_line_num'})", $NO_MAIL);
            return 0;
        }
        %forward_info = (
            'internal_ip'   => $1,
            'external_port' => $2,
        );
        my $port_ctr = 0;
        for my $proto (keys %open_ports) {
            for my $port (keys %{$open_ports{$proto}}) {
                $port_ctr++;
            }
        }
        ### we can only map one forwarding port on the external interface
        ### to be forwarded to one internal service
        if ($port_ctr > 1) {
            &logr('[-]', "cannot forward more than one port " .
                "(SOURCE line num: $access_hr->{'src_line_num'})", $NO_MAIL);
            return 0;
        }
    } else {
        if ($access_hr->{'FORWARD_ACCESS'}) {
            &logr('[-]', "non-forward access requested through FORWARD " .
                "access SOURCE block (SOURCE line num: " .
                "$access_hr->{'src_line_num'})", $NO_MAIL);
            return 0;
        }
    }

    if ($decrypt_algo == $ALG_GNUPG) {
        if ($access_hr->{'GPG_REMOTE_ID'} ne 'ANY') {
            &logr('[+]', "received valid GnuPG encrypted packet " .
                qq|(signed with required key ID: "$gpg_sign_id") from: | .
                "$src_ip, remote user: $msg_hr->{'username'} " .
                "(SOURCE line num: $access_hr->{'src_line_num'})", $NO_MAIL);
        } else {
            &logr('[+]', "received valid GnuPG encrypted packet " .
                "from: $src_ip, remote user: $msg_hr->{'username'} " .
                "(SOURCE line num: $access_hr->{'src_line_num'})",
                $NO_MAIL);
        }
    } else {
        &logr('[+]', "received valid Rijndael encrypted " .
            "packet from: $src_ip, remote user: $msg_hr->{'username'} " .
            "(SOURCE line num: $access_hr->{'src_line_num'})",
            $NO_MAIL);
    }

    ### cache the MD5 sum
    $md5_msg_store{$md5sum} = $src_ip;

    ### write MD5 sum to disk
    &diskwrite_md5_sum($md5sum, $src_ip)
        if $config{'ENABLE_MD5_PERSISTENCE'} eq 'Y';

    ### grant access through the firewall
    &grant_access($allow_src, \%forward_info, {}, \%open_ports, $access_hr);

    return 1;
}

sub SPA_cmd() {