perl/legacy/fwknop/fwknopd

   1 #!/usr/bin/perl -w
   2 #
   3 #############################################################################
   4 #
   5 # File: fwknopd (/usr/sbin/fwknopd)
   6 #
   7 # URL: http://www.cipherdyne.org/fwknop/
   8 #
   9 # Purpose: fwknopd implements the server portion of an authorization scheme
  10 #          known as Single Packet Authorization (SPA) that requires only a
  11 #          single encrypted packet to communicate various pieces of
  12 #          information including desired access through an iptables policy
  13 #          and/or specific commands to execute on the target system.  The
  14 #          main application of this program is to protect services such as
  15 #          SSH with an additional layer of security in order to make the
  16 #          exploitation of vulnerabilities (both 0-day and unpatched code)
  17 #          much more difficult.  For more information, see the fwknop(8) man
  18 #          page.
  19 #
  20 #          More information can be found in the fwknop(8) and fwknopd(8) man
  21 #          pages, and also online here:
  22 #
  23 #          http://www.cipherdyne.org/fwknop/docs/
  24 #
  25 # Author: Michael Rash (mbr@cipherdyne.org)
  26 #
  27 # Version: 1.9.12
  28 #
  29 # Copyright (C) 2004-2009 Michael Rash (mbr@cipherdyne.org)
  30 #
  31 # License - GNU Public License version 2 (GPLv2):
  32 #
  33 #    This program is distributed in the hope that it will be useful,
  34 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
  35 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  36 #    GNU General Public License for more details.
  37 #
  38 #    You should have received a copy of the GNU General Public License
  39 #    along with this program; if not, write to the Free Software
  40 #    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
  41 #    USA
  42 #
  43 #############################################################################
  44 #
  45 # $Id: fwknopd 1533 2009-09-08 02:44:02Z mbr $
  46 #
  47
  48 use IO::Socket;
  49 use IO::Handle;
  50 use MIME::Base64;
  51 use Data::Dumper;
  52 use POSIX ':sys_wait_h';
  53 use Getopt::Long;
  54 use strict;
  55
  56 my $config_file = '/etc/fwknop/fwknop.conf';
  57 my $access_conf_file = '';
  58
  59 my $version = '1.9.12';
  60 my $revision_svn = '$Revision: 1533 $';
  61 my $rev_num = '1';
  62 ($rev_num) = $revision_svn =~ m|\$Rev.*:\s+(\S+)|;
  63
  64 my %config = ();
  65 my $override_config_str = '';
  66 my %cmds   = ();
  67 my %p0f    = ();
  68 my @access = ();
  69 my $blacklist_ar = [];
  70 my $blacklist_exclude_ar = [];
  71 my %p0f_sigs  = ();
  72 my %pid_files = ();
  73 my %ip_sequences = ();
  74 my %digest_store = ();
  75 my %ipt_input    = ();
  76 my %ipt_forward  = ();
  77 my %ipt_prerouting  = ();
  78 my %ipt_postrouting = ();
  79 my %ipt_output = ();  ### optional
  80 my @ipt_config = ();
  81
  82 my $ipfw_is_dynamic = 0;
  83
  84 my $os_fprint_only = 0;
  85 my $print_version  = 0;
  86 my $print_help     = 0;
  87 my $stop_daemons   = 0;
  88 my $restart        = 0;
  89 my $status         = 0;
  90 my $debug          = 0;
  91 my $packet_ctr     = 0;
  92 my $packet_limit   = 0;
  93 my $lib_dir        = '';
  94 my $fw_list        = 0;
  95 my $fw_type        = '';
  96 my $fw_flush       = 0;
  97 my $ipt_del_chains = 0;
  98 my $fw_del_ip      = '';
  99 my $test_mode      = 0;
 100 my $verbose        = 0;
 101 my $imported_gpg   = 0;
 102 my $os_ipt_log     = '';
 103 my $use_sendmail   = 0;
 104 my $cmdline_intf   = '';
 105 my $warn_msg       = '';
 106 my $die_msg        = '';
 107 my $cmdline_knoptm = '';
 108 my $skip_fko_module = 0;
 109 my $use_fko_module  = 0;
 110 my $test_fko_exists = 0;
 111 my $fko_incoming_digest_type = 0;
 112 my $fko_obj = ();
 113 my $cmdl_disable_gpg = 0;
 114 my $cmdline_fwknop_serv = '';
 115 my $knoptm_debug_file = '';
 116 my $knoptm_include_pidname = 0;
 117 my $fwkserv_debug_file = '';
 118 my $fwkserv_include_pidname = 0;
 119 my $err_wait_timer = 30;  ### seconds
 120 my $gpg_agent_info = '';
 121 my $gpg_no_options = 0;
 122 my $gpg_use_options = 0;
 123 my $gpg_default_prefix = 'hQ';  ### base64 encoded 0x8502
 124 my $build_ipt_config = 0;
 125 my $skipped_first_loop = 0;
 126 my $imported_crypt_cbc = 0;
 127 my $pcap_sleep_interval = 1;  ### seconds
 128 my $imported_iptables_modules = 0;
 129 my $include_all_config_data   = 0;
 130 my $voluntary_exit_timestamp  = 0;
 131 my $fw_data_file = '';  ### legacy port knocking mode
 132 my $dump_config = 0;
 133 my $spa_dump_packets = '';
 134
 135 my $cmdline_locale = '';
 136 my $no_locale = 0;
 137
 138 ### SPA message types from fwknop clients
 139
 140 ### COMMAND message:
 141 ###     random data : user : client_timestamp : client_version : \
 142 ###     type (0) : command : digest
 143 my $SPA_COMMAND_MODE = 0;
 144
 145 ### ACCESS message (this type is used most often):
 146 ###     random data : user : client_timestamp : client_version : \
 147 ###     type (1) : access_request : digest
 148 my $SPA_ACCESS_MODE  = 1;  ### default
 149
 150 ### NAT ACCESS message:
 151 ###     random data : user : client_timestamp : client_version : \
 152 ###     type (2) : access_request : NAT_info : digest
 153 my $SPA_NAT_ACCESS_MODE = 2;
 154
 155 ### ACCESS message with client-defined firewall timeout:
 156 ###     random data : user : client_timestamp : client_version : \
 157 ###     type (3) : access_request : timeout : digest
 158 my $SPA_CLIENT_TIMEOUT_ACCESS_MODE = 3;
 159
 160 ### NAT ACCESS message with client-defined firewall timeout:
 161 ###     random data : user : client_timestamp : client_version : \
 162 ###     type (4) : access_request : NAT_info : timeout : digest
 163 my $SPA_CLIENT_TIMEOUT_NAT_ACCESS_MODE = 4;
 164
 165 ### local NAT ACCESS message:
 166 ###     random data : user : client_timestamp : client_version : \
 167 ###     type (5) : access_request : NAT_info : message digest
 168 my $SPA_LOCAL_NAT_ACCESS_MODE = 5;
 169
 170 ### local NAT ACCESS message with client-defined firewall timeout:
 171 ###     random data : user : client_timestamp : client_version : \
 172 ###     type (6) : access_request : NAT_info : timeout : message digest
 173 my $SPA_CLIENT_TIMEOUT_LOCAL_NAT_ACCESS_MODE = 6;
 174
 175 my %spa_mode_strings = (
 176     $SPA_COMMAND_MODE    => 'SPA_COMMAND_MODE',
 177     $SPA_ACCESS_MODE     => 'SPA_ACCESS_MODE',
 178     $SPA_NAT_ACCESS_MODE => 'SPA_NAT_ACCESS_MODE',
 179     $SPA_CLIENT_TIMEOUT_ACCESS_MODE     => 'SPA_CLIENT_TIMEOUT_ACCESS_MODE',
 180     $SPA_CLIENT_TIMEOUT_NAT_ACCESS_MODE => 'SPA_CLIENT_TIMEOUT_NAT_ACCESS_MODE',
 181     $SPA_LOCAL_NAT_ACCESS_MODE          => 'SPA_LOCAL_NAT_ACCESS_MODE',
 182     $SPA_CLIENT_TIMEOUT_LOCAL_NAT_ACCESS_MODE => 'SPA_CLIENT_TIMEOUT_LOCAL_NAT_ACCESS_MODE'
 183 );
 184
 185 ### limits on nummber of fields within a decrypted SPA packet
 186 my $SPA_MIN_PACKET_FIELDS = 7;
 187 my $SPA_MAX_PACKET_FIELDS = 9;
 188
 189 ### default time values
 190 my $knock_interval = 60;
 191 my $default_access_timeout = 300;
 192
 193 my $enc_port_offset   = 61000;  ### default offset
 194 my $enc_key           = '';
 195 my $enc_alg           = 'Rijndael';
 196 my $enc_blocksize     = 32;
 197
 198 ### there is a constant "RIJNDAEL_KEYSIZE" in the Crypt::Rijndael sources, but
 199 ### it is not used; a 16 byte key size is fine.
 200 my $enc_keysize = 16;
 201
 202 my $ALG_RIJNDAEL = 1;
 203 my $ALG_GNUPG    = 2;
 204
 205 my $PCAP      = 0;
 206 my $FILE_PCAP = 1;
 207 my $ULOG_PCAP = 2;
 208 my $SHARED_SEQUENCE  = 3;
 209 my $ENCRYPT_SEQUENCE = 4;
 210
 211 ### Bool to detect Linux "Cooked" datalink layers
 212 my $PCAP_COOKED_INTF = 0;
 213
 214 ### digest constants
 215 my $SHA256_DIGEST_LEN = 43;
 216 my $SHA1_DIGEST_LEN   = 27;
 217 my $MD5_DIGEST_LEN    = 22;
 218 my $FKO_RECOMPUTE     = 1;
 219
 220 ### logr constants
 221 my $SEND_MAIL = 1;
 222 my $NO_MAIL   = 0;
 223 my $LOG_VERBOSE = 1;
 224 my $LOG_QUIET   = 2;
 225
 226 my $ZERO_SLEEP = 0;
 227 my $STDOUT = 1;
 228 my $STDERR = 2;
 229
 230 ### packet counters
 231 my $tcp_ctr  = 0;
 232 my $udp_ctr  = 0;
 233 my $icmp_ctr = 0;
 234
 235 ### protocol values
 236 my $IPPROTO_ICMP = 1;
 237 my $IPPROTO_TCP  = 6;
 238 my $IPPROTO_UDP  = 17;
 239
 240 ### tcp option types
 241 my $tcp_nop_type       = 1;
 242 my $tcp_mss_type       = 2;
 243 my $tcp_win_scale_type = 3;
 244 my $tcp_sack_type      = 4;
 245 my $tcp_timestamp_type = 8;
 246
 247 my %tcp_p0f_opt_types = (
 248     'N' => $tcp_nop_type,
 249     'M' => $tcp_mss_type,
 250     'W' => $tcp_win_scale_type,
 251     'S' => $tcp_sack_type,
 252     'T' => $tcp_timestamp_type
 253 );
 254
 255 my $ETH_HDR_LEN      = 14;
 256 my $MIN_IP_HDR_LEN   = 20;
 257 my $MIN_ICMP_HDR_LEN = 8;   ### most practical for SPA packets over ICMP
 258 my $UDP_HDR_LEN      = 8;
 259 my $MIN_TCP_HDR_LEN  = 20;
 260
 261 my $EXTERNAL_CMD_ALARM = 30;  ### default for external commands
 262
 263 my %access_keys = (
 264     'SOURCE' => [],
 265     'KEY'    => '',
 266     'OPEN_PORTS'     => '',
 267     'GPG_REMOTE_ID'  => '',
 268     'GPG_DECRYPT_ID' => '',
 269     'GPG_DECRYPT_PW' => '',
 270     'GPG_HOME_DIR'   => '',
 271     'GPG_NO_OPTIONS' => 0,
 272     'GPG_USE_OPTIONS' => 0,
 273     'GPG_NO_REQUIRE_PREFIX' => 0,
 274     'GPG_PREFIX' => '',
 275     'GPG_PATH'   => '',
 276     'ULOG_PCAP'  => '',
 277     'FILE_PCAP'  => '',
 278     'DATA_COLLECT_MODE' => '',
 279     'ENCRYPT_SEQUENCE'  => '',
 280     'SHARED_SEQUENCE'   => '',
 281     'PORT_OFFSET'       => '',
 282     'REQUIRE_AUTH_METHOD' => '',
 283     'SHADOW_FILE'    => '',
 284     'KNOCK_INTERVAL' => '',
 285     'KNOCK_LIMIT'    => '',
 286     'PERMIT_CLIENT_PORTS' => '',
 287     'PERMIT_CLIENT_TIMEOUT' => '',
 288     'ENABLE_FORWARD_ACCESS' => 0,
 289     'ENABLE_CMD_EXEC'     => '',
 290     'DISABLE_FW_ACCESS'   => '',
 291     'REQUIRE_SOURCE_ADDRESS' => [],
 292     'require_src_addr_exceptions' => [],
 293     'INTERNAL_NET_ACCESS' => [],  ### for --Forward-access IP restrictions
 294     'internal_net_exceptions' => [],
 295     'CMD_REGEX'         => '',
 296     'FW_ACCESS_TIMEOUT' => '',
 297     'REQUIRE_USERNAME'  => '',
 298     'MIN_TIME_DIFF' => '',
 299     'MAX_TIME_DIFF' => '',
 300     'RESTRICT_INTF' => '',
 301     'ENABLE_EXTERNAL_CMDS' => 0,
 302     'EXTERNAL_CMD_OPEN'  => '',
 303     'EXTERNAL_CMD_CLOSE' => '',
 304     'EXTERNAL_CMD_ALARM' => '',
 305 );
 306
 307 my $ip_re = qr|(?:[0-2]?\d{1,2}\.){3}[0-2]?\d{1,2}|;
 308
 309 my @args_cp = @ARGV;
 310
 311 ### run GetOpt() to get comand line args
 312 &handle_command_line();
 313
 314 &usage(0) if $print_help;
 315
 316 if ($print_version) {
 317     print "[+] fwknopd v$version (file revision: $rev_num)\n",
 318         "      by Michael Rash <mbr\@cipherdyne.org>\n";
 319     exit 0;
 320 }
 321
 322 if ($os_fprint_only) {
 323     print "[+] Entering OS fingerprinting mode.\n";
 324 }
 325
 326 print STDERR localtime() . " [+] ** Starting fwknopd (debug mode) **\n",
 327     "    fwknopd Command line: @args_cp\n" if $debug;
 328
 329 ### setup to run
 330 &fwknop_init();
 331
 332 if ($config{'AUTH_MODE'} eq 'KNOCK' or $os_fprint_only) {
 333
 334     ### we are running in traditional port knocking mode
 335     &knock_loop();
 336
 337 } elsif ($config{'AUTH_MODE'} eq 'FILE_PCAP'
 338         or $config{'AUTH_MODE'} eq 'ULOG_PCAP'
 339         or $config{'AUTH_MODE'} eq 'PCAP') {
 340
 341     ### we are parsing the pcap file created by the ulogd pcap
 342     ### writer, or in sniffing mode against an interface
 343
 344     require Net::Pcap;
 345
 346     if ($debug ) {
 347         print STDERR "[+] Net::Pcap::VERSION $Net::Pcap::VERSION\n";
 348     }
 349
 350     &pcap_loop();
 351
 352 } elsif ($config{'AUTH_MODE'} eq 'SOCKET') {
 353
 354     ### we are going to acquire SPA packet data from the fwknop_serv
 355     ### process via a domain socket.  fwknop_serv itself will listen
 356     ### on a tcp or udp port for an incoming SPA packet, so libpcap
 357     ### does not become involved in this mode.
 358
 359     &socket_loop();
 360 }
 361
 362 exit 0;
 363 #============================ end main ==============================
 364
 365 sub pcap_loop() {
 366
 367     ### we use both a size and an inode check in the FILE_PCAP and
 368     ### ULOG_PCAP modes to check if the file has been rotated
 369     my $pcap_file_size  = 0;
 370     my $pcap_file_inode = 0;
 371
 372     ### get pcap opject
 373     my $pcap_t = &get_pcap_obj();
 374
 375     ### Check for "cooked" Linux datalink layers (i.e. rp-pppoe)
 376     eval {
 377         if (not $PCAP_COOKED_INTF and $Net::Pcap::VERSION > 0.05) {
 378             if (Net::Pcap::datalink_val_to_name(
 379                     Net::Pcap::datalink($pcap_t)) eq 'LINUX_SLL') {
 380                 print STDERR "[+] Detected Linux Cooked Interface.\n" if $debug;
 381                 $PCAP_COOKED_INTF = 1;
 382             }
 383         }
 384     };
 385     &collect_warn_die_msgs() if $@;
 386
 387     if ($config{'AUTH_MODE'} eq 'FILE_PCAP'
 388             or $config{'AUTH_MODE'} eq 'ULOG_PCAP') {
 389         ### get file size (we don't need a -e check here because
 390         ### this is handled in get_pcap_obj()).
 391         $pcap_file_size = -s $config{'PCAP_PKT_FILE'};
 392
 393         ### get inode associated with the sniffing file
 394         $pcap_file_inode = (stat($config{'PCAP_PKT_FILE'}))[1];
 395     }
 396     print STDERR localtime() . " [+] pcap_loop()\n" if $debug;
 397
 398     my $check_file_ctr = 0;
 399
 400     &collect_warn_die_msgs();
 401
 402     for (;;) {
 403
 404         my @tmpcbargs; my $cbcalled = 0;
 405         my $tmpcb = sub {
 406             my $tag = $_[0];
 407             my %hdr = %{$_[1]};
 408             my $pkt = $_[2];
 409             @tmpcbargs = ($tag, \%hdr, $pkt);
 410             $cbcalled = 1;
 411         };
 412
 413         Net::Pcap::loop($pcap_t, 1, $tmpcb, 'fwknop_tag');
 414         pcap_process_pkt(@tmpcbargs) if($cbcalled);
 415
 416         if ($config{'AUTH_MODE'} eq 'FILE_PCAP'
 417                 or $config{'AUTH_MODE'} eq 'ULOG_PCAP') {
 418
 419             ### check to see if the pcap file has been rotated (we need to
 420             ### close and re-open)
 421             if ($check_file_ctr >= 10) {
 422                 if (-e $config{'PCAP_PKT_FILE'}) {
 423                     my $size_tmp  = -s $config{'PCAP_PKT_FILE'};
 424                     my $inode_tmp = (stat($config{'PCAP_PKT_FILE'}))[1];
 425                     if ($inode_tmp != $pcap_file_inode
 426                             or $size_tmp < $pcap_file_size) {
 427
 428                         ### the file was rotated or shrank, so get new
 429                         ### pcap_t object
 430                         Net::Pcap::close($pcap_t);
 431
 432                         &logr('[+]', "pcap file $config{'PCAP_PKT_FILE'} " .
 433                             "shrank or was rotated, so re-opening", $NO_MAIL);
 434                         $pcap_t = &get_pcap_obj();
 435
 436                         ### set file size and inode
 437                         $pcap_file_size  = $size_tmp;
 438                         $pcap_file_inode = $inode_tmp;
 439                     }
 440                 } else {
 441                     Net::Pcap::close($pcap_t);
 442                     &logr('[+]', "pcap file $config{'PCAP_PKT_FILE'} " .
 443                         "was rotated, so re-opening", $NO_MAIL);
 444                     $pcap_t = &get_pcap_obj();
 445
 446                     ### set file size and inode
 447                     $pcap_file_size  = -s $config{'PCAP_PKT_FILE'};
 448                     $pcap_file_inode = (stat($config{'PCAP_PKT_FILE'}))[1];
 449                 }
 450                 $check_file_ctr = 0;
 451             }
 452             $check_file_ctr++;
 453         }
 454
 455         &collect_warn_die_msgs();
 456         sleep $pcap_sleep_interval;
 457     }
 458
 459     Net::Pcap::close($pcap_t);
 460
 461     return;
 462 }
 463
 464 sub pcap_process_pkt() {
 465     my ($tag, $hdr, $pkt) = @_;
 466
 467     &collect_warn_die_msgs();
 468
 469     return unless $tag eq 'fwknop_tag';
 470     return unless defined $hdr;
 471     return unless defined $pkt;
 472
 473     my $ether_data = '';
 474     my $ip         = '';
 475     my $src_ip     = '';
 476     my $proto      = '';
 477     my $transport_data = '';
 478
 479     if ($debug) {
 480         print STDERR localtime() . " [+] Received packet ***[" .
 481             localtime() . "]***\n";
 482         if ($verbose) {
 483             print STDERR localtime() .
 484                 "     Complete raw packet data (hex dump, including ",
 485                     "packet headers):\n";
 486             &hex_dump($pkt);
 487         }
 488     }
 489
 490     ### check the length of the packet; if it is not at least
 491     ### 160 bytes long (this is the default MIN_SPA_PKT_LEN value, and
 492     ### this is conservative) then it cannot be an SPA packet
 493     my $pkt_len = length($pkt);
 494     if (length($pkt) < $config{'MIN_SPA_PKT_LEN'}) {
 495         if ($debug and $verbose) {
 496             print
 497 "[-] Packet length ($pkt_len bytes) less than $config{'MIN_SPA_PKT_LEN'}\n",
 498 "    minimum, so is not an SPA packet; skipping.\n";
 499         }
 500         return;
 501     }
 502
 503     if ($config{'AUTH_MODE'} eq 'ULOG_PCAP') {
 504         ### The ulogd pcap writer does not include link layer information
 505         $ip = &ip_decode($pkt) or return;
 506     } else {
 507         if ($config{'FIREWALL_TYPE'} eq 'ipfw'
 508                 and $config{'PCAP_INTF'} eq 'lo0') {
 509
 510             ### it seems that FreeBSD does not include an Ethernet header
 511             ### over loopback but puts a different set of four bytes
 512             $pkt =~ s/^.{4}// if $pkt =~ /^[^\x45].{3}\x45/;
 513
 514             $ip = &ip_decode($pkt) or return;
 515         } else {
 516             if ($PCAP_COOKED_INTF) {
 517                 $ether_data = unpack("x16a*", $pkt);
 518             } else {
 519                 $ether_data = &ethernet_strip($pkt) or return;
 520             }
 521             $ip = &ip_decode($ether_data) or return;
 522         }
 523     }
 524
 525     ### get the source IP address from the IP header
 526     $src_ip = $ip->{'src_ip'} or return;
 527
 528     ### get the protocol
 529     $proto = $ip->{'proto'} or return;
 530
 531     if ($proto == $IPPROTO_ICMP) {
 532         $transport_data = &icmp_decode_data($ip->{'data'});
 533     } elsif ($proto == $IPPROTO_TCP) {
 534         $transport_data = &tcp_decode_data($ip->{'data'});
 535     } elsif ($proto == $IPPROTO_UDP) {
 536         $transport_data = &udp_decode_data($ip->{'data'});
 537     } else {
 538         return;
 539     }
 540
 541     &decode_SPA_data($transport_data, $src_ip, $proto);
 542
 543     return;
 544 }
 545
 546 sub decode_SPA_data() {
 547     my ($transport_data, $src_ip, $proto) = @_;
 548
 549     ### make sure we have _some_ data in the packet; in practice
 550     ### any valid SPA message will be longer than 10 bytes, but this
 551     ### check is better than nothing
 552     return if $transport_data eq '';
 553
 554     my $enc_msg_len = 0;
 555     $enc_msg_len = length($transport_data);
 556     if (10 < $enc_msg_len and $enc_msg_len < $config{'MAX_SNIFF_BYTES'}) {
 557         print STDERR localtime() . " [+] Data len: $enc_msg_len bytes\n"
 558             if $debug;
 559     } else {
 560         print STDERR localtime() . " [-] $enc_msg_len bytes, not ",
 561             "attempting decrypt)\n" if $debug;
 562         return;
 563     }
 564
 565     if ($debug) {
 566         ### make sure not to print non-printable stuff
 567         my $data_tmp = $transport_data;
 568         $data_tmp =~ s/[^\x20-\x7e]/NA/g;
 569         print STDERR localtime() .
 570             " [+] Raw packet data (single line): $data_tmp\n";
 571
 572         ### print packet data out in tcpdump -X format
 573         if ($verbose) {
 574             print STDERR localtime() .
 575                 "     Raw packet data (hex dump, minus packet headers):\n";
 576             &hex_dump($transport_data);
 577         }
 578     }
 579
 580     my $candidate_spa_data = '';
 581
 582     if ($proto == $IPPROTO_TCP and $config{'ENABLE_SPA_OVER_HTTP'} eq 'Y') {
 583         if ($transport_data =~ m|GET\s+(\S+)\s+HTTP/\d|) {
 584             $candidate_spa_data = $1;
 585
 586             $candidate_spa_data =~ s/\.html// if $candidate_spa_data =~ /\.html/;
 587             $candidate_spa_data =~ s|^/|| if $candidate_spa_data =~ m|^/|;
 588             $candidate_spa_data =~ s|^http://\S+/||
 589                 if $candidate_spa_data =~ m|^http://\S+/|;
 590
 591             unless (&is_url_base64($candidate_spa_data)) {
 592                 if ($debug) {
 593                     print STDERR localtime() . " [+] Packet contains non-base64 ",
 594                         "(with URL mods) encoded characters, skipping.\n";
 595                     &check_packet_limit();
 596                 }
 597                 return;
 598             }
 599         }
 600     }
 601
 602     unless ($candidate_spa_data) {
 603         $candidate_spa_data = $transport_data;
 604
 605         ### check to make sure the packet data only contains base64 encoded
 606         ### characters per RFC 3548:   0-9, A-Z, a-z, +, /, =
 607         unless (&is_base64($candidate_spa_data)) {
 608             if ($debug) {
 609                 print STDERR localtime() . " [+] Packet contains non-base64 ",
 610                     "encoded characters, skipping.\n";
 611                 &check_packet_limit();
 612             }
 613             return;
 614         }
 615     }
 616
 617     ### see if this packet is worthy of being granted access through
 618     ### the firewall
 619     &SPA_check_grant_access($src_ip, $enc_msg_len, $candidate_spa_data);
 620
 621     &collect_warn_die_msgs();
 622
 623     return;
 624 }
 625
 626 sub ethernet_strip() {
 627     my $pkt = shift;
 628
 629     my $eth_data = '';
 630
 631     if (length($pkt) >= $ETH_HDR_LEN) {
 632         $eth_data = substr($pkt, $ETH_HDR_LEN);
 633     }
 634
 635     if (not $eth_data and ($debug and $verbose)) {
 636         print "[-] Could not properly decode Ethernet header.\n";
 637     }
 638     ### Silently return '' for short frames
 639     return $eth_data;
 640 }
 641
 642 sub ip_addr_bytes_to_string() {
 643     my $bytes = shift;
 644
 645     my ($a, $b, $c, $d) = unpack('C4', $bytes);
 646     return "$a.$b.$c.$d";
 647 }
 648
 649 sub ip_decode() {
 650     my $pkt = shift;
 651
 652     my $ip = {};
 653     if (length($pkt) >= $MIN_IP_HDR_LEN and $pkt =~ /^\x45/) {
 654         (my $ver_ihl, $ip->{'tos'}, $ip->{'len'}, $ip->{'id'}, my $flags_frag,
 655          $ip->{'ttl'}, $ip->{'proto'}, $ip->{'cksum'}, my $src_ip, my $dest_ip)
 656             = unpack("CCnnnCCna4a4", $pkt);
 657         $ip->{'ver'} = $ver_ihl >> 4;
 658         $ip->{'hlen'} = $ver_ihl & 0x0F;
 659         $ip->{'flags'} = $flags_frag >> 13;
 660         $ip->{'foffset'} = ($flags_frag & 0x1FFF) * 8;
 661         $ip->{'src_ip'} = &ip_addr_bytes_to_string($src_ip);
 662         $ip->{'dest_ip'} = &ip_addr_bytes_to_string($dest_ip);
 663         my $data_start = $ip->{'hlen'} * 4;
 664         if ($data_start >= $MIN_IP_HDR_LEN) {
 665             $ip->{'data'} = substr($pkt, $data_start);
 666         }
 667     }
 668     if (not keys %$ip and ($debug and $verbose)) {
 669         print "[-] Could not properly decode IP header.\n";
 670     }
 671     return $ip;
 672 }
 673
 674 sub icmp_decode_data() {
 675     my $icmp = shift;
 676
 677     my $icmp_data = '';
 678     if (length($icmp) >= $MIN_ICMP_HDR_LEN) {
 679         $icmp_data = substr($icmp, $MIN_ICMP_HDR_LEN);
 680     }
 681     ### Silently return '' for short packets
 682     if (not $icmp_data and ($debug and $verbose)) {
 683         print "[-] Could not properly decode ICMP header.\n";
 684     }
 685     return $icmp_data;
 686 }
 687
 688 sub tcp_decode_data() {
 689     my $tcp = shift;
 690
 691     my $tcp_data = '';
 692
 693     if (length($tcp) >= $MIN_TCP_HDR_LEN) {
 694
 695         my $data_start = 4 * (ord(substr($tcp, 12, 1)) >> 4);
 696         if ($data_start >= $MIN_TCP_HDR_LEN) {
 697             $tcp_data = substr($tcp, $data_start);
 698         }
 699     }
 700     ### Silently return '' for short packets
 701     if (not $tcp_data and ($debug and $verbose)) {
 702         print "[-] Could not properly decode TCP header.\n";
 703     }
 704     return $tcp_data;
 705 }
 706
 707 sub udp_decode_data() {
 708     my $udp = shift;
 709
 710     my $udp_data = '';
 711     if (length($udp) >= $UDP_HDR_LEN) {
 712         $udp_data = substr($udp, $UDP_HDR_LEN);
 713     }
 714     ### Silently return '' for short packets
 715     if (not $udp_data and ($debug and $verbose)) {
 716         print "[-] Could not properly decode UDP header.\n";
 717     }
 718     return $udp_data;
 719 }
 720
 721 sub socket_loop() {
 722
 723     print STDERR localtime() . " [+] socket_loop() acquiring SPA ",
 724         "packet data from: $cmds{'fwknop_serv'} via domain socket: ",
 725         "$config{'FWKNOP_SERV_SOCK'}\n";
 726
 727     my $fwknop_serv_sock = IO::Socket::UNIX->new(
 728         Type    => SOCK_STREAM,
 729         Local   => $config{'FWKNOP_SERV_SOCK'},
 730         Listen  => SOMAXCONN,
 731         Timeout => .1
 732     ) or die "[*] Could not acquire fwknopd communications domain socket: $!";
 733
 734     for (;;) {
 735
 736         my $fwknop_serv_connection = $fwknop_serv_sock->accept();
 737         if ($fwknop_serv_connection) {
 738
 739             my @fwknop_serv_msgs = <$fwknop_serv_connection>;
 740             for my $msg (@fwknop_serv_msgs) {
 741                 if ($msg =~ /^($ip_re):(\d{1,2}):(\S+)/) {
 742                     my $src_ip  = $1;
 743                     my $proto   = $2;
 744                     my $spa_msg = $3;
 745
 746                     &decode_SPA_data($spa_msg, $src_ip, $proto);
 747                 }
 748             }
 749             @fwknop_serv_msgs = ();
 750         }
 751     }
 752     return;
 753 }
 754
 755 sub SPA_check_grant_access() {
 756     my ($src_ip, $enc_msg_len, $pkt_data) = @_;
 757
 758     if ($spa_dump_packets) {
 759         if (&is_base64($pkt_data)) {
 760             print "\nLen: $enc_msg_len, pkt: $pkt_data\n";
 761         } else {
 762             print "\nLine contains non base64 chars, skipping.\n";
 763             return;
 764         }
 765     }
 766
 767     ### first check to see if we have any matching access directives
 768     ### (in access.conf) for $src_ip, and if not we will do _nothing_
 769     ### with this packet.
 770     my $access_nums_aref = &check_src($src_ip);
 771
 772     if ($#$access_nums_aref > -1) {
 773
 774         ### See if the packet qualifies for any access
 775         SOURCE: for my $num (@$access_nums_aref) {
 776             my $access_hr = $access[$num];
 777
 778             next SOURCE unless $access_hr->{'DATA_COLLECT_MODE'} == $PCAP
 779                 or $access_hr->{'DATA_COLLECT_MODE'} == $FILE_PCAP
 780                 or $access_hr->{'DATA_COLLECT_MODE'} == $ULOG_PCAP;
 781
 782             &dump_access($access_hr, $num) if $debug and $verbose;
 783
 784             ### keep track of which source block we are dealing with from
 785             ### access.conf
 786             my $source_block_num = $access_hr->{'block_num'};
 787
 788             ### see if we can decrypt and base64-decode
 789             &fko_acquire_object() if $use_fko_module;
 790             my ($decrypt_rv, $decrypted_msg, $gpg_sign_id, $decrypt_algo)
 791                 = &SPA_decrypt($pkt_data, $enc_msg_len, $access_hr);
 792
 793             unless ($decrypt_rv) {
 794                 &fko_destroy_object() if $use_fko_module;
 795                 next SOURCE;
 796             }
 797
 798             ### check for replay attacks
 799             my ($digest_rv, $digest)
 800                 = &is_replay_attack($decrypted_msg, $src_ip);
 801             if ($digest_rv) {
 802                 &fko_destroy_object() if $use_fko_module;
 803                 return;
 804             }
 805
 806             ### see if we have a syntactically valid message - this
 807             ### also runs the check_digest() function to validate the
 808             ### internal digest against the decrypted data.
 809             my ($validate_rv, $msg_hr) = &pcap_validate_msg(
 810                 $decrypted_msg, $source_block_num, $access_hr);
 811             if ($debug and not $validate_rv) {
 812                 print STDERR localtime() . " [-] Decrypted message does not ",
 813                     "conform to a valid SPA packet.\n";
 814             }
 815             unless ($validate_rv) {
 816                 &fko_destroy_object() if $use_fko_module;
 817                 next SOURCE;
 818             }
 819
 820             if ($spa_dump_packets) {
 821                 print "    Disk write digest: $digest\n";
 822                 for my $key (keys %$msg_hr) {
 823                     printf "    %20s -> %s\n", $key, $msg_hr->{$key};
 824                 }
 825                 return;
 826             }
 827
 828             ### check to see if client side time stamp is too old
 829             my $time_check_rv = &SPA_check_packet_age($msg_hr->{'remote_time'});
 830             unless ($validate_rv) {
 831                 &fko_destroy_object() if $use_fko_module;
 832                 next SOURCE;
 833             }
 834             next SOURCE unless $time_check_rv;
 835
 836             ### dump packet to stderr for debugging purposes
 837             &SPA_dump_packet($msg_hr) if $debug;
 838
 839             ### check username
 840             next SOURCE unless &SPA_check_user($access_hr, $src_ip, $msg_hr);
 841             unless ($validate_rv) {
 842                 &fko_destroy_object() if $use_fko_module;
 843                 next SOURCE;
 844             }
 845
 846             ### check authentication method
 847             unless (&SPA_check_auth_method($access_hr, $src_ip, $msg_hr)) {
 848                 &fko_destroy_object() if $use_fko_module;
 849                 next SOURCE;
 850             }
 851
 852             if ($msg_hr->{'action_type'} == $SPA_ACCESS_MODE
 853                     or $msg_hr->{'action_type'} == $SPA_NAT_ACCESS_MODE
 854                     or $msg_hr->{'action_type'} == $SPA_LOCAL_NAT_ACCESS_MODE
 855                     or $msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_ACCESS_MODE
 856                     or $msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_NAT_ACCESS_MODE
 857                     or $msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_LOCAL_NAT_ACCESS_MODE) {
 858
 859                 if (&SPA_access($msg_hr, $src_ip, $decrypt_algo,
 860                         $gpg_sign_id, $digest, $access_hr)) {
 861                     &fko_destroy_object() if $use_fko_module;
 862                     last SOURCE;
 863                 } else {
 864                     &fko_destroy_object() if $use_fko_module;
 865                     next SOURCE;
 866                 }
 867             } elsif ($msg_hr->{'action_type'} == $SPA_COMMAND_MODE) {
 868                 if (&SPA_cmd($msg_hr, $src_ip, $decrypt_algo,
 869                         $gpg_sign_id, $digest, $access_hr)) {
 870                     &fko_destroy_object() if $use_fko_module;
 871                     last SOURCE;
 872                 } else {
 873                     &fko_destroy_object() if $use_fko_module;
 874                     next SOURCE;
 875                 }
 876             }
 877         }
 878     } else {
 879         print STDERR localtime() . " [-] Packet from $src_ip did not ",
 880             "match any SOURCE blocks in $config{'ACCESS_CONF'}\n" if $debug;
 881     }
 882
 883     &check_packet_limit();
 884     return;
 885 }
 886
 887 sub check_packet_limit() {
 888     ### see if we need to exit if the packet limit (set with -C on the
 889     ### command line) has been reached
 890     return unless $packet_limit;
 891
 892     $packet_ctr++;
 893     if ($packet_ctr >= $packet_limit) {
 894         &logr('[+]', "packet limit ($packet_limit) reached, exiting.",
 895             $NO_MAIL);
 896         if ($knoptm_debug_file and -e $knoptm_debug_file) {
 897             &logr('[+]', "collecting knoptm debug messages " .
 898                 "from $knoptm_debug_file", $NO_MAIL);
 899             open F, "< $knoptm_debug_file" or die $!;
 900             while (<F>) {
 901                 chomp;
 902                 &logr("KNOPTM:", $_, $NO_MAIL);
 903             }
 904             close F;
 905         }
 906         if ($fwkserv_debug_file and -e $fwkserv_debug_file) {
 907             &logr('[+]', "collecting fwknop_serv debug messages " .
 908                 "from $fwkserv_debug_file", $NO_MAIL);
 909             open F, "< $fwkserv_debug_file" or die $!;
 910             while (<F>) {
 911                 chomp;
 912                 &logr("FWKNOP_SERV:", $_, $NO_MAIL);
 913             }
 914             close F;
 915         }
 916         exit 0;
 917     }
 918     return;
 919 }
 920
 921 sub SPA_decrypt() {
 922     my ($pkt_data, $enc_msg_len, $access_hr) = @_;
 923
 924     my $decrypted_msg = '';
 925     my $decrypt_algo  = $ALG_RIJNDAEL;
 926     my $gpg_sign_id   = '';
 927     my $decrypt_rv    = 0;
 928
 929     if ($debug) {
 930         print STDERR localtime() . " [+] Attempting to ",
 931             "decrypt the following data ($enc_msg_len bytes):\n";
 932         &hex_dump($pkt_data);
 933     }
 934
 935     if (not $cmdl_disable_gpg
 936             and $enc_msg_len > $config{'MIN_GNUPG_MSG_SIZE'}
 937             and defined $access_hr->{'GPG_REMOTE_ID'}) {
 938         ### attempt GPG decrypt (only if the length of the encrypted
 939         ### payload is greater than the minimum size for an SPA message
 940         ### encrypted with GnuPG; even encrypting a single byte of data
 941         ### with a 1024 bit GnuPG key results in 340 bytes of encrypted
 942         ### payload in my testing).
 943         ($decrypt_rv, $decrypted_msg, $gpg_sign_id) =
 944                 &pcap_GPG_decrypt_msg($pkt_data, $access_hr);
 945
 946         $decrypt_algo = $ALG_GNUPG if $decrypt_rv;
 947     }
 948
 949     ### fall back to Rijndael if the GnuPG decrypt was not successful
 950     ### (and note that the GnuPG decryption is only attempted if the
 951     ### packet size is large enough).
 952     if (defined $access_hr->{'KEY'} and not $decrypt_rv) {
 953
 954         ($decrypt_rv, $decrypted_msg) = &pcap_Rijndael_decrypt_msg(
 955                             $pkt_data, $access_hr->{'KEY'});
 956     }
 957
 958     if ($decrypt_rv) {
 959         if ($debug and not $use_fko_module) {
 960             ### make sure not to print non-printable stuff
 961             my $dec_tmp_msg = $decrypted_msg;
 962             $dec_tmp_msg =~ s/[^\x20-\x7e]/NA/g;
 963             print STDERR localtime() . " [+] Decrypted ",
 964                 "message: $dec_tmp_msg\n";
 965             if ($verbose) {
 966                 print STDERR localtime() . "     Decrypted message (hex dump):\n";
 967                 &hex_dump($decrypted_msg);
 968             }
 969         }
 970     } else {
 971         print STDERR localtime() . " [-] Failed decrypt for SOURCE block ",
 972             "$access_hr->{'src_str'}\n" if $debug;
 973     }
 974
 975     return $decrypt_rv, $decrypted_msg, $gpg_sign_id, $decrypt_algo;
 976 }
 977
 978 sub SPA_check_packet_age() {
 979     my $remote_time = shift;
 980
 981     if ($config{'ENABLE_SPA_PACKET_AGING'} eq 'Y') {
 982         my $time_diff = time() - $remote_time;
 983         if (abs($time_diff) > $config{'MAX_SPA_PACKET_AGE'}) {
 984             &logr('[-]', "remote time stamp age difference is larger than " .
 985                 "$config{'MAX_SPA_PACKET_AGE'} second max.", $SEND_MAIL);
 986             print STDERR localtime() . " [-] Time difference: $time_diff " .
 987                 "(seconds), " . ($time_diff / 3600) . " (hours)\n";
 988             return 0;
 989         }
 990     }
 991     return 1;
 992 }
 993
 994 sub SPA_dump_packet() {
 995     my $msg_hr = shift;
 996
 997     print STDERR localtime() . " [+] Packet fields:\n";
 998     printf STDERR "    %-16s %s\n    %-16s %s\n    %-16s %s\n" .
 999                   "    %-16s %s\n    %-16s %s",
1000             'Random data:', $msg_hr->{'random_number'},
1001             'Username:',    $msg_hr->{'username'},
1002             'Remote time:', $msg_hr->{'remote_time'},
1003             'Remote ver:',  $msg_hr->{'remote_version'},
1004             'Action type:', $msg_hr->{'action_type'};
1005
1006     for my $action_type (keys %spa_mode_strings) {
1007         if ($msg_hr->{'action_type'} == $action_type) {
1008             print STDERR " ($spa_mode_strings{$action_type})\n";
1009             last;
1010         }
1011     }
1012
1013     printf STDERR "    %-16s %s\n",
1014             'Action:', $msg_hr->{'action'};
1015
1016     if ($msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_ACCESS_MODE
1017             or $msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_NAT_ACCESS_MODE
1018             or $msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_LOCAL_NAT_ACCESS_MODE) {
1019         printf STDERR "    %-16s %s\n",
1020                 'Client timeout:', $msg_hr->{'client_timeout'};
1021     }
1022
1023     if ($msg_hr->{'server_auth'}) {
1024         if ($msg_hr->{'server_auth'} =~ /^\s*(\w+),(.*)/) {
1025             my $server_auth_type = lc($1);
1026             my $server_auth_crypt_pw = $2;
1027             if ($debug) {
1028                 printf STDERR "    %-16s %s", 'Server auth:', $server_auth_type;
1029                 for (my $i=0; $i < length($server_auth_crypt_pw); $i++) {
1030                     print STDERR '*';
1031                 }
1032                 print STDERR "\n";
1033             }
1034         }
1035     }
1036     if ($msg_hr->{'nat_info'}) {
1037         printf STDERR "    %-16s %s\n", 'NAT info:',
1038             $msg_hr->{'nat_info'};
1039     }
1040     printf STDERR "    %-16s %s\n", "$msg_hr->{'digest_str'} digest:",
1041         $msg_hr->{'digest'};
1042     return;
1043 }
1044
1045 sub SPA_check_user() {
1046     my ($access_hr, $src_ip, $msg_hr) = @_;
1047
1048     if (defined $access_hr->{'REQUIRE_USERNAME'}) {
1049         my $found = 0;
1050         my $user  = '';
1051         for my $valid_user (@{$access_hr->{'VALID_USERS'}}) {
1052             if ($valid_user eq $msg_hr->{'username'}) {
1053                 $found = 1;
1054                 $user  = $valid_user;
1055             }
1056         }
1057         unless ($found) {
1058             &logr('[-]', "username mismatch from $src_ip, expecting " .
1059                 "$access_hr->{'REQUIRE_USERNAME'}, got " .
1060                 "$msg_hr->{'username'}", $SEND_MAIL);
1061             return 0;
1062         }
1063     }
1064     return 1;
1065 }
1066
1067 sub SPA_check_auth_method() {
1068     my ($access_hr, $src_ip, $msg_hr) = @_;
1069
1070     my $server_auth_type     = '';
1071     my $server_auth_crypt_pw = '';
1072     if ($msg_hr->{'server_auth'}) {
1073         if ($msg_hr->{'server_auth'} =~ /^\s*(\w+),(.*)/) {
1074             $server_auth_type = lc($1);
1075             $server_auth_crypt_pw = $2;
1076         }
1077     }
1078
1079     if (defined $access_hr->{'REQUIRE_AUTH_METHOD'}) {
1080         if ($server_auth_type
1081                 eq $access_hr->{'REQUIRE_AUTH_METHOD'}) {
1082             if ($server_auth_type eq 'crypt') {
1083                 ### check the local UNIX crypt() password associated
1084                 ### with the user
1085                 unless (&server_auth_verify_crypt_pw(
1086                             $msg_hr->{'username'},
1087                             $server_auth_crypt_pw,
1088                             $access_hr->{'SHADOW_FILE'})) {
1089                     &logr('[-]', "IP: $src_ip failed server-auth UNIX " .
1090                         "crypt() password test", $NO_MAIL);
1091                     return 0;
1092                 }
1093             }
1094         } else {
1095             &logr('[-]', "required server-auth method " .
1096                 "\"$access_hr->{'REQUIRE_AUTH_METHOD'}\" " .
1097                 "not supplied by $src_ip", $NO_MAIL);
1098             return 0;
1099         }
1100     }
1101     return 1;
1102 }
1103
1104 sub SPA_access() {
1105     my ($msg_hr, $src_ip, $decrypt_algo, $gpg_sign_id,
1106         $digest, $access_hr) = @_;
1107
1108     my $allow_src    = '';
1109     my %open_ports   = ();
1110     my %grant_ports  = ();
1111     my %nat_info     = ();
1112     my $grant_access = 0;
1113
1114     if ($access_hr->{'DISABLE_FW_ACCESS'}) {
1115         &logr('[-]', "received fw access request from $src_ip, " .
1116             "but DISABLE_FW_ACCESS is set to a true value " .
1117             "(SOURCE line num: $access_hr->{'src_line_num'})", $NO_MAIL);
1118         return 0;
1119     }
1120
1121     if ($msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_ACCESS_MODE
1122             or $msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_NAT_ACCESS_MODE
1123             or $msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_LOCAL_NAT_ACCESS_MODE) {
1124
1125         if ($access_hr->{'PERMIT_CLIENT_TIMEOUT'}) {
1126             $access_hr->{'FW_ACCESS_TIMEOUT'} = $msg_hr->{'client_timeout'};
1127         } else {
1128             &logr('[-]', "received fw access request from $src_ip, " .
1129                 "with client-defined timeout, but PERMIT_CLIENT_TIMEOUT is not " .
1130                 "set (SOURCE line num: $access_hr->{'src_line_num'})", $NO_MAIL);
1131             return 0;
1132         }
1133     }
1134
1135     $allow_src = $1 if $msg_hr->{'action'} =~ /($ip_re)/;
1136
1137     unless ($allow_src) {
1138         &logr('[-]', "no valid IP address within action portion of SPA " .
1139             "packet from $src_ip (SOURCE line num: " .
1140             "$access_hr->{'src_line_num'})", $SEND_MAIL);
1141         return 0;
1142     }
1143
1144     if ($allow_src eq '0.0.0.0') {
1145         if ($config{'REQUIRE_SOURCE_ADDRESS'} eq 'Y' or not
1146                 &is_ip_included($src_ip,
1147                     $access_hr->{'REQUIRE_SOURCE_ADDRESS'},
1148                     $access_hr->{'require_src_addr_exceptions'})) {
1149             &logr('[-]', "IP: $src_ip sent SPA packet that " .
1150                 "contained 0.0.0.0 (-s on the client side) " .
1151                 "but REQUIRE_SOURCE_ADDRESS is enabled " .
1152                 "(SOURCE line num: $access_hr->{'src_line_num'})",
1153                 $SEND_MAIL);
1154             return 0;
1155         } else {
1156             $allow_src = $src_ip;
1157         }
1158     }
1159
1160     if (&is_ip_included($allow_src, $blacklist_ar, $blacklist_exclude_ar)) {
1161         print STDERR localtime() . " [+] SPA_access() ",
1162         "$allow_src in BLACKLIST" if $debug;
1163         &logr('[-]', "allow IP: $allow_src SPA packet from $src_ip is " .
1164             "blacklisted (SOURCE line num: " .
1165             "$access_hr->{'src_line_num'})", $SEND_MAIL);
1166         return 0;
1167     }
1168
1169     ### initialize to the OPEN_PORTS directives (if defined; we know that
1170     ### either OPEN_PORTS or PERMIT_CLIENT_PORTS was specified in the
1171     ### access.conf file)
1172     %open_ports = %{$access_hr->{'OPEN_PORTS'}}
1173         if defined $access_hr->{'OPEN_PORTS'};
1174
1175     if ($access_hr->{'ENABLE_EXTERNAL_CMDS'}
1176             or ($config{'FIREWALL_TYPE'} eq 'external_cmd'
1177             and $config{'ENABLE_EXTERNAL_CMDS'} eq 'Y')) {
1178
1179         $grant_access = 1;
1180     }
1181
1182     if ($msg_hr->{'action'} =~ /$ip_re,(tcp|udp|icmp),(\d+)/i) {
1183
1184         ### single port access format (e.g. tcp,22)
1185         my $allow_port  = $1;
1186         my $allow_proto = $2;
1187
1188         if ($access_hr->{'PERMIT_CLIENT_PORTS'}) {
1189             $grant_ports{$allow_proto}{$allow_port} = '';
1190             $grant_access = 1;
1191         } else {
1192             if (defined $open_ports{$allow_proto} and
1193                     defined $open_ports{$allow_proto}{$allow_port}) {
1194                 $grant_ports{$allow_proto}{$allow_port} = '';
1195                 $grant_access = 1;
1196             } else {
1197                 unless ($grant_access) {
1198                     &logr('[-]', "IP $allow_src not permitted to open " .
1199                         "$allow_proto/$allow_port (SOURCE line num: " .
1200                         "$access_hr->{'src_line_num'})", $NO_MAIL);
1201                     return 0;
1202                 }
1203             }
1204         }
1205
1206     } elsif ($msg_hr->{'action'} =~ /$ip_re,(\S+)/) {
1207
1208         ### multi-port access format (-A was specified by
1209         ### the client)
1210         my $access_str = $1;
1211
1212         my @dec_allow_ports = split /,/, $access_str;
1213
1214         for my $port_str (@dec_allow_ports) {
1215             if ($port_str =~ m|(\D+)/(\d+)|) {
1216                 my $proto = lc($1);
1217                 my $port  = $2;
1218
1219                 next unless ($proto eq 'tcp'
1220                     or $proto eq 'udp'
1221                     or $proto eq 'icmp');
1222                 $port = 0 if $proto eq 'icmp';
1223
1224                 if ($access_hr->{'PERMIT_CLIENT_PORTS'}) {
1225                     $grant_ports{$proto}{$port} = '';
1226                     $grant_access = 1;
1227                 } else {
1228                     if (defined $open_ports{$proto} and
1229                             defined $open_ports{$proto}{$port}) {
1230                         $grant_ports{$proto}{$port} = '';
1231                         $grant_access = 1;
1232                     } else {
1233                         unless ($grant_access) {
1234                             &logr('[-]', "IP $allow_src not permitted to " .
1235                                 "open $proto/$port (SOURCE line num: " .
1236                                 "$access_hr->{'src_line_num'})", $NO_MAIL);
1237                             return 0;
1238                         }
1239                     }
1240                 }
1241             }
1242         }
1243     }
1244
1245     ### handle SPA access through iptables FORWARD chain for
1246     ### SPA_NAT_ACCESS_MODE messages (or through the INPUT chain for
1247     ### SPA_LOCAL_NAT_ACCESS_MODE messages)
1248     ### iptables -t nat -A PREROUTING -p tcp -s <SPA_src> --dport 55000 \
1249     ### -i eth0 -j DNAT --to 192.168.10.3:80
1250     if ($msg_hr->{'nat_info'}
1251                 and $msg_hr->{'nat_info'} =~ /($ip_re),(\d+)/) {
1252
1253         %nat_info = (
1254             'internal_ip'   => $1,
1255             'external_port' => $2,
1256         );
1257
1258         unless ($config{'FIREWALL_TYPE'} eq 'iptables') {
1259             &logr('[-]', "NAT access requested through non-iptables " .
1260                 "firewall (SOURCE line num: ".
1261                 "$access_hr->{'src_line_num'})", $NO_MAIL);
1262             return 0;
1263         }
1264
1265         if ($msg_hr->{'action_type'} == $SPA_NAT_ACCESS_MODE
1266                 or $msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_NAT_ACCESS_MODE) {
1267             unless ($access_hr->{'ENABLE_FORWARD_ACCESS'}) {
1268                 &logr('[-]', "FORWARD access requested through non-forward " .
1269                     "access SOURCE block (SOURCE line num: ".
1270                     "$access_hr->{'src_line_num'})", $NO_MAIL);
1271                 return 0;
1272             }
1273         }
1274
1275         if ($msg_hr->{'action_type'} == $SPA_LOCAL_NAT_ACCESS_MODE
1276                 or $msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_LOCAL_NAT_ACCESS_MODE) {
1277             unless ($config{'ENABLE_IPT_LOCAL_NAT'} eq 'Y') {
1278                 &logr('[-]', "Local NAT access requested without " .
1279                     "ENABLE_IPT_LOCAL_NAT enabled", $NO_MAIL);
1280                 return 0;
1281             }
1282         }
1283
1284         ### check to see if access is allowed to internal IP (or a local IP
1285         ### for NAT'd local connections)
1286         unless (&is_ip_included($nat_info{'internal_ip'},
1287                 $access_hr->{'INTERNAL_NET_ACCESS'},
1288                 $access_hr->{'internal_net_exceptions'})) {
1289             &logr('[-]', "NAT access to $nat_info{'internal_ip'} " .
1290                 "restricted (SOURCE line num: ".
1291                 "$access_hr->{'src_line_num'})", $NO_MAIL);
1292             return 0;
1293         }
1294         my $port_ctr = 0;
1295         for my $proto (keys %grant_ports) {
1296             for my $port (keys %{$grant_ports{$proto}}) {
1297                 $port_ctr++;
1298             }
1299         }
1300         ### we can only map one forwarding port on the external interface
1301         ### to be forwarded to one internal service
1302         if ($port_ctr > 1) {
1303             &logr('[-]', "cannot forward more than one port " .
1304                 "(SOURCE line num: $access_hr->{'src_line_num'})", $NO_MAIL);
1305             return 0;
1306         }
1307     } else {
1308         if ($access_hr->{'ENABLE_FORWARD_ACCESS'}) {
1309             &logr('[-]', "non-forward access requested through FORWARD " .
1310                 "access SOURCE block (SOURCE line num: " .
1311                 "$access_hr->{'src_line_num'})", $NO_MAIL);
1312             return 0;
1313         }
1314     }
1315
1316     if ($decrypt_algo == $ALG_GNUPG) {
1317         if ($access_hr->{'GPG_REMOTE_ID'} ne 'ANY') {
1318             &logr('[+]', "received valid GnuPG encrypted packet " .
1319                 qq|(signed with required key ID: "$gpg_sign_id") from: | .
1320                 "$src_ip, remote user: $msg_hr->{'username'}, " .
1321                 "client version: $msg_hr->{'remote_version'} " .
1322                 "(SOURCE line num: $access_hr->{'src_line_num'})", $NO_MAIL);
1323         } else {
1324             &logr('[+]', "received valid GnuPG encrypted packet " .
1325                 "from: $src_ip, remote user: $msg_hr->{'username'}, " .
1326                 "client version: $msg_hr->{'remote_version'} " .
1327                 "(SOURCE line num: $access_hr->{'src_line_num'})",
1328                 $NO_MAIL);
1329         }
1330     } else {
1331         &logr('[+]', "received valid Rijndael encrypted " .
1332             "packet from: $src_ip, remote user: $msg_hr->{'username'}, " .
1333             "client version: $msg_hr->{'remote_version'} " .
1334             "(SOURCE line num: $access_hr->{'src_line_num'})",
1335             $NO_MAIL);
1336     }
1337
1338     unless ($grant_access) {
1339         &logr('[-]', "Could not work out access to ports from SPA packet " .
1340             "originating from: $src_ip", $NO_MAIL);
1341         return 0;
1342     }
1343
1344     ### cache the digest
1345     $digest_store{$digest} = $src_ip;
1346
1347     ### write digest to disk
1348     &diskwrite_digest($digest, $src_ip)
1349         if $config{'ENABLE_DIGEST_PERSISTENCE'} eq 'Y';
1350
1351     ### grant access through the firewall
1352     &grant_access($allow_src, $msg_hr, \%nat_info,
1353         {}, \%grant_ports, $access_hr);
1354
1355     return 1;
1356 }
1357
1358 sub SPA_cmd() {
1359     my ($msg_hr, $src_ip, $decrypt_algo, $gpg_sign_id,
1360         $digest, $access_hr) = @_;
1361
1362     unless ($access_hr->{'ENABLE_CMD_EXEC'}) {
1363         &logr('[-]', qq|received command "$msg_hr->{'action'}" | .
1364                 "but command mode not enabled for $src_ip", $SEND_MAIL);
1365         return 0;
1366     }
1367
1368     if (defined $access_hr->{'CMD_REGEX'}) {
1369         unless ($msg_hr->{'action'} =~ m|$access_hr->{'CMD_REGEX'}|) {
1370             &logr('[-]', qq|received command "$msg_hr->{'action'}" | .
1371                     "from $src_ip but CMD_REGEX did not match $src_ip",
1372                     $SEND_MAIL);
1373             return 0;
1374         }
1375     }
1376
1377     my $cmd = $msg_hr->{'action'};
1378     my $run_cmd = '';
1379     my $cmd_ip  = '';
1380
1381     if ($cmd =~ m|^\s*($ip_re),(.*)|) {
1382         $cmd_ip  = $1;
1383         $run_cmd = $2;
1384     } else {
1385         $run_cmd = $cmd;
1386     }
1387
1388     ### pre-1.0 versions did not prepend command string with "<ip>,"
1389     if ($cmd_ip eq '0.0.0.0') {
1390         if ($config{'REQUIRE_SOURCE_ADDRESS'} eq 'Y' or not
1391                 &is_ip_included($cmd_ip,
1392                     $access_hr->{'REQUIRE_SOURCE_ADDRESS'},
1393                     $access_hr->{'require_src_addr_exceptions'})) {
1394             &logr('[-]', "IP: $src_ip sent SPA packet that " .
1395                 "contained 0.0.0.0 (-s on the client side) " .
1396                 "but REQUIRE_SOURCE_ADDRESS is enabled " .
1397                 "(SOURCE line num: $access_hr->{'src_line_num'})",
1398                 $SEND_MAIL);
1399             return 0;
1400         }
1401     }
1402
1403     if (&is_ip_included($cmd_ip, $blacklist_ar, $blacklist_exclude_ar)) {
1404         print STDERR localtime() . " [+] SPA_cmd() ",
1405         "$cmd_ip in BLACKLIST" if $debug;
1406         &logr('[-]', "cmd IP: $cmd_ip SPA packet from $src_ip is " .
1407             "blacklisted (SOURCE line num: " .
1408             "$access_hr->{'src_line_num'})", $SEND_MAIL);
1409         return 0;
1410     }
1411
1412     if ($decrypt_algo == $ALG_GNUPG) {
1413         if ($access_hr->{'GPG_REMOTE_ID'} ne 'ANY') {
1414             &logr('[+]', "received valid GnuPG encrypted packet " .
1415                 qq|(signed with required key ID: "$gpg_sign_id") from: | .
1416                 "$src_ip, remote user: $msg_hr->{'username'}",
1417                 $NO_MAIL);
1418         } else {
1419             &logr('[+]', "received valid GnuPG encrypted packet " .
1420                 "from: $src_ip, remote user: $msg_hr->{'username'}",
1421                 $NO_MAIL);
1422         }
1423     } else {
1424         &logr('[+]', "received valid Rijndael encrypted " .
1425             "packet from: $src_ip, remote user: $msg_hr->{'username'}",
1426             $NO_MAIL);
1427     }
1428
1429     &logr('[+]', qq|executing command "$run_cmd" for $src_ip|, $SEND_MAIL);
1430
1431     ### cache the digest
1432     $digest_store{$digest} = $src_ip;
1433
1434     ### write the digest to disk
1435     &diskwrite_digest($digest, $src_ip)
1436         if $config{'ENABLE_DIGEST_PERSISTENCE'} eq 'Y';
1437
1438     ### execute the command
1439     &exec_command($run_cmd, $config{'PCAP_CMD_TIMEOUT'});
1440
1441     return 1;
1442 }
1443
1444 sub external_cmd_open() {
1445     my ($src, $msg_hr, $open_ports_hr, $access_hr) = @_;
1446
1447     my $open_cmd  = '';
1448     my $close_cmd = '';
1449     my $cmd_port  = 0;
1450     my $cmd_proto = 'NA';
1451     my $found_port_proto = 0;
1452     my $cmd_alarm = $EXTERNAL_CMD_ALARM;
1453
1454     if ($access_hr->{'EXTERNAL_CMD_OPEN'}) {
1455         $open_cmd  = $access_hr->{'EXTERNAL_CMD_OPEN'};
1456         $close_cmd = $access_hr->{'EXTERNAL_CMD_CLOSE'};
1457         $cmd_alarm = $access_hr->{'EXTERNAL_CMD_ALARM'};
1458     } elsif ($config{'EXTERNAL_CMD_OPEN'} and $config{'EXTERNAL_CMD_CLOSE'}) {
1459         $open_cmd  = $config{'EXTERNAL_CMD_OPEN'};
1460         $close_cmd = $config{'EXTERNAL_CMD_CLOSE'};
1461         $cmd_alarm = $config{'EXTERNAL_CMD_ALARM'};
1462     } else {
1463         return;
1464     }
1465
1466     PROTO: for my $proto (keys %{$open_ports_hr}) {
1467         for my $port (keys %{$open_ports_hr->{$proto}}) {
1468             ### only allow one port/proto substitution for now - this can be
1469             ### worked around by passing OPEN_PORTS directly (via key
1470             ### substitution below) on the external command line.
1471             $cmd_port  = $port;
1472             $cmd_proto = $proto;
1473             $found_port_proto = 1;
1474             last PROTO;
1475         }
1476     }
1477
1478     ### perform variable substitutions on the external command to run
1479     $open_cmd = &external_cmd_str_expand($open_cmd, $src, $cmd_port,
1480             $cmd_proto, $access_hr);
1481     $close_cmd = &external_cmd_str_expand($close_cmd, $src, $cmd_port,
1482             $cmd_proto, $access_hr);
1483
1484     &logr('[+]', qq|executing external open command "$open_cmd" for $src|,
1485         $SEND_MAIL);
1486
1487     ### execute the "open" command
1488     &exec_command($open_cmd, $cmd_alarm);
1489
1490     ### let knoptm run the "close" command
1491     &write_knoptm_fw_cache_entry(
1492         time(),
1493         $access_hr->{'FW_ACCESS_TIMEOUT'},
1494         $src,
1495         0,
1496         '0.0.0.0',
1497         $cmd_port,
1498         $cmd_proto,
1499         'NA',
1500         'NA',
1501         'NA',
1502         'NA',
1503         '0.0.0.0/0',
1504         0,
1505         encode_base64($close_cmd, ''),
1506         $cmd_alarm
1507     );
1508
1509     return;
1510 }
1511
1512 sub external_cmd_str_expand() {
1513     my ($cmd_str, $src, $cmd_port, $cmd_proto, $access_hr) = @_;
1514
1515     print STDERR localtime() . " [+] External command ",
1516         "(before var expansion): $cmd_str\n" if $debug;
1517
1518     ### expand SPA source IP, port, and protocol
1519     if ($config{'ENABLE_EXT_CMD_PREFIX'} eq 'Y') {
1520         $cmd_str =~ s|\$$config{'EXT_CMD_PREFIX'}SRC|$src|;
1521         $cmd_str =~ s|\$$config{'EXT_CMD_PREFIX'}PORT|$cmd_port|;
1522         $cmd_str =~ s|\$$config{'EXT_CMD_PREFIX'}PROTO|$cmd_proto|;
1523     } else {
1524         $cmd_str =~ s|\$SRC|$src|;
1525         $cmd_str =~ s|\$PORT|$cmd_port|;
1526         $cmd_str =~ s|\$PROTO|$cmd_proto|;
1527     }
1528
1529     ### expand any hash keys from access.conf
1530     for my $key (keys %access_keys) {
1531         next unless defined $access_hr->{$key};
1532         if ($config{'ENABLE_EXT_CMD_PREFIX'} eq 'Y') {
1533             $cmd_str =~ s|\$$config{'EXT_CMD_PREFIX'}$key|$access_hr->{$key}|;
1534         } else {
1535             $cmd_str =~ s|\$$key|$access_hr->{$key}|;
1536         }
1537     }
1538
1539     print STDERR localtime() . "     External command ",
1540         "(after var expansion): $cmd_str\n" if $debug;
1541
1542     return $cmd_str;
1543 }
1544
1545 sub is_replay_attack() {
1546     my ($decrypted_data, $src_ip) = @_;
1547
1548     my $rv = 0;
1549     my @digests = ();
1550     my $disk_write_digest = '';
1551
1552     if ($use_fko_module) {
1553         ### store off the original digest type associated with this incoming
1554         ### SPA packet
1555         $fko_incoming_digest_type = 0;
1556         $fko_incoming_digest_type = $fko_obj->digest_type() or return 1, '';
1557     }
1558
1559     if ($config{'DIGEST_TYPE'} eq 'ALL') {
1560         if ($use_fko_module) {
1561             for my $digest_type (FKO->FKO_DIGEST_SHA256,
1562                     FKO->FKO_DIGEST_SHA1,
1563                     FKO->FKO_DIGEST_MD5) {
1564                 my $digest = &fko_compute_digest($digest_type);
1565                 if ($digest) {
1566                     push @digests, $digest;
1567                 } else {
1568                     return 1, '';
1569                 }
1570             }
1571         } else {
1572             push @digests, sha256_base64($decrypted_data);
1573             push @digests, sha1_base64($decrypted_data);
1574             push @digests, md5_base64($decrypted_data);
1575         }
1576     } else {
1577         if ($config{'DIGEST_TYPE'} =~ /SHA256/) {
1578             if ($use_fko_module) {
1579                 my $digest = &fko_compute_digest(FKO->FKO_DIGEST_SHA256);
1580                 if ($digest) {
1581                     push @digests, $digest;
1582                 } else {
1583                     return 1, '';
1584                 }
1585             } else {
1586                 push @digests, sha256_base64($decrypted_data);
1587             }
1588         }
1589         if ($config{'DIGEST_TYPE'} =~ /SHA1/) {
1590             if ($use_fko_module) {
1591                 my $digest = &fko_compute_digest(FKO->FKO_DIGEST_SHA1);
1592                 if ($digest) {
1593                     push @digests, $digest;
1594                 } else {
1595                     return 1, '';
1596                 }
1597             } else {
1598                 push @digests, sha1_base64($decrypted_data);
1599             }
1600         }
1601         if ($config{'DIGEST_TYPE'} =~ /MD5/) {
1602             if ($use_fko_module) {
1603                 my $digest = &fko_compute_digest(FKO->FKO_DIGEST_MD5);
1604                 if ($digest) {
1605                     push @digests, $digest;
1606                 } else {
1607                     return 1, '';
1608                 }
1609             } else {
1610                 push @digests, md5_base64($decrypted_data);
1611             }
1612         }
1613     }
1614
1615     if (@digests) {
1616
1617         ### this prefers SHA256 because of the ordering above.
1618         $disk_write_digest = $digests[0];
1619
1620         if ($debug) {
1621             print STDERR localtime() . ' [+] Final @digests array: ', "\n",
1622                 Dumper(@digests);
1623         }
1624         for my $digest (@digests) {
1625             ### note that the %digest_store may contain non-SHA256 digests from
1626             ### a previous instance of fwknop - this check ensures that we
1627             ### consider all previous digests
1628             if (defined $digest_store{$digest}) {
1629                 ### Replay attack!  Send warning email and return.
1630                 if ($digest_store{$digest}) {
1631                     &logr('[-]', "attempted SPA packet replay from: $src_ip " .
1632                         "(original SPA src: $digest_store{$digest}, " .
1633                         "digest: $digest)",
1634                         $SEND_MAIL);
1635                 } else {
1636                     &logr('[-]', "attempted SPA packet replay from: $src_ip " .
1637                         "($digest: $digest)", $SEND_MAIL);
1638                 }
1639
1640                 ### see if we need to exit if the packet limit (set with -C on the
1641                 ### command line) has been reached
1642                 &check_packet_limit();
1643
1644                 $rv = 1;
1645                 last;
1646             }
1647         }
1648     } else {
1649         ### could not calculate the digest for some reason; don't
1650         ### trust the packet
1651         &logr('[-]', "could not calculate digest " .
1652             "for SPA packet from: $src_ip", $SEND_MAIL);
1653         $rv = 1;
1654     }
1655     return $rv, $disk_write_digest;
1656 }
1657
1658 sub fko_acquire_object() {
1659
1660     &fko_destroy_object() if $fko_obj;
1661
1662     ### initialize the FKO object
1663     $fko_obj = FKO->new()
1664         or die "[*] Could not acquire FKO object: ", FKO->error_str;
1665
1666     if ($debug) {
1667         print STDERR localtime() . " [+] Using libfko ",
1668             "functions via the FKO module.\n";
1669     }
1670     return;
1671 }
1672
1673 sub fko_destroy_object() {
1674     $fko_obj->destroy();
1675     $fko_obj = ();
1676     return;
1677 }
1678
1679 sub fko_compute_digest() {
1680     my $digest_type = shift;
1681
1682     my $fko_err = $fko_obj->digest_type($digest_type);
1683     if ($fko_err) {
1684         &logr('[-]', "FKO error setting digest type " .
1685             "$digest_type: " . $fko_obj->errstr($fko_err),
1686             $NO_MAIL);
1687     }
1688     $fko_err = $fko_obj->spa_digest($FKO_RECOMPUTE);
1689     if ($fko_err) {
1690         &logr('[-]', "FKO error recomputing computing digest: " .
1691             $fko_obj->errstr($fko_err),
1692             $NO_MAIL);
1693         return 0;
1694     }
1695
1696     my $digest = $fko_obj->spa_digest();
1697     unless ($digest) {
1698         &logr('[-]', "FKO error computing digest: " .
1699             $fko_obj->errstr($fko_err),
1700             $NO_MAIL);
1701         return 0;
1702     }
1703
1704     print STDERR localtime() . " [+] FKO calculated digest ",
1705         "(type: $digest_type): $digest\n" if $debug;
1706     return $digest;
1707 }
1708
1709 sub server_auth_verify_crypt_pw() {
1710     my ($username, $pw, $shadow_file) = @_;
1711
1712     unless (-e $shadow_file) {
1713         &logr('[-]', "shadow file $shadow_file does not exist", $NO_MAIL);
1714         return 0;
1715     }
1716
1717     my $shadow_hash = '';
1718     open S, "< $shadow_file" or die "[*] Could not open $shadow_file: $!";
1719     while (<S>) {
1720         my $line = $_;
1721         if ($line =~ /^\s*$username:(\S+?):/) {
1722             $shadow_hash = $1;
1723         }
1724     }
1725     close S;
1726
1727     ### mbr:$1$nrU****************************:13108:0:99999:7:::
1728     unless ($shadow_hash) {
1729         &logr('[-]', "could not get password entry for $username " .
1730             "from /etc/shadow", $NO_MAIL);
1731         return 0;
1732     }
1733
1734     return 1 if (crypt($pw, $shadow_hash) eq $shadow_hash);
1735     return 0;
1736 }
1737
1738 sub knock_loop() {
1739
1740     print STDERR localtime() . " [+] Opening $fw_data_file, and ",
1741         "entering main loop.\n" if $debug;
1742
1743     ### track file size so we can re-open if the logfile is rotated
1744     my $fw_data_file_size  = -s $fw_data_file;
1745     my $fw_data_file_inode = (stat($fw_data_file))[1];
1746     my $fw_data_file_check_ctr = 0;
1747
1748     my $skip_first_loop = 1;
1749
1750     open FWLOG, $fw_data_file or die "[*] Could not open $fw_data_file: $!";
1751
1752     ### main server loop to parse iptables log messages
1753     MAIN: for (;;) {
1754
1755         my @fw_pkts = ();
1756
1757         ### allow the contents of the fwdata file to be processed only after
1758         ### the first loop has been executed.
1759         if ($skip_first_loop) {
1760
1761             $skip_first_loop = 0;
1762             seek FWLOG,0,2;  ### seek to the end of the file
1763             next MAIN;
1764
1765         } else {
1766
1767             @fw_pkts = <FWLOG>;
1768         }
1769
1770         if ($fw_data_file_check_ctr == 10) {
1771             if (-e $fw_data_file) {
1772                 my $size_tmp  = -s $fw_data_file;
1773                 my $inode_tmp = (stat($fw_data_file))[1];
1774                 if ($inode_tmp != $fw_data_file_inode
1775                         or $size_tmp < $fw_data_file_size) {
1776
1777                     close FWDATA;
1778
1779                     &sys_log('[+]', "iptables syslog file $fw_data_file " .
1780                         "shrank or was rotated, so re-opening");
1781
1782                     ### re-open the fwdata file
1783                     open FWDATA, $fw_data_file or die
1784                         "[*] Could not open $fw_data_file: $!";
1785
1786                     $skip_first_loop = 1;
1787
1788                     ### set file size and inode
1789                     $fw_data_file_size  = $size_tmp;
1790                     $fw_data_file_inode = $inode_tmp;
1791                 }
1792             }
1793             $fw_data_file_check_ctr = 0;
1794         }
1795
1796         &process_pkts(\@fw_pkts) if @fw_pkts;
1797
1798         ### always check to see if we need to timeout knock sequences
1799         ### that exceed the KNOCK_INTERVAL
1800         &timeout_invalid_sequences();
1801
1802         &collect_warn_die_msgs();
1803
1804         ### clearerr() on the FWLOG filehandle to be ready for new packets
1805         FWLOG->clearerr();
1806
1807         sleep $config{'SLEEP_INTERVAL'};
1808     }
1809     close FWLOG;
1810     return;
1811 }
1812
1813 sub pcap_validate_msg() {
1814     my ($msg, $source_block_num, $access_hr) = @_;
1815
1816     my %msg_hsh = (
1817         'random_number'   => 0,
1818         'username'        => '',
1819         'remote_time'     => 0,
1820         'remote_version'  => '',
1821         'numeric_version' => 0,   ### calculated locally by fwknopd
1822         'action_type'     => -1,
1823         'action'          => '',
1824         'server_auth'     => '',  ### optional
1825         'nat_info'        => '',  ### optional
1826         'client_timeout'  => -1,  ### optional
1827         'digest'          => ''
1828     );
1829
1830     my @fields = ();
1831     my $fko_err = 0;
1832
1833     ### the last field in the SPA packet is the digest, so see if it
1834     ### checks out first (this is the internal digest, not the digest that
1835     ### guards against replay attacks).
1836     unless (&check_digest($msg, \%msg_hsh)) {
1837         print STDERR localtime() . " [-] Key mis-match or broken message ",
1838             "checksum for SOURCE $access_hr->{'src_str'} ",
1839             "(# $source_block_num in access.conf)\n"
1840             if $debug;
1841         return 0, {};
1842     }
1843
1844     unless ($use_fko_module) {
1845         @fields = split /:/, $msg;
1846
1847         unless (@fields) {
1848             print STDERR localtime() . " [-] Could not split decrypted ",
1849                 "message into an array.\n" if $debug;
1850             return 0, {};
1851         }
1852
1853         if ($debug and $verbose) {
1854             print STDERR localtime() . " [+] Packet array:\n", Dumper @fields;
1855         }
1856
1857         unless ($#fields+1 >= $SPA_MIN_PACKET_FIELDS
1858                 and $#fields+1 <= $SPA_MAX_PACKET_FIELDS) {
1859             print STDERR localtime() . " [-] Invalid number of fields in ",
1860                 "SPA packet, expected $SPA_MIN_PACKET_FIELDS-",
1861                 "$SPA_MAX_PACKET_FIELDS, got " . ($#fields+1) . ".\n" if $debug;
1862             return 0, {};
1863         }
1864     }
1865
1866     ### random number
1867     #
1868     if ($use_fko_module) {
1869         $msg_hsh{'random_number'} = $fko_obj->rand_value();
1870     } else {
1871         $msg_hsh{'random_number'} = $fields[0];
1872     }
1873     unless (&is_digit($msg_hsh{'random_number'})) {
1874         &logr('[-]', "non-digit random number in decrypted SPA " .
1875             "packet: $msg_hsh{'random_number'}", $SEND_MAIL);
1876         return 0, {};
1877     }
1878
1879     ### username
1880     #
1881     if ($use_fko_module) {
1882         $msg_hsh{'username'} = $fko_obj->username();
1883     } else {
1884         $msg_hsh{'username'} = decode_base64($fields[1]);
1885     }
1886
1887     ### timestamp
1888     #
1889     if ($use_fko_module) {
1890         $msg_hsh{'remote_time'} = $fko_obj->timestamp();
1891     } else {
1892         $msg_hsh{'remote_time'} = $fields[2];
1893     }
1894     unless (&is_digit($msg_hsh{'remote_time'})) {
1895         &logr('[-]', "non-digit timestamp in decrypted SPA packet",
1896             $SEND_MAIL);
1897         return 0, {};
1898     }
1899
1900     ### remote client version
1901     #
1902     if ($use_fko_module) {
1903         $msg_hsh{'remote_version'} = $fko_obj->version();
1904     } else {
1905         $msg_hsh{'remote_version'} = $fields[3];
1906     }
1907
1908     unless (&SPA_parse_client_version(\%msg_hsh)) {
1909         &logr('[-]', "invalid client string in decrypted SPA packet",
1910             $SEND_MAIL);
1911         return 0, {};
1912     }
1913
1914     ### message type
1915     #
1916     if ($use_fko_module) {
1917         $msg_hsh{'action_type'} = $fko_obj->spa_message_type();
1918     } else {
1919         $msg_hsh{'action_type'} = $fields[4];
1920     }
1921
1922     if (&is_digit($msg_hsh{'action_type'})) {
1923         return 0, {} unless $msg_hsh{'action_type'} == $SPA_COMMAND_MODE
1924                 or $msg_hsh{'action_type'} == $SPA_ACCESS_MODE
1925                 or $msg_hsh{'action_type'} == $SPA_NAT_ACCESS_MODE
1926                 or $msg_hsh{'action_type'} == $SPA_CLIENT_TIMEOUT_ACCESS_MODE
1927                 or $msg_hsh{'action_type'} == $SPA_CLIENT_TIMEOUT_NAT_ACCESS_MODE
1928                 or $msg_hsh{'action_type'} == $SPA_LOCAL_NAT_ACCESS_MODE
1929                 or $msg_hsh{'action_type'} == $SPA_CLIENT_TIMEOUT_LOCAL_NAT_ACCESS_MODE;
1930         $msg_hsh{'action_type'} = $msg_hsh{'action_type'};
1931     } else {
1932         &logr('[-]', "non-digit action type in decrypted SPA packet",
1933             $SEND_MAIL);
1934         return 0, {};
1935     }
1936     if ($debug) {
1937         print STDERR localtime() .
1938             " [+] SPA action type: $msg_hsh{'action_type'}\n";
1939     }
1940
1941     ### action
1942     #
1943     if ($use_fko_module) {
1944         $msg_hsh{'action'} = $fko_obj->spa_message();
1945     } else {
1946         $msg_hsh{'action'} = decode_base64($fields[5]);
1947     }
1948
1949     ### server_auth was introduced in 0.9.3
1950     #
1951     if ($msg_hsh{'numeric_version'} >= 93) {
1952
1953         ### iptables FORWARD/DNAT access was introduced in 1.9.0
1954         if ($msg_hsh{'numeric_version'} >= 190) {
1955             my $found = 0;
1956             if ($msg_hsh{'action_type'} == $SPA_NAT_ACCESS_MODE
1957                         or $msg_hsh{'action_type'} == $SPA_LOCAL_NAT_ACCESS_MODE) {
1958                 if ($use_fko_module) {
1959                     $msg_hsh{'nat_info'} = $fko_obj->spa_nat_access();
1960                 } else {
1961                     if ($#fields == $SPA_MIN_PACKET_FIELDS) {
1962                         $msg_hsh{'nat_info'} = decode_base64($fields[6]);
1963                     }
1964                 }
1965                 $found = 1;
1966             } elsif ($msg_hsh{'numeric_version'} >= 192) {
1967                 ### client timeouts were introduced in 1.9.2
1968                 if ($msg_hsh{'action_type'} == $SPA_CLIENT_TIMEOUT_ACCESS_MODE) {
1969                     if ($use_fko_module) {
1970                         $msg_hsh{'client_timeout'} = $fko_obj->spa_client_timeout();
1971                     } else {
1972                         $msg_hsh{'client_timeout'} = $fields[6];
1973                     }
1974                     $found = 1;
1975                 } elsif ($msg_hsh{'action_type'}
1976                             == $SPA_CLIENT_TIMEOUT_NAT_ACCESS_MODE) {
1977                     if ($use_fko_module) {
1978                         $msg_hsh{'nat_info'} = $fko_obj->spa_nat_access();
1979                         $msg_hsh{'client_timeout'} = $fko_obj->spa_client_timeout();
1980                     } else {
1981                         $msg_hsh{'nat_info'} = decode_base64($fields[6]);
1982                         $msg_hsh{'client_timeout'} = $fields[7];
1983                     }
1984                     $found = 1;
1985                 } elsif ($msg_hsh{'action_type'}
1986                             == $SPA_CLIENT_TIMEOUT_LOCAL_NAT_ACCESS_MODE) {
1987                     if ($use_fko_module) {
1988                         $msg_hsh{'nat_info'} = $fko_obj->spa_nat_access();
1989                         $msg_hsh{'client_timeout'} = $fko_obj->spa_client_timeout();
1990                     } else {
1991                         $msg_hsh{'nat_info'} = decode_base64($fields[6]);
1992                         $msg_hsh{'client_timeout'} = $fields[7];
1993                     }
1994                     $found = 1;
1995                 }
1996                 if ($found) {
1997                     unless (&is_digit($msg_hsh{'client_timeout'})) {
1998                         &logr('[-]', "non-digit client timeout in decrypted " .
1999                             "SPA packet", $SEND_MAIL);
2000                         return 0, {};
2001                     }
2002                 }
2003             }
2004             unless ($found) {
2005                 if (not $use_fko_module and $#fields+1 > $SPA_MIN_PACKET_FIELDS) {
2006                     $msg_hsh{'server_auth'} = decode_base64($fields[6]);
2007                 }
2008             }
2009         } else {
2010             if ($use_fko_module) {
2011                 &logr('[-]', "remote libfko version less than minimum ",
2012                     "required by FKO module", $SEND_MAIL);
2013                 return 0, {};
2014             } else {
2015                 if ($#fields+1 > $SPA_MIN_PACKET_FIELDS) {
2016                     $msg_hsh{'server_auth'} = decode_base64($fields[6]);
2017                 }
2018             }
2019         }
2020     } else {
2021         unless ($use_fko_module and $#fields+1 == $SPA_MIN_PACKET_FIELDS) {
2022             print STDERR localtime() . " [-] SPA packet from version: ",
2023                 "$msg_hsh{'remote_version'} ",
2024                 "does not have $SPA_MIN_PACKET_FIELDS fields"
2025                 if $debug;
2026             return 0, {};
2027         }
2028     }
2029
2030     print STDERR Dumper \%msg_hsh if $debug and $verbose;
2031
2032     if ($debug) {
2033         print STDERR localtime() .
2034             " [+] Decoded message: $msg_hsh{'random_number'}:",
2035             "$msg_hsh{'username'}:$msg_hsh{'remote_time'}:",
2036             "$msg_hsh{'remote_version'}:$msg_hsh{'action_type'}:",
2037             "$msg_hsh{'action'}";
2038
2039         if ($msg_hsh{'nat_info'}) {
2040             print STDERR ":$msg_hsh{'nat_info'}";
2041         }
2042
2043         if ($msg_hsh{'client_timeout'}) {
2044             print STDERR ":$msg_hsh{'client_timeout'}";
2045         }
2046
2047         ### careful not to display password information
2048         if ($msg_hsh{'server_auth'}
2049                 and $msg_hsh{'server_auth'} =~ /^\s*(\w+),(.*)/) {
2050
2051             print STDERR ":$1,";
2052             for (my $i=0; $i < length($2); $i++) {
2053                 print STDERR "*";
2054             }
2055         }
2056
2057         print STDERR ":$msg_hsh{'digest'}\n";
2058     }
2059     return 1, \%msg_hsh;
2060 }
2061
2062 sub SPA_parse_client_version() {
2063     my $msg_hr = shift;
2064
2065     my $ver = '';
2066     if ($msg_hr->{'remote_version'} =~ /^(\d+\.\d+\.\d+)-pre\d+$/) {
2067         ### remote client is a -pre release
2068         $ver = $1;
2069     } elsif ($msg_hr->{'remote_version'} =~ /^(\d+\.\d+\.\d+)$/) {
2070         $ver = $1;
2071     } elsif ($msg_hr->{'remote_version'} =~ /^(\d+\.\d+)-pre\d+$/) {
2072         ### remote client is a -pre release
2073         $ver = $1;
2074     } elsif ($msg_hr->{'remote_version'} =~ /^(\d+\.\d+)$/) {
2075         $ver = $1;
2076     } else {
2077         print STDERR localtime() . " [-] Could not determine remote ",
2078             "client numeric version." if $debug;
2079         return 0;
2080     }
2081
2082     $ver =~ s|\.||g;
2083     $ver =~ s|^0||;
2084     $msg_hr->{'numeric_version'} = $ver;
2085
2086     print STDERR localtime() . " [+] Remote client numeric version: $ver\n"
2087         if $debug;
2088     return 1;
2089 }
2090
2091 sub check_digest() {
2092     my ($msg_str, $hr) = @_;
2093
2094     ### give priority to FKO module
2095     return &fko_check_digest($hr) if $use_fko_module;
2096
2097     my $rv = 0;
2098     if ($msg_str =~ /(.*):(\S+)/) {
2099         my $msg = $1;
2100         my $sum = $2;
2101         if (length($sum) == $SHA256_DIGEST_LEN) {
2102             if ($config{'DIGEST_TYPE'} eq 'ALL'
2103                     or $config{'DIGEST_TYPE'} =~ /SHA256/) {
2104                 if ($sum eq sha256_base64($msg)) {
2105                     $hr->{'digest_str'} = 'SHA256';
2106                     $hr->{'digest'} = $sum;
2107                     $rv = 1;
2108                 }
2109             }
2110         } elsif (length($sum) == $SHA1_DIGEST_LEN) {
2111             if ($config{'DIGEST_TYPE'} eq 'ALL'
2112                     or $config{'DIGEST_TYPE'} =~ /SHA1/) {
2113                 if ($sum eq sha1_base64($msg)) {
2114                     $hr->{'digest_str'} = 'SHA1';
2115                     $hr->{'digest'} = $sum;
2116                     $rv = 1;
2117                 }
2118             }
2119         } elsif (length($sum) == $MD5_DIGEST_LEN) {
2120             if ($config{'DIGEST_TYPE'} eq 'ALL'
2121                     or $config{'DIGEST_TYPE'} =~ /MD5/) {
2122                 if ($sum eq md5_base64($msg)) {
2123                     $hr->{'digest_str'} = 'MD5';
2124                     $hr->{'digest'} = $sum;
2125                     $rv = 1;
2126                 }
2127             }
2128         }
2129     }
2130
2131     unless ($rv) {
2132         print STDERR localtime() . " [-] Digest alg mis-match.\n" if $debug;
2133     }
2134
2135     return $rv;
2136 }
2137
2138 sub fko_check_digest() {
2139     my $hr = shift;
2140
2141     my $rv = 0;
2142
2143     my $digest_type = $fko_incoming_digest_type;
2144
2145     print localtime() . " [+] FKO digest type: $digest_type, ",
2146         "DIGEST_TYPE var: $config{'DIGEST_TYPE'}\n" if $debug;
2147
2148     if ($digest_type == FKO->FKO_DIGEST_SHA256) {
2149         if ($config{'DIGEST_TYPE'} eq 'ALL'
2150                 or $config{'DIGEST_TYPE'} =~ /SHA256/) {
2151             $hr->{'digest_str'} = 'SHA256';
2152             $rv = 1;
2153         }
2154     } elsif ($digest_type == FKO->FKO_DIGEST_SHA1) {
2155         if ($config{'DIGEST_TYPE'} eq 'ALL'
2156                 or $config{'DIGEST_TYPE'} =~ /SHA1/) {
2157             $hr->{'digest_str'} = 'SHA1';
2158             $rv = 1;
2159         }
2160     } elsif ($digest_type == FKO->FKO_DIGEST_MD5) {
2161         if ($config{'DIGEST_TYPE'} eq 'ALL'
2162                 or $config{'DIGEST_TYPE'} =~ /MD5/) {
2163             $hr->{'digest_str'} = 'MD5';
2164             $rv = 1;
2165         }
2166     } else {
2167         print STDERR localtime() . " [-] FKO invalid digest type: $digest_type\n"
2168             if $debug;
2169     }
2170
2171     if ($rv) {
2172         $hr->{'digest'} = $fko_obj->spa_digest();
2173     } else {
2174         print STDERR localtime() . " [-] Digest alg mis-match.\n" if $debug;
2175     }
2176
2177     return $rv;
2178 }
2179
2180 sub get_pcap_obj() {
2181
2182     my $pcap_t  = '';
2183     my $filter  = '';
2184     my $err     = '';
2185     my $netmask = 0;
2186     my $address = 0;
2187
2188     if ($config{'AUTH_MODE'} eq 'FILE_PCAP'
2189             or $config{'AUTH_MODE'} eq 'ULOG_PCAP') {
2190
2191         unless (-e $config{'PCAP_PKT_FILE'}) {
2192             &pcap_file_exists_loop();
2193         }
2194
2195         unless (-s $config{'PCAP_PKT_FILE'} > 0) {
2196             ### required since we cannot use Net::Pcap::open_offline()
2197             ### to open a zero-size pcap file.
2198             &pcap_nonzero_size_loop();
2199         }
2200
2201         print STDERR localtime() . " [+] Acquiring packet data from file: ",
2202             "$config{'PCAP_PKT_FILE'}\n" if $debug;
2203
2204         $pcap_t = Net::Pcap::open_offline($config{'PCAP_PKT_FILE'}, \$err)
2205             or die "[*] Could not open $config{'PCAP_PKT_FILE'}: $err";
2206
2207         ### get past any packets that were from a previous fwknopd
2208         ### execution.
2209         Net::Pcap::loop($pcap_t, -1, \&null_func, 'fwknop_tag');
2210
2211     } else {
2212         if ($config{'ENABLE_PCAP_PROMISC'} eq 'Y') {
2213             print STDERR localtime() . " [+] Sniffing (promisc) packet data ",
2214                 "from interface: $config{'PCAP_INTF'}\n" if $debug;
2215             $pcap_t = Net::Pcap::open_live($config{'PCAP_INTF'},
2216                 $config{'MAX_SNIFF_BYTES'}, 1, 100, \$err)
2217                     or die "[*] Could not open $config{'PCAP_INTF'}: $err";
2218         } else {
2219             print STDERR localtime() . " [+] Sniffing (non-promisc) packet ",
2220                 "data from interface: $config{'PCAP_INTF'}\n" if $debug;
2221             $pcap_t = Net::Pcap::open_live($config{'PCAP_INTF'},
2222                 $config{'MAX_SNIFF_BYTES'}, 0, 100, \$err)
2223                     or die "[*] Could not open $config{'PCAP_INTF'}: $err";
2224         }
2225     }
2226
2227     ### apply pcap filter if necessary
2228     if ($config{'PCAP_FILTER'} ne 'NONE') {
2229         if ($config{'AUTH_MODE'} eq 'PCAP') {
2230             if (Net::Pcap::lookupnet($config{'PCAP_INTF'}, \$address,
2231                     \$netmask, \$err) != 0) {
2232                 if ($config{'ENABLE_PCAP_PROMISC'} eq 'N') {
2233                     &logr('[-]', "warning: ENABLE_PCAP_PROMISC is disabled and " .
2234                         "could not get net information for " .
2235                         "$config{'PCAP_INTF'}: $err, continuing anyway",
2236                         $NO_MAIL);
2237                 }
2238             }
2239         }
2240         ### set the filter on the traffic
2241         Net::Pcap::compile($pcap_t, \$filter, $config{'PCAP_FILTER'},
2242                 0, $netmask)
2243             && die '[*] Unable to compile packet capture filter';
2244         Net::Pcap::setfilter($pcap_t, $filter)
2245             && die '[*] Unable to set packet capture filter';
2246     }
2247
2248     return $pcap_t;
2249 }
2250
2251 sub pcap_file_exists_loop() {
2252     while (not -e $config{'PCAP_PKT_FILE'}) {
2253         &logr('[-]', "pcap file $config{'PCAP_PKT_FILE'} does not " .
2254             "exist, waiting $err_wait_timer seconds for sniffer to " .
2255             "create file", $NO_MAIL);
2256         sleep $err_wait_timer;
2257     }
2258     return;
2259 }
2260
2261 sub pcap_nonzero_size_loop() {
2262     while (-s $config{'PCAP_PKT_FILE'} == 0) {
2263         &logr('[-]', "zero size pcap file $config{'PCAP_PKT_FILE'}, " .
2264             "waiting $err_wait_timer seconds for packet data", $NO_MAIL);
2265         sleep $err_wait_timer;
2266     }
2267     return;
2268 }
2269
2270 sub exec_command() {
2271     my ($cmd, $cmd_alarm) = @_;
2272     my $pid;
2273     if ($pid = fork()) {
2274         local $SIG{'ALRM'} = sub {die "[*] External script timeout.\n"};
2275         ### the external script should be finished within this timeout
2276         alarm $cmd_alarm;
2277         eval {
2278             waitpid($pid, 0);
2279         };
2280         alarm 0;
2281         if ($@) {
2282             kill 9, $pid unless kill 15, $pid;
2283         }
2284     } else {
2285         die "[*] Could not fork for external script: $!" unless defined $pid;
2286         ### if we are already redirecting output within the command itself
2287         ### then don't redirect again
2288         if ($cmd =~ /\s*>\s*/) {
2289             exec qq{$cmd};
2290         } else {
2291             exec qq{$cmd > /dev/null 2>&1};
2292         }
2293     }
2294     return;
2295 }
2296
2297 ### knock server processsing
2298 sub process_pkts() {
2299     my $fw_pkts_aref = shift;
2300     PKT: for my $pkt (@$fw_pkts_aref) {
2301         my $src = '';
2302         my $dst = '';
2303         my $len = -1;
2304         my $tos = '';
2305         my $ttl = -1;
2306         my $id  = -1;
2307         my $proto = '';
2308         my $sp    = -1;
2309         my $dp    = -1;
2310         my $win   = -1;
2311         my $type  = -1;
2312         my $code  = -1;
2313         my $seq   = -1;
2314         my $flags = '';
2315         my $frag_bit = 0;
2316         my $tcp_options = '';
2317         next unless $pkt =~ /kernel.*IN=.*OUT=/;
2318         ### May 18 22:21:26 orthanc kernel: DROP IN=eth2 OUT=
2319         ### MAC=00:60:1d:23:d0:01:00:60:1d:23:d3:0e:08:00 SRC=192.168.20.25
2320         ### DST=192.168.20.1 LEN=60 TOS=0x10 PREC=0x00 TTL=64 ID=47300 DF
2321         ### PROTO=TCP SPT=34111 DPT=6345 WINDOW=5840 RES=0x00 SYN URGP=0
2322         if ($pkt =~ /SRC=(\S+)\s+DST=(\S+)\s+LEN=(\d+)\s+TOS=(\S+)
2323                     \s*.*\s+TTL=(\d+)\s+ID=(\d+)\s*.*\s+PROTO=TCP\s+
2324                     SPT=(\d+)\s+DPT=(\d+)\s+WINDOW=(\d+)\s+
2325                     RES=\S+\s*(.*)\s+URGP=/x) {
2326             ($src, $dst, $len, $tos, $ttl, $id, $sp, $dp, $win, $flags) =
2327                 ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10);
2328             if ($pkt =~ /\sRES=\S+\s*(.*)\s+URGP=/) {
2329                     $flags = $1;
2330             }
2331             $proto = 'tcp';
2332             unless ($flags !~ /WIN/ &&
2333                     $flags =~ /ACK/ ||
2334                     $flags =~ /SYN/ ||
2335                     $flags =~ /RST/ ||
2336                     $flags =~ /URG/ ||
2337                     $flags =~ /PSH/ ||
2338                     $flags =~ /FIN/ ||
2339                     $flags eq 'NULL') {
2340                 print STDERR localtime() . " [*] err packet: bad tcp flags.\n"
2341                     if $debug;
2342                 next PKT;
2343             }
2344             $frag_bit = 1 if $pkt =~ /\sDF\s+PROTO/;
2345             ### don't pickup IP options if --log-ip-options is used
2346             ### (they appear before the PROTO= field).
2347             if ($pkt =~ /URGP=\S+\s+OPT\s+\((\S+)\)/) {
2348                 $tcp_options = $1;
2349             }
2350             $tcp_ctr++;
2351
2352             ### Jul 15 23:32:53 orthanc kernel: DROP IN=eth1 OUT=
2353             ### MAC=00:0c:41:24:68:ef:00:0c:41:24:56:37:08:00 SRC=192.168.10.3
2354             ### DST=192.168.10.1 LEN=29 TOS=0x00 PREC=0x00 TTL=64 ID=48500 DF
2355             ### PROTO=UDP SPT=32768 DPT=65533 LEN=9
2356         } elsif ($pkt =~ /SRC=(\S+)\s+DST=(\S+)\s+LEN=(\d+)\s+TOS=(\S+)\s+
2357                           .*?\sTTL=(\d+)\s+ID=(\d+)\s*.*\sPROTO=UDP\s+
2358                           SPT=(\d+)\s+DPT=(\d+)/x) {
2359             ($src, $dst, $len, $tos, $ttl, $id, $sp, $dp) =
2360                 ($1,$2,$3,$4,$5,$6,$7,$8);
2361             $proto = 'udp';
2362             ### make sure we have a "reasonable" packet (note that nmap
2363             ### can scan port 0 and iptables can report this fact)
2364             unless ($src and $dst and $len >= 0 and $tos and $ttl >= 0
2365                     and $id >= 0 and $sp >= 0 and $dp >= 0) {
2366                 next PKT;
2367             }
2368             $udp_ctr++;
2369         } elsif ($pkt =~ /SRC=(\S+)\s+DST=(\S+)\s+LEN=(\d+).*
2370                           TTL=(\d+).*PROTO=ICMP\s+TYPE=(\d+)\s+
2371                           CODE=(\d+)\s+ID=(\d+)\s+SEQ=(\d+)/x) {
2372             ($src, $dst, $len, $ttl, $type, $code, $id, $seq) =
2373                 ($1,$2,$3,$4,$5,$6,$7,$8);
2374             $proto = 'icmp';
2375             unless ($src and $dst and $len >= 0 and $ttl >= 0 and $proto
2376                     and $type >= 0 and $code >= 0 and $id >= 0
2377                     and $seq >= 0) {
2378                 next PKT;
2379             }
2380             $proto = 'icmp';
2381             $icmp_ctr++;
2382         } else {
2383             print STDERR localtime() . " [-] no regex match for pkt: $pkt\n"
2384                 if $debug;
2385         }
2386
2387         ### check to see if there are any access directives for $src, and
2388         ### if not we will do _nothing_ with this IP (unless we are just
2389         ### trying to fingerprint it).
2390         my $access_nums_aref = &check_src($src) unless $os_fprint_only;
2391
2392         unless ($os_fprint_only) {
2393             unless ($access_nums_aref) {
2394                 print STDERR localtime() . " [-] Packet from $src did not ",
2395                     "match any SOURCE in $config{'ACCESS_CONF'}\n" if $debug;
2396                 next PKT;
2397             }
2398         }
2399
2400         if ($proto eq 'tcp') {
2401             print STDERR localtime() . " [+] $proto $src $sp -> $dst $dp, ",
2402                 "$flags\n" if $debug;
2403         } elsif ($proto eq 'udp') {
2404             print STDERR localtime() . " [+] $proto $src $sp -> $dst ",
2405                 "$dp\n" if $debug;
2406         } elsif ($proto eq 'icmp') {
2407             print STDERR localtime() . " [+] $proto $src -> $dst\n" if $debug;
2408         }
2409
2410         ### try to fingerprint the remote OS even though the knock
2411         ### sequence is not validated yet.
2412         if ($proto eq 'tcp' and $flags =~ /SYN/) {  ### must have a SYN pkt
2413             if ($tcp_options) {  ### hopefully --log-tcp-options is being used
2414
2415                 ### p0f based fingerprinting
2416                 &p0f($src, $len, $frag_bit, $ttl, $win, $tcp_options);
2417             }
2418         }
2419
2420         next PKT if $os_fprint_only;
2421
2422         my $expecting_decrypt = 0;
2423         my $decrypted = 0;
2424
2425         NUM: for my $num (@$access_nums_aref) {
2426             my $access_hr = $access[$num];
2427
2428             $ip_sequences{$src}{$num} = {}
2429                 unless defined $ip_sequences{$src}{$num};
2430
2431             my $seq_hr = $ip_sequences{$src}{$num};
2432
2433             ### keep track of which source block we are dealing with from
2434             ### access.conf
2435             my $source_block_num = $access_hr->{'block_num'};
2436
2437             $seq_hr->{'grant_ctr'} = 0
2438                 if not defined $seq_hr->{'grant_ctr'};
2439
2440             ### see if the destination port is part of the correct knock sequence
2441             ### for this source
2442             my $matched_sequence = 0;
2443
2444             if ($access_hr->{'DATA_COLLECT_MODE'} == $ENCRYPT_SEQUENCE) {
2445                 if ($dp >= $access_hr->{'PORT_OFFSET'} and
2446                         $dp < $access_hr->{'PORT_OFFSET'} + 256) {
2447
2448                     ### keep timestamp for when we started tracking the
2449                     ### encrypted sequence
2450                     $seq_hr->{'enc_stime'} = time()
2451                         unless defined $seq_hr->{'enc_stime'};
2452
2453                     ### add the destination port to the encrypted sequence
2454                     push @{$seq_hr->{'enc_ports'}}, $dp;
2455
2456                     print STDERR localtime() . " [+] Added $dp to encrypted ",
2457                         "sequence for $src ",
2458                         "(packet: $#{$seq_hr->{'enc_ports'}})\n"
2459                         if $debug;
2460                 }
2461
2462                 ### see if the encrypted sequence checks out
2463                 if ($#{$seq_hr->{'enc_ports'}}
2464                         == $enc_blocksize - 1) {
2465
2466                     $expecting_decrypt = 1;
2467
2468                     ### attempt to decrypt the sequence
2469                     my ($rv, $allow_src, $dec_allow_port,
2470                         $dec_allow_proto, $username) =
2471                             &decrypt_sequence($src, $seq_hr,
2472                                 $access_hr);
2473
2474                     if ($rv) {
2475                         $decrypted = 1;
2476
2477                         &logr('[+]', "successful knock decrypt for $src " .
2478                             "(SOURCE block: $source_block_num)", $SEND_MAIL);
2479
2480                         ### see if we need to match the OS
2481                         unless (&matched_os($src, $access_hr)) {
2482                             delete $ip_sequences{$src}{$num};
2483                             next NUM;
2484                         }
2485
2486                         ### see if we need to match the username
2487                         unless (&matched_username($username,
2488                                 $access_hr)) {
2489                             delete $ip_sequences{$src}{$num};
2490                             next NUM;
2491                         }
2492
2493                         ### check to see if we have already exceeded the
2494                         ### maximum number of allowed sequences (this helps
2495                         ### to prevent replay attacks).
2496                         if (defined $access_hr->{'KNOCK_LIMIT'}) {
2497                             if ($seq_hr->{'grant_ctr'}
2498                                     > $access_hr->{'KNOCK_LIMIT'}) {
2499                                 &logr('[-]', "$src exceeded knock limit (set to " .
2500                                     "$access_hr->{'KNOCK_LIMIT'} accesses)",
2501                                     $SEND_MAIL);
2502                                 &logr('[-]', "access controls for $src will " .
2503                                     "not be modified", $SEND_MAIL);
2504                                 delete $ip_sequences{$src}{$num};
2505                                 next NUM;
2506                             }
2507                         }
2508
2509                         ### all criteria met for encrypted sequence;
2510                         ### grant access
2511                         my %open_ports = %{$access_hr->{'OPEN_PORTS'}};
2512                         $open_ports{$dec_allow_proto}{$dec_allow_port} = '';
2513
2514                         &grant_access($allow_src, {}, {}, $seq_hr,
2515                             \%open_ports, $access_hr);
2516
2517                     }
2518                     delete $ip_sequences{$src}{$num};
2519                     next NUM;
2520                 }
2521             } elsif (defined $access_hr->{'SHARED_SEQUENCE'}) {
2522                 $seq_hr->{'port_seq'} = 0
2523                     unless defined $seq_hr->{'port_seq'};
2524                 if ($dp == $access_hr->{'SHARED_SEQUENCE'}->
2525                             [$seq_hr->{'port_seq'}]->{'port'}
2526                         and $proto eq $access_hr->{'SHARED_SEQUENCE'}->
2527                             [$seq_hr->{'port_seq'}]->{'proto'}) {
2528
2529                     push @{$seq_hr->{'port_times'}}, time();
2530
2531                     ### increment sequence counter (takes into account timing
2532                     ### requirements).
2533                     next NUM unless &incr_seq($src, $seq_hr, $access_hr);
2534
2535                     ### if we made it to the end of the sequence then we have
2536                     ### a correct knock sequence
2537                     if ($seq_hr->{'port_seq'}
2538                             == $#{$access_hr->{'SHARED_SEQUENCE'}}+1) {
2539                         print STDERR localtime() . " [+] Matched knock ",
2540                             "sequence for $src\n" if $debug;
2541                         $matched_sequence = 1;
2542                     }
2543                 } else {
2544                     print STDERR localtime() . " [-] Could not match dst ",
2545                         "port: $dp at sequence ",
2546                         "number: $seq_hr->{'port_seq'}\n"
2547                         if $debug;
2548                     delete $ip_sequences{$src}{$num};
2549                     next NUM;
2550                 }
2551             }
2552
2553             ### we matched the knock sequence, so reset for new
2554             ### sequence (note we may have other criteria to meet
2555             ### before actually granting access).
2556             if ($matched_sequence) {
2557                 delete $seq_hr->{'port_times'};
2558                 $seq_hr->{'port_seq'} = 0;
2559
2560                 &logr('[+]', "port knock access sequence matched for $src " .
2561                     "(SOURCE block: $source_block_num)", $SEND_MAIL);
2562
2563                 next NUM unless &matched_os($src, $seq_hr);
2564
2565                 ### check to see if we have already exceeded the maximum number
2566                 ### of allowed sequences (this helps to prevent replay attacks).
2567                 if (defined $access_hr->{'KNOCK_LIMIT'}) {
2568                     if ($seq_hr->{'grant_ctr'}
2569                             > $access_hr->{'KNOCK_LIMIT'}) {
2570                         &logr('[-]', "$src exceeded knock limit (set to " .
2571                             "$access_hr->{'KNOCK_LIMIT'} accesses)",
2572                             $SEND_MAIL);
2573                         &logr('[-]', "access controls for $src will not be " .
2574                             "modified", $SEND_MAIL);
2575                         next NUM;
2576                     }
2577                 }
2578
2579                 ### if we made it here then the shared sequence checked out and
2580                 ### we need to grant access by modifying the iptables ruleset
2581                 ### (if the ruleset does not already allow $src of course).
2582                 &grant_access($src, {}, {}, $seq_hr,
2583                     $access_hr->{'OPEN_PORTS'}, $access_hr);
2584             }
2585         }
2586         if ($expecting_decrypt and not $decrypted) {
2587             &logr('[-]', "sequence decrypt failed for $src", $SEND_MAIL);
2588         }
2589     }
2590
2591     ### see if we need to exit if the packet limit (set with -C on the
2592     ### command line) has been reached
2593     &check_packet_limit();
2594
2595     if ($os_fprint_only) {
2596         &print_p0f();
2597     }
2598     return;
2599 }
2600
2601 sub matched_os() {
2602     my ($src, $href) = @_;
2603
2604     ### see if we require any OS match at all
2605     return 1 unless (defined $href->{'REQUIRE_OS'} or
2606             defined $href->{'REQUIRE_OS_REGEX'});
2607
2608     unless (defined $p0f{$src}) {
2609         ### could not guess the OS
2610         if (defined $href->{'REQUIRE_OS'}) {
2611             &logr('[-]', "could not fingerprint OS for $src, expecting OS: " .
2612                 $href->{'REQUIRE_OS'}, $SEND_MAIL);
2613         } elsif (defined $href->{'REQUIRE_OS_REGEX'}) {
2614             &logr('[-]', "could not fingerprint OS for $src, expecting OS " .
2615                 "regex: $href->{'REQUIRE_OS_REGEX'}", $SEND_MAIL);
2616         }
2617         return 0;
2618     }
2619
2620     if (defined $href->{'REQUIRE_OS'}) {
2621         if (defined $p0f{$src}) {
2622             my $first_os_key = '';
2623             for my $os (keys %{$p0f{$src}}) {
2624                 $first_os_key = $os unless $first_os_key;
2625                 if ($os eq $href->{'REQUIRE_OS'}) {
2626                     &logr('[+]', "OS guess: $os " .
2627                         "matched for $src", $SEND_MAIL);
2628                     return 1;
2629                 }
2630             }
2631             ### there may be more than one OS fingerprint, but
2632             ### just print one (if we make it here there was no
2633             ### match).
2634             &logr('[-]', "OS fingerprint mismatch for $src: " .
2635                 "expected: $href->{'REQUIRE_OS'}, " .
2636                 "received: $first_os_key", $SEND_MAIL);
2637             return 0;
2638
2639         }
2640     } elsif (defined $href->{'REQUIRE_OS_REGEX'}) {
2641         if (defined $p0f{$src}) {
2642             my $first_os_key = '';
2643             for my $os (keys %{$p0f{$src}}) {
2644                 $first_os_key = $os unless $first_os_key;
2645                 if ($os =~ m|$href->{'REQUIRE_OS_REGEX'}|i) {
2646                     &logr('[+]', "OS guess: $os " .
2647                         "regex matched for $src", $SEND_MAIL);
2648                     return 1;
2649                 }
2650             }
2651
2652             ### there may be more than one OS fingerprint, but
2653             ### just print one.
2654             &logr('[-]', "OS fingerprint regex mismatch for $src: " .
2655                 "expected: $href->{'REQUIRE_OS_REGEX'}, " .
2656                 "received: $first_os_key", $SEND_MAIL);
2657             return 0;
2658         }
2659     }
2660     return 0;
2661 }
2662
2663 sub matched_username() {
2664     my ($username, $href) = @_;
2665
2666     return 1 unless defined $href->{'REQUIRE_USERNAME'};
2667
2668     if ($username) {
2669         if ($username eq $href->{'REQUIRE_USERNAME'}) {
2670             &logr('[+]', "username $username match", $NO_MAIL);
2671             return 1;
2672         } else {
2673             &logr('[-]', "username mismatch, expected: " .
2674                 "$href->{'REQUIRE_USERNAME'}, got: $username", $SEND_MAIL);
2675             return 0;
2676         }
2677     } else {
2678         &logr('[-]', "missing username in encrypted " .
2679             "sequence, expected: $href->{'REQUIRE_USERNAME'}", $SEND_MAIL);
2680         return 0;
2681     }
2682     return 0;
2683 }
2684
2685 sub check_src() {
2686     my $src = shift;
2687
2688     my @access_nums = ();
2689
2690     if (&is_ip_included($src, $blacklist_ar, $blacklist_exclude_ar)) {
2691         print STDERR localtime() . " [+] check_src() ",
2692             "$src in BLACKLIST" if $debug;
2693         return \@access_nums;
2694     }
2695
2696     ### now process the SOURCE stanzas
2697     for (my $i=0; $i<=$#access; $i++) {
2698         my $access_hr = $access[$i];
2699         my $matched_src = 0;
2700         if (&is_ip_included($src, $access_hr->{'SOURCE'},
2701                 $access_hr->{'exclude_nets'})) {
2702             print STDERR localtime() . " [+] Packet from $src matched ",
2703                 "$access_hr->{'src_str'} (line: ",
2704                 "$access_hr->{'src_line_num'})\n"
2705                 if $debug;
2706             push @access_nums, $i;
2707         }
2708     }
2709     return \@access_nums;
2710 }
2711
2712 sub is_base64() {
2713     my $data = shift;
2714
2715     ### check to make sure the packet data only contains base64 encoded
2716     ### characters per RFC 3548:   0-9, A-Z, a-z, +, /, =
2717     if ($data =~ /[^\x30-\x39\x41-\x5a\x61-\x7a\x2b\x2f\x3d]/) {
2718         return 0;
2719     }
2720     if ($data =~ /=[^=]/) {
2721         return 0;
2722     }
2723     return 1;
2724 }
2725
2726 sub is_url_base64() {
2727     my $data = shift;
2728
2729     ### check to make sure the packet data only contains base64 encoded
2730     ### characters per RFC 3548, except that "-" replaces "+", and "_"
2731     ### replaces "/":
2732     if ($data =~ /[^\x30-\x39\x41-\x5a\x61-\x7a\x2d\x5f\x3d]/) {
2733         return 0;
2734     }
2735     if ($data =~ /=[^=]/) {
2736         return 0;
2737     }
2738     return 1;
2739 }
2740
2741 sub is_ip_included() {
2742     my ($ip, $include_ar, $exclude_ar) = @_;
2743
2744     my $is_included = 0;
2745
2746     ### check the include criteria
2747     for my $net (@$include_ar) {
2748         if (ipv4_in_network($net, $ip)) {
2749             print STDERR localtime() . " [+] $ip included by $net\n"
2750                 if $debug;
2751             $is_included = 1;
2752             last;
2753         }
2754     }
2755
2756     if ($is_included) {
2757         ### check the exclude criteria
2758         for my $net (@$exclude_ar) {
2759             if (ipv4_in_network($net, $ip)) {
2760                 print STDERR localtime() . " [-] $ip excluded by ! $net\n"
2761                     if $debug;
2762                 $is_included = 0;
2763                 last;
2764             }
2765         }
2766     }
2767     return $is_included;
2768 }
2769
2770 sub incr_seq() {
2771     my ($src, $seq_hr, $access_hr) = @_;
2772     if (defined $access_hr->{'MIN_TIME_DIFF'}) {
2773         ### can check relative timings only after we have more than
2774         ### one matching sequence packet
2775         if ($seq_hr->{'port_seq'} > 0) {
2776             if (defined $access_hr->{'MAX_TIME_DIFF'}) {
2777                 my $time = time();
2778                 if (($time - $seq_hr->{'port_times'}[$seq_hr->{'port_seq'}-1])
2779                             > $access_hr->{'MIN_TIME_DIFF'} and
2780                         ($time - $seq_hr->{'port_times'}[$seq_hr->{'port_seq'}-1])
2781                             < $access_hr->{'MAX_TIME_DIFF'}) {
2782                     print STDERR localtime() . " [+] Sequence min/max time match: ",
2783                         "($seq_hr->{'port_seq'}) ",
2784                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'proto'}/",
2785                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'port'}\n"
2786                         if $debug;
2787                 } else {
2788                     &logr('[-]', 'Sequence min/max_time exceeded: ' .
2789                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'proto'}/" .
2790                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'port'} " .
2791                         "(port sequence num: $seq_hr->{'port_seq'}) ", $SEND_MAIL);
2792                     $seq_hr->{'port_seq'} = 0;
2793                     delete $seq_hr->{'port_times'};
2794                     return 0;
2795                 }
2796             } else {
2797                 if ((time()
2798                         - $seq_hr->{'port_times'}[$seq_hr->{'port_seq'}-1])
2799                         > $access_hr->{'MIN_TIME_DIFF'}) {
2800                     print STDERR localtime() . " [+] Sequence min_time match: ",
2801                         "($seq_hr->{'port_seq'}) ",
2802                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'proto'}/",
2803                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'port'}\n"
2804                         if $debug;
2805                 } else {
2806                     &logr('[-]', "Sequence min_time (" .
2807                         "$access_hr->{'MIN_TIME_DIFF'} seconds) not met: " .
2808                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'proto'}/" .
2809                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'port'} " .
2810                         "(port sequence num: $seq_hr->{'port_seq'}) ", $SEND_MAIL);
2811                     delete $seq_hr->{'port_times'};
2812                     $seq_hr->{'port_seq'} = 0;
2813                     return 0;
2814                 }
2815             }
2816         } else {
2817             print STDERR localtime() . " [+] 1 Sequence match: ",
2818                 "($seq_hr->{'port_seq'}) ",
2819                 "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'proto'}/",
2820                 "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'port'}\n"
2821                 if $debug;
2822         }
2823     } elsif (defined $access_hr->{'MAX_TIME_DIFF'}) {
2824         if ($seq_hr->{'port_seq'} > 0) {
2825             if ((time()
2826                     - $seq_hr->{'port_times'}[$seq_hr->{'port_seq'}-1])
2827                     < $access_hr->{'MAX_TIME_DIFF'}) {
2828                 print STDERR localtime() . " [+] Sequence max_time match: ",
2829                     "($seq_hr->{'port_seq'}) ",
2830                     "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'proto'}/",
2831                     "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'port'}\n"
2832                     if $debug;
2833             } else {
2834                 &logr('[-]', "Sequence max_time ($access_hr->{'MAX_TIME_DIFF'} seconds) exceeded: " .
2835                     "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'proto'}/" .
2836                     "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'port'}" .
2837                     "(port sequence num: $seq_hr->{'port_seq'}) ", $SEND_MAIL);
2838                 delete $seq_hr->{'port_times'};
2839                 $seq_hr->{'port_seq'} = 0;
2840                 return 0;
2841             }
2842         } else {
2843             print STDERR localtime() . " [+] Sequence match: ($seq_hr->{'port_seq'}) ",
2844                 "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'proto'}/",
2845                 "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'port'}\n"
2846                 if $debug;
2847         }
2848     } else {
2849         print STDERR localtime() . " [+] Sequence match: ($seq_hr->{'port_seq'}) ",
2850             "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'proto'}/",
2851             "$access_hr->{'SHARED_SEQUENCE'}->[$seq_hr->{'port_seq'}]->{'port'}\n"
2852             if $debug;
2853     }
2854
2855     ### if we made it here, then we met the timing requirements (if required)
2856     $seq_hr->{'port_seq'}++;
2857     return 1;
2858 }
2859
2860 sub pcap_GPG_decrypt_msg() {
2861     my ($msg, $access_hr) = @_;
2862
2863     my @plaintext = ();
2864     my $decrypt_rv = 0;
2865     my $pid;
2866     my $decrypted_msg = '';
2867     my $base64_decoded_msg = '';
2868     my $found_sig     = 0;
2869     my $gpg_sign_id   = '';
2870
2871     unless ($msg =~ /^$access_hr->{'GPG_PREFIX'}/) {
2872         if ($access_hr->{'GPG_NO_REQUIRE_PREFIX'}) {
2873             print STDERR localtime() . qq| [-] Incoming base64-encoded |,
2874                 qq|SPA packet is not prefixed with: |,
2875                 qq|"$access_hr->{'GPG_PREFIX'}"\n| if $debug;
2876         } else {
2877             print STDERR localtime() . qq| [+] Adding |,
2878                 qq|"$access_hr->{'GPG_PREFIX'}" prefix to |,
2879                 "base64-encoded message.\n" if $debug;
2880             $msg = $access_hr->{'GPG_PREFIX'} . $msg;
2881         }
2882     }
2883
2884     my ($equals_rv, $equals_padding) = &base64_equals_padding($msg);
2885
2886     unless ($equals_rv) {
2887         return $decrypt_rv, $decrypted_msg, $gpg_sign_id;
2888     }
2889
2890     if ($equals_rv and $equals_padding) {
2891         print STDERR localtime() . " [+] Padding base64-encoded message ",
2892             "with '$equals_padding'.\n" if $debug;
2893         $msg .= $equals_padding;
2894     }
2895
2896     if ($config{'ENABLE_SPA_OVER_HTTP'} eq 'Y' and &is_url_base64($msg)) {
2897         $msg =~ s|\-|+|g;
2898         $msg =~ s|\_|/|g;
2899     }
2900
2901     if ($use_fko_module) {
2902
2903         my $fko_err = $fko_obj->spa_data($msg);
2904         if ($fko_err) {
2905             if ($debug) {
2906                 &logr('[-]', "FKO error setting spa_data(): " .
2907                     $fko_obj->errstr($fko_err), $NO_MAIL);
2908             }
2909             return $decrypt_rv, $decrypted_msg, $gpg_sign_id;
2910         }
2911
2912         ### set the decryption type to use gpg
2913         $fko_err = $fko_obj->encryption_type(FKO->FKO_ENCRYPTION_GPG);
2914         if ($fko_err) {
2915             if ($debug) {
2916                 &logr('[-]', "FKO error setting decryption type to gpg: " .
2917                     $fko_obj->errstr($fko_err), $NO_MAIL);
2918                 return $decrypt_rv, $decrypted_msg, $gpg_sign_id;
2919             }
2920         }
2921
2922         $fko_err = $fko_obj->gpg_home_dir($access_hr->{'GPG_HOME_DIR'});
2923         if ($fko_err) {
2924             if ($debug) {
2925                 &logr('[-]', "FKO error setting gpg home dir: " .
2926                     $fko_obj->errstr($fko_err), $NO_MAIL);
2927                 return $decrypt_rv, $decrypted_msg, $gpg_sign_id;
2928             }
2929         }
2930
2931         $fko_err = $fko_obj->gpg_recipient($access_hr->{'GPG_DECRYPT_ID'});
2932         if ($fko_err) {
2933             if ($debug) {
2934                 &logr('[-]', "FKO error setting signing key " .
2935                     "gpg_signer(): " . $fko_obj->errstr($fko_err),
2936                     $NO_MAIL);
2937             }
2938             return $decrypt_rv, $decrypted_msg, $gpg_sign_id;
2939         }
2940
2941         $fko_err = $fko_obj->decrypt_spa_data($access_hr->{'GPG_DECRYPT_PW'});
2942         if ($fko_err) {
2943             if ($debug) {
2944                 &logr('[-]', "FKO error decrypting data via " .
2945                     "GnuPG decrypt_spa_data(): " .
2946                     $fko_obj->errstr($fko_err),
2947                     $NO_MAIL);
2948             }
2949             return $decrypt_rv, $decrypted_msg, $gpg_sign_id;
2950         }
2951
2952         return 1, $decrypted_msg, $gpg_sign_id;
2953     }
2954
2955     if ($debug) {
2956         print STDERR localtime() . " [+] decode_base64() against the ",
2957             "following data: $msg\n";
2958     }
2959
2960     ### base64 decode the packet
2961     $base64_decoded_msg = decode_base64($msg);
2962
2963     ### continue only if decode_base64() had no "Premature end of base64 data"
2964     ### errors - we want to minimize code that executes against suspicious
2965     ### packet data
2966     if ($warn_msg =~ /Premature\s+end/i
2967             or $warn_msg =~ /Premature\s+padding/i) {
2968         if ($debug) {
2969             print STDERR localtime() . " [-] $warn_msg";
2970         }
2971         return $decrypt_rv, $decrypted_msg, $gpg_sign_id;
2972     }
2973
2974     print STDERR localtime() . " [+] Attempting GnuPG decrypt...\n" if $debug;
2975     if ($debug and $verbose) {
2976         print STDERR localtime() . "     Decrypting raw data (hex dump):\n";
2977         &hex_dump($base64_decoded_msg);
2978     }
2979
2980     my $gnupg = GnuPG::Interface->new();
2981
2982     my %gnupg_options = (
2983         'batch'   => 1,
2984         'homedir' => $access_hr->{'GPG_HOME_DIR'},
2985         'no_options' => 1
2986     );
2987
2988     delete $gnupg_options{'batch'} if ($debug and $verbose and not $test_mode);
2989     delete $gnupg_options{'batch'} if $access_hr->{'GPG_USE_OPTIONS'};
2990
2991     $gnupg->options->hash_init(%gnupg_options);
2992
2993     if ($access_hr->{'GPG_PATH'}) {
2994         $gnupg->call($access_hr->{'GPG_PATH'});
2995     } elsif (defined $cmds{'gpg'}) {
2996         $gnupg->call($cmds{'gpg'});
2997     }
2998
2999     my $input_fh  = IO::Handle->new() or die $!;
3000     my $output_fh = IO::Handle->new() or die $!;
3001     my $error_fh  = IO::Handle->new() or die $!;
3002     my $pw_fh     = IO::Handle->new() or die $!;
3003     my $status_fh = IO::Handle->new() or die $!;
3004
3005     my $handles = GnuPG::Handles->new(
3006         stdin      => $input_fh,
3007         stdout     => $output_fh,
3008         stderr     => $error_fh,
3009         passphrase => $pw_fh,
3010         status     => $status_fh,
3011     );
3012
3013     $gnupg->options->default_key($access_hr->{'GPG_DECRYPT_ID'});
3014
3015     if (defined $access_hr->{'GPG_AGENT_INFO'}) {
3016
3017         $ENV{'GPG_AGENT_INFO'} = $access_hr->{'GPG_AGENT_INFO'};
3018
3019         $pid = $gnupg->decrypt('handles' => $handles,
3020             'command_args' => [ qw( --use-agent ) ]);
3021
3022     } elsif ($gpg_agent_info) {
3023
3024         ### global definition for gpg-agent connection information
3025         ### from the command line
3026         $ENV{'GPG_AGENT_INFO'} = $gpg_agent_info;
3027
3028         $pid = $gnupg->decrypt('handles' => $handles,
3029             'command_args' => [ qw( --use-agent ) ]);
3030
3031     } else {
3032
3033         $pid = $gnupg->decrypt('handles' => $handles);
3034     }
3035
3036     print $pw_fh $access_hr->{'GPG_DECRYPT_PW'};
3037
3038     close $pw_fh;
3039
3040     print $input_fh $base64_decoded_msg;
3041     close $input_fh;
3042
3043     @plaintext = <$output_fh>;
3044     close $output_fh;
3045
3046     my @errors = <$error_fh>;
3047     close $error_fh;
3048
3049     my @status = <$status_fh>;
3050     close $status_fh;
3051
3052     waitpid $pid, 0;
3053
3054     if ($debug) {
3055         print STDERR localtime() . " [+] GnuPG status messages:\n";
3056         print STDERR for @status;
3057     }
3058
3059     ### we require the message to be signed; make sure
3060     ### the signature is good
3061     KEY: for my $key_id (@{$access_hr->{'GPG_REMOTE_ID'}}) {
3062         $key_id = $1 if $key_id =~ /^0x(\w+)/;
3063         my $found_candidate_sig = 0;
3064         if ($debug) {
3065             print STDERR localtime() . " [+] gpg key ID: $key_id\n",
3066                     localtime() . "     GnuPG error messages:\n";
3067         }
3068         LINE: for my $err (@errors) {
3069             print STDERR localtime() . "     $err" if $debug;
3070             if ($key_id eq 'ANY') {
3071                 if ($err =~ /Good\s+signature/i) {
3072                     $found_sig = 1;
3073                     $gpg_sign_id = $key_id;
3074                     last KEY;
3075                 }
3076             } else {
3077                 if ($err =~ /Signature\s+made.*ID\s+$key_id$/) {
3078                     $found_candidate_sig = 1;
3079                     next LINE;
3080                 }
3081                 if ($found_candidate_sig and $err =~ /Good\s+signature/i) {
3082                     $found_sig = 1;
3083                     $gpg_sign_id = $key_id;
3084                     last KEY;
3085                 }
3086             }
3087         }
3088     }
3089
3090     if ($found_sig and @plaintext) {
3091         $decrypt_rv = 1;
3092         $decrypted_msg .= $_ for @plaintext;
3093     } else {
3094         print STDERR localtime() . " [-] GnuPG message not signed by any ",
3095             "required key ID.\n" if $debug;
3096     }
3097
3098     return $decrypt_rv, $decrypted_msg, $gpg_sign_id;
3099 }
3100
3101 sub pcap_Rijndael_decrypt_msg() {
3102     my ($msg, $enc_key) = @_;
3103
3104     my $decrypted_msg = '';
3105     my $decrypt_rv    = 0;
3106     my $base64_decoded_msg = '';
3107
3108     unless ($msg =~ /^U2FsdGVkX1/) {
3109         if ($debug) {
3110             print STDERR localtime() . " [+] Adding encoded 'Salted__' ",
3111                 "prefix (U2FsdGVkX1) to incoming encoded SPA packet.\n";
3112         }
3113         $msg = 'U2FsdGVkX1' . $msg;
3114     }
3115
3116     my ($equals_rv, $equals_padding) = &base64_equals_padding($msg);
3117
3118     unless ($equals_rv) {
3119         return $decrypt_rv, $decrypted_msg;
3120     }
3121
3122     if ($use_fko_module) {
3123
3124         if ($config{'ENABLE_SPA_OVER_HTTP'} eq 'Y' and &is_url_base64($msg)) {
3125             $msg =~ s|\-|+|g;
3126             $msg =~ s|\_|/|g;
3127         }
3128
3129         my $fko_err = $fko_obj->spa_data($msg);
3130         if ($fko_err) {
3131             if ($debug) {
3132                 &logr('[-]', "FKO error setting spa_data(): " .
3133                     $fko_obj->errstr($fko_err), $NO_MAIL);
3134             }
3135             return $decrypt_rv, $decrypted_msg;
3136         }
3137
3138         $fko_err = $fko_obj->decrypt_spa_data($enc_key);
3139         if ($fko_err) {
3140             if ($debug) {
3141                 &logr('[-]', "FKO error decrypting data via " .
3142                     "Rijndael decrypt_spa_data(): " .
3143                     $fko_obj->errstr($fko_err),
3144                     $NO_MAIL);
3145             }
3146             return $decrypt_rv, $decrypted_msg;
3147         }
3148
3149         return 1, $decrypted_msg;
3150
3151     }
3152
3153     if ($equals_padding) {
3154         print STDERR localtime() . " [+] Padding base64-encoded message ",
3155             "with '$equals_padding'.\n" if $debug;
3156         $msg .= $equals_padding;
3157     }
3158
3159     if ($config{'ENABLE_SPA_OVER_HTTP'} eq 'Y' and &is_url_base64($msg)) {
3160         $msg =~ s|\-|+|g;
3161         $msg =~ s|\_|/|g;
3162     }
3163
3164     if ($debug) {
3165         print STDERR localtime() . " [+] decode_base64() against the ",
3166             "following data: $msg\n";
3167     }
3168
3169     ### base64 decode the packet
3170     $base64_decoded_msg = decode_base64($msg);
3171
3172     ### continue only if decode_base64() had no "Premature end of base64 data"
3173     ### errors - we want to minimize code that executes against suspicious
3174     ### packet data
3175     if ($warn_msg =~ /Premature\s+end/i
3176             or $warn_msg =~ /Premature\s+padding/i) {
3177         if ($debug) {
3178             print STDERR localtime() . " [-] $warn_msg";
3179         }
3180         return $decrypt_rv, $decrypted_msg;
3181     }
3182
3183     ### look for the Salted__ prefix
3184     unless ($base64_decoded_msg =~ /^Salted__/) {
3185         if ($debug) {
3186             print STDERR localtime() . " [-] base64-decoded data does ",
3187                 "not begin with 'Salted__'\n";
3188         }
3189         return $decrypt_rv, $decrypted_msg;
3190     }
3191
3192     print STDERR localtime() . " [+] Attempting Rijndael decrypt...\n"
3193         if $debug;
3194
3195     if ($debug and $verbose) {
3196         print STDERR localtime() . "     Decrypting raw data (hex dump):\n";
3197         &hex_dump($base64_decoded_msg);
3198     }
3199
3200     my $cipher = Crypt::CBC->new({
3201         'key'    => $enc_key,
3202         'cipher' => $enc_alg,
3203     });
3204     eval {
3205         $decrypted_msg = $cipher->decrypt($base64_decoded_msg);
3206     };
3207     if ($debug and $verbose) {
3208         print STDERR "    Salt:\n";
3209         &hex_dump($cipher->salt());
3210         print STDERR "    Key:\n";
3211         &hex_dump($cipher->key());
3212         print STDERR "    IV:\n";
3213         &hex_dump($cipher->iv());
3214         print STDERR "    PassPhrase:\n";
3215         &hex_dump($cipher->passphrase());
3216         print STDERR "    Block Size: " . $cipher->blocksize() ."\n",
3217             "    Key Size:   " . $cipher->keysize(). "\n\n";
3218     }
3219
3220     if ($@) {
3221         $decrypted_msg = '';
3222     } else {
3223         $decrypt_rv = 1;
3224     }
3225     return $decrypt_rv, $decrypted_msg;
3226 }
3227
3228 sub decrypt_sequence() {
3229     my ($src, $seq_hr, $access_hr) = @_;
3230
3231     my $cipher_txt = '';
3232     my $allow_src  = '';
3233
3234     $cipher_txt .= chr($_ - $access_hr->{'PORT_OFFSET'})
3235         for @{$seq_hr->{'enc_ports'}};
3236
3237     return 0 unless $cipher_txt;
3238
3239     if ($debug) {
3240         my @tmp_chars = split //, $cipher_txt;
3241         print STDERR localtime() . ' [+] Cipher text (' .
3242             length($cipher_txt) . ' bytes): ';
3243         print STDERR ord($_) . ' ' for @tmp_chars;
3244         print STDERR "\n";
3245     }
3246
3247     my $cipher = Crypt::CBC->new({
3248         'key'    => $access_hr->{'KEY'},
3249         'cipher' => $enc_alg,
3250     });
3251
3252     ### we now have our encrypted string, so try to decrypt it
3253     my $plain_txt = '';
3254     eval {
3255         $plain_txt = $cipher->decrypt($cipher_txt);
3256     };
3257     undef $cipher;
3258
3259     return 0,0,0,0 if ($@ or not $plain_txt);
3260
3261     if ($debug) {
3262         my @tmp_chars = split //, $plain_txt;
3263         print STDERR localtime() . " [+] Plain text: ";
3264         print STDERR ord($_) . ' ' for @tmp_chars;
3265         print STDERR "\n";
3266     }
3267
3268     my @chars = split //, $plain_txt;
3269
3270     ### the first four characters in the @chars array represent the
3271     ### four octets of the IP we are going to modify access for
3272     for my $octet ($chars[0], $chars[1], $chars[2], $chars[3]) {
3273         unless (0 <= ord($octet) and ord($octet) < 256) {
3274             &logr('[-]', "invalid IP octet: " . ord($octet), $SEND_MAIL);
3275             return 0,0,0,0;
3276         }
3277         $allow_src .= ord($octet) . '.';
3278     }
3279     $allow_src =~ s/\.$//;
3280
3281     if ($allow_src eq '0.0.0.0') {
3282         ### the client sent 0.0.0.0 across, so it may be behind a
3283         ### NAT device (or the person just doesn't know their source
3284         ### address) so open the firewall for the source of the
3285         ### encrypted sequence.
3286         if ($config{'REQUIRE_SOURCE_ADDRESS'} eq 'Y' or not
3287                 &is_ip_included($allow_src,
3288                     $access_hr->{'REQUIRE_SOURCE_ADDRESS'},
3289                     $access_hr->{'require_src_addr_exceptions'})) {
3290             ### we require the source address to be contained within
3291             ### the encrypted packet.
3292             return 0,0,0,0;
3293         }
3294         $allow_src = $src;
3295     }
3296
3297     my $port_upper_bits = ord($chars[4]) << 8;
3298     my $port_lower_bits = ord($chars[5]);
3299     my $allow_port = $port_upper_bits | $port_lower_bits;
3300
3301     unless (0 <= $allow_port and $allow_port < 65536) {
3302         &logr('[-]', "bad port number: $allow_port", $SEND_MAIL);
3303         return 0,0,0,0;
3304     }
3305
3306     my $allow_proto = '';
3307     my $proto = ord($chars[6]);
3308     if ($proto == 6) {
3309         $allow_proto = 'tcp';
3310     } elsif ($proto == 17) {
3311         $allow_proto = 'udp';
3312     } elsif ($proto == 1) {
3313         $allow_proto = 'icmp';
3314     } else {
3315         &logr('[-]', "bad protocol number: $proto", $SEND_MAIL);
3316         return 0,0,0,0;
3317     }
3318
3319     my $checksum_data = ord($chars[7]);
3320
3321     my $checksum = 0;
3322     for (my $i=0; $i < 7; $i++) {
3323         $checksum += ord($chars[$i]);
3324     }
3325     $checksum = $checksum % 256;
3326
3327     unless ($checksum_data == $checksum) {
3328         &logr('[-]', "invalid checksum for $src", $SEND_MAIL);
3329         return 0,0,0,0;
3330     }
3331
3332     my $username = '';
3333     my $i=8;
3334     while ($i <= $#chars and ord($chars[$i]) != 0) {
3335         $username .= $chars[$i];
3336         $i++;
3337     }
3338
3339     return 1, $allow_src, $allow_port, $allow_proto, $username;
3340 }
3341
3342 sub grant_access() {
3343     my ($src, $msg_hr, $nat_info_hr, $seq_hr,
3344             $open_ports_hr, $access_hr) = @_;
3345
3346     if ($access_hr->{'EXTERNAL_CMD_OPEN'}
3347             or ($config{'FIREWALL_TYPE'} eq 'external_cmd'
3348             and $config{'EXTERNAL_CMD_OPEN'})) {
3349
3350         ### run EXTERNAL_CMD_OPEN and let knoptm run EXTERNAL_CMD_CLOSE
3351         &external_cmd_open($src, $msg_hr, $open_ports_hr, $access_hr);
3352
3353     } else {
3354         if ($config{'FIREWALL_TYPE'} eq 'iptables') {
3355
3356             ### iptables access; the destination IP is only used if access is
3357             ### forwarded through the iptables policy
3358             &grant_ipt_access($src, $msg_hr, $nat_info_hr,
3359                     $seq_hr, $open_ports_hr, $access_hr);
3360
3361         } elsif ($config{'FIREWALL_TYPE'} eq 'ipfw') {
3362
3363             ### ipfw access
3364             &grant_ipfw_access($src, $open_ports_hr, $access_hr);
3365         }
3366     }
3367     return;
3368 }
3369
3370 sub grant_ipt_access() {
3371     my ($src, $msg_hr, $nat_info_hr, $seq_hr,
3372             $open_ports_hr, $access_hr) = @_;
3373
3374     my @ipt_hrefs = ();
3375     my $ipt = &get_iptables_chainmgr_obj($config{'IPT_EXEC_SLEEP'});
3376
3377     my $local_nat = 0;
3378
3379     if (keys %$msg_hr) {  ### For PK mode, this hash ref is empty
3380         if ($msg_hr->{'action_type'} == $SPA_LOCAL_NAT_ACCESS_MODE
3381                 or $msg_hr->{'action_type'}
3382                     == $SPA_CLIENT_TIMEOUT_LOCAL_NAT_ACCESS_MODE) {
3383             $local_nat = 1;
3384         }
3385     }
3386
3387     if ($access_hr->{'ENABLE_FORWARD_ACCESS'} or $local_nat) {
3388
3389         unless (defined $nat_info_hr->{'internal_ip'}) {
3390             print STDERR localtime() . " [-] Internal IP not ",
3391                 "defined for NAT\n" if $debug;
3392             undef $ipt;
3393             return;
3394         }
3395         push @ipt_hrefs, \%ipt_prerouting if %ipt_prerouting;
3396         push @ipt_hrefs, \%ipt_postrouting if %ipt_postrouting;
3397
3398         if ($local_nat) {
3399             push @ipt_hrefs, \%ipt_input;
3400             print STDERR localtime() . " [+] INPUT NAT access for $src ",
3401                 "to local IP: $nat_info_hr->{'internal_ip'}\n"
3402                 if $debug;
3403         } else {
3404             push @ipt_hrefs, \%ipt_forward;
3405             print STDERR localtime() . " [+] FORWARD access for $src ",
3406                 "to internal IP: $nat_info_hr->{'internal_ip'}\n"
3407                 if $debug;
3408         }
3409
3410     } else {
3411         if (defined $nat_info_hr->{'internal_ip'}) {
3412             undef $ipt;
3413             return;
3414         }
3415         push @ipt_hrefs, \%ipt_input;
3416         if ($access_hr->{'ENABLE_OUTPUT_ACCESS'}) {
3417             push @ipt_hrefs, \%ipt_output;
3418         }
3419     }
3420
3421     my $ipt_hr_num = 0;
3422     for my $hr (@ipt_hrefs) {
3423
3424         if ($debug) {
3425             $ipt_hr_num++;
3426             print STDERR localtime() . " [+] ipt_href: $ipt_hr_num\n",
3427                 Dumper($hr);
3428         }
3429         my $nat_ip   = '0.0.0.0/0';
3430         my $nat_port = 0;
3431
3432         ### add rule for $ip unless it already exists
3433         my $target     = $hr->{'target'};
3434         my $direction  = $hr->{'direction'};
3435         my $table      = $hr->{'table'};
3436         my $from_chain = $hr->{'from_chain'};
3437         my $to_chain   = $hr->{'to_chain'};
3438         my $jump_rule_position = $hr->{'jump_rule_position'};
3439         my $auto_rule_position = $hr->{'auto_rule_position'};
3440
3441         my $grant_src = $src;
3442         my $grant_dst = '0.0.0.0/0';
3443
3444         if ($direction eq 'dst') {
3445             ### OUTPUT chain
3446             $grant_dst = $src;
3447             $grant_src = '0.0.0.0/0';
3448         }
3449
3450         my $rv = 0;
3451         my $out_ar = [];
3452         my $err_ar = [];
3453
3454         ### make sure "to_chain" exists
3455         for (my $try=0; $try < $config{'IPT_EXEC_TRIES'}; $try++) {
3456             ($rv, $out_ar, $err_ar)
3457                 = $ipt->create_chain($table, $to_chain);
3458             last if $rv;
3459         }
3460
3461         if ($rv) {
3462             print STDERR localtime() . "     create_chain() returned: $rv\n"
3463                 if $debug;
3464         } else {
3465             print STDERR localtime() . " [-] create_chain() ",
3466                 "returned: $rv, errors:\n" if $debug;
3467             &psyslog_errs($err_ar);
3468             undef $ipt;
3469             return;
3470         }
3471
3472         ### add jump rule to the "to_chain" from the "from_chain"
3473         for (my $try=0; $try < $config{'IPT_EXEC_TRIES'}; $try++) {
3474             ($rv, $out_ar, $err_ar) = $ipt->add_jump_rule($table,
3475                 $from_chain, $jump_rule_position, $to_chain);
3476             last if $rv;
3477         }
3478
3479         if ($rv) {
3480             print STDERR localtime() . "     add_jump_rule() ",
3481                 "returned: $rv\n" if $debug;
3482         } else {
3483             print STDERR localtime() . " [-] add_jump_rule() ",
3484                 "returned: $rv, errors:\n" if $debug;
3485             &psyslog_errs($err_ar);
3486             undef $ipt;
3487             return;
3488         }
3489
3490         for my $proto (keys %{$open_ports_hr}) {
3491             for my $port (keys %{$open_ports_hr->{$proto}}) {
3492
3493                 my $num_chain_rules = 0;
3494                 my $dport = $port;
3495                 my $sport = 0;
3496
3497                 my %extended_info = ('protocol' => $proto);
3498                 if ($direction eq 'dst') {
3499                     ### OUTPUT chain
3500                     $extended_info{'s_port'} = $port;
3501                     $sport = $port;
3502                     $dport = 0;
3503                 } else {
3504                     $extended_info{'d_port'} = $port;
3505                 }
3506
3507                 ### deal with DNAT and SNAT (normally MASQUERADE unless
3508                 ### ENABLE_IPT_SNAT is set)
3509                 if ($table eq 'nat' and ($target eq 'DNAT'
3510                             or $target eq 'SNAT')) {
3511                     if ($target eq 'DNAT') {
3512                         $extended_info{'to_ip'}
3513                             = $nat_info_hr->{'internal_ip'};
3514                         $extended_info{'to_port'} = $dport;
3515                         $extended_info{'d_port'}
3516                             = $nat_info_hr->{'external_port'};
3517                         $nat_ip   = $nat_info_hr->{'internal_ip'};
3518                         $nat_port = $dport;
3519                         $dport    = $nat_info_hr->{'external_port'};
3520                     } elsif ($target eq 'SNAT') {
3521                         $extended_info{'to_ip'}
3522                             = $config{'SNAT_TRANSLATE_IP'};
3523                         $extended_info{'to_port'} = $dport;
3524                         $extended_info{'d_port'}  = $dport;
3525                         $nat_ip   = $config{'SNAT_TRANSLATE_IP'};
3526                         $nat_port = $dport;
3527                     }
3528                 }
3529
3530                 ($rv, $num_chain_rules) = $ipt->find_ip_rule($grant_src,
3531                     $grant_dst, $table, $to_chain, $target, \%extended_info);
3532
3533                 if ($rv) {
3534                     print STDERR localtime() . "     find_ip_rule() ",
3535                         "returned $rv\n" if $debug;
3536                     my $str = "$grant_src -> $grant_dst($proto/$port)";
3537                     if ($direction eq 'dst') {
3538                         $str = "$grant_src($proto/$port) -> $grant_dst";
3539                     }
3540                     if (defined $extended_info{'to_ip'}) {
3541                         $str = "$grant_src -> $extended_info{'to_ip'}" .
3542                             "($proto/$extended_info{'d_port'} to " .
3543                             "$extended_info{'to_port'})";
3544                     }
3545                     &logr('[-]', "source: $str already allowed to connect " .
3546                         "in chain: $to_chain", $SEND_MAIL);
3547                 } else {
3548                     print STDERR localtime() . "     find_ip_rule() ",
3549                         "returned $rv\n" if $debug;
3550                     my $str = "add $to_chain $grant_src -> " .
3551                         "$grant_dst($proto/$port) $target rule ";
3552                     if ($direction eq 'dst') {
3553                         $str = "add $to_chain $grant_src($proto/$port) -> " .
3554                             "$grant_dst $target rule ";
3555                     }
3556                     if (defined $extended_info{'to_ip'}) {
3557                         $str = "add $to_chain $grant_src -> " .
3558                             "$extended_info{'to_ip'}" .
3559                             "($proto/$extended_info{'d_port'} to " .
3560                             "$extended_info{'to_port'}) " .
3561                             "$target rule ";
3562                     }
3563                     $str .= "$access_hr->{'FW_ACCESS_TIMEOUT'} sec";
3564
3565                     &logr('[+]', $str, $SEND_MAIL);
3566
3567                     for (my $try=0; $try < $config{'IPT_EXEC_TRIES'}; $try++) {
3568                         ($rv, $out_ar, $err_ar) = $ipt->add_ip_rule($grant_src,
3569                             $grant_dst, $auto_rule_position, $table, $to_chain,
3570                             $target, \%extended_info);
3571                         last if $rv;
3572                     }
3573
3574                     if ($rv) {
3575
3576                         if ($debug) {
3577                             print STDERR localtime() . " [+] add_ip_rule() ",
3578                                 "returned $rv\n",
3579                                  " [+] Dumping $to_chain to ",
3580                                 "see newly added rule:\n";
3581                             $ipt->run_ipt_cmd("$cmds{'iptables'} -t " .
3582                                 "$table -v -n -L $to_chain");
3583                         }
3584
3585                         ### keep track of how many times we have granted access
3586                         $seq_hr->{'grant_ctr'}++ unless
3587                             $access_hr->{'DATA_COLLECT_MODE'} == $PCAP
3588                             or $access_hr->{'DATA_COLLECT_MODE'} == $FILE_PCAP
3589                             or $access_hr->{'DATA_COLLECT_MODE'} == $ULOG_PCAP;
3590
3591                         ### Communicate the new firewall rule to knoptm so
3592                         ### that it can be removed.
3593                         &write_knoptm_fw_cache_entry(
3594                             time(),
3595                             $access_hr->{'FW_ACCESS_TIMEOUT'},
3596                             $grant_src,
3597                             $sport,
3598                             $grant_dst,
3599                             $dport,
3600                             $proto,
3601                             $table,
3602                             $to_chain,
3603                             $target,
3604                             $direction,
3605                             $nat_ip,
3606                             $nat_port,
3607                             encode_base64('NA', ''),
3608                             0
3609                         );
3610                     } else {
3611                         print STDERR localtime() . " [-] add_ip_rule() ",
3612                             "returned $rv\n" if $debug;
3613                         &psyslog_errs($err_ar);
3614                     }
3615                 }
3616             }
3617         }
3618     }
3619     $seq_hr->{'port_seq'} = 0
3620         unless $access_hr->{'DATA_COLLECT_MODE'} == $PCAP
3621             or $access_hr->{'DATA_COLLECT_MODE'} == $FILE_PCAP
3622             or $access_hr->{'DATA_COLLECT_MODE'} == $ULOG_PCAP;
3623
3624     undef $ipt;
3625     return;
3626 }
3627
3628 sub grant_ipfw_access() {
3629     my ($src, $open_ports_hr, $access_hr) = @_;
3630
3631     my $dst = '0.0.0.0/0';
3632
3633     for my $proto (keys %{$open_ports_hr}) {
3634         for my $port (keys %{$open_ports_hr->{$proto}}) {
3635
3636             my ($active_rulenum, $set_num, $new_rulenum)
3637                     = &ipfw_find_ip_rule($src, 'any', $proto, $port);
3638
3639             if ($active_rulenum and $set_num == 0) {
3640                 &logr('[-]', "source: $src already allowed " .
3641                     "to connect to $proto/$port", $SEND_MAIL);
3642             } else {
3643
3644                 my $msg = '';
3645                 if ($active_rulenum and $ipfw_is_dynamic
3646                         and $set_num == $config{'IPFW_SET_NUM'}) {
3647                     $msg = 'reactivating ipfw allow rule for '
3648                 } else {
3649                     $msg = 'adding ipfw allow rule for '
3650                 }
3651                 $msg .= "$src -> $proto";
3652
3653                 $msg .= "/$po