root/fwknop/tags/fwknop-1.9.2/fwknopd

Revision 1028, 164.6 kB (checked in by mbr, 1 year ago)

bumped version to 1.9.2

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Revision
Line 
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 # Author: Michael Rash (mbr@cipherdyne.org)
21 #
22 # Version: 1.9.2
23 #
24 # Copyright (C) 2004-2007 Michael Rash (mbr@cipherdyne.org)
25 #
26 # License (GNU Public License):
27 #
28 #    This program is distributed in the hope that it will be useful,
29 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
30 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
31 #    GNU General Public License for more details.
32 #
33 #    You should have received a copy of the GNU General Public License
34 #    along with this program; if not, write to the Free Software
35 #    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
36 #    USA
37 #
38 #############################################################################
39 #
40 # $Id: fwknopd 583 2006-11-04 20:43:01Z mbr $
41 #
42
43 use lib '/usr/lib/fwknop';
44 use Crypt::CBC;
45 use Unix::Syslog qw(:subs :macros);
46 use Net::IPv4Addr qw(ipv4_in_network);
47 use Net::Pcap;
48 use NetPacket::IP;
49 use NetPacket::UDP;
50 use NetPacket::TCP;
51 use NetPacket::ICMP;
52 use NetPacket::Ethernet;
53 use IO::Socket;
54 use IO::Handle;
55 use MIME::Base64;
56 use Data::Dumper;
57 use POSIX;
58 use Getopt::Long;
59 use strict;
60
61 my $config_file = '/etc/fwknop/fwknop.conf';
62 my $access_conf_file = '';
63
64 my $version = '1.9.2';
65 my $revision_svn = '$Revision$';
66 my $rev_num = '1';
67 ($rev_num) = $revision_svn =~ m|\$Rev.*:\s+(\S+)|;
68
69 my %config = ();
70 my %cmds   = ();
71 my %p0f    = ();
72 my @access = ();
73 my $blacklist_ar = [];
74 my $blacklist_exclude_ar = [];
75 my %p0f_sigs = ();
76 my %pid_files = ();
77 my %ip_sequences  = ();
78 my %digest_store = ();
79 my %ipt_input   = ();
80 my %ipt_forward = ();
81 my %ipt_prerouting = ();
82 my %ipt_output  = ();  ### optional
83 my @ipt_config  = ();
84
85 my $os_fprint_only = 0;
86 my $print_version  = 0;
87 my $print_help     = 0;
88 my $kill           = 0;
89 my $restart        = 0;
90 my $status         = 0;
91 my $debug          = 0;
92 my $packet_ctr     = 0;
93 my $packet_limit   = 0;
94 my $fw_list        = 0;
95 my $fw_type        = '';
96 my $ipt_flush      = 0;
97 my $ipt_del_chains = 0;
98 my $fw_del_ip      = '';
99 my $test_mode      = 0;
100 my $verbose        = 0;
101 my $use_gpg        = 0;
102 my $os_ipt_log     = '';
103 my $cmdline_intf   = '';
104 my $warn_msg       = '';
105 my $die_msg        = '';
106 my $cmdline_knoptm = '';
107 my $err_wait_timer = 30;  ### seconds
108 my $gpg_agent_info = '';
109 my $build_ipt_config = 0;
110 my $skipped_first_loop = 0;
111 my $pcap_sleep_interval = 1;  ### seconds
112 my $imported_iptables_modules = 0;
113 my $include_all_config_data   = 0;
114 my $voluntary_exit_timestamp  = 0;
115
116 ### SPA message types from fwknop clients
117
118 ### ACCESS message:
119 ###     random data :user : client_timestamp : client_version : \
120 ###     type (1) : access_request : digest
121 my $SPA_ACCESS_MODE  = 1;  ### default
122
123 ### COMMAND message:
124 ###     random data :user : client_timestamp : client_version : \
125 ###     type (0) : command : digest
126 my $SPA_COMMAND_MODE = 0;
127
128 ### FORWARD ACCESS message:
129 ###     random data :user : client_timestamp : client_version : \
130 ###     type (2) : access_request : NAT_info : digest
131 my $SPA_FORWARD_ACCESS_MODE = 2;
132
133 ### ACCESS message with client-defined firewall timeout:
134 ###     random data :user : client_timestamp : client_version : \
135 ###     type (3) : access_request : timeout : digest
136 my $SPA_CLIENT_TIMEOUT_ACCESS_MODE = 3;
137
138 ### FORWARD ACCESS message with client-defined firewall timeout:
139 ###     random data :user : client_timestamp : client_version : \
140 ###     type (4) : access_request : NAT_info : timeout : digest
141 my $SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE = 4;
142
143 ### minimum nummber of fields within a decrypted SPA packet
144 my $SPA_MIN_PACKET_FIELDS = 6;
145
146 ### default time values
147 my $knock_interval = 60;
148 my $default_access_timeout = 300;
149
150 my $enc_port_offset   = 61000;  ### default offset
151 my $enc_key           = '';
152 my $enc_alg           = 'Rijndael';
153 my $enc_blocksize     = 32;
154
155 ### there is a constant "RIJNDAEL_KEYSIZE" in the Crypt::Rijndael sources, but
156 ### it is not used; a 16 byte key size is fine.
157 my $enc_keysize = 16;
158
159 my $ALG_RIJNDAEL = 1;
160 my $ALG_GNUPG    = 2;
161
162 my $PCAP      = 0;
163 my $FILE_PCAP = 1;
164 my $ULOG_PCAP = 2;
165 my $SHARED_SEQUENCE  = 3;
166 my $ENCRYPT_SEQUENCE = 4;
167
168 ### Bool to detect Linux "Cooked" datalink layers
169 my $PCAP_COOKED_INTF = 0;
170
171 ### digest constants
172 my $SHA256_DIGEST_LEN = 43;
173 my $SHA1_DIGEST_LEN   = 27;
174 my $MD5_DIGEST_LEN    = 22;
175
176 ### logr constants
177 my $SEND_MAIL = 1;
178 my $NO_MAIL   = 0;
179 my $LOG_VERBOSE = 1;
180 my $LOG_QUIET   = 2;
181
182 ### packet counters
183 my $tcp_ctr  = 0;
184 my $udp_ctr  = 0;
185 my $icmp_ctr = 0;
186
187 ### tcp option types
188 my $tcp_nop_type       = 1;
189 my $tcp_mss_type       = 2;
190 my $tcp_win_scale_type = 3;
191 my $tcp_sack_type      = 4;
192 my $tcp_timestamp_type = 8;
193
194 my %tcp_p0f_opt_types = (
195     'N' => $tcp_nop_type,
196     'M' => $tcp_mss_type,
197     'W' => $tcp_win_scale_type,
198     'S' => $tcp_sack_type,
199     'T' => $tcp_timestamp_type
200 );
201
202 my %access_keys = (
203     'SOURCE' => [],
204     'KEY'    => '',
205     'OPEN_PORTS'     => '',
206     'GPG_REMOTE_ID'  => '',
207     'GPG_DECRYPT_ID' => '',
208     'GPG_DECRYPT_PW' => '',
209     'GPG_HOME_DIR'   => '',
210     'ULOG_PCAP'      => '',
211     'FILE_PCAP'      => '',
212     'DATA_COLLECT_MODE' => '',
213     'ENCRYPT_SEQUENCE'  => '',
214     'SHARED_SEQUENCE'   => '',
215     'PORT_OFFSET'       => '',
216     'REQUIRE_AUTH_METHOD' => '',
217     'SHADOW_FILE'    => '',
218     'KNOCK_INTERVAL' => '',
219     'KNOCK_LIMIT'    => '',
220     'PERMIT_CLIENT_PORTS' => '',
221     'PERMIT_CLIENT_TIMEOUT' => '',
222     'ENABLE_FORWARD_ACCESS' => 0,
223     'ENABLE_CMD_EXEC'     => '',
224     'DISABLE_FW_ACCESS'   => '',
225     'REQUIRE_SOURCE_ADDRESS' => [],
226     'require_src_addr_exceptions' => [],
227     'INTERNAL_NET_ACCESS' => [],  ### for --Forward-access IP restrictions
228     'internal_net_exceptions' => [],
229     'CMD_REGEX'         => '',
230     'FW_ACCESS_TIMEOUT' => '',
231     'REQUIRE_USERNAME'  => '',
232     'MIN_TIME_DIFF' => '',
233     'MAX_TIME_DIFF' => '',
234     'RESTRICT_INTF' => '',
235 );
236
237 my $ip_re = qr|(?:[0-2]?\d{1,2}\.){3}[0-2]?\d{1,2}|;
238
239 my @args_cp = @ARGV;
240
241 ### run GetOpt() to get comand line args
242 &handle_command_line();
243
244 &usage(0) if $print_help;
245
246 if ($print_version) {
247     print "[+] fwknopd v$version (file revision: $rev_num)\n",
248         "      by Michael Rash <mbr\@cipherdyne.org>\n";
249     exit 0;
250 }
251
252 if ($os_fprint_only) {
253     print "[+] Entering OS fingerprinting mode.\n";
254 }
255
256 print STDERR localtime() . " [+] ** Starting fwknopd (debug mode) **\n",
257     "    Command line: @args_cp\n" if $debug;
258
259 ### setup to run
260 &fwknop_init();
261
262 if ($config{'AUTH_MODE'} eq 'KNOCK' or $os_fprint_only) {
263
264     ### we are running in traditional port knocking mode
265     &knock_loop();
266
267 } elsif ($config{'AUTH_MODE'} eq 'FILE_PCAP'
268         or $config{'AUTH_MODE'} eq 'ULOG_PCAP'
269         or $config{'AUTH_MODE'} eq 'PCAP') {
270
271     ### we are parsing the pcap file created by the ulogd pcap
272     ### writer, or in sniffing mode against an interface
273     &pcap_loop();
274 }
275 exit 0;
276 #============================ end main ==============================
277
278 sub pcap_loop() {
279
280     ### we use both a size and an inode check in the FILE_PCAP and
281     ### ULOG_PCAP modes to check if the file has been rotated
282     my $pcap_file_size  = 0;
283     my $pcap_file_inode = 0;
284
285     ### get pcap opject
286     my $pcap_t = &get_pcap_obj();
287
288     ### Check for "cooked" Linux datalink layers (i.e. rp-pppoe)
289     eval {
290         if (not $PCAP_COOKED_INTF and $Net::Pcap::VERSION > 0.05) {
291             if (Net::Pcap::pcap_datalink_val_to_name(
292                     Net::Pcap::pcap_datalink($pcap_t)) eq 'LINUX_SLL') {
293                 print STDERR "[+] Detected Linux Cooked Interface.\n" if $debug;
294                 $PCAP_COOKED_INTF = 1;
295             }
296         }
297     };
298     &collect_warn_die_msgs() if $@;
299
300     if ($config{'AUTH_MODE'} eq 'FILE_PCAP'
301             or $config{'AUTH_MODE'} eq 'ULOG_PCAP') {
302         ### get file size (we don't need a -e check here because
303         ### this is handled in get_pcap_obj()).
304         $pcap_file_size = -s $config{'PCAP_PKT_FILE'};
305
306         ### get inode associated with the sniffing file
307         $pcap_file_inode = (stat($config{'PCAP_PKT_FILE'}))[1];
308     }
309     print STDERR localtime() . " [+] pcap_loop()\n" if $debug;
310
311     my $check_file_ctr = 0;
312
313     &collect_warn_die_msgs();
314
315     for (;;) {
316
317         Net::Pcap::loop($pcap_t, 1, \&pcap_process_pkt, 'fwknop_tag');
318
319         if ($config{'AUTH_MODE'} eq 'FILE_PCAP'
320                 or $config{'AUTH_MODE'} eq 'ULOG_PCAP') {
321
322             ### check to see if the pcap file has been rotated (we need to
323             ### close and re-open)
324             if ($check_file_ctr >= 10) {
325                 if (-e $config{'PCAP_PKT_FILE'}) {
326                     my $size_tmp  = -s $config{'PCAP_PKT_FILE'};
327                     my $inode_tmp = (stat($config{'PCAP_PKT_FILE'}))[1];
328                     if ($inode_tmp != $pcap_file_inode
329                             or $size_tmp < $pcap_file_size) {
330
331                         ### the file was rotated or shrank, so get new
332                         ### pcap_t object
333                         Net::Pcap::close($pcap_t);
334
335                         &logr('[+]', "pcap file $config{'PCAP_PKT_FILE'} " .
336                             "shrank or was rotated, so re-opening", $NO_MAIL);
337                         $pcap_t = &get_pcap_obj();
338
339                         ### set file size and inode
340                         $pcap_file_size  = $size_tmp;
341                         $pcap_file_inode = $inode_tmp;
342                     }
343                 } else {
344                     Net::Pcap::close($pcap_t);
345                     &logr('[+]', "pcap file $config{'PCAP_PKT_FILE'} " .
346                         "was rotated, so re-opening", $NO_MAIL);
347                     $pcap_t = &get_pcap_obj();
348
349                     ### set file size and inode
350                     $pcap_file_size  = -s $config{'PCAP_PKT_FILE'};
351                     $pcap_file_inode = (stat($config{'PCAP_PKT_FILE'}))[1];
352                 }
353                 $check_file_ctr = 0;
354             }
355             $check_file_ctr++;
356         }
357
358         &collect_warn_die_msgs();
359         sleep $pcap_sleep_interval;
360     }
361
362     Net::Pcap::close($pcap_t);
363
364     return;
365 }
366
367 sub pcap_process_pkt() {
368     my ($tag, $hdr, $pkt) = @_;
369
370     &collect_warn_die_msgs();
371
372     return unless $tag eq 'fwknop_tag';
373     return unless defined $hdr;
374     return unless defined $pkt;
375
376     my $ether_data = '';
377     my $ip         = '';
378     my $src_ip     = '';
379     my $proto      = '';
380     my $transport_obj = '';
381
382     if ($debug) {
383         print STDERR localtime() . " [+] Received packet ***[" .
384             localtime() . "]***\n";
385         if ($verbose) {
386             print STDERR localtime() .
387                 "     Complete raw packet data (hex dump, including ",
388                     "packet headers):\n";
389             &hex_dump($pkt);
390         }
391     }
392
393     if ($config{'AUTH_MODE'} eq 'ULOG_PCAP') {
394         ### The ulogd pcap writer does not include link layer information
395         $ip = NetPacket::IP->decode($pkt) or return;
396     } else {
397         if ($config{'FIREWALL_TYPE'} eq 'ipfw' and $cmdline_intf eq 'lo0') {
398
399             ### it seems that FreeBSD does not include an Ethernet header
400             ### over loopback
401             $pkt =~ s/^.{4}// if $pkt =~ /^[^\x45].{3}\x45/;
402
403             $ip = NetPacket::IP->decode($pkt) or return;
404         } else {
405             if ($PCAP_COOKED_INTF) {
406                 $ether_data = unpack("x[16]a*", $pkt);
407             } else {
408                 $ether_data = NetPacket::Ethernet::strip($pkt) or return;
409             }
410             $ip = NetPacket::IP->decode($ether_data) or return;
411         }
412     }
413
414     ### get the source IP address from the IP header
415     $src_ip = $ip->{'src_ip'} or return;
416
417     ### get the protocol
418     $proto = $ip->{'proto'} or return;
419
420     if ($proto == 1) {
421         $transport_obj = NetPacket::ICMP->decode($ip->{'data'});
422     } elsif ($proto == 6) {
423         $transport_obj = NetPacket::TCP->decode($ip->{'data'});
424     } elsif ($proto == 17) {
425         $transport_obj = NetPacket::UDP->decode($ip->{'data'});
426     } else {
427         return;
428     }
429
430     ### make sure we have _some_ data in the packet; in practice
431     ### any valid SPA message will be longer than 10 bytes, but this
432     ### check is better than nothing
433     return unless defined $transport_obj->{'data'};
434
435     my $enc_msg_len = 0;
436     $enc_msg_len = length($transport_obj->{'data'});
437     if (10 < $enc_msg_len and $enc_msg_len < 1500) {
438         print STDERR localtime() . " [+] Data len: $enc_msg_len bytes\n"
439             if $debug;
440     } else {
441         print STDERR localtime() . " [-] $enc_msg_len bytes, not ",
442             "attempting decrypt)\n" if $debug;
443         return;
444     }
445
446     if ($debug) {
447         ### make sure not to print non-printable stuff
448         my $data_tmp = $transport_obj->{'data'};
449         $data_tmp =~ s/[^\x20-\x7e]/NA/g;
450         print STDERR localtime() .
451             " [+] Raw packet data (single line): $data_tmp\n";
452
453         ### print packet data out in tcpdump -X format
454         if ($verbose) {
455             print STDERR localtime() .
456                 "     Raw packet data (hex dump, minus packet headers):\n";
457             &hex_dump($transport_obj->{'data'});
458         }
459     }
460
461     ### see if this packet is worthy of being granted access through
462     ### the firewall
463     &SPA_check_grant_access($src_ip, $enc_msg_len, $transport_obj->{'data'});
464
465     &collect_warn_die_msgs();
466
467     return;
468 }
469
470 sub SPA_check_grant_access() {
471     my ($src_ip, $enc_msg_len, $pkt_data) = @_;
472
473     ### first check to see if we have any matching access directives
474     ### (in access.conf) for $src_ip, and if not we will do _nothing_
475     ### with this packet.
476     my $access_nums_aref = &check_src($src_ip);
477
478     if ($#$access_nums_aref > -1) {
479
480         ### See if the packet qualifies for any access
481         SOURCE: for my $num (@$access_nums_aref) {
482             my $access_hr = $access[$num];
483
484             next SOURCE unless $access_hr->{'DATA_COLLECT_MODE'} == $PCAP
485                 or $access_hr->{'DATA_COLLECT_MODE'} == $FILE_PCAP
486                 or $access_hr->{'DATA_COLLECT_MODE'} == $ULOG_PCAP;
487
488             &dump_access($access_hr, $num) if $debug and $verbose;
489
490             ### keep track of which source block we are dealing with from
491             ### access.conf
492             my $source_block_num = $access_hr->{'block_num'};
493
494             ### see if we can decrypt and base64-decode
495             my ($decrypt_rv, $decrypted_msg, $gpg_sign_id, $decrypt_algo)
496                 = &SPA_decrypt($pkt_data, $enc_msg_len, $access_hr);
497             next SOURCE unless $decrypt_rv;
498
499             ### check for replay attacks
500             my ($digest_rv, $digest)
501                 = &check_replay_attack($decrypted_msg, $src_ip);
502             return if $digest_rv;
503
504             ### see if we have a syntactically valid message
505             my ($validate_rv, $msg_hr) = &pcap_validate_msg(
506                 $decrypted_msg, $source_block_num, $access_hr);
507             if ($debug and not $validate_rv) {
508                 print STDERR localtime() . " [-] Decrypted message does not ",
509                     "conform to a valid SPA packet.\n";
510             }
511             next SOURCE unless $validate_rv;
512
513             ### check to see if client side time stamp is too old
514             my $time_check_rv = &SPA_check_packet_age($msg_hr->{'remote_time'});
515             next SOURCE unless $time_check_rv;
516
517             ### dump packet to stderr for debugging purposes
518             &SPA_dump_packet($msg_hr) if $debug;
519
520             ### check username
521             next SOURCE unless &SPA_check_user($access_hr, $src_ip, $msg_hr);
522
523             ### check authentication method
524             next SOURCE unless &SPA_check_auth_method(
525                 $access_hr, $src_ip, $msg_hr);
526
527             if ($msg_hr->{'action_type'} == $SPA_ACCESS_MODE
528                     or $msg_hr->{'action_type'} == $SPA_FORWARD_ACCESS_MODE
529                     or $msg_hr->{'action_type'} == $SPA_FORWARD_ACCESS_MODE
530                     or $msg_hr->{'action_type'}
531                         == $SPA_CLIENT_TIMEOUT_ACCESS_MODE
532                     or $msg_hr->{'action_type'}
533                         == $SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE) {
534
535                 if (&SPA_access($msg_hr, $src_ip, $decrypt_algo,
536                         $gpg_sign_id, $digest, $access_hr)) {
537                     last SOURCE;
538                 } else {
539                     next SOURCE;
540                 }
541             } elsif ($msg_hr->{'action_type'} == $SPA_COMMAND_MODE) {
542                 if (&SPA_cmd($msg_hr, $src_ip, $decrypt_algo,
543                         $gpg_sign_id, $digest, $access_hr)) {
544                     last SOURCE;
545                 } else {
546                     next SOURCE;
547                 }
548             }
549         }
550     } else {
551         print STDERR localtime() . " [-] Packet from $src_ip did not ",
552             "match any SOURCE blocks in $config{'ACCESS_CONF'}\n" if $debug;
553     }
554
555     ### see if we need to exit if the packet limit (set with -C on the
556     ### command line) has been reached
557     if ($packet_limit) {
558         $packet_ctr++;
559         if ($packet_ctr >= $packet_limit) {
560             &logr('[+]', "packet limit ($packet_limit) reached, exiting.",
561                 $NO_MAIL);
562             exit 0;
563         }
564     }
565
566     return;
567 }
568
569 sub SPA_decrypt() {
570     my ($pkt_data, $enc_msg_len, $access_hr) = @_;
571
572     my $decrypted_msg = '';
573     my $decrypt_algo  = $ALG_RIJNDAEL;
574     my $gpg_sign_id   = '';
575     my $decrypt_rv    = 0;
576
577     if ($enc_msg_len > $config{'MIN_GNUPG_MSG_SIZE'}
578             and defined $access_hr->{'GPG_REMOTE_ID'}) {
579         ### attempt GPG decrypt (only if the length of the encrypted
580         ### payload is greater than the minimum size for an SPA message
581         ### encrypted with GnuPG; even encrypting a single byte of data
582         ### with a 1024 bit GnuPG key results in 340 bytes of encrypted
583         ### payload in my testing).
584         ($decrypt_rv, $decrypted_msg, $gpg_sign_id) =
585                 &pcap_GPG_decrypt_msg($pkt_data, $access_hr);
586
587         $decrypt_algo = $ALG_GNUPG if $decrypt_rv;
588     }
589
590     ### fall back to Rijndael if the GnuPG decrypt was not successful
591     ### (and note that the GnuPG decryption is only attempted if the
592     ### packet size is large enough).
593     if (defined $access_hr->{'KEY'} and not $decrypt_rv) {
594
595         ($decrypt_rv, $decrypted_msg) = &pcap_Rijndael_decrypt_msg(
596                             $pkt_data, $access_hr->{'KEY'});
597     }
598
599     if ($decrypt_rv) {
600         if ($debug) {
601             ### make sure not to print non-printable stuff
602             my $dec_tmp_msg = $decrypted_msg;
603             $dec_tmp_msg =~ s/[^\x20-\x7e]/NA/g;
604             print STDERR localtime() . " [+] Decrypted ",
605                 "message: $dec_tmp_msg\n";
606             if ($verbose) {
607                 print STDERR localtime() . "     Decrypted message (hex dump):\n";
608                 &hex_dump($decrypted_msg);
609             }
610         }
611     } else {
612         print STDERR localtime() . " [-] Failed decrypt for SOURCE block ",
613             "$access_hr->{'src_str'}\n" if $debug;
614     }
615
616     return $decrypt_rv, $decrypted_msg, $gpg_sign_id, $decrypt_algo;
617 }
618
619 sub SPA_check_packet_age() {
620     my $remote_time = shift;
621
622     if ($config{'ENABLE_SPA_PACKET_AGING'} eq 'Y') {
623         if (abs((time() - $remote_time))
624                 > $config{'MAX_SPA_PACKET_AGE'}) {
625             &logr('[-]', "remote time stamp is older than " .
626                 "$config{'MAX_SPA_PACKET_AGE'} second max age.", $SEND_MAIL);
627             return 0;
628         }
629     }
630     return 1;
631 }
632
633 sub SPA_dump_packet() {
634     my $msg_hr = shift;
635
636     print STDERR localtime() . " [+] Packet fields:\n";
637     printf STDERR "    %-16s %s\n    %-16s %s\n    %-16s %s\n" .
638                   "    %-16s %s\n    %-16s %s",
639             'Random data:', $msg_hr->{'random_number'},
640             'Username:',    $msg_hr->{'username'},
641             'Remote time:', $msg_hr->{'remote_time'},
642             'Remote ver:',  $msg_hr->{'remote_version'},
643             'Action type:', $msg_hr->{'action_type'};
644
645     if ($msg_hr->{'action_type'} == $SPA_ACCESS_MODE) {
646         print STDERR " (SPA_ACCESS_MODE)\n";
647     } elsif ($msg_hr->{'action_type'} == $SPA_COMMAND_MODE) {
648         print STDERR " (SPA_COMMAND_MODE)\n";
649     } elsif ($msg_hr->{'action_type'} == $SPA_FORWARD_ACCESS_MODE) {
650         print STDERR " (SPA_FORWARD_ACCESS_MODE)\n";
651     } elsif ($msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_ACCESS_MODE) {
652         print STDERR " (SPA_CLIENT_TIMEOUT_ACCESS_MODE)\n";
653     } elsif ($msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE) {
654         print STDERR " (SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE)\n";
655     }
656     printf STDERR "    %-16s %s\n",
657             'Action:', $msg_hr->{'action'};
658
659     if ($msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_ACCESS_MODE
660             or $msg_hr->{'action_type'}
661                 == $SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE) {
662         printf STDERR "    %-16s %s\n",
663                 'Client timeout:', $msg_hr->{'client_timeout'};
664     }
665
666     if ($msg_hr->{'server_auth'}) {
667         if ($msg_hr->{'server_auth'} =~ /^\s*(\w+),(.*)/) {
668             my $server_auth_type = lc($1);
669             my $server_auth_crypt_pw = $2;
670             if ($debug) {
671                 printf STDERR "    %-16s %s", 'Server auth:', $server_auth_type;
672                 for (my $i=0; $i<length($server_auth_crypt_pw); $i++) {
673                     print STDERR '*';
674                 }
675                 print STDERR "\n";
676             }
677         }
678     }
679     if ($msg_hr->{'forward_info'}) {
680         printf STDERR "    %-16s %s\n", 'Forward info:',
681             $msg_hr->{'forward_info'};
682     }
683     printf STDERR "    %-16s %s\n", "$msg_hr->{'digest_str'} digest:",
684         $msg_hr->{'digest'};
685     return;
686 }
687
688 sub SPA_check_user() {
689     my ($access_hr, $src_ip, $msg_hr) = @_;
690
691     if (defined $access_hr->{'REQUIRE_USERNAME'}) {
692         my $found = 0;
693         my $user  = '';
694         for my $valid_user (@{$access_hr->{'VALID_USERS'}}) {
695             if ($valid_user eq $msg_hr->{'username'}) {
696                 $found = 1;
697                 $user  = $valid_user;
698             }
699         }
700         unless ($found) {
701             &logr('[-]', "username mismatch from $src_ip, expecting " .
702                 "$access_hr->{'REQUIRE_USERNAME'}, got " .
703                 "$msg_hr->{'username'}", $SEND_MAIL);
704             return 0;
705         }
706     }
707     return 1;
708 }
709
710 sub SPA_check_auth_method() {
711     my ($access_hr, $src_ip, $msg_hr) = @_;
712
713     my $server_auth_type     = '';
714     my $server_auth_crypt_pw = '';
715     if ($msg_hr->{'server_auth'}) {
716         if ($msg_hr->{'server_auth'} =~ /^\s*(\w+),(.*)/) {
717             $server_auth_type = lc($1);
718             $server_auth_crypt_pw = $2;
719         }
720     }
721
722     if (defined $access_hr->{'REQUIRE_AUTH_METHOD'}) {
723         if ($server_auth_type
724                 eq $access_hr->{'REQUIRE_AUTH_METHOD'}) {
725             if ($server_auth_type eq 'crypt') {
726                 ### check the local UNIX crypt() password associated
727                 ### with the user
728                 unless (&server_auth_verify_crypt_pw(
729                             $msg_hr->{'username'},
730                             $server_auth_crypt_pw,
731                             $access_hr->{'SHADOW_FILE'})) {
732                     &logr('[-]', "IP: $src_ip failed server-auth UNIX " .
733                         "crypt() password test", $NO_MAIL);
734                     return 0;
735                 }
736             }
737         } else {
738             &logr('[-]', "required server-auth method " .
739                 "\"$access_hr->{'REQUIRE_AUTH_METHOD'}\" " .
740                 "not supplied by $src_ip", $NO_MAIL);
741             return 0;
742         }
743     }
744     return 1;
745 }
746
747 sub SPA_access() {
748     my ($msg_hr, $src_ip, $decrypt_algo, $gpg_sign_id,
749         $digest, $access_hr) = @_;
750
751     my $allow_src    = '';
752     my %open_ports   = ();
753     my %forward_info = ();
754
755     if ($access_hr->{'DISABLE_FW_ACCESS'}) {
756         &logr('[-]', "received fw access request from $src_ip, " .
757             "but DISABLE_FW_ACCESS is set to a true value " .
758             "(SOURCE line num: $access_hr->{'src_line_num'})", $NO_MAIL);
759         return 0;
760     }
761
762     if ($msg_hr->{'action_type'} == $SPA_CLIENT_TIMEOUT_ACCESS_MODE
763             or $msg_hr->{'action_type'}
764                 == $SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE) {
765
766         if ($access_hr->{'PERMIT_CLIENT_TIMEOUT'}) {
767             $access_hr->{'FW_ACCESS_TIMEOUT'} = $msg_hr->{'client_timeout'};
768         } else {
769             &logr('[-]', "received fw access request from $src_ip, " .
770                 "with client-defined timeout, but PERMIT_CLIENT_TIMEOUT is not " .
771                 "set (SOURCE line num: $access_hr->{'src_line_num'})", $NO_MAIL);
772             return 0;
773         }
774     }
775
776     $allow_src = $1 if $msg_hr->{'action'} =~ /($ip_re)/;
777
778     unless ($allow_src) {
779         &logr('[-]', "no valid IP address within action portion of SPA " .
780             "packet from $src_ip (SOURCE line num: " .
781             "$access_hr->{'src_line_num'})", $SEND_MAIL);
782         return 0;
783     }
784
785     if ($allow_src eq '0.0.0.0') {
786         if ($config{'REQUIRE_SOURCE_ADDRESS'} eq 'Y' or not
787                 &is_ip_included($src_ip,
788                     $access_hr->{'REQUIRE_SOURCE_ADDRESS'},
789                     $access_hr->{'require_src_addr_exceptions'})) {
790             &logr('[-]', "IP: $src_ip sent SPA packet that " .
791                 "contained 0.0.0.0 (-s on the client side) " .
792                 "but REQUIRE_SOURCE_ADDRESS is enabled " .
793                 "(SOURCE line num: $access_hr->{'src_line_num'})", $SEND_MAIL);
794             return 0;
795         } else {
796             $allow_src = $src_ip;
797         }
798     }
799
800     ### initialize to the OPEN_PORTS directives (if defined; we know that
801     ### either OPEN_PORTS or PERMIT_CLIENT_PORTS was specified in the
802     ### access.conf file)
803     %open_ports = %{$access_hr->{'OPEN_PORTS'}}
804         if defined $access_hr->{'OPEN_PORTS'};
805
806     if ($msg_hr->{'action'}
807             =~ /$ip_re,(tcp|udp|icmp),(\d+)/i) {
808         ### single port access format (e.g. tcp,22)
809         my $allow_port  = $1;
810         my $allow_proto = $2;
811
812         if ($access_hr->{'PERMIT_CLIENT_PORTS'}) {
813             $open_ports{$allow_proto}{$allow_port} = '';
814         } else {
815             unless (defined $open_ports{$allow_proto} and
816                     defined $open_ports{$allow_proto}{$allow_port}) {
817                 &logr('[-]', "IP $allow_src not permitted to open " .
818                     "$allow_proto/$allow_port (SOURCE line num: " .
819                     "$access_hr->{'src_line_num'})", $NO_MAIL);
820                 return 0;
821             }
822         }
823
824     } elsif ($msg_hr->{'action'}
825              =~ /$ip_re,(\S+)/) {
826         ### multi-port access format (-A was specified by
827         ### the client)
828         my $access_str = $1;
829
830         my @dec_allow_ports = split /,/, $access_str;
831
832         for my $port_str (@dec_allow_ports) {
833             if ($port_str =~ m|(\D+)/(\d+)|) {
834                 my $proto = lc($1);
835                 my $port  = $2;
836
837                 next unless ($proto eq 'tcp'
838                     or $proto eq 'udp'
839                     or $proto eq 'icmp');
840                 $port = 0 if $proto eq 'icmp';
841
842                 if ($access_hr->{'PERMIT_CLIENT_PORTS'}) {
843                     $open_ports{$proto}{$port} = '';
844                 } else {
845                     unless (defined $open_ports{$proto} and
846                             defined $open_ports{$proto}{$port}) {
847                         &logr('[-]', "IP $allow_src not permitted to open " .
848                             "$proto/$port (SOURCE line num: " .
849                             "$access_hr->{'src_line_num'})", $NO_MAIL);
850                         return 0;
851                     }
852                 }
853             }
854         }
855     }
856
857     ### handle SPA access through iptables FORWARD chain for
858     ### SPA_FORWARD_ACCESS_MODE messages
859     ### iptables -t nat -A PREROUTING -p tcp -s <SPA_src> --dport 55000 \
860     ### -i eth0 -j DNAT --to 192.168.10.3:80
861     if ($msg_hr->{'forward_info'}
862                 and $msg_hr->{'forward_info'} =~ /($ip_re),(\d+)/) {
863         unless ($config{'FIREWALL_TYPE'} eq 'iptables') {
864             &logr('[-]', "FORWARD access requested through non-iptables " .
865                 "firewall (SOURCE line num: ".
866                 "$access_hr->{'src_line_num'})", $NO_MAIL);
867             return 0;
868         }
869         unless ($access_hr->{'ENABLE_FORWARD_ACCESS'}) {
870             &logr('[-]', "FORWARD access requested through non-forward " .
871                 "access SOURCE block (SOURCE line num: ".
872                 "$access_hr->{'src_line_num'})", $NO_MAIL);
873             return 0;
874         }
875         %forward_info = (
876             'internal_ip'   => $1,
877             'external_port' => $2,
878         );
879
880         ### check to see if access is allowed to internal IP
881         unless (&is_ip_included($forward_info{'internal_ip'},
882                 $access_hr->{'INTERNAL_NET_ACCESS'},
883                 $access_hr->{'internal_net_exceptions'})) {
884             &logr('[-]', "FORWARD access to $forward_info{'internal_ip'} " .
885                 "restricted (SOURCE line num: ".
886                 "$access_hr->{'src_line_num'})", $NO_MAIL);
887             return 0;
888         }
889         my $port_ctr = 0;
890         for my $proto (keys %open_ports) {
891             for my $port (keys %{$open_ports{$proto}}) {
892                 $port_ctr++;
893             }
894         }
895         ### we can only map one forwarding port on the external interface
896         ### to be forwarded to one internal service
897         if ($port_ctr > 1) {
898             &logr('[-]', "cannot forward more than one port " .
899                 "(SOURCE line num: $access_hr->{'src_line_num'})", $NO_MAIL);
900             return 0;
901         }
902     } else {
903         if ($access_hr->{'ENABLE_FORWARD_ACCESS'}) {
904             &logr('[-]', "non-forward access requested through FORWARD " .
905                 "access SOURCE block (SOURCE line num: " .
906                 "$access_hr->{'src_line_num'})", $NO_MAIL);
907             return 0;
908         }
909     }
910
911     if ($decrypt_algo == $ALG_GNUPG) {
912         if ($access_hr->{'GPG_REMOTE_ID'} ne 'ANY') {
913             &logr('[+]', "received valid GnuPG encrypted packet " .
914                 qq|(signed with required key ID: "$gpg_sign_id") from: | .
915                 "$src_ip, remote user: $msg_hr->{'username'}, " .
916                 "client version: $msg_hr->{'remote_version'} " .
917                 "(SOURCE line num: $access_hr->{'src_line_num'})", $NO_MAIL);
918         } else {
919             &logr('[+]', "received valid GnuPG encrypted packet " .
920                 "from: $src_ip, remote user: $msg_hr->{'username'}, " .
921                 "client version: $msg_hr->{'remote_version'} " .
922                 "(SOURCE line num: $access_hr->{'src_line_num'})",
923                 $NO_MAIL);
924         }
925     } else {
926         &logr('[+]', "received valid Rijndael encrypted " .
927             "packet from: $src_ip, remote user: $msg_hr->{'username'}, " .
928             "client version: $msg_hr->{'remote_version'} " .
929             "(SOURCE line num: $access_hr->{'src_line_num'})",
930             $NO_MAIL);
931     }
932
933     ### cache the digest
934     $digest_store{$digest} = $src_ip;
935
936     ### write digest to disk
937     &diskwrite_digest($digest, $src_ip)
938         if $config{'ENABLE_DIGEST_PERSISTENCE'} eq 'Y';
939
940     ### grant access through the firewall
941     &grant_access($allow_src, \%forward_info, {}, \%open_ports, $access_hr);
942
943     return 1;
944 }
945
946 sub SPA_cmd() {
947     my ($msg_hr, $src_ip, $decrypt_algo, $gpg_sign_id,
948         $digest, $access_hr) = @_;
949
950     unless ($access_hr->{'ENABLE_CMD_EXEC'}) {
951         &logr('[-]', qq|received command "$msg_hr->{'action'}" | .
952                 "but command mode not enabled for $src_ip", $SEND_MAIL);
953         return 0;
954     }
955
956     if (defined $access_hr->{'CMD_REGEX'}) {
957         unless ($msg_hr->{'action'} =~ m|$access_hr->{'CMD_REGEX'}|) {
958             &logr('[-]', qq|received command "$msg_hr->{'action'}" | .
959                     "from $src_ip but CMD_REGEX did not match $src_ip",
960                     $SEND_MAIL);
961             return 0;
962         }
963     }
964
965     my $cmd = $msg_hr->{'action'};
966     my $run_cmd = '';
967     my $cmd_ip  = '';
968
969     if ($cmd =~ m|^\s*($ip_re),(.*)|) {
970         $cmd_ip  = $1;
971         $run_cmd = $2;
972     } else {
973         $run_cmd = $cmd;
974     }
975
976     ### pre-1.0 versions did not prepend command string with "<ip>,"
977     if ($cmd_ip eq '0.0.0.0') {
978         if ($config{'REQUIRE_SOURCE_ADDRESS'} eq 'Y' or not
979                 &is_ip_included($cmd_ip,
980                     $access_hr->{'REQUIRE_SOURCE_ADDRESS'},
981                     $access_hr->{'require_src_addr_exceptions'})) {
982             &logr('[-]', "IP: $src_ip sent SPA packet that " .
983                 "contained 0.0.0.0 (-s on the client side) " .
984                 "but REQUIRE_SOURCE_ADDRESS is enabled " .
985                 "(SOURCE line num: $access_hr->{'src_line_num'})",
986                 $SEND_MAIL);
987             return 0;
988         }
989     }
990
991     if ($decrypt_algo == $ALG_GNUPG) {
992         if ($access_hr->{'GPG_REMOTE_ID'} ne 'ANY') {
993             &logr('[+]', "received valid GnuPG encrypted packet " .
994                 qq|(signed with required key ID: "$gpg_sign_id") from: | .
995                 "$src_ip, remote user: $msg_hr->{'username'}",
996                 $NO_MAIL);
997         } else {
998             &logr('[+]', "received valid GnuPG encrypted packet " .
999                 "from: $src_ip, remote user: $msg_hr->{'username'}",
1000                 $NO_MAIL);
1001         }
1002     } else {
1003         &logr('[+]', "received valid Rijndael encrypted " .
1004             "packet from: $src_ip, remote user: $msg_hr->{'username'}",
1005             $NO_MAIL);
1006     }
1007
1008     &logr('[+]', qq|executing command "$run_cmd" for $src_ip|, $SEND_MAIL);
1009
1010     ### cache the digest
1011     $digest_store{$digest} = $src_ip;
1012
1013     ### write the digest to disk
1014     &diskwrite_digest($digest, $src_ip)
1015         if $config{'ENABLE_DIGEST_PERSISTENCE'} eq 'Y';
1016
1017     ### execute the command
1018     &exec_command($run_cmd);
1019
1020     return 1;
1021 }
1022
1023 sub check_replay_attack() {
1024     my ($decrypted_data, $src_ip) = @_;
1025
1026     my $rv = 0;
1027     my @digests = ();
1028     my $disk_write_digest = '';
1029
1030     if ($config{'DIGEST_TYPE'} eq 'ALL') {
1031         push @digests, sha256_base64($decrypted_data);
1032         push @digests, sha1_base64($decrypted_data);
1033         push @digests, md5_base64($decrypted_data);
1034     } else {
1035         if ($config{'DIGEST_TYPE'} =~ /SHA256/) {
1036             push @digests, sha256_base64($decrypted_data);
1037         }
1038         if ($config{'DIGEST_TYPE'} =~ /SHA1/) {
1039             push @digests, sha1_base64($decrypted_data);
1040         }
1041         if ($config{'DIGEST_TYPE'} =~ /MD5/) {
1042             push @digests, md5_base64($decrypted_data);
1043         }
1044     }
1045
1046     if (@digests) {
1047
1048         ### this prefers SHA256 because of the ordering above.
1049         $disk_write_digest = $digests[0];
1050
1051         for my $digest (@digests) {
1052             if (defined $digest_store{$digest}) {
1053                 ### Replay attack!  Send warning email and return.
1054                 if ($digest_store{$digest}) {
1055                     &logr('[-]', "attempted SPA packet replay from: $src_ip " .
1056                         "(original SPA src: $digest_store{$digest}, " .
1057                         "digest: $digest)",
1058                         $SEND_MAIL);
1059                 } else {
1060                     &logr('[-]', "attempted SPA packet replay from: $src_ip " .
1061                         "($digest: $digest)", $SEND_MAIL);
1062                 }
1063
1064                 ### see if we need to exit if the packet limit (set with -C on the
1065                 ### command line) has been reached
1066                 if ($packet_limit) {
1067                     $packet_ctr++;
1068                     if ($packet_ctr >= $packet_limit) {
1069                         &logr('[+]', "packet limit ($packet_limit) reached, " .
1070                             "exiting.", $NO_MAIL);
1071                         exit 0;
1072                     }
1073                 }
1074                 $rv = 1;
1075                 last;
1076             }
1077         }
1078     } else {
1079         ### could not calculate the digest for some reason; don't
1080         ### trust the packet
1081         &logr('[-]', "could not calculate digest " .
1082             "for SPA packet from: $src_ip", $SEND_MAIL);
1083         $rv = 1;
1084     }
1085     return $rv, $disk_write_digest;
1086 }
1087
1088 sub server_auth_verify_crypt_pw() {
1089     my ($username, $pw, $shadow_file) = @_;
1090
1091     unless (-e $shadow_file) {
1092         &logr('[-]', "shadow file $shadow_file does not exist", $NO_MAIL);
1093         return 0;
1094     }
1095
1096     my $shadow_hash = '';
1097     open S, "< $shadow_file" or die "[*] Could not open $shadow_file: $!";
1098     while (<S>) {
1099         my $line = $_;
1100         if ($line =~ /^\s*$username:(\S+?):/) {
1101             $shadow_hash = $1;
1102         }
1103     }
1104     close S;
1105
1106     ### mbr:$1$nrU****************************:13108:0:99999:7:::
1107     unless ($shadow_hash) {
1108         &logr('[-]', "could not get password entry for $username " .
1109             "from /etc/shadow", $NO_MAIL);
1110         return 0;
1111     }
1112
1113     return 1 if (crypt($pw, $shadow_hash) eq $shadow_hash);
1114     return 0;
1115 }
1116
1117 sub knock_loop() {
1118     print STDERR localtime() . " [+] Opening $config{'FW_DATA_FILE'}, and ",
1119         "entering main loop.\n" if $debug;
1120
1121     ### main server loop
1122     open FWLOG, $config{'FW_DATA_FILE'} or die $!;
1123     for (;;) {
1124         my @fw_pkts = <FWLOG>;
1125         if (@fw_pkts and ($os_fprint_only or $skipped_first_loop)) {
1126             &process_pkts(\@fw_pkts);
1127         }
1128
1129         @fw_pkts = ();
1130         $skipped_first_loop = 1 unless $skipped_first_loop;
1131
1132         ### always check to see if we need to timeout knock sequences
1133         ### that exceed the KNOCK_INTERVAL
1134         &timeout_invalid_sequences();
1135
1136         &write_die_msg() if $die_msg;
1137         &write_warn_msg() if $warn_msg;
1138
1139         ### clearerr() on the FWLOG filehandle to be ready for new packets
1140         FWLOG->clearerr();
1141
1142         sleep $config{'SLEEP_INTERVAL'};
1143     }
1144     close FWLOG;
1145     return;
1146 }
1147
1148 sub pcap_validate_msg() {
1149     my ($msg, $source_block_num, $access_hr) = @_;
1150
1151     my %msg_hsh = (
1152         'random_number'   => 0,
1153         'username'        => '',
1154         'remote_time'     => 0,
1155         'remote_version'  => '',
1156         'numeric_version' => 0,   ### calculated locally by fwknopd
1157         'action_type'     => -1,
1158         'action'          => '',
1159         'server_auth'     => '',  ### optional
1160         'forward_info'    => '',  ### optional
1161         'client_timeout'  => -1,  ### optional
1162         'digest'          => '',
1163     );
1164
1165     ### the last field in the SPA packet is the digest, so see if it
1166     ### checks out first (this is the internal digest, not the digest that
1167     ### guards against replay attacks).
1168     unless (&check_digest($msg, \%msg_hsh)) {
1169         print STDERR localtime() . " [-] Key mis-match or broken message ",
1170             "checksum for SOURCE $access_hr->{'src_str'} ",
1171             "(# $source_block_num in access.conf)\n"
1172             if $debug;
1173         return 0, {};
1174     }
1175
1176     my @fields = split /:/, $msg;
1177
1178     unless (@fields) {
1179         print STDERR localtime() . " [-] Could not split decrypted ",
1180             "message into array.\n" if $debug;
1181         return 0, {};
1182     }
1183
1184     unless ($#fields >= $SPA_MIN_PACKET_FIELDS
1185             and $#fields <= $SPA_MIN_PACKET_FIELDS + 1) {
1186         print STDERR localtime() . " [-] Invalid number of fields in ",
1187             "SPA packet.\n" if $debug;
1188         return 0, {};
1189     }
1190
1191     ### random number
1192     if (&is_digit($fields[0])) {
1193         $msg_hsh{'random_number'} = $fields[0];
1194     } else {
1195         &logr('[-]', "non-digit random number in decrypted SPA packet",
1196             $SEND_MAIL);
1197         return 0, {};
1198     }
1199
1200     ### username
1201     $msg_hsh{'username'} = decode_base64($fields[1]);
1202
1203     ### timestamp
1204     if (&is_digit($fields[2])) {
1205         $msg_hsh{'remote_time'} = $fields[2];
1206     } else {
1207         &logr('[-]', "non-digit timestamp in decrypted SPA packet",
1208             $SEND_MAIL);
1209         return 0, {};
1210     }
1211
1212     ### remote client version
1213     $msg_hsh{'remote_version'} = $fields[3];
1214     unless (&SPA_parse_client_version(\%msg_hsh)) {
1215         &logr('[-]', "invalid client string in decrypted SPA packet",
1216             $SEND_MAIL);
1217         return 0, {};
1218     }
1219
1220     ### message type
1221     if (&is_digit($fields[4])) {
1222         return 0, {} unless $fields[4] == $SPA_COMMAND_MODE
1223                 or $fields[4] == $SPA_ACCESS_MODE
1224                 or $fields[4] == $SPA_FORWARD_ACCESS_MODE
1225                 or $fields[4] == $SPA_CLIENT_TIMEOUT_ACCESS_MODE
1226                 or $fields[4] == $SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE;
1227         $msg_hsh{'action_type'} = $fields[4];
1228     } else {
1229         &logr('[-]', "non-digit action type in decrypted SPA packet",
1230             $SEND_MAIL);
1231         return 0, {};
1232     }
1233
1234     ### action
1235     $msg_hsh{'action'} = decode_base64($fields[5]);
1236
1237     ### server_auth was introduced in 0.9.3
1238     if ($msg_hsh{'numeric_version'} >= 93) {
1239
1240         ### iptables FORWARD/DNAT access was introduced in 1.9.0
1241         if ($msg_hsh{'numeric_version'} >= 190) {
1242             my $found = 0;
1243             if ($msg_hsh{'action_type'} == $SPA_FORWARD_ACCESS_MODE) {
1244                 if ($#fields == $SPA_MIN_PACKET_FIELDS+1) {
1245                     $msg_hsh{'forward_info'} = decode_base64($fields[6]);
1246                     $found = 1;
1247                 }
1248             } elsif ($msg_hsh{'numeric_version'} >= 192) {
1249                 ### client timeouts were introduced in 1.9.2
1250                 if ($msg_hsh{'action_type'} == $SPA_CLIENT_TIMEOUT_ACCESS_MODE) {
1251                     $msg_hsh{'client_timeout'} = $fields[6];
1252                     $found = 1;
1253                 } elsif ($msg_hsh{'action_type'}
1254                             == $SPA_CLIENT_TIMEOUT_FORWARD_ACCESS_MODE) {
1255                     $msg_hsh{'client_timeout'} = $fields[7];
1256                     $found = 1;
1257                 }
1258             }
1259             unless ($found) {
1260                 if ($#fields > $SPA_MIN_PACKET_FIELDS) {
1261                     $msg_hsh{'server_auth'} = decode_base64($fields[6]);
1262                 }
1263             }
1264         } else {
1265             if ($#fields > $SPA_MIN_PACKET_FIELDS) {
1266                 $msg_hsh{'server_auth'} = decode_base64($fields[6]);
1267             }
1268         }
1269     } else {
1270         unless ($#fields == $SPA_MIN_PACKET_FIELDS) {
1271             print STDERR localtime() . " [-] SPA packet from version: ",
1272                 "$msg_hsh{'remote_version'} ",
1273                 "does not have $SPA_MIN_PACKET_FIELDS fields"
1274                 if $debug;
1275             return 0, {};
1276         }
1277     }
1278
1279     print STDERR Dumper \%msg_hsh if $debug and $verbose;
1280
1281     if ($debug) {
1282         print STDERR localtime() .
1283             " [+] Decoded message: $msg_hsh{'random_number'}:",
1284             "$msg_hsh{'username'}:$msg_hsh{'remote_time'}:",
1285             "$msg_hsh{'remote_version'}:$msg_hsh{'action_type'}:",
1286             "$msg_hsh{'action'}";
1287
1288         if ($msg_hsh{'forward_info'}) {
1289             print STDERR ":$msg_hsh{'forward_info'}";
1290         }
1291
1292         if ($msg_hsh{'client_timeout'}) {
1293             print STDERR ":$msg_hsh{'client_timeout'}";
1294         }
1295
1296         ### careful not to display password information
1297         if ($msg_hsh{'server_auth'}
1298                 and $msg_hsh{'server_auth'} =~ /^\s*(\w+),(.*)/) {
1299
1300             print STDERR ":$1,";
1301             for (my $i=0; $i < length($2); $i++) {
1302                 print STDERR "*";
1303             }
1304         }
1305
1306         print STDERR ":$msg_hsh{'digest'}\n";
1307     }
1308     return 1, \%msg_hsh;
1309 }
1310
1311 sub SPA_parse_client_version() {
1312     my $msg_hr = shift;
1313
1314     my $ver = '';
1315     if ($msg_hr->{'remote_version'} =~ /^(\d+\.\d+\.\d+)-pre\d+$/) {
1316         ### remote client is a -pre release
1317         $ver = $1;
1318     } elsif ($msg_hr->{'remote_version'} =~ /^(\d+\.\d+\.\d+)$/) {
1319         $ver = $1;
1320     } elsif ($msg_hr->{'remote_version'} =~ /^(\d+\.\d+)-pre\d+$/) {
1321         ### remote client is a -pre release
1322         $ver = $1;
1323     } elsif ($msg_hr->{'remote_version'} =~ /^(\d+\.\d+)$/) {
1324         $ver = $1;
1325     } else {
1326         print STDERR localtime() . " [-] Could not determine remote ",
1327             "client numeric version." if $debug;
1328         return 0;
1329     }
1330
1331     $ver =~ s|\.||g;
1332     $ver =~ s|^0||;
1333     $msg_hr->{'numeric_version'} = $ver;
1334
1335     print STDERR localtime() . " [+] Remote client numeric version: $ver\n"
1336         if $debug;
1337     return 1;
1338 }
1339
1340 sub check_digest() {
1341     my ($msg_str, $hr) = @_;
1342
1343     my $rv = 0;
1344     if ($msg_str =~ /(.*):(\S+)/) {
1345         my $msg = $1;
1346         my $sum = $2;
1347         if (length($sum) == $SHA256_DIGEST_LEN) {
1348             if ($sum eq sha256_base64($msg)) {
1349                 $hr->{'digest_str'} = 'SHA256';
1350                 $hr->{'digest'} = $sum;
1351                 $rv = 1;
1352             }
1353         } elsif (length($sum) == $SHA1_DIGEST_LEN) {
1354             if ($sum eq sha1_base64($msg)) {
1355                 $hr->{'digest_str'} = 'SHA1';
1356                 $hr->{'digest'} = $sum;
1357                 $rv = 1;
1358             }
1359         } elsif (length($sum) == $MD5_DIGEST_LEN) {
1360             if ($sum eq md5_base64($msg)) {
1361                 $hr->{'digest_str'} = 'MD5';
1362                 $hr->{'digest'} = $sum;
1363                 $rv = 1;
1364             }
1365         }
1366     }
1367     return $rv;
1368 }
1369
1370 sub get_pcap_obj() {
1371
1372     my $pcap_t  = '';
1373     my $filter  = '';
1374     my $err     = '';
1375     my $netmask = 0;
1376     my $address = 0;
1377
1378     if ($config{'AUTH_MODE'} eq 'FILE_PCAP'
1379             or $config{'AUTH_MODE'} eq 'ULOG_PCAP') {
1380
1381         unless (-e $config{'PCAP_PKT_FILE'}) {
1382             &pcap_file_exists_loop();
1383         }
1384
1385         unless (-s $config{'PCAP_PKT_FILE'} > 0) {
1386             ### required since we cannot use Net::Pcap::open_offline()
1387             ### to open a zero-size pcap file.
1388             &pcap_nonzero_size_loop();
1389         }
1390
1391         print STDERR localtime() . " [+] Acquiring packet data from file: ",
1392             "$config{'PCAP_PKT_FILE'}\n" if $debug;
1393
1394         $pcap_t = Net::Pcap::open_offline($config{'PCAP_PKT_FILE'}, \$err)
1395             or die "[*] Could not open $config{'PCAP_PKT_FILE'}: $err";
1396
1397         ### get past any packets that were from a previous fwknopd
1398         ### execution.
1399         Net::Pcap::loop($pcap_t, -1, \&null_func, 'fwknop_tag');
1400
1401     } else {
1402         if ($config{'ENABLE_PCAP_PROMISC'} eq 'Y') {
1403             print STDERR localtime() . " [+] Sniffing (promisc) packet data ",
1404                 "from interface: $config{'PCAP_INTF'}\n" if $debug;
1405             $pcap_t = Net::Pcap::open_live($config{'PCAP_INTF'},
1406                 1500, 1, 100, \$err) or die "[*] Could not open ",
1407                     "$config{'PCAP_INTF'}: $!";
1408         } else {
1409             print STDERR localtime() . " [+] Sniffing (non-promisc) packet ",
1410                 "data from interface: $config{'PCAP_INTF'}\n" if $debug;
1411             $pcap_t = Net::Pcap::open_live($config{'PCAP_INTF'},
1412                 1500, 0, 100, \$err) or die "[*] Could not open ",
1413                     "$config{'PCAP_INTF'}: $!";
1414         }
1415     }
1416
1417     ### apply pcap filter if necessary
1418     if ($config{'PCAP_FILTER'} ne 'NONE') {
1419         if ($config{'AUTH_MODE'} eq 'PCAP') {
1420             if (Net::Pcap::lookupnet($config{'PCAP_INTF'}, \$address,
1421                 \$netmask, \$err) != 0) {
1422                 die "[*] Could not get net information for ",
1423                     "$config{'PCAP_INTF'}: $!";
1424             }
1425         }
1426
1427         ### set the filter on the traffic
1428         Net::Pcap::compile($pcap_t, \$filter, $config{'PCAP_FILTER'},
1429             0, $netmask)
1430             && die '[*] Unable to compile packet capture filter';
1431         Net::Pcap::setfilter($pcap_t, $filter)
1432             && die '[*] Unable to set packet capture filter';
1433     }
1434
1435     return $pcap_t;
1436 }
1437
1438 sub pcap_file_exists_loop() {
1439     while (not -e $config{'PCAP_PKT_FILE'}) {
1440         &logr('[-]', "pcap file $config{'PCAP_PKT_FILE'} does not " .
1441             "exist, waiting $err_wait_timer seconds for sniffer to " .
1442             "create file", $NO_MAIL);
1443         sleep $err_wait_timer;
1444     }
1445     return;
1446 }
1447
1448 sub pcap_nonzero_size_loop() {
1449     while (-s $config{'PCAP_PKT_FILE'} == 0) {
1450         &logr('[-]', "zero size pcap file $config{'PCAP_PKT_FILE'}, " .
1451             "waiting $err_wait_timer seconds for packet data", $NO_MAIL);
1452         sleep $err_wait_timer;
1453     }
1454     return;
1455 }
1456
1457 sub exec_command() {
1458     my $cmd = shift;
1459     my $pid;
1460     if ($pid = fork()) {
1461         local $SIG{'ALRM'} = sub {die "[*] External script timeout.\n"};
1462         ### the external script should be finished within this timeout
1463         alarm $config{'PCAP_CMD_TIMEOUT'};
1464         eval {
1465             waitpid($pid, 0);
1466         };
1467         alarm 0;
1468         if ($@) {
1469             kill 9, $pid unless kill 15, $pid;
1470         }
1471     } else {
1472         die "[*] Could not fork for external script: $!" unless defined $pid;
1473         ### if we are already redirecting output within the command itself
1474         ### then don't redirect again
1475         if ($cmd =~ /\s*>\s*/) {
1476             exec qq{$cmd};
1477         } else {
1478             exec qq{$cmd > /dev/null 2>&1};
1479         }
1480     }
1481     return;
1482 }
1483
1484 ### knock server processsing
1485 sub process_pkts() {
1486     my $fw_pkts_aref = shift;
1487     PKT: for my $pkt (@$fw_pkts_aref) {
1488         my $src = '';
1489         my $dst = '';
1490         my $len = -1;
1491         my $tos = '';
1492         my $ttl = -1;
1493         my $id  = -1;
1494         my $proto = '';
1495         my $sp    = -1;
1496         my $dp    = -1;
1497         my $win   = -1;
1498         my $type  = -1;
1499         my $code  = -1;
1500         my $seq   = -1;
1501         my $flags = '';
1502         my $frag_bit = 0;
1503         my $tcp_options = '';
1504         next unless $pkt =~ /kernel.*IN=.*OUT=/;
1505         ### May 18 22:21:26 orthanc kernel: DROP IN=eth2 OUT=
1506         ### MAC=00:60:1d:23:d0:01:00:60:1d:23:d3:0e:08:00 SRC=192.168.20.25
1507         ### DST=192.168.20.1 LEN=60 TOS=0x10 PREC=0x00 TTL=64 ID=47300 DF
1508         ### PROTO=TCP SPT=34111 DPT=6345 WINDOW=5840 RES=0x00 SYN URGP=0
1509         if ($pkt =~ /SRC=(\S+)\s+DST=(\S+)\s+LEN=(\d+)\s+TOS=(\S+)
1510                     \s*.*\s+TTL=(\d+)\s+ID=(\d+)\s*.*\s+PROTO=TCP\s+
1511                     SPT=(\d+)\s+DPT=(\d+)\s+WINDOW=(\d+)\s+
1512                     RES=\S+\s*(.*)\s+URGP=/x) {
1513             ($src, $dst, $len, $tos, $ttl, $id, $sp, $dp, $win, $flags) =
1514                 ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10);
1515             if ($pkt =~ /\sRES=\S+\s*(.*)\s+URGP=/) {
1516                     $flags = $1;
1517             }
1518             $proto = 'tcp';
1519             unless ($flags !~ /WIN/ &&
1520                     $flags =~ /ACK/ ||
1521                     $flags =~ /SYN/ ||
1522                     $flags =~ /RST/ ||
1523                     $flags =~ /URG/ ||
1524                     $flags =~ /PSH/ ||
1525                     $flags =~ /FIN/ ||
1526                     $flags eq 'NULL') {
1527                 print STDERR localtime() . " [*] err packet: bad tcp flags.\n"
1528                     if $debug;
1529                 next PKT;
1530             }
1531             $frag_bit = 1 if $pkt =~ /\sDF\s+PROTO/;
1532             ### don't pickup IP options if --log-ip-options is used
1533             ### (they appear before the PROTO= field).
1534             if ($pkt =~ /URGP=\S+\s+OPT\s+\((\S+)\)/) {
1535                 $tcp_options = $1;
1536             }
1537             $tcp_ctr++;
1538
1539             ### Jul 15 23:32:53 orthanc kernel: DROP IN=eth1 OUT=
1540             ### MAC=00:0c:41:24:68:ef:00:0c:41:24:56:37:08:00 SRC=192.168.10.3
1541             ### DST=192.168.10.1 LEN=29 TOS=0x00 PREC=0x00 TTL=64 ID=48500 DF
1542             ### PROTO=UDP SPT=32768 DPT=65533 LEN=9
1543         } elsif ($pkt =~ /SRC=(\S+)\s+DST=(\S+)\s+LEN=(\d+)\s+TOS=(\S+)\s+
1544                           .*?\sTTL=(\d+)\s+ID=(\d+)\s*.*\sPROTO=UDP\s+
1545                           SPT=(\d+)\s+DPT=(\d+)/x) {
1546             ($src, $dst, $len, $tos, $ttl, $id, $sp, $dp) =
1547                 ($1,$2,$3,$4,$5,$6,$7,$8);
1548             $proto = 'udp';
1549             ### make sure we have a "reasonable" packet (note that nmap
1550             ### can scan port 0 and iptables can report this fact)
1551             unless ($src and $dst and $len >= 0 and $tos and $ttl >= 0
1552                     and $id >= 0 and $sp >= 0 and $dp >= 0) {
1553                 next PKT;
1554             }
1555             $udp_ctr++;
1556         } elsif ($pkt =~ /SRC=(\S+)\s+DST=(\S+)\s+LEN=(\d+).*
1557                           TTL=(\d+).*PROTO=ICMP\s+TYPE=(\d+)\s+
1558                           CODE=(\d+)\s+ID=(\d+)\s+SEQ=(\d+)/x) {
1559             ($src, $dst, $len, $ttl, $type, $code, $id, $seq) =
1560                 ($1,$2,$3,$4,$5,$6,$7,$8);
1561             $proto = 'icmp';
1562             unless ($src and $dst and $len >= 0 and $ttl >= 0 and $proto
1563                     and $type >= 0 and $code >= 0 and $id >= 0
1564                     and $seq >= 0) {
1565                 next PKT;
1566             }
1567             $proto = 'icmp';
1568             $icmp_ctr++;
1569         } else {
1570             print STDERR localtime() . " [-] no regex match for pkt: $pkt\n"
1571                 if $debug;
1572         }
1573
1574         ### check to see if there are any access directives for $src, and
1575         ### if not we will do _nothing_ with this IP (unless we are just
1576         ### trying to fingerprint it).
1577         my $access_nums_aref = &check_src($src) unless $os_fprint_only;
1578
1579         unless ($os_fprint_only) {
1580             unless ($access_nums_aref) {
1581                 print STDERR localtime() . " [-] Packet from $src did not ",
1582                     "match any SOURCE in $config{'ACCESS_CONF'}\n" if $debug;
1583                 next PKT;
1584             }
1585         }
1586
1587         if ($proto eq 'tcp') {
1588             print STDERR localtime() . " [+] $proto $src $sp -> $dst $dp, ",
1589                 "$flags\n" if $debug;
1590         } elsif ($proto eq 'udp') {
1591             print STDERR localtime() . " [+] $proto $src $sp -> $dst ",
1592                 "$dp\n" if $debug;
1593         } elsif ($proto eq 'icmp') {
1594             print STDERR localtime() . " [+] $proto $src -> $dst\n" if $debug;
1595         }
1596
1597         ### try to fingerprint the remote OS even though the knock
1598         ### sequence is not validated yet.
1599         if ($proto eq 'tcp' and $flags =~ /SYN/) {  ### must have a SYN pkt
1600             if ($tcp_options) {  ### hopefully --log-tcp-options is being used
1601
1602                 ### p0f based fingerprinting
1603                 &p0f($src, $len, $frag_bit, $ttl, $win, $tcp_options);
1604             }
1605         }
1606
1607         next PKT if $os_fprint_only;
1608
1609         my $expecting_decrypt = 0;
1610         my $decrypted = 0;
1611
1612         NUM: for my $num (@$access_nums_aref) {
1613             my $access_hr = $access[$num];
1614
1615             $ip_sequences{$src}{$num} = {}
1616                 unless defined $ip_sequences{$src}{$num};
1617
1618             my $seq_href = $ip_sequences{$src}{$num};
1619
1620             ### keep track of which source block we are dealing with from
1621             ### access.conf
1622             my $source_block_num = $access_hr->{'block_num'};
1623
1624             $seq_href->{'grant_ctr'} = 0
1625                 if not defined $seq_href->{'grant_ctr'};
1626
1627             ### see if the destination port is part of the correct knock sequence
1628             ### for this source
1629             my $matched_sequence = 0;
1630
1631             if ($access_hr->{'DATA_COLLECT_MODE'} == $ENCRYPT_SEQUENCE) {
1632                 if ($dp >= $access_hr->{'PORT_OFFSET'} and
1633                         $dp < $access_hr->{'PORT_OFFSET'} + 256) {
1634
1635                     ### keep timestamp for when we started tracking the
1636                     ### encrypted sequence
1637                     $seq_href->{'enc_stime'} = time()
1638                         unless defined $seq_href->{'enc_stime'};
1639
1640                     ### add the destination port to the encrypted sequence
1641                     push @{$seq_href->{'enc_ports'}}, $dp;
1642
1643                     print STDERR localtime() . " [+] Added $dp to encrypted ",
1644                         "sequence for $src ",
1645                         "(packet: $#{$seq_href->{'enc_ports'}})\n"
1646                         if $debug;
1647                 }
1648
1649                 ### see if the encrypted sequence checks out
1650                 if ($#{$seq_href->{'enc_ports'}}
1651                         == $enc_blocksize - 1) {
1652
1653                     $expecting_decrypt = 1;
1654
1655                     ### attempt to decrypt the sequence
1656                     my ($rv, $allow_src, $dec_allow_port,
1657                         $dec_allow_proto, $username) =
1658                             &decrypt_sequence($src, $seq_href,
1659                                 $access_hr);
1660
1661                     if ($rv) {
1662                         $decrypted = 1;
1663
1664                         &logr('[+]', "successful knock decrypt for $src " .
1665                             "(SOURCE block: $source_block_num)", $SEND_MAIL);
1666
1667                         ### see if we need to match the OS
1668                         unless (&matched_os($src, $access_hr)) {
1669                             delete $ip_sequences{$src}{$num};
1670                             next NUM;
1671                         }
1672
1673                         ### see if we need to match the username
1674                         unless (&matched_username($username,
1675                                 $access_hr)) {
1676                             delete $ip_sequences{$src}{$num};
1677                             next NUM;
1678                         }
1679
1680                         ### check to see if we have already exceeded the
1681                         ### maximum number of allowed sequences (this helps
1682                         ### to prevent replay attacks).
1683                         if (defined $access_hr->{'KNOCK_LIMIT'}) {
1684                             if ($seq_href->{'grant_ctr'}
1685                                     > $access_hr->{'KNOCK_LIMIT'}) {
1686                                 &logr('[-]', "$src exceeded knock limit (set to " .
1687                                     "$access_hr->{'KNOCK_LIMIT'} accesses)",
1688                                     $SEND_MAIL);
1689                                 &logr('[-]', "access controls for $src will " .
1690                                     "not be modified", $SEND_MAIL);
1691                                 delete $ip_sequences{$src}{$num};
1692                                 next NUM;
1693                             }
1694                         }
1695
1696                         ### all criteria met; grant access
1697                         my %open_ports = %{$access_hr->{'OPEN_PORTS'}};
1698                         $open_ports{$dec_allow_proto}{$dec_allow_port} = '';
1699
1700                         &grant_access($allow_src, {}, $seq_href,
1701                             \%open_ports, $access_hr);
1702
1703                     }
1704                     delete $ip_sequences{$src}{$num};
1705                     next NUM;
1706                 }
1707             } elsif (defined $access_hr->{'SHARED_SEQUENCE'}) {
1708                 $seq_href->{'port_seq'} = 0
1709                     unless defined $seq_href->{'port_seq'};
1710                 if ($dp == $access_hr->{'SHARED_SEQUENCE'}->
1711                             [$seq_href->{'port_seq'}]->{'port'}
1712                         and $proto eq $access_hr->{'SHARED_SEQUENCE'}->
1713                             [$seq_href->{'port_seq'}]->{'proto'}) {
1714
1715                     push @{$seq_href->{'port_times'}}, time();
1716
1717                     ### increment sequence counter (takes into account timing
1718                     ### requirements).
1719                     next NUM unless &incr_seq($src, $seq_href, $access_hr);
1720
1721                     ### if we made it to the end of the sequence then we have
1722                     ### a correct knock sequence
1723                     if ($seq_href->{'port_seq'}
1724                             == $#{$access_hr->{'SHARED_SEQUENCE'}}+1) {
1725                         print STDERR localtime() . " [+] Matched knock ",
1726                             "sequence for $src\n" if $debug;
1727                         $matched_sequence = 1;
1728                     }
1729                 } else {
1730                     print STDERR localtime() . " [-] Could not match dst ",
1731                         "port: $dp at sequence ",
1732                         "number: $seq_href->{'port_seq'}\n"
1733                         if $debug;
1734                     delete $ip_sequences{$src}{$num};
1735                     next NUM;
1736                 }
1737             }
1738
1739             ### we matched the knock sequence, so reset for new
1740             ### sequence (note we may have other criteria to meet
1741             ### before actually granting access).
1742             if ($matched_sequence) {
1743                 delete $seq_href->{'port_times'};
1744                 $seq_href->{'port_seq'} = 0;
1745
1746                 &logr('[+]', "port knock access sequence matched for $src " .
1747                     "(SOURCE block: $source_block_num)", $SEND_MAIL);
1748
1749                 next NUM unless &matched_os($src, $seq_href);
1750
1751                 ### check to see if we have already exceeded the maximum number
1752                 ### of allowed sequences (this helps to prevent replay attacks).
1753                 if (defined $access_hr->{'KNOCK_LIMIT'}) {
1754                     if ($seq_href->{'grant_ctr'}
1755                             > $access_hr->{'KNOCK_LIMIT'}) {
1756                         &logr('[-]', "$src exceeded knock limit (set to " .
1757                             "$access_hr->{'KNOCK_LIMIT'} accesses)",
1758                             $SEND_MAIL);
1759                         &logr('[-]', "access controls for $src will not be " .
1760                             "modified", $SEND_MAIL);
1761                         next NUM;
1762                     }
1763                 }
1764
1765                 ### if we made it here then we need to grant access by modifying
1766                 ### the iptables ruleset (if the ruleset does not already allow
1767                 ### $src of course)
1768                 &grant_access($src, {}, $seq_href,
1769                     $access_hr->{'OPEN_PORTS'}, $access_hr);
1770             }
1771         }
1772         if ($expecting_decrypt and not $decrypted) {
1773             &logr('[-]', "sequence decrypt failed for $src", $SEND_MAIL);
1774         }
1775     }
1776
1777     if ($os_fprint_only) {
1778         &print_p0f();
1779     }
1780     return;
1781 }
1782
1783 sub matched_os() {
1784     my ($src, $href) = @_;
1785
1786     ### see if we require any OS match at all
1787     return 1 unless (defined $href->{'REQUIRE_OS'} or
1788             defined $href->{'REQUIRE_OS_REGEX'});
1789
1790     unless (defined $p0f{$src}) {
1791         ### could not guess the OS
1792         if (defined $href->{'REQUIRE_OS'}) {
1793             &logr('[-]', "could not fingerprint OS for $src, expecting OS: " .
1794                 $href->{'REQUIRE_OS'}, $SEND_MAIL);
1795         } elsif (defined $href->{'REQUIRE_OS_REGEX'}) {
1796             &logr('[-]', "could not fingerprint OS for $src, expecting OS " .
1797                 "regex: $href->{'REQUIRE_OS_REGEX'}", $SEND_MAIL);
1798         }
1799         return 0;
1800     }
1801
1802     if (defined $href->{'REQUIRE_OS'}) {
1803         if (defined $p0f{$src}) {
1804             my $first_os_key = '';
1805             for my $os (keys %{$p0f{$src}}) {
1806                 $first_os_key = $os unless $first_os_key;
1807                 if ($os eq $href->{'REQUIRE_OS'}) {
1808                     &logr('[+]', "OS guess: $os " .
1809                         "matched for $src", $SEND_MAIL);
1810                     return 1;
1811                 }
1812             }
1813             ### there may be more than one OS fingerprint, but
1814             ### just print one (if we make it here there was no
1815             ### match).
1816             &logr('[-]', "OS fingerprint mismatch for $src: " .
1817                 "expected: $href->{'REQUIRE_OS'}, " .
1818                 "received: $first_os_key", $SEND_MAIL);
1819             return 0;
1820
1821         }
1822     } elsif (defined $href->{'REQUIRE_OS_REGEX'}) {
1823         if (defined $p0f{$src}) {
1824             my $first_os_key = '';
1825             for my $os (keys %{$p0f{$src}}) {
1826                 $first_os_key = $os unless $first_os_key;
1827                 if ($os =~ m|$href->{'REQUIRE_OS_REGEX'}|i) {
1828                     &logr('[+]', "OS guess: $os " .
1829                         "regex matched for $src", $SEND_MAIL);
1830                     return 1;
1831                 }
1832             }
1833
1834             ### there may be more than one OS fingerprint, but
1835             ### just print one.
1836             &logr('[-]', "OS fingerprint regex mismatch for $src: " .
1837                 "expected: $href->{'REQUIRE_OS_REGEX'}, " .
1838                 "received: $first_os_key", $SEND_MAIL);
1839             return 0;
1840         }
1841     }
1842     return 0;
1843 }
1844
1845 sub matched_username() {
1846     my ($username, $href) = @_;
1847
1848     return 1 unless defined $href->{'REQUIRE_USERNAME'};
1849
1850     if ($username) {
1851         if ($username eq $href->{'REQUIRE_USERNAME'}) {
1852             &logr('[+]', "username $username match", $NO_MAIL);
1853             return 1;
1854         } else {
1855             &logr('[-]', "username mismatch, expected: " .
1856                 "$href->{'REQUIRE_USERNAME'}, got: $username", $SEND_MAIL);
1857             return 0;
1858         }
1859     } else {
1860         &logr('[-]', "missing username in encrypted " .
1861             "sequence, expected: $href->{'REQUIRE_USERNAME'}", $SEND_MAIL);
1862         return 0;
1863     }
1864     return 0;
1865 }
1866
1867 sub check_src() {
1868     my $src = shift;
1869
1870     my @access_nums = ();
1871
1872     if (&is_ip_included($src, $blacklist_ar, $blacklist_exclude_ar)) {
1873         print STDERR localtime() . " [+] check_src() ",
1874             "$src in BLACKLIST" if $debug;
1875         return \@access_nums;
1876     }
1877
1878     ### now process the SOURCE stanzas
1879     for (my $i=0; $i<=$#access; $i++) {
1880         my $access_hr = $access[$i];
1881         my $matched_src = 0;
1882         if (&is_ip_included($src, $access_hr->{'SOURCE'},
1883                 $access_hr->{'exclude_nets'})) {
1884             print STDERR localtime() . " [+] Packet from $src matched ",
1885                 "$access_hr->{'src_str'} (line: ",
1886                 "$access_hr->{'src_line_num'})\n"
1887                 if $debug;
1888             push @access_nums, $i;
1889         }
1890     }
1891     return \@access_nums;
1892 }
1893
1894 sub is_ip_included() {
1895     my ($ip, $include_ar, $exclude_ar) = @_;
1896
1897     my $is_included = 0;
1898
1899     ### check the include criteria
1900     for my $net (@$include_ar) {
1901         if (ipv4_in_network($net, $ip)) {
1902             print STDERR localtime() . " [+] $ip included by $net\n"
1903                 if $debug;
1904             $is_included = 1;
1905             last;
1906         }
1907     }
1908
1909     if ($is_included) {
1910         ### check the exclude criteria
1911         for my $net (@$exclude_ar) {
1912             if (ipv4_in_network($net, $ip)) {
1913                 print STDERR localtime() . " [-] $ip excluded by ! $net\n"
1914                     if $debug;
1915                 $is_included = 0;
1916                 last;
1917             }
1918         }
1919     }
1920     return $is_included;
1921 }
1922
1923 sub incr_seq() {
1924     my ($src, $seq_href, $access_hr) = @_;
1925     if (defined $access_hr->{'MIN_TIME_DIFF'}) {
1926         ### can check relative timings only after we have more than
1927         ### one matching sequence packet
1928         if ($seq_href->{'port_seq'} > 0) {
1929             if (defined $access_hr->{'MAX_TIME_DIFF'}) {
1930                 my $time = time();
1931                 if (($time - $seq_href->{'port_times'}[$seq_href->{'port_seq'}-1])
1932                             > $access_hr->{'MIN_TIME_DIFF'} and
1933                         ($time - $seq_href->{'port_times'}[$seq_href->{'port_seq'}-1])
1934                             < $access_hr->{'MAX_TIME_DIFF'}) {
1935                     print STDERR localtime() . " [+] Sequence min/max time match: ",
1936                         "($seq_href->{'port_seq'}) ",
1937                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'proto'}/",
1938                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'port'}\n"
1939                         if $debug;
1940                 } else {
1941                     &logr('[-]', 'Sequence min/max_time exceeded: ' .
1942                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'proto'}/" .
1943                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'port'} " .
1944                         "(port sequence num: $seq_href->{'port_seq'}) ", $SEND_MAIL);
1945                     $seq_href->{'port_seq'} = 0;
1946                     delete $seq_href->{'port_times'};
1947                     return 0;
1948                 }
1949             } else {
1950                 if ((time()
1951                         - $seq_href->{'port_times'}[$seq_href->{'port_seq'}-1])
1952                         > $access_hr->{'MIN_TIME_DIFF'}) {
1953                     print STDERR localtime() . " [+] Sequence min_time match: ",
1954                         "($seq_href->{'port_seq'}) ",
1955                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'proto'}/",
1956                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'port'}\n"
1957                         if $debug;
1958                 } else {
1959                     &logr('[-]', "Sequence min_time (" .
1960                         "$access_hr->{'MIN_TIME_DIFF'} seconds) not met: " .
1961                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'proto'}/" .
1962                         "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'port'} " .
1963                         "(port sequence num: $seq_href->{'port_seq'}) ", $SEND_MAIL);
1964                     delete $seq_href->{'port_times'};
1965                     $seq_href->{'port_seq'} = 0;
1966                     return 0;
1967                 }
1968             }
1969         } else {
1970             print STDERR localtime() . " [+] 1 Sequence match: ",
1971                 "($seq_href->{'port_seq'}) ",
1972                 "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'proto'}/",
1973                 "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'port'}\n"
1974                 if $debug;
1975         }
1976     } elsif (defined $access_hr->{'MAX_TIME_DIFF'}) {
1977         if ($seq_href->{'port_seq'} > 0) {
1978             if ((time()
1979                     - $seq_href->{'port_times'}[$seq_href->{'port_seq'}-1])
1980                     < $access_hr->{'MAX_TIME_DIFF'}) {
1981                 print STDERR localtime() . " [+] Sequence max_time match: ",
1982                     "($seq_href->{'port_seq'}) ",
1983                     "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'proto'}/",
1984                     "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'port'}\n"
1985                     if $debug;
1986             } else {
1987                 &logr('[-]', "Sequence max_time ($access_hr->{'MAX_TIME_DIFF'} seconds) exceeded: " .
1988                     "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'proto'}/" .
1989                     "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'port'}" .
1990                     "(port sequence num: $seq_href->{'port_seq'}) ", $SEND_MAIL);
1991                 delete $seq_href->{'port_times'};
1992                 $seq_href->{'port_seq'} = 0;
1993                 return 0;
1994             }
1995         } else {
1996             print STDERR localtime() . " [+] Sequence match: ($seq_href->{'port_seq'}) ",
1997                 "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'proto'}/",
1998                 "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'port'}\n"
1999                 if $debug;
2000         }
2001     } else {
2002         print STDERR localtime() . " [+] Sequence match: ($seq_href->{'port_seq'}) ",
2003             "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'proto'}/",
2004             "$access_hr->{'SHARED_SEQUENCE'}->[$seq_href->{'port_seq'}]->{'port'}\n"
2005             if $debug;
2006     }
2007
2008     ### if we made it here, then we met the timing requirements (if required)
2009     $seq_href->{'port_seq'}++;
2010     return 1;
2011 }
2012
2013 sub pcap_GPG_decrypt_msg() {
2014     my ($msg, $access_hr) = @_;
2015
2016     my @plaintext = ();
2017     my $decrypt_rv = 0;
2018     my $pid;
2019     my $decrypted_msg = '';
2020     my $found_sig     = 0;
2021     my $gpg_sign_id   = '';
2022
2023     print STDERR localtime() . " [+] Attempting GnuPG decrypt...\n" if $debug;
2024     if ($debug and $verbose) {
2025         print STDERR localtime() . "     Decrypting raw data (hex dump):\n";
2026         &hex_dump(decode_base64($msg));
2027     }
2028
2029     my $gnupg = GnuPG::Interface->new();
2030
2031     if ($debug and $verbose and not $test_mode) {
2032         $gnupg->options->hash_init(
2033              'homedir' => $access_hr->{'GPG_HOME_DIR'});
2034     } else {
2035         $gnupg->options->hash_init(
2036              'batch' => 1,
2037              'homedir' => $access_hr->{'GPG_HOME_DIR'});
2038     }
2039
2040     my $input  = IO::Handle->new() or die $!;
2041     my $output = IO::Handle->new() or die $!;
2042     my $error  = IO::Handle->new() or die $!;
2043     my $pw     = IO::Handle->new() or die $!;
2044     my $status = IO::Handle->new() or die $!;
2045
2046     my $handles = GnuPG::Handles->new(
2047         stdin      => $input,
2048         stdout     => $output,
2049         stderr     => $error,
2050         passphrase => $pw,
2051         status     => $status,
2052     );
2053
2054     $gnupg->options->default_key($access_hr->{'GPG_DECRYPT_ID'});
2055
2056     if (defined $access_hr->{'GPG_AGENT_INFO'}) {
2057
2058         $ENV{'GPG_AGENT_INFO'} = $access_hr->{'GPG_AGENT_INFO'};
2059
2060         $pid = $gnupg->decrypt('handles' => $handles,
2061             'command_args' => [ qw( --use-agent ) ]);
2062
2063     } elsif ($gpg_agent_info) {
2064
2065         ### global definition for gpg-agent connection information
2066         ### from the command line
2067         $ENV{'GPG_AGENT_INFO'} = $gpg_agent_info;
2068
2069         $pid = $gnupg->decrypt('handles' => $handles,
2070             'command_args' => [ qw( --use-agent ) ]);
2071
2072     } else {
2073
2074         $pid = $gnupg->decrypt('handles' => $handles);
2075     }
2076
2077     print $pw $access_hr->{'GPG_DECRYPT_PW'};
2078
2079     close $pw;
2080
2081     print $input decode_base64($msg);
2082     close $input;
2083
2084     @plaintext = <$output>;
2085     close $output;
2086
2087     my @errors = <$error>;
2088     close $error;
2089
2090     waitpid $pid, 0;
2091
2092     ### we require the message to be signed; make sure
2093     ### the signature is good
2094     KEY: for my $key_id (@{$access_hr->{'GPG_REMOTE_ID'}}) {
2095         $key_id = $1 if $key_id =~ /^0x(\w+)/;
2096         my $found_candidate_sig = 0;
2097         LINE: for my $err (@errors) {
2098             print STDERR localtime() . "     $err" if $debug and $verbose;
2099             if ($key_id eq 'ANY') {
2100                 if ($err =~ /Good\s+signature/i) {
2101                     $found_sig = 1;
2102                     $gpg_sign_id = $key_id;
2103                     last KEY;
2104                 }
2105             } else {
2106                 if ($err =~ /Signature\s+made.*ID\s+$key_id$/) {
2107                     $found_candidate_sig = 1;
2108                     next LINE;
2109                 }
2110                 if ($found_candidate_sig and $err =~ /Good\s+signature/i) {
2111                     $found_sig = 1;
2112                     $gpg_sign_id = $key_id;
2113                     last KEY;
2114                 }
2115             }
2116         }
2117     }
2118
2119     if ($found_sig and @plaintext) {
2120         $decrypt_rv = 1;
2121         $decrypted_msg .= $_ for @plaintext;
2122     } else {
2123         print STDERR localtime() . " [-] GnuPG message not signed by any ",
2124             "required key ID.\n" if $debug;
2125     }
2126
2127     return $decrypt_rv, $decrypted_msg, $gpg_sign_id;
2128 }
2129
2130 sub pcap_Rijndael_decrypt_msg() {
2131     my ($msg, $enc_key) = @_;
2132
2133     my $decrypted_msg = '';
2134     my $decrypt_rv    = 0;
2135
2136     unless ($msg =~ /^U2FsdGVkX1/) {
2137         if ($debug) {
2138             print STDERR localtime() . " [+] Adding encoded Salted__ prefix ",
2139                 "(U2FsdGVkX1) to incoming encoded SPA packet.\n"
2140         }
2141         $msg = 'U2FsdGVkX1' . $msg;
2142     }
2143
2144     print STDERR localtime() . " [+] Attempting Rijndael decrypt...\n" if $debug;
2145
2146     if ($debug and $verbose) {
2147         print STDERR localtime() . "     Decrypting raw data (hex dump):\n";
2148         &hex_dump(decode_base64($msg));
2149     }
2150     my $cipher = Crypt::CBC->new({
2151         'key'    => $enc_key,
2152         'cipher' => $enc_alg,
2153     });
2154     eval {
2155         $decrypted_msg = $cipher->decrypt(decode_base64($msg));
2156     };
2157     if ($debug and $verbose) {
2158         print STDERR "    Salt:\n";
2159         &hex_dump($cipher->salt());
2160         print STDERR "    Key:\n";
2161         &hex_dump($cipher->key());
2162         print STDERR "    IV:\n";
2163         &hex_dump($cipher->iv());
2164         print STDERR "    PassPhrase:\n";
2165         &hex_dump($cipher->passphrase());
2166         print STDERR "    Block Size: " . $cipher->blocksize() ."\n",
2167             "    Key Size:   " . $cipher->keysize(). "\n\n";
2168     }
2169
2170     if ($@) {
2171         $decrypted_msg = '';
2172     } else {
2173         $decrypt_rv = 1;
2174     }
2175     return $decrypt_rv, $decrypted_msg;
2176 }
2177
2178 sub decrypt_sequence() {
2179     my ($src, $seq_href, $access_hr) = @_;
2180
2181     my $cipher_txt = '';
2182     my $allow_src  = '';
2183
2184     $cipher_txt .= chr($_ - $access_hr->{'PORT_OFFSET'})
2185         for @{$seq_href->{'enc_ports'}};
2186
2187     return 0 unless $cipher_txt;
2188
2189     if ($debug) {
2190         my @tmp_chars = split //, $cipher_txt;
2191         print STDERR localtime() . ' [+] Cipher text (' .
2192             length($cipher_txt) . ' bytes): ';
2193         print STDERR ord($_) . ' ' for @tmp_chars;
2194         print STDERR "\n";
2195     }
2196
2197     my $cipher = Crypt::CBC->new({
2198         'key'    => $access_hr->{'KEY'},
2199         'cipher' => $enc_alg,
2200     });
2201
2202     ### we now have our encrypted string, so try to decrypt it
2203     my $plain_txt = '';
2204     eval {
2205         $plain_txt = $cipher->decrypt($cipher_txt);
2206     };
2207     undef $cipher;
2208
2209     return 0,0,0,0 if ($@ or not $plain_txt);
2210
2211     if ($debug) {
2212         my @tmp_chars = split //, $plain_txt;
2213         print STDERR localtime() . " [+] Plain text: ";
2214         print STDERR ord($_) . ' ' for @tmp_chars;
2215         print STDERR "\n";
2216     }
2217
2218     my @chars = split //, $plain_txt;
2219
2220     ### the first four characters in the @chars array represent the
2221     ### four octets of the IP we are going to modify access for
2222     for my $octet ($chars[0], $chars[1], $chars[2], $chars[3]) {
2223         unless (0 <= ord($octet) and ord($octet) < 256) {
2224             &logr('[-]', "invalid IP octet: " . ord($octet), $SEND_MAIL);
2225             return 0,0,0,0;
2226         }
2227         $allow_src .= ord($octet) . '.';
2228     }
2229     $allow_src =~ s/\.$//;
2230
2231     if ($allow_src eq '0.0.0.0') {
2232         ### the client sent 0.0.0.0 across, so it may be behind a
2233         ### NAT device (or the person just doesn't know their source
2234         ### address) so open the firewall for the source of the
2235         ### encrypted sequence.
2236         if ($config{'REQUIRE_SOURCE_ADDRESS'} eq 'Y' or not
2237                 &is_ip_included($allow_src,
2238                     $access_hr->{'REQUIRE_SOURCE_ADDRESS'},
2239                     $access_hr->{'require_src_addr_exceptions'})) {
2240             ### we require the source address to be contained within
2241             ### the encrypted packet.
2242             return 0,0,0,0;
2243         }
2244         $allow_src = $src;
2245     }
2246
2247     my $port_upper_bits = ord($chars[4]) << 8;
2248     my $port_lower_bits = ord($chars[5]);
2249     my $allow_port = $port_upper_bits | $port_lower_bits;
2250
2251     unless (0 <= $allow_port and $allow_port < 65536) {
2252         &logr('[-]', "bad port number: $allow_port", $SEND_MAIL);
2253         return 0,0,0,0;
2254     }
2255
2256     my $allow_proto = '';
2257     my $proto = ord($chars[6]);
2258     if ($proto == 6) {
2259         $allow_proto = 'tcp';
2260     } elsif ($proto == 17) {
2261         $allow_proto = 'udp';
2262     } elsif ($proto == 1) {
2263         $allow_proto = 'icmp';
2264     } else {
2265         &logr('[-]', "bad protocol number: $proto", $SEND_MAIL);
2266         return 0,0,0,0;
2267     }
2268
2269     my $checksum_data = ord($chars[7]);
2270
2271     my $checksum = 0;
2272     for (my $i=0; $i < 7; $i++) {
2273         $checksum += ord($chars[$i]);
2274     }
2275     $checksum = $checksum % 256;
2276
2277     unless ($checksum_data == $checksum) {
2278         &logr('[-]', "invalid checksum for $src", $SEND_MAIL);
2279         return 0,0,0,0;
2280     }
2281
2282     my $username = '';
2283     my $i=8;
2284     while ($i <= $#chars and ord($chars[$i]) != 0) {
2285         $username .= $chars[$i];
2286         $i++;
2287     }
2288
2289     return 1, $allow_src, $allow_port, $allow_proto, $username;
2290 }
2291
2292 sub grant_access() {
2293     my ($src, $forward_info_hr, $seq_hr, $open_ports_hr, $access_hr) = @_;
2294
2295     if ($config{'FIREWALL_TYPE'} eq 'iptables') {
2296
2297         ### iptables access; the destination IP is only used if access is
2298         ### forwarded through the iptables policy
2299         &grant_ipt_access($src, $forward_info_hr,
2300                 $seq_hr, $open_ports_hr, $access_hr);
2301
2302     } elsif ($config{'FIREWALL_TYPE'} eq 'ipfw') {
2303
2304         ### ipfw access
2305         &grant_ipfw_access($src, $open_ports_hr, $access_hr);
2306
2307     }
2308     return;
2309 }
2310
2311 sub grant_ipt_access() {
2312     my ($src, $forward_info_hr, $seq_href, $open_ports_hr, $access_hr) = @_;
2313
2314     my @ipt_hrefs = ();
2315
2316     my $dst      = '0.0.0.0/0';
2317     my $nat_ip   = '0.0.0.0/0';
2318     my $nat_port = 0;
2319
2320     my $ipt = &get_iptables_chainmgr_obj();
2321
2322     if ($access_hr->{'ENABLE_FORWARD_ACCESS'}) {
2323         return unless defined $forward_info_hr->{'internal_ip'};
2324         push @ipt_hrefs, \%ipt_forward;
2325         push @ipt_hrefs, \%ipt_prerouting;
2326         $dst = $forward_info_hr->{'internal_ip'};
2327         print STDERR localtime() . " [+] FORWARD access for $src ",
2328             "to internal IP: $dst\n" if $debug;
2329     } else {
2330         return if defined $forward_info_hr->{'internal_ip'};
2331         push @ipt_hrefs, \%ipt_input;
2332         if ($access_hr->{'ENABLE_OUTPUT_ACCESS'}) {
2333             push @ipt_hrefs, \%ipt_output;
2334         }
2335     }
2336
2337     for my $hr (@ipt_hrefs) {
2338
2339         ### add rule for $ip unless it already exists
2340         my $target     = $hr->{'target'};
2341         my $direction  = $hr->{'direction'};
2342         my $table      = $hr->{'table'};
2343         my $from_chain = $hr->{'from_chain'};
2344         my $to_chain   = $hr->{'to_chain'};
2345         my $jump_rule_position = $hr->{'jump_rule_position'};
2346         my $auto_rule_position = $hr->{'auto_rule_position'};
2347
2348         my $grant_src = $src;
2349         my $grant_dst = '0.0.0.0/0';
2350
2351         if ($direction eq 'dst') {
2352             ### OUTPUT chain
2353             $grant_dst = $src;
2354             $grant_src = '0.0.0.0/0';
2355         }
2356
2357         ### make sure "to_chain" exists
2358         my ($rv, $out_aref, $err_aref)
2359             = $ipt->create_chain($table, $to_chain);
2360
2361         unless ($rv) {
2362             &psyslog_errs($err_aref);
2363             return;
2364         }
2365
2366         ### add jump rule to the "to_chain" from the "from_chain"
2367         ($rv, $out_aref, $err_aref) = $ipt->add_jump_rule($table,
2368             $from_chain, $jump_rule_position, $to_chain);
2369
2370         unless ($rv) {
2371             &psyslog_errs($err_aref);
2372             return;
2373         }
2374
2375         for my $proto (keys %{$open_ports_hr}) {
2376             for my $port (keys %{$open_ports_hr->{$proto}}) {
2377
2378                 my $num_chain_rules = 0;
2379                 my $dport = $port;
2380                 my $sport = 0;
2381
2382                 my %extended_info = ('protocol' => $proto);
2383                 if ($direction eq 'dst') {
2384                     ### OUTPUT chain
2385                     $extended_info{'s_port'} = $port;
2386                     $sport = $port;
2387                     $dport = 0;
2388                 } else {
2389                     $extended_info{'d_port'} = $port;
2390                 }
2391
2392                 ### deal with DNAT
2393                 if ($table eq 'nat' and $target eq 'DNAT') {
2394                     $extended_info{'to_ip'}   = $forward_info_hr->{'internal_ip'};
2395                     $extended_info{'to_port'} = $dport;
2396                     $extended_info{'d_port'}  = $forward_info_hr->{'external_port'};
2397                     $nat_ip   = $forward_info_hr->{'internal_ip'};
2398                     $nat_port = $dport;
2399                     $dport    = $forward_info_hr->{'external_port'};
2400                 }
2401
2402                 ($rv, $num_chain_rules) = $ipt->find_ip_rule($grant_src,
2403                     $grant_dst, $table, $to_chain, $target, \%extended_info);
2404
2405                 if ($rv) {
2406                     my $str = "$grant_src -> $grant_dst($proto/$port)";
2407                     if ($direction eq 'dst') {
2408                         $str = "$grant_src($proto/$port) -> $grant_dst";
2409                     }
2410                     if (defined $extended_info{'to_ip'}) {
2411                         $str = "$grant_src -> $extended_info{'to_ip'}" .
2412                             "($proto/$extended_info{'to_port'})";
2413                     }
2414                     &logr('[-]', "source: $str already allowed to connect " .
2415                         "in chain: $to_chain", $SEND_MAIL);
2416                 } else {
2417                     my $str = "add $to_chain $grant_src -> " .
2418                         "$grant_dst($proto/$port) $target rule ";
2419                     if ($direction eq 'dst') {
2420                         $str = "add $to_chain $grant_src($proto/$port) -> " .
2421                             "$grant_dst $target rule ";
2422                     }
2423                     if (defined $extended_info{'to_ip'}) {
2424                         $str = "add $to_chain $grant_src -> " .
2425                             "$extended_info{'to_ip'}" .
2426                             "($proto/$extended_info{'to_port'}) " .
2427                             "$target rule ";
2428                     }
2429                     $str .= "$access_hr->{'FW_ACCESS_TIMEOUT'} sec";
2430
2431                     &logr('[+]', $str, $SEND_MAIL);
2432
2433                     ($rv, $out_aref, $err_aref) = $ipt->add_ip_rule($grant_src,
2434                         $grant_dst, $auto_rule_position, $table, $to_chain,
2435                         $target, \%extended_info);
2436
2437                     if ($rv) {
2438
2439                         ### keep track of how many times we have granted access
2440                         $seq_href->{'grant_ctr'}++ unless
2441                             $access_hr->{'DATA_COLLECT_MODE'} == $PCAP
2442                             or $access_hr->{'DATA_COLLECT_MODE'} == $FILE_PCAP
2443                             or $access_hr->{'DATA_COLLECT_MODE'} == $ULOG_PCAP;
2444
2445                         ### Communicate the new firewall rule to knoptm so
2446                         ### that it can be removed.
2447                         &write_knoptm_fw_cache_entry(
2448                             time(),
2449                             $access_hr->{'FW_ACCESS_TIMEOUT'},
2450                             $grant_src,
2451                             $sport,
2452                             $grant_dst,
2453                             $dport,
2454                             $proto,
2455                             $table,
2456                             $to_chain,
2457                             $target,
2458                             $direction,
2459                             $nat_ip,
2460                             $nat_port
2461                         );
2462                     } else {
2463                         &psyslog_errs($err_aref);
2464                     }
2465                 }
2466             }
2467         }
2468     }
2469     $seq_href->{'port_seq'} = 0
2470         unless $access_hr->{'DATA_COLLECT_MODE'} == $PCAP
2471             or $access_hr->{'DATA_COLLECT_MODE'} == $FILE_PCAP
2472             or $access_hr->{'DATA_COLLECT_MODE'} == $ULOG_PCAP;
2473
2474     return;
2475 }
2476
2477 sub grant_ipfw_access() {
2478     my ($src, $open_ports_hr, $access_hr) = @_;
2479
2480     my $dst = '0.0.0.0/0';
2481
2482     for my $proto (keys %{$open_ports_hr}) {
2483         for my $port (keys %{$open_ports_hr->{$proto}}) {
2484
2485             my ($active_rulenum, $new_rulenum)
2486                     = &ipfw_find_ip_rule($src, 'any', $proto, $port);
2487
2488             if ($active_rulenum) {
2489                 &logr('[-]', "source: $src already allowed " .
2490                     "to connect to $proto/$port", $SEND_MAIL);
2491             } else {
2492
2493                 my $msg = 'adding ipfw pass rule for ' .
2494                     "$src -> $proto";
2495                 $msg .= "/$port" if $proto ne 'icmp';
2496                 $msg .= " ($access_hr->{'FW_ACCESS_TIMEOUT'} " .
2497                     "seconds)";
2498
2499                 &logr('[+]', $msg, $SEND_MAIL);
2500
2501                 if (&ipfw_add_ip_rule($new_rulenum,
2502                             $src, 'any', $proto, $port)) {
2503
2504                     ### communicate the new rule to knoptm so that it can
2505                     ### be removed.
2506                     &write_knoptm_fw_cache_entry(
2507                         time(),
2508                         $access_hr->{'FW_ACCESS_TIMEOUT'},
2509                         $src,
2510                         0,
2511                         $dst,
2512                         $port,
2513                         $proto,
2514                         'NA',
2515                         'NA',
2516                         'NA',
2517                         'NA',
2518                         '0.0.0.0/0',
2519                         0
2520                     );
2521                 }
2522             }
2523         }
2524     }
2525
2526     return;
2527 }
2528
2529 sub ipt_check_stateful_rule() {
2530
2531     my $ipt = &get_iptables_chainmgr_obj();
2532
2533     print STDERR localtime() . " [+] Checking for iptables state ",
2534         "tracking rule...\n" if $debug;
2535     ### check for at least one state tracking rule in _some_ chain
2536     my ($rv, $out_aref, $err_aref) = $ipt->run_ipt_cmd(
2537         "$cmds{'iptables'} -v -n -L");
2538     my $found_state_rule = 0;
2539     for my $rule (@$out_aref) {
2540         ### ACCEPT all -- 0.0.0.0/0 0.0.0.0/0 state RELATED,ESTABLISHED
2541         if ($rule =~ /\sACCEPT\s+.*ESTABLISHED/) {
2542             $found_state_rule = 1;
2543             last;
2544         }
2545     }
2546     unless ($found_state_rule) {
2547         &logr('[-]', "warning, could not find any iptables state tracking " .
2548             "rules", $SEND_MAIL);
2549     }
2550     return;
2551 }
2552
2553 sub ipfw_check_stateful_rule() {
2554
2555     open LIST, "$cmds{'ipfw'} list |" or
2556         die "[*] Could not execute 'ipfw list'";
2557     my $found_state_rule = 0;
2558     while (<LIST>) {
2559         if (/check-state/) {
2560             ### check-state means that ipfw builds "dynamic" rules against
2561             ### connections, and a subsequent rule can allow established
2562             ### connections to continue after the initial rule to accept
2563             ### an SSH connection is removed.
2564             $found_state_rule = 1;
2565         }
2566         if (/allow.*to\s+any\s+established/) {
2567             $found_state_rule = 1;
2568         }
2569     }
2570     close LIST;
2571     unless ($found_state_rule) {
2572         &logr('[-]', "warning, could not find ipfw state tracking rules",
2573             $SEND_MAIL);
2574     }
2575
2576     return;
2577 }
2578
2579 sub ipfw_del_ip() {
2580     my @del_rule_nums = ();
2581     print "[+] Deleting allow rules for src $fw_del_ip...\n";
2582     open LIST, "$cmds{'ipfw'} list |" or
2583         die "[*] Could not execute 'ipfw list'";
2584     while (<LIST>) {
2585         ### 00002 allow tcp from 1.1.1.1 to any dst-port 22 keep-state
2586         if (/^\s*(\d+)\s+allow\s+\S+\s+from\s+$fw_del_ip\s+to\s+
2587                 any\s+/x) {
2588             push @del_rule_nums, $1;
2589         }
2590     }
2591     close LIST;
2592
2593     ### delete all rules that have the IP as a source to any destination
2594     for my $rulenum (@del_rule_nums) {
2595         my $cmd = "$cmds{'ipfw'} delete $rulenum";
2596         print "    $cmd\n";
2597         open IPFW, "| $cmd" or die "[*] Could not execute $cmd";
2598         close IPFW;
2599     }
2600     return 0;
2601 }
2602
2603 sub ipfw_find_ip_rule() {
2604     my ($src, $dst, $proto, $port) = @_;
2605
2606     my $active_rulenum = 0;
2607     my $new_rulenum = $config{'IPFW_RULE_NUM'};  ### sets a minimum
2608
2609     my %rule_nums = ();
2610
2611     open LIST, "$cmds{'ipfw'} list |" or
2612         die "[*] Could not execute 'ipfw list'";
2613     while (<LIST>) {
2614         if ($proto eq 'tcp') {
2615             ### 00002 allow tcp from 1.1.1.1 to any dst-port 22 keep-state
2616             if (/^\s*(\d+)\s+allow\s+$proto\s+from\s+$src\s+to\s+
2617                         $dst\s+dst-port\s+$port\s+keep-state/x) {
2618                 $active_rulenum = $1;
2619             }
2620         } elsif ($proto eq 'udp') {
2621             ### 00002 allow udp from 1.1.1.1 to any dst-port 53
2622             if (/^\s*(\d+)\s+allow\s+$proto\s+from\s+$src\s+to\s+
2623                         $dst\s+dst-port\s+$port/x) {
2624                 $active_rulenum = $1;
2625             }
2626         } else {  ### icmp
2627             if (/^\s*(\d+)\s+allow\s+$proto\s+from\s+$src\s+to\s+$dst/x) {
2628                 $active_rulenum = $1;
2629             }
2630         }
2631         if (/^\s*(\d+)/) {
2632             my $rulenum = $1;
2633             ### remove any leading zeros from the rule number
2634             $rulenum =~ s/^0{1,4}//g;
2635             $rule_nums{$rulenum} = '';
2636         }
2637     }
2638     close LIST;
2639
2640     if ($active_rulenum) {
2641         ### remove any leading zeros from the rule number
2642         $active_rulenum =~ s/^0{1,4}//g;
2643     }
2644
2645     ### find the next unused rule number
2646     $new_rulenum++ while (defined $rule_nums{$new_rulenum});
2647
2648     return $active_rulenum, $new_rulenum;
2649 }
2650
2651 sub ipfw_add_ip_rule() {
2652     my ($new_rulenum, $src, $dst, $proto, $port) = @_;
2653
2654     my $cmd = "$cmds{'ipfw'} add $new_rulenum " .
2655         "pass $proto from $src to $dst";
2656
2657     if ($proto eq 'tcp') {
2658         $cmd .= " $port keep-state";
2659     } elsif ($proto eq 'udp') {
2660         $cmd .= " $port";
2661     }
2662
2663     open IPFW, "| $cmd" or die "[*] Could not execute $cmd: $!";
2664     close IPFW;
2665
2666     return 1;
2667 }
2668
2669 sub ipfw_delete_ip_rule() {
2670     my $rulenum = shift;
2671
2672     open IPFW, "| $cmds{'ipfw'} delete $rulenum" or die "[*] Could not ",
2673         "execute $cmds{'ipfw'} delete $rulenum";
2674     close IPFW;
2675
2676     return 1;
2677 }
2678
2679 sub write_knoptm_fw_cache_entry() {
2680     my ($rule_timestamp, $timeout, $src, $sport, $dst, $dport,
2681         $proto, $table, $chain, $target, $direction, $nat_ip, $nat_port) = @_;
2682
2683     ### the rule is permanent per the zero value for FW_ACCESS_TIMEOUT in
2684     ### this source block
2685     return if $timeout == 0;
2686
2687     my $knoptm_cache_entry_line = "$rule_timestamp $timeout $src $sport " .
2688         "$dst $dport $proto $table $chain $target $direction $nat_ip " .
2689         "$nat_port";
2690
2691     print STDERR localtime() . " [+] Writing fw time cache entry to: ",
2692         "$config{'KNOPTM_IP_TIMEOUT_SOCK'} $knoptm_cache_entry_line\n"
2693         if $debug;
2694
2695     ### open domain socket with running knoptm process
2696     my $sock = IO::Socket::UNIX->new($config{'KNOPTM_IP_TIMEOUT_SOCK'})
2697         or die "[*] Could not acquire $config{'KNOPTM_IP_TIMEOUT_SOCK'} ",
2698         "socket: $!";
2699     print $sock "$knoptm_cache_entry_line\n";
2700     close $sock;
2701
2702     return;
2703 }
2704
2705 sub timeout_invalid_sequences() {
2706     for my $src (keys %ip_sequences) {
2707         for my $seq_num (keys %{$ip_sequences{$src}}) {
2708             my $knock_interval
2709                 = $access[$seq_num]{'KNOCK_INTERVAL'};
2710
2711             if (defined $access[$seq_num]{'KNOCK_LIMIT'}) {
2712                 if (defined $ip_sequences{$src}{$seq_num}{'grant_ctr'}
2713                         and $ip_sequences{$src}{$seq_num}{'grant_ctr'} >
2714                         $access[$seq_num]{'KNOCK_LIMIT'}) {
2715                     ### don't timeout knock sequence if the knock limit
2716                     ### has been exceeded
2717                     next;
2718                 }
2719             }
2720
2721             ### encrypted sequences
2722             if (defined $ip_sequences{$src}{$seq_num}{'enc_stime'}) {
2723                 if (time() - $ip_sequences{$src}{$seq_num}{'enc_stime'}
2724                         > $knock_interval) {
2725                     &logr('[+]', "invalid encrypted sequence $src timeout",
2726                         $NO_MAIL);
2727                     delete $ip_sequences{$src}{$seq_num};
2728                     next;
2729                 }
2730             }
2731
2732             ### shared sequences
2733             if (defined $ip_sequences{$src}{$seq_num}{'port_stime'}) {
2734                 if (time() - $ip_sequences{$src}
2735                         {$seq_num}{'port_stime'}->[0]
2736                         > $knock_interval) {
2737                     &logr('[+]', "invalid shared sequence $src timeout",
2738                         $NO_MAIL);
2739                     delete $ip_sequences{$src}{$seq_num};
2740                     next;
2741                 }
2742             }
2743         }
2744     }
2745     return;
2746 }
2747
2748 sub p0f() {
2749     my ($src, $len, $frag_bit, $ttl, $win, $tcp_options) = @_;
2750
2751     print STDERR localtime() . " [+] p0f(): $src len: $len, frag_bit: ",
2752         "$frag_bit, ttl: $ttl, win: $win\n" if $debug;
2753
2754     my ($options_aref) = &parse_tcp_options($src, $tcp_options);
2755
2756     return unless $options_aref;
2757
2758     ### try to match SYN packet length
2759     LEN: for my $sig_len (keys %p0f_sigs) {
2760         my $matched_len = 0;
2761         if ($sig_len eq '*') {  ### len can be wildcarded in pf.os
2762             $matched_len = 1;
2763         } elsif ($sig_len =~ /^\%(\d+)/) {
2764             if (($len % $1) == 0) {
2765                 $matched_len = 1;
2766             }
2767         } elsif ($len == $sig_len) {
2768             $matched_len = 1;
2769         }
2770         next LEN unless $matched_len;
2771
2772         ### try to match fragmentation bit
2773         FRAG: for my $test_frag_bit ($frag_bit, '*') {  ### don't need "%nnn" check
2774             next FRAG unless defined $p0f_sigs{$sig_len}{$test_frag_bit};
2775
2776             ### find out for which p0f sigs the TTL is within range
2777             TTL: for my $sig_ttl (keys %{$p0f_sigs{$sig_len}{$test_frag_bit}}) {
2778                 unless ($ttl > $sig_ttl - $config{'MAX_HOPS'}
2779                         and $ttl <= $sig_ttl) {
2780                     next TTL;
2781                 }
2782
2783                 ### match tcp window size
2784                 WIN: for my $sig_win_size (keys
2785                         %{$p0f_sigs{$sig_len}{$test_frag_bit}{$sig_ttl}}) {
2786                     my $matched_win_size = 0;
2787                     if ($sig_win_size eq '*') {
2788                         $matched_win_size = 1;
2789                     } elsif ($sig_win_size =~ /^\%(\d+)/) {
2790                         if (($win % $1) == 0) {
2791                             $matched_win_size = 1;
2792                         }
2793                     } elsif ($sig_win_size =~ /^S(\d+)/) {
2794                         ### window size must be a multiple of maximum
2795                         ### seqment size
2796                         my $multiple = $1;
2797                         for my $opt_hr (@$options_aref) {
2798                             if (defined $opt_hr->{$tcp_p0f_opt_types{'M'}}) {
2799                                 my $mss_val = $opt_hr->{$tcp_p0f_opt_types{'M'}};
2800                                 if ($win == $mss_val * $multiple) {
2801                                     $matched_win_size = 1;
2802                                 }
2803                             }
2804                             last;
2805                         }
2806                     } elsif ($sig_win_size == $win) {
2807                         $matched_win_size = 1;
2808                     }
2809
2810                     next WIN unless $matched_win_size;
2811
2812                     TCPOPTS: for my $sig_opts (keys %{$p0f_sigs{$sig_len}
2813                             {$test_frag_bit}{$sig_ttl}{$sig_win_size}}) {
2814                         my @sig_opts = split /\,/, $sig_opts;
2815                         for (my $i=0; $i<=$#sig_opts; $i++) {
2816                             ### tcp option order is important.  Check to see if
2817                             ### the option order in the packet matches the order we
2818                             ### expect to see in the signature
2819                             if ($sig_opts[$i] =~ /^([NMWST])/) {
2820                                 my $sig_letter = $1;
2821
2822                                 unless (defined $options_aref->[$i]->
2823                                         {$tcp_p0f_opt_types{$sig_letter}}) {
2824                                     next TCPOPTS;  ### could not match tcp option order
2825                                 }
2826
2827                                 ### MSS, window scale, and timestamp have
2828                                 ### specific signatures requirements on values
2829                                 if ($sig_letter eq 'M') {
2830                                     if ($sig_opts[$i] =~ /M(\d+)/) {
2831                                         my $sig_mss_val = $1;
2832                                         next TCPOPTS unless $options_aref->[$i]->
2833                                             {$tcp_p0f_opt_types{$sig_letter}}
2834                                                 == $sig_mss_val;
2835                                     } elsif ($sig_opts[$i] =~ /M\%(\d+)/) {
2836                                         my $sig_mss_mod_val = $1;
2837                                         next TCPOPTS unless (($options_aref->[$i]->
2838                                             {$tcp_p0f_opt_types{$sig_letter}}
2839                                                 % $sig_mss_mod_val) == 0);
2840                                     } ### else it is "M*" which always matches
2841                                 } elsif ($sig_letter eq 'W') {
2842                                     if ($sig_opts[$i] =~ /W(\d+)/) {
2843                                         my $sig_win_val = $1;
2844                                         next TCPOPTS unless $options_aref->[$i]->
2845                                             {$tcp_p0f_opt_types{$sig_letter}}
2846                                                 == $sig_win_val;
2847                                     } elsif ($sig_opts[$i] =~ /W\%(\d+)/) {
2848                                         my $sig_win_mod_val = $1;
2849                                         next TCPOPTS unless (($options_aref->[$i]->
2850                                             {$tcp_p0f_opt_types{$sig_letter}}
2851                                                 % $sig_win_mod_val) == 0);
2852                                     } ### else it is "W*" which always matches
2853                                 } elsif ($sig_letter eq 'T') {
2854                                     if ($sig_opts[$i] =~ /T0/) {
2855                                         next TCPOPTS unless $options_aref->[$i]->
2856                                             {$tcp_p0f_opt_types{$sig_letter}}
2857                                                 == 0;
2858                                     }  ### else it is just "T" which matches
2859                                 }
2860
2861                             }
2862                         }
2863                         OS: for my $os (keys %{$p0f_sigs{$sig_len}
2864                                 {$test_frag_bit}{$sig_ttl}{$sig_win_size}
2865                                 {$sig_opts}}) {
2866                             my $sig = $p0f_sigs{$sig_len}
2867                                 {$test_frag_bit}{$sig_ttl}{$sig_win_size}
2868                                 {$sig_opts}{$os};
2869                             print STDERR localtime() . " [+] os: $os, $sig\n"
2870                                 if $debug;
2871                             $p0f{$src}{$os} = $sig;
2872                         }
2873                     }
2874                 }
2875             }
2876         }
2877     }
2878     return;
2879 }
2880
2881 sub parse_tcp_options() {
2882     my ($src, $tcp_options) = @_;
2883     my @opts = ();
2884     my @hex_nums = ();
2885     my $debug_str = '';
2886
2887     if (length($tcp_options) % 2 != 0) {  ### make sure length a multiple of two
2888         &logr('[-]', 'tcp options length not a multiple of two.', $NO_MAIL);
2889         return '';
2890     }
2891     ### $tcp_options is a hex string like "020405B401010402" from the iptables
2892     ### log message
2893     my @chars = split //, $tcp_options;
2894     for (my $i=0; $i <= $#chars; $i += 2) {
2895         my $str = $chars[$i] . $chars[$i+1];
2896         push @hex_nums, $str;
2897     }
2898
2899     my $max_parse_attempts = $#chars;
2900     my $parse_ctr = 0;
2901
2902     OPT: for (my $opt_kind=0; $opt_kind <= $#hex_nums;) {
2903
2904         $parse_ctr++;
2905         return [] if $parse_ctr > $max_parse_attempts;
2906
2907         last OPT unless defined $hex_nums[$opt_kind+1];
2908
2909         my $is_nop = 0;
2910         my $len = hex($hex_nums[$opt_kind+1]);
2911         if (hex($hex_nums[$opt_kind]) == $tcp_nop_type) {
2912             $debug_str .= 'NOP, ' if $debug;
2913             push @opts, {$tcp_nop_type => ''};
2914             $is_nop = 1;
2915         } elsif (hex($hex_nums[$opt_kind]) == $tcp_mss_type) {  ### MSS
2916             my $mss_hex = '';
2917             for (my $i=$opt_kind+2; $i < ($opt_kind+$len); $i++) {
2918                 $mss_hex .= $hex_nums[$i];
2919             }
2920             my $mss = hex($mss_hex);
2921             push @opts, {$tcp_mss_type => $mss};
2922             $debug_str .= 'MSS: ' . hex($mss_hex) . ', ' if $debug;
2923         } elsif (hex($hex_nums[$opt_kind]) == $tcp_win_scale_type) {
2924             my $window_scale_hex = '';
2925             for (my $i=$opt_kind+2; $i < ($opt_kind+$len); $i++) {
2926                 $window_scale_hex .= $hex_nums[$i];
2927             }
2928             my $win_scale = hex($window_scale_hex);
2929             push @opts, {$tcp_win_scale_type => $win_scale};
2930             $debug_str .= 'Win Scale: ' . hex($window_scale_hex) . ', ' if $debug;
2931         } elsif (hex($hex_nums[$opt_kind]) == $tcp_sack_type) {
2932             push @opts, {$tcp_sack_type => ''};
2933             $debug_str .= 'SACK, ' if $debug;
2934         } elsif (hex($hex_nums[$opt_kind]) == $tcp_timestamp_type) {
2935             my $timestamp_hex = '';
2936             for (my $i=$opt_kind+2; $i < ($opt_kind+$len) - 4; $i++) {
2937                 $timestamp_hex .= $hex_nums[$i];
2938             }
2939             my $timestamp = hex($timestamp_hex);
2940             push @opts, {$tcp_timestamp_type => $timestamp};
2941             $debug_str .= 'Timestamp: ' . hex($timestamp_hex) . ', ' if $debug;
2942         } elsif (hex($hex_nums[$opt_kind]) == 0) {  ### End of option list
2943             last OPT;
2944         }
2945         if ($is_nop) {
2946             $opt_kind += 1;
2947         } else {
2948             if ($len == 0 or $len == 1) {
2949                 ### this should never happen; it indicates a broken TCP stack
2950                 ### or maliciously constructed options since the len field is
2951                 ### large enough to accomodate the TLV encoding
2952                 my $msg = "broken $len-byte len field within TCP options " .
2953                     "string: $tcp_options from source IP: $src";
2954                 print STDERR "    $msg\n" if $debug;
2955                 &sys_log($msg);
2956                 return [];
2957             }
2958             ### get to the next option-kind field
2959             $opt_kind += $len;
2960         }
2961     }
2962     if ($debug) {
2963         $debug_str =~ s/\,$//;
2964         print STDERR localtime() . " [+] $debug_str\n" if $debug;
2965     }
2966     return \@opts;
2967 }
2968
2969 sub print_p0f() {
2970     for my $src (keys %p0f) {
2971         print "[+] $src\n";
2972         for my $os (keys %{$p0f{$src}}) {
2973             printf "      %-33s%s\n", $p0f{$src}{$os}, $os;
2974         }
2975     }
2976     exit 0;
2977 }
2978
2979 sub import_p0f_sigs() {
2980     my $p0f_file = $config{'P0F_FILE'};
2981     open P, "< $p0f_file" or die '[*] Could not open ',
2982         "$p0f_file: $!";
2983     my @lines = <P>;
2984     close P;
2985     my $os = '';
2986     for my $line (@lines) {
2987         chomp $line;
2988         next if $line =~ /^\s*#/;
2989         next unless $line =~ /\S/;
2990
2991         ### S3:64:1:60:M*,S,T,N,W1:        Linux:2.5::Linux 2.5 (sometimes 2.4)
2992         ### 16384:64:1:60:M*,N,W0,N,N,T:   FreeBSD:4.4::FreeBSD 4.4
2993         ### 16384:64:1:44:M*:              FreeBSD:2.0-2.2::FreeBSD 2.0-4.1
2994
2995         if ($line =~ /^(\S+?):(\S+?):(\S+?):(\S+?):(\S+?):\s+(.*)\s*/) {
2996             my $win_size = $1;
2997             my $ttl      = $2;
2998             my $frag_bit = $3;
2999             my $len      = $4;
3000             my $options  = $5;
3001             my $os       = $6;
3002
3003             my $sig_str = "$win_size:$ttl:$frag_bit:$len:$options";
3004             ### don't know how to handle MTU-based window size yet
3005             unless ($win_size =~ /T/) {
3006                 $p0f_sigs{$len}{$frag_bit}{$ttl}{$win_size}{$options}{$os}
3007                     = $sig_str;
3008             }
3009         }
3010     }
3011
3012     print STDERR Dumper %p0f_sigs if $debug and $verbose;
3013     &logr('[+]', 'imported p0f-based passive OS fingerprinting signatures',
3014         $NO_MAIL);
3015     return;
3016 }
3017
3018 sub import_access() {
3019     open A, "< $config{'ACCESS_CONF'}" or die "[*] Could not open ",
3020         "$config{'ACCESS_CONF'}: $!";
3021     my @lines = <A>;
3022     close A;
3023     my $src  = '';
3024     my $type = '';
3025     my $valid_ctr = 0;
3026     my $source_block_num = 0;
3027     for (my $i=0; $i<=$#lines; $i++) {
3028         my $line = $lines[$i];
3029         chomp $line;
3030         next if $line =~ /^\s*#/;
3031         next unless $line =~ /\S/;
3032
3033         my $type = '';
3034         my %access_hsh = ();
3035
3036         if ($line =~ /^\s*SOURCE:/) {
3037             ### keep track of SOURCE block number; note that this value
3038             ### increments whether or not we actually have a valid block
3039             ### (so we can keep track of exactly which block within the
3040             ### access.conf file).
3041             $source_block_num++;
3042             $access_hsh{'block_num'} = $source_block_num;
3043
3044             my $src_str = '';
3045             if ($line =~ m|^\s*SOURCE:\s*(.*)\s*;|) {
3046                 $src_str = $1;
3047                 ($access_hsh{'SOURCE'}, $access_hsh{'exclude_nets'})
3048                         = &parse_nets($src_str);
3049             }
3050             $i++;
3051             $access_hsh{'src_line_num'} = $i;
3052             $access_hsh{'src_str'}      = $src_str;
3053             while (defined $lines[$i] and $lines[$i] !~ /^\s*SOURCE:/) {
3054                 my $line = $lines[$i];
3055                 $i++;
3056       &nbs