File: psad

package info (click to toggle)
psad 2.4.3-1.2~deb9u1
links: PTS, VCS
area: main
in suites: stretch
size: 3,884 kB
sloc: perl: 13,751; ansic: 1,322; sh: 342; makefile: 74
file content (11465 lines) | stat: -rwxr-xr-x 418,541 bytes
parent folder | download | duplicates (2)
#!/usr/bin/perl -w
#
################################################################################
#
# File: psad (/usr/sbin/psad)
#
# URL: http://www.cipherdyne.org/psad/
#
# Purpose: psad makes use of iptables logs to detect port scans,
#          probes for backdoors and DDoS tools, and other suspect traffic
#          (many signatures were adapted from the SNORT intrusion
#          detection system).  Data is provided by parsing syslog
#          firewall messages out of /var/log/messages (or wherever syslog
#          is configured to write iptables logs to).
#
#          For more information read the psad man page or view the
#          documentation provided at: http://www.cipherdyne.org/psad/
#
# Author: Michael Rash (mbr@cipherdyne.org)
#
# Credits: (see the CREDITS file bundled with the psad sources.)
#
# Version: 2.4.3
#
# Copyright (C) 1999-2015 Michael Rash (mbr@cipherdyne.org)
#
# Reference: SNORT is a registered trademark of Sourcefire, Inc.
#
# License (GNU Public License):
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
#    USA
#
# TODO: (see the TODO file bundled with the psad sources.)
#
# Default behavior is as follows.  Each of these features can be disabled
# with command line arguments:
#
#       - passive OS fingerprinting                   = yes
#       - snort rule matching                         = yes
#       - write fw errors to error log                = yes
#       - daemon mode                                 = yes
#       - reverse dns lookups                         = yes
#       - validate firewall rules                     = yes
#       - whois lookups of scanning IPs               = yes
#       - parse netstat output for local server ports = yes
#
# Coding Style:  All configuration variables from psad.conf are stored in
#   the %config hash by keys that are in capital letters.  This is
#   the only place in the code where capital letters will be used in
#   variables names.  There are several variables with file-scope, and
#   these variables are clearly commented near the top of each of the
#   psad daemons.  Lines are generally limited to 80 characters for easy
#   reading.
#
# Scan hash key explanation:
#   absnum        - Total number of packets from $src to $dst
#   tot_protocols - Total number of IP protocols scanned by $src against $dst
#   chain         - iptables chain under which the scan packets appear in the
#                   logs.
#   s_time        - Start time for the first packet seen from src to dst.
#   alerted       - An alert has been sent.
#   pkts          - Number of packets (used for signatures and a packet counter
#                   for the current interval.
#   flags         - Keeps track of tcp flags.
#   sid           - Signature tracking
#   abs_sp        - Absolute starting port.
#   abs_ep        - Absolute ending port.
#   strtp         - Starting port.
#   endp          - Ending port.
#
# Sample iptables log messages:
#
#  Sample tcp packet (rejected by iptables... --log-prefix = "DROP ")
#
#  Mar 11 13:15:52 orthanc kernel: DROP IN=lo OUT= MAC=00:00:00:00:00:00:00:00:
#  00:00:00:00:08:00 SRC=127.0.0.1 DST=127.0.0.1 LEN=60 TOS=0x00 PREC=0x00
#  TTL=64 ID=0 DF PROTO=TCP SPT=44847 DPT=35 WINDOW=32304 RES=0x00 SYN URGP=0
#
#  Sample icmp packet rejected by iptables INPUT chain:
#
#  Nov 27 15:45:51 orthanc kernel: DROP IN=eth1 OUT= MAC=00:a0:cc:e2:1f:f2:00:
#  20:78:10:70:e7:08:00 SRC=192.168.10.20 DST=192.168.10.1 LEN=84 TOS=0x00
#  PREC=0x00 TTL=64 ID=0 DF PROTO=ICMP TYPE=8 CODE=0 ID=61055 SEQ=256
#
#  Sample icmp packet logged through FORWARD chain:
#
#  Aug 20 21:23:32 orthanc kernel: SID365 IN=eth2 OUT=eth1 SRC=192.168.20.25
#  DST=192.168.10.15 LEN=84 TOS=0x00 PREC=0x00 TTL=63 ID=0 DF PROTO=ICMP TYPE=8
#  CODE=0 ID=19467 SEQ=256
#
#  Occasionally the kernel klogd ring buffer must become full since log
#  entries are sometimes generated by a long port scan like this (note
#  there is no 'DPT' field):
#
#  Mar 16 23:50:25 orthanc kernel: DROP IN=lo OUT= MAC=00:00:00:00:00:00:00:
#  00:00:00:00:00:08:00 SRC=127.0.0.1 DST=127.0.0.1 LEN=60 TOS=0x00 PREC=0x00
#  TTL=64 ID=0 DF PROTO=TCP SPT=39935 DINDOW=32304 RES=0x00 SYN URGP=0
#
# Note on iptables tcp log messages:
#
#   iptables reports tcp flags in the following order:
#
#       URG ACK PSH RST SYN FIN
#
# Files specification for /var/log/psad/<srcip> directories:
#
#   psad creates a new directory "/var/log/psad/<src>" for each new <src>
#   from which a scan is detected.  Under this directory several files are
#   created:
#
#       danger_level       - Overall danger level aggregated for all scans.
#       p0f_guess          - Passive OS fingerprint guess for <src>.
#       <src/dst>_whois    - Whois information for <src> (or <dst> if src
#                            is a local IP).
#       <dst>_email_ctr    - Total email alerts sent for <src>.
#       <dst>_email_alert  - The most recent email alert for <dst>.
#       <dst>_packet_ctr   - Packet counters for <dst>.
#       <dst>_signatures   - Signatures detected against <dst>.
#
#   Note that some of the files above contain the destination address since a
#   single source address may scan several destination addresses.
#
###############################################################################
#

### modules used by psad
use File::Copy;
use File::Path;
use IO::Socket;
use IO::Select;
use Socket;
use POSIX;
use IO::Handle;
use Data::Dumper;
use Getopt::Long 'GetOptions';
use strict;

### ========================== main =================================

### set the current version
my $version = '2.4.3';

### default config file for psad (can be changed with
### --config switch)
my $config_file  = '/etc/psad/psad.conf';

### this will be set to either FW_DATA_FILE, ULOG_DATA_FILE
### or IPT_SYSLOG_FILE
my $fw_data_file = '';

### disable debugging by default
my $debug     = 0;
my $debug_sid = 0;  ### debug a specific signature

my $flush_fw = 0;

### build the iptables blocking configuration out of the
### IPT_AUTO_CHAIN variable
my @ipt_config = ();

### main configuration hash
my %config = ();
my $override_config_str = '';

### local subnets
my @local_nets = ();

### fw search string array
my @fw_search = ();

### socket for --fw-block
my $ipt_sock = '';

### commands hash
my %cmds = ();

### main psad data structure; contains ips, port ranges,
### protocol info, tcp flags, etc.
my %scan = ();

### cache scan danger levels
my %scan_dl = ();

### cache scan email counters
my %scan_email_ctrs = ();

### cache executions of external script (only used if
### ENABLE_EXT_SCRIPT_EXEC is set to 'Y');
my %scan_ext_exec = ();

### cache p0f-based passive os fingerprinting information
my %p0f = ();

### cache p0f-based passive os fingerprinting signature information
my %p0f_ipv4_sigs = ();
my %p0f_ipv6_sigs = ();

### cache TOS-based passive os fingerprinting information
my %posf = ();

### cache TOS-based passive os fingerprinting signature information
my %posf_sigs = ();

### cache valid icmp types and corresponding codes
my %valid_icmp_types  = ();
my %valid_icmp6_types = ();

### Cache snort rule messages unless --no-snort-sids switch was
### given.  This is only useful if iptables includes rules
### that log things like "SID123".  "fwsnort"
### (http://www.cipherdyne.org/fwsnort/) will automatically
### build such a ruleset from snort signatures.
my %fwsnort_sigs = ();

### Cache snort classification.config file for class priorities
my %snort_class_dl = ();

### Cache any individual Snort rule priority definitions from
### the snort_rule_dl file
my %snort_rule_dl = ();

### Cache Snort rule reference configuration
my %snort_ref_baseurl = ();

### cache all scan signatures from /etc/psad/signatures file
my %sigs = ();
my %sig_search = ();
my %sig_ip_objs = ();

### cache iptables prefixes
my %ipt_prefixes = ();

### ignore ports
my %ignore_ports = ();

### ignore protocols
my %ignore_protocols = ();

### ignore interfaces
my %ignore_interfaces = ();

### data array used for dshield.org logs
my @dshield_data = ();

### track the last time we sent an alert to dshield.org
my $last_dshield_alert = '';

### calculate how often a dshield alert will be sent
my $dshield_alert_interval = '';

### dshield stats counters
my $dshield_email_ctr = 0;
my $dshield_lines_ctr = 0;

### get the current timezone for dshield (this is calculated
### and re-calculated since the timezone may change).
my $timezone = '';

### get the current year for dshield
my $year = '';

### keep track of how many CHECK_INTERVALS have elapsed; this is
### useful for TOP_SCANS_CTR_THRESHOLD
my $check_interval_ctr = 0;

### track the number of scan IP pairs for MAX_SCAN_IP_PAIRS thresholding
my $scan_ip_pairs = 0;

### %auto_dl holds all ip addresses that should automatically
### be assigned a danger level (or ignored).
my %auto_dl = ();
my %auto_dl_ip_objs = ();
my %auto_assigned_msg = ();
my $PERMANENT = 0;

### cache the source ips that we have automatically blocked
### (if ENABLE_AUTO_IDS == 'Y')
my %auto_blocked_ips = ();

### counter to check psad iptables chains and jump rules
my $iptables_prereq_check = 0;

### cache the addresses we have issued dns lookups against.
my %dns_cache = ();

### cache the addresses we have executed whois lookups against.
my %whois_cache = ();

### cache ports the local machine is listening on (periodically
### updated by get_listening_ports()).
my %local_ports = ();

### cache the ip addresses associated with each interface on the
### local machine.
my %local_ips = ();

### Top attacking statistics
my %top_tcp_ports = ();
my %top_udp_ports = ();
my %top_udplite_ports = ();
my %top_sigs    = ();
my %sig_sources = ();
my %top_sig_counts = ();
my %top_packet_counts = ();
my %local_src = ();

### regex to match IP addresses
my $ipv4_re = qr|(?:[0-2]?\d{1,2}\.){3}[0-2]?\d{1,2}|;  ### IPv4

### IPv6 - full version in ip6tables logs
my $ipv6_re = qr|(?:[a-f0-9]{4}:){7}(?:[a-f0-9]{4})|i;

### ttl values are decremented depending on the number of hops
### the packet has taken before it hits the firewall.  We will
### assume packets will not jump through more than 20 hops on
### average.
my $max_hops = 20;

### initial set of protocol packet counters (may get expanded through
### things like protocol scan detection)
my %protocols = (
    'tcp'     => '',
    'udp'     => '',
    'udplite' => '',
    'icmp'    => '',
    'icmp6'   => ''
);
my %proto_ctrs = ();
my %protocol_strings = ();

### pid file hash
my %pidfiles = ();

### for the IPTables::ChainMgr module
my %ipt_opts = ();

### initialize and scope some default variables (command
### line args can override some default values)
my $sigs_file        = '';
my $posf_file        = '';
my $auto_dl_file     = '';
my $snort_rules_dir  = '';
my $srules_type      = '';
my $cmdline_file     = '';
my $analyze_mode     = 0;
my $analysis_fields  = '';
my $analysis_tokens_ar = [];
my $analysis_match_criteria_ar = [];
my $analyze_mode_auto_block = 0;
my $get_next_rule_id = 0;
my $test_mode        = 0;
my $syslog_server    = 0;
my $kill             = 0;
my $restart          = 0;
my $restrict_ip      = '';
my $restrict_ip_cmdline = '';
my $status_mode      = 0;
my $status_ip        = '';
my $status_min_dl    = 0;
my $status_summary   = 0;
my $fw_list_auto     = 0;
my $fw_block_ip      = '';
my $fw_rm_block_ip   = '';
my $fw_del_chains    = 0;
my $gnuplot_mode     = 0;
my $gnuplot_year     = 0;
my $gnuplot_prev_mon = 0;
my $gnuplot_title    = '';
my $gnuplot_legend_title = '';
my $gnuplot_grayscale = 0;
my $gnuplot_x_label = '';
my $gnuplot_x_range = '';
my $gnuplot_y_label = '';
my $gnuplot_y_range = '';
my $gnuplot_z_label = '';
my $gnuplot_z_range = '';
my $gnuplot_3d   = 0;
my $gnuplot_view = '';
my $gnuplot_sort_style = 'value';
my $gnuplot_graph_style = '';
my $gnuplot_count_type  = '';
my $gnuplot_count_element = -1;
my %gnuplot_cache_uniq = ();
my @gnuplot_data = ();
my $gnuplot_data_file = 'psad_iptables.dat';
my $gnuplot_plot_file = 'psad_iptables.gnu';
my $gnuplot_png_file  = 'psad_iptables.png';
my $gnuplot_file_prefix = '';
my $gnuplot_template_file = '';
my $store_file       = '';
my $gnuplot_interactive = 0;
my $plot_separator   = ', ';  ### default to CSV format for plot data
my $csv_mode         = 0;
my $csv_stdin        = 0;
my $csv_fields       = '';
my $csv_print_uniq   = 0;
my $csv_line_limit   = 0;
my $csv_start_line   = 0;
my $csv_end_line     = 0;
my $csv_regex        = '';
my $csv_neg_regex    = '';
my $csv_have_timestamp = 0;
my $pkts_from_stdin = 0;
my $dump_ipt_policy  = 0;
my $fw_include_ips   = 0;
my $benchmark        = 0;
my $num_packets      = 0;
my $usr1             = 0;
my $hup              = 0;
my $usr1_flag        = 0;
my $hup_flag         = 0;
my $verbose          = 0;
my $print_ver        = 0;
my $help             = 0;
my $dump_conf        = 0;
my $download_sigs    = 0;
my $chk_interval     = 0;
my $log_len          = 23;  ### used in scan_logr()
my $fw_analyze       = 0;
my $fw_file          = '';
my $lib_dir          = '';
my $rm_data_ctr      = 0;
my $analysis_emails  = 0;
my $analysis_whois   = 0;
my $enable_analysis_dns = 0;
my $netstat_lkup_ctr = 0;
my $kmsgsd_started   = 0;
my $warn_msg         = '';
my $die_msg          = '';
my $skip_first_loop  = 1;
my $fw_msg_read_continue = 1;
my $fw_msg_read_do_sleep = 1;
my $fw_read_cmd = '';
my $cmdl_interface  = '';
my $analyze_write_data = 0;
my $local_ips_lkup_ctr = 0;
my $num_hash_marks = 76;  ### for gnuplot output
my $imported_syslog_module = 0;
my $TRUNCATE    = 1;
my $NO_TRUNCATE = 0;
my $s = ''; ### for IO::Select

### these flags are used to disable several features
### in psad if specified from the command line
my $no_snort_sids = 0;
my $no_signatures = 0;
my $no_icmp_types = 0;
my $no_icmp6_types = 0;
my $no_auto_dl    = 0;
my $no_posf       = 0;
my $no_daemon     = 0;
my $no_ipt_errors = 0;
my $no_rdns       = 0;
my $no_whois      = 0;
my $no_netstat    = 0;
my $no_fwcheck    = 0;
my $no_kmsgsd     = 0;
my $no_email_alerts  = 0;
my $no_syslog_alerts = 0;

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

### for EXPECT_TCP_OPTIONS handling
my $found_one_tcp_options_field = 0;

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

my %ip_options = ();

### for ICMP
my $ICMP_ECHO_REQUEST  = 8;
my $ICMP_ECHO_REPLY    = 0;
my $ICMP6_ECHO_REQUEST = 128;
my $ICMP6_ECHO_REPLY   = 129;

### These are not directly support by psad because they
### do not appear in iptables logs; however, several of
### these options are supported if fwsnort is also running.
my @unsupported_snort_opts = qw(
    pcre
    fragbits
    content-list
    rpc
    byte_test
    byte_jump
    distance
    within
    flowbits
    rawbytes
    regex
    isdataat
    uricontent
    content
    offset
    replace
    resp
    flowbits
    ip_proto
);  ### the ip_proto keyword could be supported, but would require
    ### refactoring parse_NF_pkt_str().

### for Snort signature sp/dp matching
my @port_types = (
    {'sp' => 'norm', 'dp' => 'norm'},
    {'sp' => 'norm', 'dp' => 'neg'},
    {'sp' => 'neg',  'dp' => 'norm'},
    {'sp' => 'neg',  'dp' => 'neg'},
);

### main packet data structure
my %pkt_NF_init = (

    ### data link layer
    'src_mac' => '',
    'dst_mac' => '',
    'intf'    => '',   ### FIXME in and out interfaces?

    ### network layer
    'src'    => '',
    's_obj'  => '',
    'dst'    => '',
    'd_obj'  => '',
    'proto'  => '',
    'ip_len' => -1,
    'ip_opts'  => '',  ### v4 or v6

    ### IPv4
    'ip_id'  => -1,
    'ttl'    => -1,
    'tos'    => '',
    'frag_bit' => 0,

    ### IPv6
    'is_ipv6' => 0,
    'tc'      => -1,
    'hop_limit'  => -1,
    'flow_label' => -1,

    ### ICMP
    'itype'    => -1,
    'icode'    => -1,
    'icmp_seq' => -1,
    'icmp_id'  => -1,

    ### transport layer
    'sp'  => -1,
    'dp'  => -1,
    'win' => -1,
    'flags' => -1,
    'tcp_seq'  => -1,
    'tcp_ack'  => -1,
    'tcp_opts' => '',
    'udp_len'  => -1,

    ### extra fields for psad internals (DShield reporting, fwsnort
    ### sid matching, iptables logging prefixes and chains, etc.)
    'fwsnort_sid'   => 0,
    'fwsnort_rnum'  => 0,
    'fwsnort_estab' => 0,
    'is_topera'     => 0,  ### Topera IPv6 scanner detection, requires --log-ip-options
    'is_masscan'    => 0,  ### Masscan detection, requires --log-tcp-options
    'chain'         => '',
    'log_prefix'    => '',
    'dshield_str'   => '',
    'syslog_host'   => '',
    'timestamp'     => ''
);

my %gnuplot_non_digit_packet_fields = (
    ### 'hashentry' - maps the field to an integer based on whether
    ###               it has been seen before
    ### 'intf2int'  - converts interface number to an integer (e.g. eth0 -> 0)
    ### 'ip2int'    - converts IP address to integer representation

    ### data link layer
    'src_mac' => 'hashentry',
    'dst_mac' => 'hashentry',
    'intf'    => 'intf2int',

    ### network layer
    'src'      => 'ip2int',
    'dst'      => 'ip2int',
    'proto'    => 'proto2int',
    'tos'      => 'hashentry',
    'ip_opts'  => 'hashentry',
    'frag_bit' => 'hashentry',

    ### transport layer
    'flags'    => 'hashentry',
    'tcp_opts' => 'hashentry',

    ### extra fields for psad internals (DShield reporting, fwsnort
    ### sid matching, iptables logging prefixes and chains, etc.)
    'chain'         => 'hashentry',
    'log_prefix'    => 'hashentry',
    'dshield_str'   => 'hashentry',
    'syslog_host'   => 'hashentry',
);
my %gnuplot_non_digit_map = ();
my %ip2int_cache   = ();
my %gnuplot_ip2int = ();

my $EXIT_SUCCESS = 0;
my $EXIT_FAILURE = 1;

### packet parsing return values
my $PKT_ERROR   = 0;
my $PKT_SUCCESS = 1;
my $PKT_IGNORE  = 2;

### icmp header validation
my $BAD_ICMP_TYPE = 1;
my $BAD_ICMP_CODE = 2;

my $SIG_MATCH    = 1;
my $NO_SIG_MATCH = 0;

### header lengths
my $TCP_HEADER_LEN   = 20;  ### excludes options
my $TCP_MAX_OPTS_LEN = 44;
my $UDP_HEADER_LEN   = 8;
my $ICMP_HEADER_LEN  = 4;
my $IP_HEADER_LEN    = 20;  ### excludes options

### save a copy of the command line arguments
my @args_cp = @ARGV;

### handle command line args
&getopt_wrapper();

### Everthing after this point must be executed as root (psad
### only needs root if run in auto-blocking mode; should take
### this into account and drop privileges).
&is_root();

### Import all psad configuration and signatures files
### (psad.conf, posf, signatures, psad_icmp_types,
### and auto_dl), and call setup().
&psad_init();

### check to make sure another psad process is not already running.
&unique_pid($config{'PSAD_PID_FILE'});

### get the ip addresses that are local to this machine
&get_local_ips();

### get the current services running on this machine
&get_listening_ports() unless $no_netstat;

### daemonize psad unless running with --no-daemon or an
### analysis mode
unless ($no_daemon or $debug) {
    my $pid = fork();
    exit 0 if $pid;
    die "[*] $0: Couldn't fork: $!" unless defined $pid;
    POSIX::setsid() or die "[*] $0: Can't start a new session: $!";
}

### write the current pid associated with psad to the psad pid file
&write_pid($config{'PSAD_PID_FILE'});

### write the command line args used to start psad to $cmdline_file
&write_cmd_line(\@args_cp, $cmdline_file)
    unless $debug;

### psad requires that kmsgsd is running to receive any data (unless
### SYSLOG_DAEMON is set to ulogd or psad is configured to acquire data
### from a normal file via IPT_SYSLOG_FILE), so let's start it here for good
### measure (as of 0.9.2 it makes use of the pid files and unique_pid(),
### so we don't have to worry about starting a duplicate copy).  While
### we're at it, start psadwatchd as well.  Note that this is the best
### place to start the other daemons since we just wrote the psad pid
### to PID_FILE above.
my $cmd = '';
unless ($config{'ENABLE_SYSLOG_FILE'} eq 'Y'
        or $no_kmsgsd
        or $config{'SYSLOG_DAEMON'} =~ /ulog/i
        or $kmsgsd_started) {
    $cmd  = $cmds{'kmsgsd'};
    $cmd .= " -c $config_file";
    $cmd .= " -O $override_config_str"
        if $override_config_str;
    open KMSGSD, "| $cmd" or die "[*] Could not execute $cmds{'kmsgsd'}";
    close KMSGSD;
    $kmsgsd_started = 1;
}

unless ($kmsgsd_started) {
    my $pid = &is_running($pidfiles{'kmsgsd'});

    if ($pid) {
        kill 9, $pid unless kill 15, $pid;
    }
    unlink $pidfiles{'kmsgsd'} if -e $pidfiles{'kmsgsd'};
}

unless ($debug or $no_daemon or $config{'ENABLE_PSADWATCHD'} eq 'N') {
    $cmd  = $cmds{'psadwatchd'};
    $cmd .= " -c $config_file";
    $cmd .= " -O $override_config_str"
        if $override_config_str;
    open PSADWATCHD, "| $cmd" or die "[*] Could not ",
        "execute $cmds{'psadwatchd'}";
    close PSADWATCHD;
}

if ($config{'ENABLE_AUTO_IDS'} eq 'Y') {
    ### always flush old rules (the subsequent renew_auto_blocked_ips()
    ### will re-instantiate any that should not have been expired).
    &flush_auto_blocked_ips() if $config{'FLUSH_IPT_AT_INIT'} eq 'Y';

    ### Check to see if psad automatically blocked some IPs from
    ### a previous run.  This feature is most useful for preserving
    ### auto-block rules for IPs after a reboot or after restarting
    ### psad.  (Note that ENABLE_AUTO_IDS is disabled by psad_init()
    ### if we are running on a syslog server or if we are running
    ### in -A mode).
    &renew_auto_blocked_ips();
}

### Install signal handlers for debugging %scan with Data::Dumper,
### and for reaping zombie whois processes.
$SIG{'__WARN__'} = \&warn_handler;
$SIG{'__DIE__'}  = \&die_handler;
$SIG{'USR1'}     = \&usr1_handler;
$SIG{'HUP'}      = \&hup_handler;

if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y') {
    $last_dshield_alert = time() unless $last_dshield_alert;
}

### Initialize current time for disk space checking.
my $last_disk_check = time();

if ($config{'IMPORT_OLD_SCANS'} eq 'Y') {
    ### import old scans and counters from /var/log/psad/
    &import_old_scans();
} elsif ($config{'ENABLE_SCAN_ARCHIVE'} eq 'Y') {
    &archive_data();
} else {
    &remove_old_scans();
}

### zero out the packet counter file (the counters
### are all zero at this point anyway unless we
### imported old scans).
&write_global_packet_counters();

### zero out prefix counters
&write_prefix_counters();

### zero out dshield alert stats (note we do this here regardless of
### whether DShield alerting is enabled since if it isn't we will
### just zero out the counters).
&write_dshield_stats();

my $fw_data_file_size  = -s $fw_data_file;
my $fw_data_file_inode = (stat($fw_data_file))[1];

my $fw_data_file_check_ctr = 0;

### main firewall packets array
my @fw_packets = ();

### Get an open filehandle for the main firewall data file FW_DATA_FILE.
my $fwdata_fh = &open_fw_data();

&get_auto_response_domain_sock()
    if $config{'ENABLE_AUTO_IDS'} eq 'Y';

###=========================================================###
######                    MAIN LOOP                      ######
###=========================================================###
MAIN: for (;;) {

    ### for --fw-block <ip>
    my @add_ipt_addrs = ();

    $fwdata_fh = &hup_re_init($fwdata_fh) if $hup_flag;

    &usr1_print_scan() if $usr1_flag;

    ### allow the contents of the fwdata file to be processed only after
    ### the first loop has been executed.
    if ($skip_first_loop) {

        $skip_first_loop = 0;
        unless ($config{'ENABLE_FW_MSG_READ_CMD'} eq 'Y') {
            seek $fwdata_fh,0,SEEK_END;  ### seek to the end of the file
        }
        next MAIN;

    } else {

        ### Get any new packets have been written to syslog
        if ($config{'ENABLE_FW_MSG_READ_CMD'} eq 'Y') {
            if ($s->can_read(.5)) {
                my $syslog_line = <$fwdata_fh>;
                $fwdata_fh->flush();
                push @fw_packets, $syslog_line unless $fw_msg_read_continue;
                $fw_msg_read_do_sleep = 0;
            } else {
                $fw_msg_read_continue = 0;
                $fw_msg_read_do_sleep = 1;
            }

        } else {
            @fw_packets = <$fwdata_fh>;
        }

        if ($config{'ENABLE_AUTO_IDS'} eq 'Y') {

            ### get IP from the domain socket
            my $ipt_add_connection = $ipt_sock->accept();
            if ($ipt_add_connection) {
                @add_ipt_addrs = <$ipt_add_connection>;
            }
        }
    }

    $fwdata_fh = &fw_data_file_check($fwdata_fh)
        unless $config{'ENABLE_FW_MSG_READ_CMD'} eq 'Y';

    ### sleep for the check interval seconds
    if ($config{'ENABLE_FW_MSG_READ_CMD'} eq 'Y') {

        if ($fw_msg_read_do_sleep
                or (($#fw_packets+1) % $config{'FW_MSG_READ_MIN_PKTS'} == 0)) {

            if (@fw_packets) {
                ### Extract data and summarize scan packets, assign danger
                ### level, send email/syslog alerts.
                &check_scan(\@fw_packets);
            }

            &post_scan_processing($#fw_packets+1, \@add_ipt_addrs);
            @fw_packets = ();
        }

        unless (&look_for_process(quotemeta($fw_read_cmd))) {
            &sys_log("firewall logs read command '$fw_read_cmd' " .
                "is not running, restarting");
            close $fwdata_fh;
            $s->remove($fwdata_fh);
            undef $s;
            $fwdata_fh = &open_fw_data();
            $fw_msg_read_continue = 1;
        }

        sleep $config{'CHECK_INTERVAL'} if $fw_msg_read_do_sleep;

    } else {

        if (@fw_packets) {
            ### Extract data and summarize scan packets, assign danger
            ### level, send email/syslog alerts.
            &check_scan(\@fw_packets);
        }

        &post_scan_processing($#fw_packets+1, \@add_ipt_addrs);

        @fw_packets = ();

        ### clearerr() on the $fwdata_fh file handle to be ready
        ### for new packets
        $fwdata_fh->clearerr();

        sleep $config{'CHECK_INTERVAL'};
    }

    $check_interval_ctr++;
    $fw_data_file_check_ctr++;

} ### MAIN

### for completeness
close $fwdata_fh;
exit 0;
###=========================================================###
######                    END MAIN                       ######
###=========================================================###

#=================== BEGIN SUBROUTINES ========================

sub post_scan_processing() {
    my ($num_packets, $add_ipt_addrs_ar) = @_;

    ### log top scans data
    my $do_log = 0;
    if ($config{'TOP_SCANS_CTR_THRESHOLD'} == 0) {
        $do_log = 1;
    } elsif ($check_interval_ctr % $config{'TOP_SCANS_CTR_THRESHOLD'} == 0) {
        $do_log = 1;
    }

    if ($do_log) {
        ### log the top port and signature matches
        &log_top_scans();
    }

    ### Write the number of tcp/udp/icmp packets out
    ### to the global packet counters file
    &write_global_packet_counters();

    ### Write out log prefix counters
    &write_prefix_counters();

    if ($config{'ENABLE_AUTO_IDS'} eq 'Y') {
        ### Timeout any auto-blocked IPs that are past due (need to
        ### check the timeouts against existing IPs in the scan hash
        ### even if new packets are not found).
        &timeout_auto_blocked_ips();

        ### see if we need to add any IP addresses from the domain
        ### socket
        &check_ipt_cmd($add_ipt_addrs_ar) if $#$add_ipt_addrs_ar > -1;
    }

    ### Send logs to dshield in dshield format
    &dshield_email_log() if $config{'ENABLE_DSHIELD_ALERTS'} eq 'Y';

    ### Allow disk space utilization checks to be disabled by
    ### setting DISK_MAX_PERCENTAGE = 0.
    if ($config{'DISK_MAX_PERCENTAGE'} > 0
            and (time() - $last_disk_check) > $config{'DISK_CHECK_INTERVAL'}) {
        $fwdata_fh = &disk_check($fwdata_fh);
    }

    &check_auto_response_sock()
        if $config{'ENABLE_AUTO_IDS'} eq 'Y';

    &notifications($num_packets);

    ### see if we need to timeout any old scans
    &scan_timeouts() if $config{'ENABLE_PERSISTENCE'} eq 'N';

    return;
}

### Keeps track of scanning ip's, increments packet counters,
### keeps track of tcp flags for each scan, test for snort sid
### values in iptables packets (if fwsnort is being used).
sub check_scan() {
    my $fw_packets_ar = shift;

    print STDERR "[+] check_scan()...\n" if $debug;

    if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y') {
        ### calculate the timezone offset
        $timezone = sprintf("%.2d", (Timezone())[3]) . ':00';
        $year     = This_Year();
    }

    unless ($no_netstat) {
        ### we don't expect the list of ports the machine is listening
        ### on to change very often.
        if ($netstat_lkup_ctr == 10) {
            &get_listening_ports();
            $netstat_lkup_ctr = 0;
        }
        $netstat_lkup_ctr++;
    }
    ### the local machine ip addresses could change (dhcp, etc.)
    ### but not that often.
    if ($local_ips_lkup_ctr == 30) {
        &get_local_ips();
        $local_ips_lkup_ctr = 0;
    }
    $local_ips_lkup_ctr++;

    my %curr_scan = ();
    my %curr_sigs_dl = ();
    my %curr_sids_dl = ();
    my @err_pkts     = ();
    my %auto_block_regex_match = ();

    my $pkt_ctr = 0;
    my $log_scan_ip_pair_max = 0;

    my $print_scale_factor = &get_scale_factor($#$fw_packets_ar);

    ### loop through all of the packet log messages we have just acquired
    ### from iptables

    PKT: for my $pkt_str (@$fw_packets_ar) {

        ### main packet data structure
        my %pkt = %pkt_NF_init;

        if ($analyze_mode) {
            $pkt_ctr++;
            if ($pkt_ctr % $print_scale_factor == 0) {
                print "[+] Processed $pkt_ctr packets...\n";
            }
        }

        ### main parsing routine for the iptables packet logging message
        my $pkt_parse_rv = &parse_NF_pkt_str(\%pkt, $pkt_str);
        print STDERR Dumper \%pkt if $debug and $verbose;
        if ($pkt_parse_rv == $PKT_ERROR) {
            push @err_pkts, $pkt_str unless $no_ipt_errors;
            next PKT;
        } elsif ($pkt_parse_rv == $PKT_IGNORE) {
            next PKT;
        }

        if ($analyze_mode and $analysis_fields) {
            my ($matched_fields_ar, $gnuplot_comment_str)
                = &ipt_match_criteria(\%pkt, $analysis_tokens_ar,
                        $analysis_match_criteria_ar);
            next PKT unless $#$matched_fields_ar > -1;
        }

        $proto_ctrs{$pkt{'proto'}}++;
        $protocols{$pkt{'proto'}} = '';
        if ($pkt{'proto'} eq 'tcp') {
            $top_tcp_ports{$pkt{'dp'}}++;
        } elsif ($pkt{'proto'} eq 'udp') {
            $top_udp_ports{$pkt{'dp'}}++;
        } elsif ($pkt{'proto'} eq 'udplite') {
            $top_udplite_ports{$pkt{'dp'}}++;
        }

        ### If we made it here then we correctly matched packets
        ### that the firewall logged.
        print STDERR "[+] valid packet: $pkt{'src'} ($pkt{'sp'}) -> ",
            "$pkt{'dst'} ($pkt{'dp'}) $pkt{'proto'}\n" if $debug;

        ### see if we have hit the MAX_SCAN_IP_PAIRS threshold
        if ($config{'MAX_SCAN_IP_PAIRS'} > 0) {
            if ($scan_ip_pairs >= $config{'MAX_SCAN_IP_PAIRS'}) {
                unless (defined $scan{$pkt{'src'}}
                        and defined $scan{$pkt{'src'}}{$pkt{'dst'}}) {
                    print STDERR "[-] excluding $pkt{'src'} -> $pkt{'dst'}, ",
                            "scan IP pairs too high: $scan_ip_pairs\n"
                        if $debug;
                    $log_scan_ip_pair_max = 1;
                    next PKT;
                }
            }
            if (not defined $scan{$pkt{'src'}}) {
                $scan_ip_pairs++;
            } elsif (not defined $scan{$pkt{'src'}}{$pkt{'dst'}}) {
                $scan_ip_pairs++;
            }
        }

        ### track packet counts for this source
        $top_packet_counts{$pkt{'src'}}++;

        if ($config{'HOME_NET'} ne 'any') {
            if ($pkt{'chain'} eq 'INPUT') {
                $local_src{$pkt{'dst'}} = '';
            } elsif ($pkt{'chain'} eq 'OUTPUT') {
                $local_src{$pkt{'src'}} = '';
            } elsif ($pkt{'chain'} eq 'FORWARD') {
                $local_src{$pkt{'src'}} = ''
                    if &is_local($pkt{'src'}, $pkt{'s_obj'});
            }
        }

        ### initialize the danger level to 0 if it is not already defined
        ### (note the same source address might have already scanned a
        ### different destination IP, so the danger level represents the
        ### aggregate danger level).
        unless (defined $scan_dl{$pkt{'src'}}) {
            $scan_dl{$pkt{'src'}} = 0;
            $scan{$pkt{'src'}}{$pkt{'dst'}}{'alerted'} = 0
                if $config{'ALERT_ALL'} eq 'N';
        }

        ### see if we need to assign a danger level according to the auto_dl
        ### file.  The return value is the auto-assigned danger level (or
        ### -1 if there is no auto-assigned danger level.
        unless ($no_auto_dl) {
            my $rv = &assign_auto_danger_level(\%pkt);

            print STDERR "[+] assign_auto_danger_level() returned: $rv\n"
                if $debug;
            if ($rv == 0) {
                print STDERR "[+] ignoring $pkt{'src'} $pkt{'proto'} ",
                    "$pkt{'dp'} scan.\n" if $debug;
                next PKT;
            }
        }

        if ($pkt{'proto'} eq 'icmp') {

            ### validate icmp type and code fields against the official values
            ### in RFC 792.  See %inval_type_code for corresponding signature
            ### message text and danger levels.
            my $type_code_rv = &check_icmp_type(
                    'icmp', \%valid_icmp_types,
                    $pkt{'itype'}, $pkt{'icode'});

            my $update_dl = 0;
            if ($type_code_rv == $BAD_ICMP_TYPE) {

                $scan{$pkt{'src'}}{$pkt{'dst'}}{'icmp'}
                    {'invalid_type'}{$pkt{'itype'}}
                    {$pkt{'chain'}}{'pkts'}++;

                $update_dl = 1;

            } elsif ($type_code_rv == $BAD_ICMP_CODE) {

                $scan{$pkt{'src'}}{$pkt{'dst'}}{'icmp'}
                    {'invalid_code'}{$pkt{'itype'}}{$pkt{'icode'}}
                    {$pkt{'chain'}}{'pkts'}++;

                $update_dl = 1;
            }

            if ($update_dl) {
                if (defined $scan_dl{$pkt{'src'}}) {
                    if ($scan_dl{$pkt{'src'}} < 2) {
                        $scan_dl{$pkt{'src'}} = 2;
                    }
                } else {
                    $scan_dl{$pkt{'src'}} = 2;
                }
            }

        } elsif ($pkt{'proto'} eq 'icmp6') {

            ### validate icmp6 type and code fields against the official values
            ### defined by IANA.  See %inval_type_code for corresponding signature
            ### message text and danger levels.
            my $type_code_rv = &check_icmp_type(
                    'icmp6', \%valid_icmp6_types,
                    $pkt{'itype'}, $pkt{'icode'});

            my $update_dl = 0;
            if ($type_code_rv == $BAD_ICMP_TYPE) {

                $scan{$pkt{'src'}}{$pkt{'dst'}}{'icmp6'}
                    {'invalid_type'}{$pkt{'itype'}}
                    {$pkt{'chain'}}{'pkts'}++;

                $update_dl = 1;

            } elsif ($type_code_rv == $BAD_ICMP_CODE) {

                $scan{$pkt{'src'}}{$pkt{'dst'}}{'icmp6'}
                    {'invalid_code'}{$pkt{'itype'}}{$pkt{'icode'}}
                    {$pkt{'chain'}}{'pkts'}++;

                $update_dl = 1;
            }

            if ($update_dl) {
                if (defined $scan_dl{$pkt{'src'}}) {
                    if ($scan_dl{$pkt{'src'}} < 2) {
                        $scan_dl{$pkt{'src'}} = 2;
                    }
                } else {
                    $scan_dl{$pkt{'src'}} = 2;
                }
            }
        }

        unless ($no_snort_sids) {
            if ($pkt{'fwsnort_sid'}) {

                ### found a fwsnort sid in the packet log message
                my ($dl, $is_sig_match) = &add_fwsnort_sid(\%pkt);

                if ($dl) {
                    $curr_sids_dl{$pkt{'src'}} = $dl;
                } else {
                    ### a signature matched but is supposed
                    ### to be ignored
                    next PKT if $is_sig_match == $SIG_MATCH;
                }

            } else {
                ### attempt to match any tcp/udp/icmp signatures in the
                ### main signatures hash
                unless ($no_signatures) {

                    my ($dl, $is_sig_match) = &match_sigs(\%pkt);

                    print STDERR "    match_sigs() returned DL: $dl\n"
                        if $debug and $verbose;

                    if ($dl) {
                        $curr_sigs_dl{$pkt{'src'}} = $dl;
                    } else {
                        ### a signature matched but is supposed
                        ### to be ignored
                        next PKT if $is_sig_match == $SIG_MATCH;
                    }
                }
            }
        }

        ### note that we send this packet data off to DShield regardless
        ### of whether psad decides that it is associated with a scan so
        ### that DShield can make its own determination
        if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
                and not $benchmark
                and not $analyze_mode
                and $pkt{'dshield_str'}) {
            if ($pkt{'timestamp'} =~ /^\s*(\w+)\s+(\d+)\s+(\S+)/) {
                my $m_tmp = $1;  ### kludge for Decode_Month() call
                my $month   = Decode_Month($m_tmp);
                my $day     = sprintf("%.2d", $2);
                my $time_24 = $3;
                push @dshield_data, "$year-$month-$day $time_24 " .
                    "$timezone\t$config{'DSHIELD_USER_ID'}\t1" .
                    "\t$pkt{'dshield_str'}\n";
            }
        }

        ### record the absolute starting time of the scan
        unless (defined $scan{$pkt{'src'}}{$pkt{'dst'}}{'s_time'}) {
            if ($analyze_mode) {
                if ($pkt_str =~ /^(.*?)\s+\S+\s+kernel:/) {
                    $scan{$pkt{'src'}}{$pkt{'dst'}}{'s_time'}
                        = &date_time($1);
                } elsif ($pkt_str =~ /^\s*(\S+\s+\S+\s+\S+)/) {
                    $scan{$pkt{'src'}}{$pkt{'dst'}}{'s_time'}
                        = &date_time($1);
                } else {
                    die "[*] Could not extract time from packet: $pkt_str\n",
                        "    Please send a bug report to: ",
                        "mbr\@cipherdyne.org\n";
                }
            } else {
                $scan{$pkt{'src'}}{$pkt{'dst'}}{'s_time'} = time();
            }
        }


        ### increment hash values
        $scan{$pkt{'src'}}{$pkt{'dst'}}{'absnum'}++;

        $scan{$pkt{'src'}}{$pkt{'dst'}}{'tot_protocols'} = 0
            unless defined $scan{$pkt{'src'}}{$pkt{'dst'}}{'tot_protocols'};
        $scan{$pkt{'src'}}{$pkt{'dst'}}{'tot_protocols'}++
            unless defined $scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}};

        $scan{$pkt{'src'}}{$pkt{'dst'}}{'chain'}
            {$pkt{'chain'}}{$pkt{'intf'}}{$pkt{'proto'}}++;

        ### keep track of MAC addresses
        $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{'s_mac'} = $pkt{'src_mac'};
        $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{'d_mac'} = $pkt{'dst_mac'};

        $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{'tot_protocols'} = 0
            unless defined $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{'tot_protocols'};
        $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{'tot_protocols'}++
            unless defined $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}};

        $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'pkts'}++;
        $curr_scan{$pkt{'src'}}{$pkt{'dst'}}
            {$pkt{'proto'}}{'flags'}{$pkt{'flags'}}++ if $pkt{'flags'};

        ### keep track of which syslog daemon reported the message.
        $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{'syslog_host'}
            {$pkt{'syslog_host'}} = '' if $pkt{'syslog_host'};

        $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{'is_topera'}  = $pkt{'is_topera'};
        $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{'is_masscan'} = $pkt{'is_masscan'};

        if ($pkt{'log_prefix'}) {
            ### see if the logging prefix matches the blocking
            ### regex, and if not the IP will not be blocked
            if ($config{'ENABLE_AUTO_IDS'} eq 'Y'
                    and $config{'ENABLE_AUTO_IDS_REGEX'} eq 'Y'
                    and $config{'AUTO_BLOCK_REGEX'} ne 'NONE') {
                ### we require a match
                if (not defined $auto_block_regex_match{$pkt{'src'}}
                        and $pkt{'log_prefix'} =~ /$config{'AUTO_BLOCK_REGEX'}/) {
                    $auto_block_regex_match{$pkt{'src'}} = '';
                }
            }
        } else {
            $pkt{'log_prefix'} = '*noprfx*';
        }

        ### keep track of iptables chain and logging prefix
        $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'chain'}
                {$pkt{'chain'}}{$pkt{'log_prefix'}}++;

        if ($pkt{'proto'} eq 'tcp' or $pkt{'proto'} eq 'udp'
                or $pkt{'proto'} eq 'udplite') {

            ### initialize the start and end port for the scanned port range
            if (not defined $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'strtp'}) {
                ### make sure the initial start port is not too low
                $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'strtp'} = 65535;
                ### make sure the initial end port is not too high
                $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'endp'} = 0;
            }
            unless (defined $scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}
                    and defined $scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'abs_sp'}) {
                ### This is the absolute starting port since the
                ### first packet was detected.  Make sure the initial
                ### start port is not too low
                $scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'abs_sp'} = 65535;
                ### make sure the initial end port is not too high
                $scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'abs_ep'} = 0;
            }

            ### see if the destination port lies outside our current range
            ### and change if needed
            ($curr_scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'strtp'},
                    $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'endp'}) =
                &check_range($pkt{'dp'},
                    $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'strtp'},
                    $curr_scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'endp'});
            ($scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'abs_sp'},
                    $scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'abs_ep'}) =
                &check_range($pkt{'dp'},
                    $scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'abs_sp'},
                    $scan{$pkt{'src'}}{$pkt{'dst'}}{$pkt{'proto'}}{'abs_ep'});

        }

        if ($debug and $verbose) {
            print STDERR "    print Dumper scan hash $pkt{'src'} -> $pkt{'dst'}\n";
            print STDERR Dumper $scan{$pkt{'src'}}{$pkt{'dst'}};
        }

        ### attempt to passively guess the remote operating
        ### system based on the ttl, id, len, window, and tos
        ### fields in tcp syn packets (this technique is based
        ### on the paper "Passive OS Fingerprinting: Details
        ### and Techniques" by Toby Miller).  Also attempt to
        ### fingerprint with a re-implementation of Michal Zalewski's
        ### p0f that only requires iptables log messages
        unless ($no_posf) {
            ### make sure we have not already guessed the OS,
            ### and if we have been unsuccessful in guessing
            ### the OS after 100 packets don't keep trying.
            if ($pkt{'proto'} eq 'tcp' and $pkt{'flags'} =~ /SYN/) {
                if ($pkt{'tcp_opts'}) {  ### got the tcp options portion of the header

                    ### p0f based fingerprinting
                    &p0f(\%pkt);

                } elsif (not defined $posf{$pkt{'src'}}{'guess'}
                        and $scan{$pkt{'src'}}{$pkt{'dst'}}{'absnum'} < 100) {
                    &posf(\%pkt);
                }
            }
        }

        %pkt = ();
    }

    ### write bogus packets to the error log.
    if ($benchmark) {
        print scalar localtime(), ' [+] Err packets: ' .
            ($#err_pkts+1) . ".\n";
    } else {
        &collect_errors(\@err_pkts) unless $no_ipt_errors;
    }

    ### Assign a danger level to the scan
    print "[+] Assigning scan danger levels...\n" if $analyze_mode;
    &assign_danger_level(\%curr_scan, \%curr_sigs_dl, \%curr_sids_dl);

    my $tot_scan_ips = 0;
    if ($analyze_mode) {
        for (my $dl=1; $dl <= 5; $dl++) {
            my $num_ips = 0;
            for my $src (keys %curr_scan) {
                $num_ips++ if $scan_dl{$src} == $dl;
            }
            $tot_scan_ips += $num_ips;
            print "    Level $dl: $num_ips IP addresses\n";
        }
        print "\n    Tracking $tot_scan_ips total IP addresses\n";
    }

    ### display the scan analysis
    &print_scan_status() if $analyze_mode;

    ### log scan data to the filesystem
    &scan_logr(\%curr_scan);

    ### remember that ENABLE_AUTO_IDS may have been set to 'N' if we
    ### are running on a syslog server, of if we are running in -A mode.
    &auto_psad_response(\%curr_scan, \%auto_block_regex_match)
        if $config{'ENABLE_AUTO_IDS'} eq 'Y'
            and (not $analyze_mode or $analyze_mode_auto_block);

    if ($config{'ENABLE_AUTO_IDS'} eq 'Y' and $analyze_mode_auto_block) {
        sleep $config{'AUTO_BLOCK_TIMEOUT'} + 1;
        &timeout_auto_blocked_ips();
    }

    if ($log_scan_ip_pair_max) {
        &sys_log("scan IP pairs threshold reached");
    }

    return;
}

sub parse_NF_pkt_str() {
    my ($pkt_hr, $pkt_str) = @_;

    my $is_ipv6    = 0;
    my $is_tcp     = 0;
    my $is_udp     = 0;
    my $is_udplite = 0;
    my $is_icmp    = 0;
    my $is_icmp6   = 0;
    my $proto_num  = -1;
    my $proto_str  = '';
    my $is_proto_num = 0;

    ### with ENABLE_SYSLOG_FILE enabled, psad sees all sorts of syslog
    ### messages that aren't just from iptables (kmsgsd is not running
    ### to filter them), so require a preliminary match
    if ($config{'ENABLE_SYSLOG_FILE'} eq 'Y') {
        return $PKT_IGNORE unless $pkt_str =~ /IN=.*OUT=/;
    }

    print STDERR "\n", $pkt_str if $debug;

    $pkt_hr->{'raw'} = $pkt_str if $csv_mode or $gnuplot_mode;

    ### see if there is a logging prefix (used for scan email alert even
    ### if we are running with FW_SEARCH_ALL = Y).  Note that sometimes
    ### there is a buffering issue in the kernel ring buffer that is used
    ### to hold the iptables log message, so we want to get only the
    ### very last possible candidate for the log prefix (this is why the
    ### "kernel:" string is preceded by .*).
    if ($pkt_str =~ /.*kernel:\s+(.*?)\s*IN=/) {
        $pkt_hr->{'log_prefix'} = $1;
        $pkt_hr->{'log_prefix'} =~ s|\[\s*\d+\.\d+\s*\]\s*||
            if ($config{'IGNORE_KERNEL_TIMESTAMP'} eq 'Y');
        if ($pkt_hr->{'log_prefix'} =~ /\S/) {
            if ($config{'IGNORE_LOG_PREFIXES'} ne 'NONE') {
                return $PKT_IGNORE if $pkt_hr->{'log_prefix'}
                        =~ m|$config{'IGNORE_LOG_PREFIXES'}|;
            }
            $ipt_prefixes{$pkt_hr->{'log_prefix'}}++;
        }
    }

    ### get the in/out interface and iptables chain (the code below
    ### allows the iptables log message to contain the PHYSDEV stuff):
    ### Feb 25 12:13:27 bridge kernel: INBOUND TCP: IN=br0 PHYSIN=eth0 OUT=br0
    ### PHYSOUT=eth1 SRC=63.147.183.21 DST=11.11.79.100 LEN=48 TOS=0x00
    ### PREC=0x00 TTL=113 ID=19664 DF PROTO=TCP SPT=4918 DPT=135 WINDOW=64240
    ### RES=0x00 SYN URGP=0
    ### Note the lack of whitespace requirement before the IN= interface
    ### because the logging prefix might not have contained it.
    if ($pkt_str =~ /IN=(\S+)\s+PHYSIN=.*?\sOUT=\s/
            or $pkt_str =~ /IN=(\S+).*?\sOUT=\s/) {
        $pkt_hr->{'intf'}  = $1;
        $pkt_hr->{'chain'} = 'INPUT';
    } elsif ($pkt_str =~ /IN=(\S+)\s+PHYSIN=.*?\sOUT=\S/
            or $pkt_str =~ /IN=(\S+).*?\sOUT=\S/) {
        $pkt_hr->{'intf'}  = $1;
        $pkt_hr->{'chain'} = 'FORWARD';
    } elsif ($pkt_str =~ /IN=\s+PHYSIN=.*?\sOUT=(\S+)/
            or $pkt_str =~ /IN=\s+OUT=(\S+)/) {
        $pkt_hr->{'intf'}  = $1;
        $pkt_hr->{'chain'} = 'OUTPUT';
    }

    ### -I was used on the command line to require a specific interface
    if ($cmdl_interface) {
        return $PKT_IGNORE unless $pkt_hr->{'intf'} eq $cmdl_interface;
    }

    if ($pkt_str =~ /\sMAC=(\S+)/) {
        my $mac_str = $1;
        if ($mac_str =~ /^((?:\w{2}\:){6})((?:\w{2}\:){6})/) {
            $pkt_hr->{'dst_mac'} = $1;
            $pkt_hr->{'src_mac'} = $2;
        }
    }
    if ($pkt_hr->{'src_mac'}) {
        $pkt_hr->{'src_mac'} =~ s/:$//;
        print STDERR "[+] src mac addr: $pkt_hr->{'src_mac'}\n" if $debug;
    }
    if ($pkt_hr->{'dst_mac'}) {
        $pkt_hr->{'dst_mac'} =~ s/:$//;
        print STDERR "[+] dst mac addr: $pkt_hr->{'dst_mac'}\n" if $debug;
    }

    unless ($pkt_hr->{'intf'} and $pkt_hr->{'chain'}) {
        print STDERR "[-] err packet: could not determine ",
            "interface and chain.\n" if $debug;
        return $PKT_ERROR;
    }

    if (%ignore_interfaces) {
        for my $ignore_intf (keys %ignore_interfaces) {
            return $PKT_IGNORE if $pkt_hr->{'intf'} eq $ignore_intf;
        }
    }

    $pkt_hr->{'syslog_host'} = '';

    ### get the syslog logging host and timestamp for this packet
    if ($config{'ENABLE_CUSTOM_SYSLOG_TS_RE'} eq 'Y') {
        if ($pkt_str =~ /$config{'CUSTOM_SYSLOG_TS_RE'}/) {
            $pkt_hr->{'timestamp'}   = $1;
            $pkt_hr->{'syslog_host'} = $2;
        }
    } else {
        if ($pkt_str =~ /^\s*((?:\S+\s+){2}\S+)\s+(\S+)\s+kernel\:/) {
            $pkt_hr->{'timestamp'}   = $1;
            $pkt_hr->{'syslog_host'} = $2;
        } elsif ($pkt_str =~ /^\s*([\d\-]+T(?:\d{2}\:){2}\d{2}\S+)\s+(\S+)\s+kernel\:/) {
            ### 2015-03-08T02:25:11.444012+02:00 servername kernel: ...
            $pkt_hr->{'timestamp'}   = $1;
            $pkt_hr->{'syslog_host'} = $2;
        }
    }

    unless ($pkt_hr->{'syslog_host'}) {
        $pkt_hr->{'timestamp'}   = localtime();
        $pkt_hr->{'syslog_host'} = 'unknown';
    }

    if ($debug) {
        print "[+] timestamp: $pkt_hr->{'timestamp'}\n",
            "    syslog hostname: $pkt_hr->{'syslog_host'}\n";
    }

    ### try to extract a snort sid (generated by fwsnort) from
    ### the packet
    unless ($no_snort_sids) {
        if ($pkt_hr->{'log_prefix'}) {

            if ($pkt_hr->{'log_prefix'} =~ /$config{'SNORT_SID_STR'}(\d+)/) {
                $pkt_hr->{'fwsnort_sid'} = $1;

                ### try to extract the fwsnort rule number (must be
                ### fwsnort-0.9.0 or greater)
                if ($pkt_hr->{'log_prefix'} =~ /\[(\d+)\]/) {
                    $pkt_hr->{'fwsnort_rnum'} = $1;
                }

                if ($pkt_hr->{'log_prefix'} =~ /ESTAB/) {
                    $pkt_hr->{'fwsnort_estab'} = 1;
                }
            }
        }
    }

    unless ($pkt_hr->{'fwsnort_sid'} or $config{'FW_SEARCH_ALL'} eq 'Y') {
        ### note that this is not _too_ strict since people
        ### have different ways of writing --log-prefix strings
        my $matched = 0;
        for my $fw_search_str (@fw_search) {
            $matched = 1 if $pkt_str =~ /$fw_search_str/;
        }
        return $PKT_IGNORE unless $matched;
    }

    ### test for IPv6
    if ($pkt_str =~ /HOPLIMIT=\d+\s+FLOWLBL=\d+/) {
        return $PKT_IGNORE unless $config{'ENABLE_IPV6_DETECTION'} eq 'Y';
        $is_ipv6 = 1;
        $pkt_hr->{'is_ipv6'} = 1;
    }

    ### test for IPv4 "don't fragment" bit
    unless ($is_ipv6) {
        $pkt_hr->{'frag_bit'} = 1 if $pkt_str =~ /\sDF\s+PROTO/;
    }

    ### get IP options if --log-ip-options is used - they appear before the
    ### PROTO= field for either IPv4 or IPv6 packets
    if ($pkt_str =~ /OPT\s+\((\S+)\)\s+PROTO=/) {
        $pkt_hr->{'ip_opts'} = $1;
    }

    if ($is_ipv6 and $pkt_str =~ /PROTO=ICMPv6\s/) {
        ### test for ICMP before TCP or UDP because ICMP destination
        ### unreachable messages can contain embedded TCP/UDP specifics like
        ### so:

        ### Jul 21 19:07:39 minastirith kernel: [1912155.755921] IPv6 Packet
        ### IN=lo OUT= MAC=00:00:00:00:00:00:00:00:00:00:00:00:86:dd
        ### SRC=0000:0000:0000:0000:0000:0000:0000:0001
        ### DST=0000:0000:0000:0000:0000:0000:0000:0001 LEN=107 TC=0
        ### HOPLIMIT=64 FLOWLBL=0 PROTO=ICMPv6 TYPE=1 CODE=4
        ### [SRC=0000:0000:0000:0000:0000:0000:0000:0001
        ### DST=0000:0000:0000:0000:0000:0000:0000:0001 LEN=59 TC=0
        ### HOPLIMIT=64 FLOWLBL=0 PROTO=UDP SPT=35186 DPT=12345 LEN=19 ]

        $is_icmp6  = 1;
        $proto_str = 'icmp6'
    } elsif ($pkt_str =~ /PROTO=ICMP\s/) {
        ### test for ICMP before TCP or UDP because ICMP destination
        ### unreachable messages can contain embedded TCP/UDP specifics like
        ### so:

        ### Sep  8 18:04:26 minastirith kernel: [28241.572876] IN_DROP
        ### IN=wlan0 OUT= MAC=00:1a:9f:91:df:ae:00:12:27:12:0a:a0:12:00
        ### SRC=10.0.0.138 DST=192.168.1.103 LEN=96 TOS=0x00 PREC=0xC0
        ### TTL=254 ID=63642 PROTO=ICMP TYPE=3 CODE=3 [SRC=192.168.1.103
        ### DST=10.0.0.138 LEN=68 TOS=0x00 PREC=0x00 TTL=0 ID=22458 PROTO=UDP
        ### SPT=35080 DPT=33434 LEN=48 ]

        $is_icmp   = 1;
        $proto_str = 'icmp';
    } elsif ($pkt_str =~ /PROTO=TCP\s/) {
        $is_tcp    = 1;
        $proto_str = 'tcp';
    } elsif ($pkt_str =~ /PROTO=UDPLITE\s/) {
        $is_udplite = 1;
        $proto_str  = 'udplite';
    } elsif ($pkt_str =~ /PROTO=UDP\s/) {
        $is_udp = 1;
        $proto_str  = 'udp';
    } elsif ($pkt_str =~ /PROTO=(\d+)\s/) {
        $proto_num = $1;
        $is_proto_num = 1;
    } else {
        print STDERR "[-] err packet: unrecognized protocol\n" if $debug;
        return $PKT_ERROR;
    }

    ### see if we need to ignore this packet based on the
    ### IGNORE_PROTOCOLS config keyword.
    return $PKT_IGNORE if &check_ignore_proto($proto_str,
            $proto_num, $is_proto_num);

    if ($is_tcp) {
        if ($is_ipv6) {

            ### Jul 18 19:19:08 lorien kernel: [ 1835.131574] IPV6 packet IN=lo
            ### OUT= MAC=00:00:00:00:00:00:00:00:00:00:00:00:86:dd
            ### SRC=0000:0000:0000:0000:0000:0000:0000:0001
            ### DST=0000:0000:0000:0000:0000:0000:0000:0001 LEN=72 TC=0
            ### HOPLIMIT=255 FLOWLBL=0 PROTO=TCP SPT=22 DPT=57005 WINDOW=512
            ### RES=0x00 ACK FIN URGP=0

            ### Topera SYN scan with --log-ip-options turned on:
            ### Dec 20 20:10:51 rohan kernel: [  499.178765] DROP IN=eth0 OUT=
            ### MAC=00:1b:f9:76:9c:e4:0a:13:33:3a:33:36:86:ed
            ### SRC=2012:1234:1234:0000:0000:0000:0000:0001
            ### DST=2012:1234:1234:0000:0000:0000:0000:0002 LEN=132 TC=0 HOPLIMIT=64
            ### FLOWLBL=0 OPT ( ) OPT ( ) OPT ( ) OPT ( ) OPT ( ) OPT ( ) OPT ( )
            ### OPT ( ) OPT ( ) PROTO=TCP SPT=26732 DPT=78 WINDOW=8192 RES=0x00 SYN URGP=0 
            if ($pkt_str =~ /SRC=($ipv6_re)\s+DST=($ipv6_re)\s+LEN=(\d+)\s+
                    TC=(\d+)\s+HOPLIMIT=(\d+)\s+FLOWLBL=(\d+)\s+.*PROTO=TCP\s+
                    SPT=(\d+)\s+DPT=(\d+)\s+WINDOW=(\d+)\s+
                    (.*)\s+URGP=/x) {

                ($pkt_hr->{'src'}, $pkt_hr->{'dst'}, $pkt_hr->{'ip_len'},
                    $pkt_hr->{'tc'}, $pkt_hr->{'hop_limit'},
                    $pkt_hr->{'flow_label'}, $pkt_hr->{'sp'}, $pkt_hr->{'dp'},
                    $pkt_hr->{'win'}, $pkt_hr->{'flags'})
                        = ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10);

                $pkt_hr->{'s_obj'} = new6 NetAddr::IP($pkt_hr->{'src'})
                    or return $PKT_ERROR;
                $pkt_hr->{'d_obj'} = new6 NetAddr::IP($pkt_hr->{'dst'})
                    or return $PKT_ERROR;

                if ($pkt_str =~ /(?:OPT\s+\(\s+\)\s+){7,}/) {
                    $pkt_hr->{'is_topera'} = 1;
                    print STDERR "    Topera IPv6 scan\n"
                        if $debug;
                }

            } else {
                print STDERR "[-] err packet: strange IPv6 TCP format\n"
                    if $debug;
                return $PKT_ERROR;
            }

        } else {

            ### May 18 22:21:26 orthanc kernel: DROP IN=eth2 OUT=
            ### MAC=00:60:1d:23:d0:01:00:60:1d:23:d3:0e:08:00 SRC=192.168.20.25
            ### DST=192.168.20.1 LEN=60 TOS=0x10 PREC=0x00 TTL=64 ID=47300 DF
            ### PROTO=TCP SPT=34111 DPT=6345 WINDOW=5840 RES=0x00 SYN URGP=0

            if ($pkt_str =~ /SRC=($ipv4_re)\s+DST=($ipv4_re)\s+LEN=(\d+)\s+TOS=(\S+)
                    \s*.*\s+TTL=(\d+)\s+ID=(\d+)\s*.*\s+PROTO=TCP\s+
                    SPT=(\d+)\s+DPT=(\d+)\s.*\s*WINDOW=(\d+)\s+
                    (.*)\s+URGP=/x) {

                ($pkt_hr->{'src'}, $pkt_hr->{'dst'}, $pkt_hr->{'ip_len'},
                    $pkt_hr->{'tos'}, $pkt_hr->{'ttl'}, $pkt_hr->{'ip_id'},
                    $pkt_hr->{'sp'}, $pkt_hr->{'dp'}, $pkt_hr->{'win'},
                    $pkt_hr->{'flags'})
                        = ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10);

                $pkt_hr->{'s_obj'} = new NetAddr::IP($pkt_hr->{'src'})
                    or return $PKT_ERROR;
                $pkt_hr->{'d_obj'} = new NetAddr::IP($pkt_hr->{'dst'})
                    or return $PKT_ERROR;

            } else {
                print STDERR "[-] err packet: strange IPv4 TCP format\n"
                    if $debug;
                return $PKT_ERROR;
            }
        }

        $pkt_hr->{'proto'} = 'tcp';

        ### the reserve bits are not reported by ulogd, but normal
        ### iptables syslog messages contain them.
        $pkt_hr->{'flags'} =~ s/\s*RES=\S+\s*//;

        ### default to NULL
        $pkt_hr->{'flags'} = 'NULL' unless $pkt_hr->{'flags'};

        if (not $pkt_hr->{'fwsnort_sid'}
                and $config{'IGNORE_CONNTRACK_BUG_PKTS'} eq 'Y' &&
                ($pkt_hr->{'flags'} =~ /ACK/ || $pkt_hr->{'flags'} =~ /RST/)) {

            ### $dp > 1024 && ($pkt_hr->{'flags'} =~ /ACK/ ||

            ### FIXME: ignore TCP packets that have the ACK or RST
            ### bits set (unless we matched a snort sid) since
            ### _usually_ we see these packets as a result of the
            ### iptables connection tracking bug.  Also, note that
            ### no signatures make use of the RST flag.

            print STDERR "[-] err packet: matched ACK or RST flag.\n"
                if $debug;
            return $PKT_IGNORE;
        }

        ### per page 595 of the Camel book, "if /blah1|blah2/"
        ### can be slower than "if /blah1/ || /blah2/
        unless ($pkt_hr->{'flags'} !~ /WIN/ &&
                $pkt_hr->{'flags'} =~ /ACK/ ||
                $pkt_hr->{'flags'} =~ /SYN/ ||
                $pkt_hr->{'flags'} =~ /RST/ ||
                $pkt_hr->{'flags'} =~ /URG/ ||
                $pkt_hr->{'flags'} =~ /PSH/ ||
                $pkt_hr->{'flags'} =~ /FIN/ ||
                $pkt_hr->{'flags'} eq 'NULL') {

            print STDERR "[-] err packet: bad tcp flags.\n" if $debug;
            return $PKT_ERROR;
        }

        ### look for TCP options, but don't pickup IP options if
        ### also --log-ip-options is used (IP options appear before
        ### the PROTO= field).
        if ($pkt_str =~ /URGP=\S+\s+OPT\s+\((\S+)\)/) {
            $pkt_hr->{'tcp_opts'} = $1;
            $found_one_tcp_options_field = 1
                if $config{'EXPECT_TCP_OPTIONS'} eq 'Y';
        }

        if ($pkt_hr->{'flags'}
                and $pkt_hr->{'flags'} eq 'SYN'
                and $found_one_tcp_options_field
                and not $pkt_hr->{'tcp_opts'}) {
            $pkt_hr->{'is_masscan'} = 1;
            print STDERR "    Masscan SYN scan\n"
                if $debug;
        }

        if ($pkt_str =~ /\sSEQ=(\d+)\s+ACK=(\d+)/) {
            $pkt_hr->{'tcp_seq'} = $1;
            $pkt_hr->{'tcp_ack'} = $2;
        }

        ### see if we need to ignore this packet based on the
        ### IGNORE_PORTS config keyword
        return $PKT_IGNORE if &check_ignore_port($pkt_hr->{'dp'},
                $pkt_hr->{'proto'});

        if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
                and not $benchmark
                and not $analyze_mode) {

            my $dflags = $pkt_hr->{'flags'};
            $dflags =~ s/\s/,/g;

            $pkt_hr->{'dshield_str'} = "$pkt_hr->{'src'}\t$pkt_hr->{'sp'}\t" .
                "$pkt_hr->{'dst'}\t$pkt_hr->{'dp'}\t$pkt_hr->{'proto'}\t" .
                "$dflags";
        }

    } elsif ($is_udp or $is_udplite) {

        if ($is_udplite) {
            $pkt_hr->{'proto'} = 'udplite';
        } else {
            $pkt_hr->{'proto'} = 'udp';
        }

        if ($is_ipv6) {

            ### Jul 21 21:07:39 minastirith kernel: [1912155.755862] IPv6 Packet IN=lo
            ### OUT= MAC=00:00:00:00:00:00:00:00:00:00:00:00:86:dd
            ### SRC=0000:0000:0000:0000:0000:0000:0000:0001
            ### DST=0000:0000:0000:0000:0000:0000:0000:0001 LEN=59 TC=0 HOPLIMIT=64
            ### FLOWLBL=0 PROTO=UDP SPT=35186 DPT=12345 LEN=19 
            if ($pkt_str =~ /SRC=($ipv6_re)\s+DST=($ipv6_re)\s+LEN=(\d+)\s+
                    TC=(\d+)\s+HOPLIMIT=(\d+)\s+FLOWLBL=(\d+)\s+
                    PROTO=UDP(?:LITE)?\s+SPT=(\d+)\s+DPT=(\d+)\s+LEN=(\d+)/x) {

                ($pkt_hr->{'src'}, $pkt_hr->{'dst'}, $pkt_hr->{'ip_len'},
                    $pkt_hr->{'tc'}, $pkt_hr->{'hop_limit'},
                    $pkt_hr->{'flow_label'}, $pkt_hr->{'sp'}, $pkt_hr->{'dp'},
                    $pkt_hr->{'udp_len'}) = ($1,$2,$3,$4,$5,$6,$7,$8,$9);

                $pkt_hr->{'s_obj'} = new6 NetAddr::IP($pkt_hr->{'src'})
                    or return $PKT_ERROR;
                $pkt_hr->{'d_obj'} = new6 NetAddr::IP($pkt_hr->{'dst'})
                    or return $PKT_ERROR;

            } else {
                print STDERR "[-] err packet: strange IPv6 UDP format\n"
                    if $debug;
                return $PKT_ERROR;
            }

        } else {

            ### May 18 22:21:26 orthanc kernel: DROP IN=eth2 OUT=
            ### MAC=00:60:1d:23:d0:01:00:60:1d:23:d3:0e:08:00
            ### SRC=192.168.20.25 DST=192.168.20.1 LEN=28 TOS=0x00 PREC=0x00
            ### TTL=40 ID=47523 PROTO=UDP SPT=57339 DPT=305 LEN=8

            if ($pkt_str =~ /SRC=($ipv4_re)\s+DST=($ipv4_re)\s+LEN=(\d+)\s+TOS=(\S+)
                      \s.*TTL=(\d+)\s+ID=(\d+)\s*.*\s+PROTO=UDP\s+
                      SPT=(\d+)\s+DPT=(\d+)\s+LEN=(\d+)/x) {

                ($pkt_hr->{'src'}, $pkt_hr->{'dst'}, $pkt_hr->{'ip_len'},
                    $pkt_hr->{'tos'}, $pkt_hr->{'ttl'}, $pkt_hr->{'ip_id'},
                    $pkt_hr->{'sp'}, $pkt_hr->{'dp'}, $pkt_hr->{'udp_len'})
                        = ($1,$2,$3,$4,$5,$6,$7,$8,$9);

                $pkt_hr->{'s_obj'} = new NetAddr::IP($pkt_hr->{'src'})
                    or return $PKT_ERROR;
                $pkt_hr->{'d_obj'} = new NetAddr::IP($pkt_hr->{'dst'})
                    or return $PKT_ERROR;

            } else {
                print STDERR "[-] err packet: strange IPv4 UDP format\n"
                    if $debug;
                return $PKT_ERROR;
            }
        }

        ### see if we need to ignore this packet based on the
        ### IGNORE_PORTS config keyword
        return $PKT_IGNORE if &check_ignore_port($pkt_hr->{'dp'},
                $pkt_hr->{'proto'});

        if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
                and not $benchmark
                and not $analyze_mode) {

            $pkt_hr->{'dshield_str'} = "$pkt_hr->{'src'}\t$pkt_hr->{'sp'}\t" .
                "$pkt_hr->{'dst'}\t$pkt_hr->{'dp'}\t$pkt_hr->{'proto'}";
        }

    } elsif ($is_icmp6 or $is_icmp) {

        $pkt_hr->{'sp'} = $pkt_hr->{'dp'} = 0;

        if ($is_ipv6) {

            ### Jul 18 17:18:19 lorien kernel: [ 1786.520508] IPV6 packet IN=lo
            ### OUT= MAC=00:00:00:00:00:00:00:00:00:00:00:00:86:dd
            ### SRC=0000:0000:0000:0000:0000:0000:0000:0001
            ### DST=0000:0000:0000:0000:0000:0000:0000:0001 LEN=104 TC=0
            ### HOPLIMIT=255 FLOWLBL=0 PROTO=ICMPv6 TYPE=129 CODE=0 ID=14997 SEQ=1 

            if ($pkt_str =~ /SRC=($ipv6_re)\s+DST=($ipv6_re)\s+LEN=(\d+)\s+TC=(\d+)\s+
                    HOPLIMIT=(\d+)\s+FLOWLBL=(\d+)\s+PROTO=ICMPv6\s+TYPE=(\d+)\s+
                    CODE=(\d+)/x) {

                ($pkt_hr->{'src'}, $pkt_hr->{'dst'}, $pkt_hr->{'ip_len'},
                    $pkt_hr->{'tc'}, $pkt_hr->{'hop_limit'},
                    $pkt_hr->{'flow_label'}, $pkt_hr->{'itype'},
                    $pkt_hr->{'icode'}) = ($1,$2,$3,$4,$5,$6,$7,$8);

                $pkt_hr->{'s_obj'} = new6 NetAddr::IP($pkt_hr->{'src'})
                    or return $PKT_ERROR;
                $pkt_hr->{'d_obj'} = new6 NetAddr::IP($pkt_hr->{'dst'})
                    or return $PKT_ERROR;

            } else {
                print STDERR "[-] err packet: strange IPv6 ICMP format\n"
                    if $debug;
                return $PKT_ERROR;
            }

            $pkt_hr->{'proto'} = 'icmp6';

        } else {

            ### Nov 27 15:45:51 orthanc kernel: DROP IN=eth1 OUT= MAC=00:a0:cc:e2:1f:f2:00:
            ### 20:78:10:70:e7:08:00 SRC=192.168.10.20 DST=192.168.10.1 LEN=84 TOS=0x00
            ### PREC=0x00 TTL=64 ID=0 DF PROTO=ICMP TYPE=8 CODE=0 ID=61055 SEQ=256

            if ($pkt_str =~ /SRC=($ipv4_re)\s+DST=($ipv4_re)\s+LEN=(\d+).*
                      TTL=(\d+)\s+ID=(\d+).*PROTO=ICMP\s+TYPE=(\d+)\s+
                      CODE=(\d+)/x) {

                ($pkt_hr->{'src'}, $pkt_hr->{'dst'}, $pkt_hr->{'ip_len'},
                    $pkt_hr->{'ttl'}, $pkt_hr->{'ip_id'}, $pkt_hr->{'itype'},
                    $pkt_hr->{'icode'}) = ($1,$2,$3,$4,$5,$6,$7);

                $pkt_hr->{'s_obj'} = new NetAddr::IP($pkt_hr->{'src'})
                    or return $PKT_ERROR;
                $pkt_hr->{'d_obj'} = new NetAddr::IP($pkt_hr->{'dst'})
                    or return $PKT_ERROR;

            } else {
                print STDERR "[-] err packet: strange IPv4 ICMP format\n"
                    if $debug;
                return $PKT_ERROR;
            }

            $pkt_hr->{'proto'} = 'icmp';

            if ($pkt_hr->{'itype'} == $ICMP_ECHO_REQUEST
                    or $pkt_hr->{'itype'} == $ICMP_ECHO_REPLY) {

                ### we expect the ICMP ID and SEQ fields to be populated
                if ($pkt_str =~ /CODE=(\d+)\s+ID=(\d+)\s+SEQ=(\d+)/) {
                    $pkt_hr->{'icmp_id'}  = $1;
                    $pkt_hr->{'icmp_seq'} = $2;
                } else {
                    return $PKT_ERROR;
                }
            }
        }

        if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
                and not $benchmark
                and not $analyze_mode) {

            $pkt_hr->{'dshield_str'} = "$pkt_hr->{'src'}\t$pkt_hr->{'itype'}" .
                "\t$pkt_hr->{'dst'}\t$pkt_hr->{'icode'}\t$pkt_hr->{'proto'}";
        }

    } elsif ($is_proto_num) {

        if ($is_ipv6) {

            ### FIXME future

        } else {

            ### Mar 15 20:59:04 linux kernel: [810523.812773] DROP IN=eth0 OUT=
            ### MAC=23:87:fc:c6:24:58:00:21:3f:98:99:78:09:00 SRC=192.168.10.55
            ### DST=192.168.10.1 LEN=20 TOS=0x00 PREC=0x00 TTL=59 ID=3052 PROTO=29

            if ($pkt_str =~ /SRC=($ipv4_re)\s+DST=($ipv4_re)\s+LEN=(\d+).*
                      TTL=(\d+)\s+ID=(\d+).*PROTO=/x) {

                ($pkt_hr->{'src'}, $pkt_hr->{'dst'}, $pkt_hr->{'ip_len'},
                    $pkt_hr->{'ttl'}, $pkt_hr->{'ip_id'}) = ($1,$2,$3,$4,$5);

                $pkt_hr->{'s_obj'} = new NetAddr::IP($pkt_hr->{'src'})
                    or return $PKT_ERROR;
                $pkt_hr->{'d_obj'} = new NetAddr::IP($pkt_hr->{'dst'})
                    or return $PKT_ERROR;
            }

            $pkt_hr->{'proto'} = $proto_num;
        }

    } else {
        ### Sometimes the iptables log entry gets messed up due to
        ### buffering issues so we write it to the error log.
        print STDERR "[-] err packet: no regex match.\n" if $debug;
        return $PKT_ERROR;
    }

    if ($restrict_ip) {
        ### we are looking to analyze packets from a specific IP/subnet
        if ($pkt_hr->{'is_ipv6'}) {
            if ($restrict_ip->version() == 6) {
                return $PKT_IGNORE unless
                    $pkt_hr->{'s_obj'}->within($restrict_ip) or
                    $pkt_hr->{'d_obj'}->within($restrict_ip);
            }
        } else {
            if ($restrict_ip->version() == 4) {
                return $PKT_IGNORE unless
                    $pkt_hr->{'s_obj'}->within($restrict_ip) or
                    $pkt_hr->{'d_obj'}->within($restrict_ip);
            }
        }
    }

    return $PKT_SUCCESS;
}

sub check_ignore_proto() {
    my ($proto_str, $proto_num, $is_proto_num) = @_;

    return 0 unless %ignore_protocols;

    if ($is_proto_num) {
        return 1 if defined $ignore_protocols{$proto_num};
    } else {
        return 1 if defined $ignore_protocols{$proto_str};
    }

    return 0;
}

sub match_sigs() {
    my $pkt_hr = shift;

    my $dl = 0;
    my $is_sig_match = $NO_SIG_MATCH;

    print STDERR "[+] match_sigs()\n" if $debug and $verbose;

    ### always run the IP protocol sigs
    PROTO: for my $proto ($pkt_hr->{'proto'}, 'ip') {

        next PROTO unless defined $sig_search{$proto};

        SRC: for my $src (keys %{$sig_search{$proto}}) {

            print STDERR "[+] match_sigs() pkt src: $pkt_hr->{'src'} within sig src: $src ?..."
                if $debug and $verbose;

            if ($pkt_hr->{'s_obj'}->within($sig_ip_objs{$src})) {
                print STDERR "yes\n"
                    if $debug and $verbose;
            } else {
                print STDERR "no\n"
                    if $debug and $verbose;
                next SRC;
            }

            DST: for my $dst (keys %{$sig_search{$proto}{$src}}) {

                print STDERR "[+] match_sigs() pkt dst: $pkt_hr->{'dst'} within sig dst: $dst ?..."
                    if $debug and $verbose;

                if ($pkt_hr->{'d_obj'}->within($sig_ip_objs{$dst})) {
                    print STDERR "yes\n"
                        if $debug and $verbose;
                } else {
                    print STDERR "no\n"
                        if $debug and $verbose;
                    next DST;
                }

                print STDERR "    Matched sig IP criteria.\n"
                    if $debug and $verbose;

                if ($proto eq 'tcp' or $proto eq 'udp' or $proto eq 'udplite') {

                    TYPE: for my $hr (@port_types) {
                        my $sp_type = $hr->{'sp'};
                        my $dp_type = $hr->{'dp'};

                        next TYPE unless
                            defined $sig_search{$proto}{$src}{$dst}{$sp_type};

                        my $sp_hr = $sig_search{$proto}{$src}{$dst}{$sp_type};

                        SP_S: for my $sp_s (keys %{$sp_hr}) {

                            if ($sp_type eq 'norm') {
                                ### normal match on the starting port value
                                next SP_S unless $pkt_hr->{'sp'} >= $sp_s;
                            }

                            SP_E: for my $sp_e (keys %{$sp_hr->{$sp_s}}) {

                                if ($sp_type eq 'norm') {
                                    ### normal match on the ending port value
                                    next SP_E unless $pkt_hr->{'sp'} <= $sp_e;
                                } else {
                                    ### negative match on the ending port value
                                    ### (note the "or" condition)
                                    next SP_E unless ($pkt_hr->{'sp'} > $sp_e
                                        or $pkt_hr->{'sp'} < $sp_s);
                                }

                                next TYPE unless defined
                                    $sp_hr->{$sp_s}->{$sp_e}->{$dp_type};

                                my $dp_hr = $sp_hr->{$sp_s}->{$sp_e}->{$dp_type};

                                DP_S: for my $dp_s (keys %$dp_hr) {
                                    if ($dp_type eq 'norm') {
                                        next DP_S unless $pkt_hr->{'dp'} >= $dp_s;
                                    }

                                    DP_E: for my $dp_e (keys %{$dp_hr->{$dp_s}}) {
                                        if ($dp_type eq 'norm') {
                                            next DP_E unless $pkt_hr->{'dp'} <= $dp_e;
                                        } else {
                                            ### negative match on the ending port value
                                            ### (note the "or" condition)
                                            next DP_E unless ($pkt_hr->{'dp'} > $dp_e
                                                or $pkt_hr->{'dp'} < $dp_s);
                                        }

                                        ### now we have the set of applicable
                                        ### signatures that match the sip/dip
                                        ### and sp/dp, so match any Snort
                                        ### keywords
                                        my ($dl_tmp, $sig_match_tmp) =
                                                &match_snort_keywords($pkt_hr,
                                                    $dp_hr->{$dp_s}->{$dp_e});

                                        print STDERR "    match_snort_keywords() ",
                                            " return DL: $dl_tmp\n" if $debug;

                                        ### return maximal danger level from all
                                        ### signature matches
                                        $dl = $dl_tmp if $dl_tmp > $dl;
                                        $is_sig_match = $SIG_MATCH
                                            if $sig_match_tmp == $SIG_MATCH;
                                    }
                                }
                            }
                        }
                    }
                } else {
                    ### now we have the set of applicable icmp
                    ### signatures that match the sip/dip
                    my ($dl_tmp, $sig_match_tmp) = &match_snort_keywords(
                            $pkt_hr, $sig_search{$proto}{$src}{$dst});

                    print STDERR "    match_snort_keywords() ",
                        " return DL: $dl_tmp\n" if $debug;
                    ### return maximal danger level from all signature matches
                    $dl = $dl_tmp if $dl_tmp > $dl;
                    $is_sig_match = $SIG_MATCH if $sig_match_tmp == $SIG_MATCH;
                }
            }
        }
    }
    return $dl, $is_sig_match;
}

sub match_snort_keywords() {
    my ($pkt_hr, $sigs_ids_hr) = @_;

    print STDERR "[+] match_snort_keywords()\n" if $debug;

    my $dl = 0;
    my $matched_sig = $NO_SIG_MATCH;

    ### see if all Snort keywords match the packet - the sigs hash has
    ### been restricted to the appropriate protocol
    SIG: for my $sid (keys %$sigs_ids_hr) {

        next SIG unless defined $sigs{$sid};  ### should never happen

        my $sig_hr = $sigs{$sid};

        ### iptables logging messages always include TTL and IP ID
        ### values (at least for ipv4, see
        ### linux/net/ipv4/netfilter/ipt_LOG.c)
        my $dl_tmp = 0;

        my ($rv, $sig_match_rv) = &match_snort_ip_keywords($pkt_hr, $sig_hr);

        if ($sig_match_rv == $SIG_MATCH) {
            $matched_sig = $SIG_MATCH;
            $dl_tmp = $rv;
            if ($rv == 0) {
                next SIG;  ### ignore signature
            }
        } elsif ($sig_match_rv == $NO_SIG_MATCH) {
            ### there were network-layer keywords that did not match
            next SIG unless $rv;
            ### else there were no network-layer keywords so continue on
        }

        $dl = $dl_tmp if $dl_tmp > $dl;

        if ($debug and $debug_sid == $sid) {
            print STDERR "[+] SID: $sid, passed match_snort_ip_keywords() ",
                "tests.\n";
        }

        if ($sig_hr->{'proto'} eq 'tcp') {

            ($rv, $sig_match_rv) = &match_snort_tcp_keywords($pkt_hr, $sig_hr);

            if ($sig_match_rv == $SIG_MATCH) {

                $matched_sig = $SIG_MATCH;
                next SIG if $rv == 0;

                $dl = $rv if $rv > $dl;

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tot_protocols'} = 0
                    unless defined $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tot_protocols'};

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tot_protocols'}++
                    unless defined $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tcp'};

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tcp'}
                    {'sid'}{$sid}{$pkt_hr->{'chain'}}{'dp'}
                        = $pkt_hr->{'dp'};

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tcp'}
                    {'sid'}{$sid}{$pkt_hr->{'chain'}}{'flags'}
                        = $pkt_hr->{'flags'};

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tcp'}
                    {'sid'}{$sid}{$pkt_hr->{'chain'}}{'pkts'}++;

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tcp'}
                    {'sid'}{$sid}{$pkt_hr->{'chain'}}{'is_fwsnort'} = 0;

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tcp'}
                    {'sid'}{$sid}{$pkt_hr->{'chain'}}{'time'} = time();

                $sig_sources{$sid}{$pkt_hr->{'src'}} = '';
                $top_sigs{$sid}++;
                $top_sig_counts{$pkt_hr->{'src'}}++;
            }

        } elsif ($sig_hr->{'proto'} eq 'udp') {

            ($rv, $sig_match_rv) = &match_snort_udp_keywords($pkt_hr, $sig_hr);

            if ($sig_match_rv == $SIG_MATCH) {

                $matched_sig = $SIG_MATCH;
                next SIG if $rv == 0;

                $dl = $rv if $rv > $dl;

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tot_protocols'} = 0
                    unless defined $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tot_protocols'};

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tot_protocols'}++
                    unless defined $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'udp'};

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'udp'}
                    {'sid'}{$sid}{$pkt_hr->{'chain'}}{'dp'}
                         = $pkt_hr->{'dp'};

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'udp'}
                    {'sid'}{$sid}{$pkt_hr->{'chain'}}{'pkts'}++;

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'udp'}
                    {'sid'}{$sid}{$pkt_hr->{'chain'}}{'is_fwsnort'} = 0;

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'udp'}
                    {'sid'}{$sid}{$pkt_hr->{'chain'}}{'time'} = time();

                $sig_sources{$sid}{$pkt_hr->{'src'}} = 0; ### not fwsnort
                $top_sigs{$sid}++;
                $top_sig_counts{$pkt_hr->{'src'}}++;
            }

        } elsif ($sig_hr->{'proto'} eq 'icmp') {

            ($rv, $sig_match_rv) = &match_snort_icmp_keywords($pkt_hr, $sig_hr);

            if ($sig_match_rv == $SIG_MATCH) {

                $matched_sig = $SIG_MATCH;
                next SIG if $rv == 0;

                $dl = $rv if $rv > $dl;

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tot_protocols'} = 0
                    unless defined $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tot_protocols'};

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tot_protocols'}++
                    unless defined $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'icmp'};

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'icmp'}{'sid'}
                    {$sid}{$pkt_hr->{'chain'}}{'pkts'}++;

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'icmp'}{'sid'}
                    {$sid}{$pkt_hr->{'chain'}}{'is_fwsnort'} = 0;

                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'icmp'}{'sid'}
                    {$sid}{$pkt_hr->{'chain'}}{'time'} = time();

                $sig_sources{$sid}{$pkt_hr->{'src'}} = 0; ### not fwsnort
                $top_sigs{$sid}++;
                $top_sig_counts{$pkt_hr->{'src'}}++;
            }

        } elsif ($sig_hr->{'proto'} eq 'icmp6') {
            ### FIXME icmp6 specifc Snort matches?
        }
    }
    return $dl, $matched_sig;
}

sub match_snort_tcp_keywords() {
    my ($pkt_hr, $sig_hr) = @_;

    if ($debug and $debug_sid == $sig_hr->{'sid'}) {
        print STDERR "[+] SID: $sig_hr->{'sid'} match_snort_tcp_keywords()\n";
    }

    if (defined $sig_hr->{'flags'}) {
        unless ($pkt_hr->{'flags'} eq $sig_hr->{'flags'}) {
            if ($debug and $debug_sid == $sig_hr->{'sid'}) {
                print STDERR "[-] SID: $sig_hr->{'sid'} ",
                    "$pkt_hr->{'flags'} != $sig_hr->{'flags'}\n";
            }
            return 0, $NO_SIG_MATCH;
        }
    }

    my $header_len = $IP_HEADER_LEN + $TCP_HEADER_LEN;

    if ($pkt_hr->{'flags'} =~ m|SYN|) {
        ### extend the header length to compensate for TCP options
        $header_len += $TCP_MAX_OPTS_LEN;
    }

    if (defined $sig_hr->{'dsize'} and defined $sig_hr->{'dsize_s'}) {
        return 0, $NO_SIG_MATCH unless &check_sig_int_range(
                ($pkt_hr->{'ip_len'}-$header_len), 'dsize', $sig_hr);
    }

    if (defined $sig_hr->{'psad_dsize'} and defined $sig_hr->{'psad_dsize_s'}) {
        return 0, $NO_SIG_MATCH unless &check_sig_int_range(
                ($pkt_hr->{'ip_len'}-$header_len), 'psad_dsize', $sig_hr);
    }

    if (defined $sig_hr->{'window'} and defined $sig_hr->{'window_s'}) {
        return 0, $NO_SIG_MATCH
            unless &check_sig_int_range($pkt_hr->{'win'}, 'window', $sig_hr);
    }

    if (defined $sig_hr->{'seq'} and defined $sig_hr->{'seq_s'}) {
        return 0, $NO_SIG_MATCH
            unless &check_sig_int_range($pkt_hr->{'tcp_seq'}, 'seq', $sig_hr);
    }

    if (defined $sig_hr->{'ack'} and defined $sig_hr->{'ack_s'}) {
        return 0, $NO_SIG_MATCH
            unless &check_sig_int_range($pkt_hr->{'tcp_ack'}, 'ack', $sig_hr);
    }

    ### matched the signature
    if ($debug) {
        print STDERR "[+] packet matched tcp keywords for sid: ",
            "$sig_hr->{'sid'} (psad_id: $sig_hr->{'psad_id'})\n",
            qq|    "$sig_hr->{'msg'}"\n|;
    }

    return &assign_sid_dl($sig_hr->{'sid'}, $sig_hr->{'dl'}), $SIG_MATCH;
}

sub match_snort_udp_keywords() {
    my ($pkt_hr, $sig_hr) = @_;

    if (defined $sig_hr->{'dsize'} and defined $sig_hr->{'dsize_s'}) {
        return 0, $NO_SIG_MATCH unless &check_sig_int_range(
                ($pkt_hr->{'udp_len'}-$UDP_HEADER_LEN),
                'dsize', $sig_hr);
    }

    if (defined $sig_hr->{'psad_dsize'} and defined $sig_hr->{'psad_dsize_s'}) {
        return 0, $NO_SIG_MATCH unless &check_sig_int_range(
                ($pkt_hr->{'udp_len'}-$UDP_HEADER_LEN),
                'psad_dsize', $sig_hr);
    }

    ### matched the signature
    if ($debug) {
        print STDERR "[+] packet matched udp keywords for sid: ",
            "$sig_hr->{'sid'} (psad_id: $sig_hr->{'psad_id'})\n",
            qq|    "$sig_hr->{'msg'}"\n|;
    }

    return &assign_sid_dl($sig_hr->{'sid'}, $sig_hr->{'dl'}), $SIG_MATCH;
}

sub match_snort_icmp_keywords() {
    my ($pkt_hr, $sig_hr) = @_;

    if (defined $sig_hr->{'dsize'} and defined $sig_hr->{'dsize_s'}) {
        return 0, $NO_SIG_MATCH unless &check_sig_int_range(
                ($pkt_hr->{'ip_len'}-$IP_HEADER_LEN-$ICMP_HEADER_LEN),
                'dsize', $sig_hr);
    }

    if (defined $sig_hr->{'psad_dsize'} and defined $sig_hr->{'psad_dsize_s'}) {
        return 0, $NO_SIG_MATCH unless &check_sig_int_range(
                ($pkt_hr->{'ip_len'}-$IP_HEADER_LEN-$ICMP_HEADER_LEN),
                'psad_dsize', $sig_hr);
    }

    if (defined $sig_hr->{'itype'} and defined $sig_hr->{'itype_s'}) {
        return 0, $NO_SIG_MATCH
            unless &check_sig_int_range($pkt_hr->{'itype'}, 'itype', $sig_hr);
    }
    if (defined $sig_hr->{'icode'} and defined $sig_hr->{'icode_s'}) {
        return 0, $NO_SIG_MATCH
            unless &check_sig_int_range($pkt_hr->{'icode'}, 'icode', $sig_hr);
    }
    if (defined $sig_hr->{'icmp_seq'} and defined $sig_hr->{'icmp_seq_s'}) {
        return 0, $NO_SIG_MATCH
            unless &check_sig_int_range($pkt_hr->{'icmp_seq'}, 'icmp_seq', $sig_hr);
    }
    if (defined $sig_hr->{'icmp_id'} and defined $sig_hr->{'icmp_id_s'}) {
        return 0, $NO_SIG_MATCH
            unless &check_sig_int_range($pkt_hr->{'icmp_id'}, 'icmp_id', $sig_hr);
    }

    ### matched the signature
    if ($debug) {
        print STDERR "[+] packet matched icmp keywords for sid: ",
            "$sig_hr->{'sid'} (psad_id: $sig_hr->{'psad_id'})\n",
            qq|    "$sig_hr->{'msg'}"\n|;
    }

    return &assign_sid_dl($sig_hr->{'sid'}, $sig_hr->{'dl'}), $SIG_MATCH;
}

sub match_snort_ip_keywords() {
    my ($pkt_hr, $sig_hr) = @_;

    if ($pkt_hr->{'is_ipv6'}) {
        ### we need to build IPv6 signature keywords
        return 1, $NO_SIG_MATCH;
    }

    if (defined $sig_hr->{'ttl'} and defined $sig_hr->{'ttl_s'}) {
        return 0, $NO_SIG_MATCH
            unless &check_sig_int_range($pkt_hr->{'ttl'}, 'ttl', $sig_hr);
    }

    if (defined $sig_hr->{'id'} and defined $sig_hr->{'id_s'}) {
        return 0, $NO_SIG_MATCH
            unless &check_sig_int_range($pkt_hr->{'ip_id'}, 'id', $sig_hr);
    }

    if (defined $sig_hr->{'psad_ip_len'} and defined $sig_hr->{'psad_ip_len_s'}) {
        return 0, $NO_SIG_MATCH
            unless &check_sig_int_range($pkt_hr->{'ip_len'},
                    'psad_ip_len', $sig_hr);
    }

    ### to handle the ip_proto keyword parse_NF_pkt_str() would have to be
    ### modified to handle packets besides TCP, UDP, and ICMP.
    return 0, $NO_SIG_MATCH if defined $sig_hr->{'ip_proto'};

    ### handle the sameip keyword
    if (defined $sig_hr->{'sameip'} and $sig_hr->{'sameip'}) {
        return 0, $NO_SIG_MATCH if $pkt_hr->{'intf'} eq 'lo';
        return 0, $NO_SIG_MATCH unless $pkt_hr->{'src'} eq $pkt_hr->{'dst'};
    }

    return 0, $NO_SIG_MATCH
        unless &check_sig_ipopts($pkt_hr->{'ip_opts'}, 'ipopts', $sig_hr);

    if ($sig_hr->{'proto'} eq 'ip') {
        ### signature match
        if ($debug) {
            print STDERR "[+] packet matched ip keywords for sid: ",
                "$sig_hr->{'sid'} (psad_id: $sig_hr->{'psad_id'})\n",
                qq|    "$sig_hr->{'msg'}"\n|;
        }

        $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'ip'}{'sid'}
            {$sig_hr->{'sid'}}{$pkt_hr->{'chain'}}{'pkts'}++;

        $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'ip'}{'sid'}
            {$sig_hr->{'sid'}}{$pkt_hr->{'chain'}}{'is_fwsnort'} = 0;

        $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'ip'}{'sid'}
            {$sig_hr->{'sid'}}{$pkt_hr->{'chain'}}{'time'} = time();

        $sig_sources{$sig_hr->{'sid'}}{$pkt_hr->{'src'}} = 0; ### not fwsnort
        $top_sigs{$sig_hr->{'sid'}}++;
        $top_sig_counts{$pkt_hr->{'src'}}++;

        return &assign_sid_dl($sig_hr->{'sid'}, $sig_hr->{'dl'}), $SIG_MATCH;
    }
    return 1, $NO_SIG_MATCH;
}

sub check_sig_int_range() {
    my ($pkt_val, $keyword, $sig_hr) = @_;

    $pkt_val = 0 if $pkt_val < 0;

    if ($sig_hr->{"${keyword}_neg"}) {
        if ($pkt_val <= $sig_hr->{"${keyword}_e"}
                and $pkt_val >= $sig_hr->{"${keyword}_s"}) {
            if ($debug) {
                if ($verbose or $debug_sid == $sig_hr->{'sid'}) {
                    print STDERR "[-] SID: $sig_hr->{'sid'} failed ",
                        "$keyword test, $pkt_val <= ",
                        qq|$sig_hr->{"${keyword}_e"} and $pkt_val |,
                        qq|>= $sig_hr->{"${keyword}_s"}\n|;
                }
            }
            return 0;
        }
    } else {
        ### normal match
        if ($pkt_val < $sig_hr->{"${keyword}_s"}) {
            if ($debug) {
                if ($verbose or $debug_sid == $sig_hr->{'sid'}) {
                    print STDERR "[-] SID: $sig_hr->{'sid'} failed ",
                        "$keyword test, $pkt_val < ",
                        qq|$sig_hr->{"${keyword}_s"} (range start)\n|;
                }
            }
            return 0;
        }
        if ($pkt_val > $sig_hr->{"${keyword}_e"}) {
            if ($debug) {
                if ($verbose or $debug_sid == $sig_hr->{'sid'}) {
                    print STDERR "[-] SID: $sig_hr->{'sid'} failed ",
                        "$keyword test, $pkt_val > ",
                        qq|$sig_hr->{"${keyword}_e"} (range end)\n|;
                }
            }
            return 0;
        }
    }
    return 1;
}

sub check_sig_ipopts() {
    my ($pkt_val, $keyword, $sig_hr) = @_;

    return 1 unless defined $sig_hr->{$keyword};
    return 0 unless $pkt_val;
    return 1 if $sig_hr->{$keyword} eq 'any';

    my $pkt_opts_hr = &parse_ip_options($pkt_val);

    return 0 unless defined $pkt_opts_hr->{$sig_hr->{$keyword}};
    return 1;
}

sub check_ignore_port() {
    my ($port, $proto) = @_;
    return 0 unless defined $ignore_ports{$proto};
    return &match_port(\%{$ignore_ports{$proto}}, $port);
}

sub match_port() {
    my ($hr, $port) = @_;
    if (defined $hr->{'port'}) {
        return 1 if defined $hr->{'port'}->{$port};
    }
    if (defined $hr->{'range'}) {
        for my $low_port (keys %{$hr->{'range'}}) {
            my $high_port = $hr->{'range'}->{$low_port};
            return 1 if ($port >= $low_port and $port <= $high_port);
        }
    }
    return 0;
}

sub p0f() {
    my $pkt_hr = shift;

    if ($pkt_hr->{'is_ipv6'}) {
        &p0f_ipv6($pkt_hr);
    } else {
        &p0f_ipv4($pkt_hr);
    }
    return;
}

sub p0f_ipv6() {
    my $pkt_hr = shift;
    return;
}

sub p0f_ipv4() {
    my $pkt_hr = shift;

    print STDERR "[+] p0f_ipv4(): $pkt_hr->{'src'} len: $pkt_hr->{'ip_len'}, ",
        "frag_bit: $pkt_hr->{'frag_bit'}, ttl: $pkt_hr->{'ttl'}, ",
        "win: $pkt_hr->{'win'}\n" if $debug;

    # p0f Fingerprint entry format:
    #
    # wwww:ttt:D:ss:OOO...:OS:Version:Subtype:Details
    #
    # wwww     - window size (can be *, %nnn, Snn or Tnn).  The special values
    #            "S" and "T" which are a multiple of MSS or a multiple of MTU
    #            respectively.
    # ttt      - initial TTL
    # D        - don't fragment bit (0 - not set, 1 - set)
    # ss       - overall SYN packet size
    # OOO      - option value and order specification (see below)
    # OS       - OS genre (Linux, Solaris, Windows)
    # Version  - OS Version (2.0.27 on x86, etc)
    # Subtype  - OS subtype or patchlevel (SP3, lo0)
    # details  - Generic OS details
    #
    ### S4:64:1:60:M*,S,T,N,W7:     Linux:2.6:8:Linux 2.6.8 and newer (?)

    my $options_ar = &parse_tcp_options($pkt_hr->{'src'},
            $pkt_hr->{'tcp_opts'});

    unless ($options_ar) {
        print STDERR "[-] Could not fingerprint remote OS.\n" if $debug;
        return;
    }

    my $matched_os = 0;

    ### try to match SYN packet length
    LEN: for my $sig_len (keys %p0f_ipv4_sigs) {
        my $matched_len = 0;
        if ($sig_len eq '*') {  ### len can be wildcarded in pf.os
            $matched_len = 1;
        } elsif ($sig_len =~ /^\%(\d+)/) {
            if (($pkt_hr->{'ip_len'} % $1) == 0) {
                $matched_len = 1;
            }
        } elsif ($pkt_hr->{'ip_len'} == $sig_len) {
            $matched_len = 1;
        }
        next LEN unless $matched_len;

        ### try to match fragmentation bit
        FRAG: for my $test_frag_bit ($pkt_hr->{'frag_bit'}, '*') {  ### don't need "%nnn" check
            next FRAG unless defined $p0f_ipv4_sigs{$sig_len}{$test_frag_bit};

            ### find out for which p0f sigs the TTL is within range
            TTL: for my $sig_ttl (keys %{$p0f_ipv4_sigs{$sig_len}{$test_frag_bit}}) {
                unless ($pkt_hr->{'ttl'} > $sig_ttl - $config{'MAX_HOPS'}
                        and $pkt_hr->{'ttl'} <= $sig_ttl) {
                    next TTL;
                }

                ### match tcp window size
                WIN: for my $sig_win_size (keys
                        %{$p0f_ipv4_sigs{$sig_len}{$test_frag_bit}{$sig_ttl}}) {
                    my $matched_win_size = 0;
                    if ($sig_win_size eq '*') {
                        $matched_win_size = 1;
                    } elsif ($sig_win_size =~ /^\%(\d+)/) {
                        if (($pkt_hr->{'win'} % $1) == 0) {
                            $matched_win_size = 1;
                        }
                    } elsif ($sig_win_size =~ /^S(\d+)/) {
                        ### window size must be a multiple of maximum
                        ### seqment size
                        my $multiple = $1;
                        for my $opt_hr (@$options_ar) {
                            if (defined $opt_hr->{$tcp_p0f_opt_types{'M'}}) {
                                my $mss_val = $opt_hr->{$tcp_p0f_opt_types{'M'}};
                                if ($pkt_hr->{'win'} == $mss_val * $multiple) {
                                    $matched_win_size = 1;
                                }
                            }
                            last;
                        }
                    } elsif ($sig_win_size == $pkt_hr->{'win'}) {
                        $matched_win_size = 1;
                    }

                    next WIN unless $matched_win_size;
                    TCPOPTS: for my $sig_opts (keys %{$p0f_ipv4_sigs{$sig_len}
                            {$test_frag_bit}{$sig_ttl}{$sig_win_size}}) {
                        my @sig_opts = split /\,/, $sig_opts;
                        for (my $i=0; $i<=$#sig_opts; $i++) {
                            ### tcp option order is important.  Check to see if
                            ### the option order in the packet matches the order we
                            ### expect to see in the signature
                            if ($sig_opts[$i] =~ /^([NMWST])/) {
                                my $sig_letter = $1;

                                unless (defined $options_ar->[$i]->
                                        {$tcp_p0f_opt_types{$sig_letter}}) {
                                    next TCPOPTS;  ### could not match tcp option order
                                }

                                ### MSS, window scale, and timestamp have
                                ### specific signatures requirements on values
                                if ($sig_letter eq 'M') {
                                    if ($sig_opts[$i] =~ /M(\d+)/) {
                                        my $sig_mss_val = $1;
                                        next TCPOPTS unless $options_ar->[$i]->
                                            {$tcp_p0f_opt_types{$sig_letter}}
                                                == $sig_mss_val;
                                    } elsif ($sig_opts[$i] =~ /M\%(\d+)/) {
                                        my $sig_mss_mod_val = $1;
                                        next TCPOPTS unless (($options_ar->[$i]->
                                            {$tcp_p0f_opt_types{$sig_letter}}
                                                % $sig_mss_mod_val) == 0);
                                    } ### else it is "M*" which always matches
                                } elsif ($sig_letter eq 'W') {
                                    if ($sig_opts[$i] =~ /W(\d+)/) {
                                        my $sig_win_val = $1;
                                        next TCPOPTS unless $options_ar->[$i]->
                                            {$tcp_p0f_opt_types{$sig_letter}}
                                                == $sig_win_val;
                                    } elsif ($sig_opts[$i] =~ /W\%(\d+)/) {
                                        my $sig_win_mod_val = $1;
                                        next TCPOPTS unless (($options_ar->[$i]->
                                            {$tcp_p0f_opt_types{$sig_letter}}
                                                % $sig_win_mod_val) == 0);
                                    } ### else it is "W*" which always matches
                                } elsif ($sig_letter eq 'T') {
                                    if ($sig_opts[$i] =~ /T0/) {
                                        next TCPOPTS unless $options_ar->[$i]->
                                            {$tcp_p0f_opt_types{$sig_letter}}
                                                == 0;
                                    }  ### else it is just "T" which matches
                                }

                            }
                        }
                        OS: for my $os (keys %{$p0f_ipv4_sigs{$sig_len}
                                {$test_frag_bit}{$sig_ttl}{$sig_win_size}
                                {$sig_opts}}) {
                            my $sig = $p0f_ipv4_sigs{$sig_len}
                                {$test_frag_bit}{$sig_ttl}{$sig_win_size}
                                {$sig_opts}{$os};
                            print STDERR "[+] os: $os, $sig\n" if $debug;
                            $matched_os = 1;
                            $p0f{$pkt_hr->{'src'}}{$os} = '';
                        }
                    }
                }
            }
        }
    }
    if ($debug and not $matched_os) {
        print STDERR "    Could not match $pkt_hr->{'src'} against any p0f signature.\n";
    }
    return;
}

sub parse_tcp_options() {
    my ($src, $tcp_options) = @_;
    my @opts = ();
    my @hex_nums = ();
    my $debug_str = '';

    unless ($tcp_options) {
        print STDERR 'no tcp options' if $debug;
        return [];
    }

    if (length($tcp_options) % 2 != 0) {  ### make sure length is a multiple of two
        print STDERR 'tcp options length not a multiple of two.' if $debug;
        return [];
    }
    ### $tcp_options is a hex string like "020405B401010402" from the iptables
    ### log message
    my @chars = split //, $tcp_options;
    for (my $i=0; $i <= $#chars; $i += 2) {
        my $str = $chars[$i] . $chars[$i+1];
        push @hex_nums, $str;
    }

    my $max_parse_attempts = $#chars;
    my $parse_ctr = 0;

    OPT: for (my $opt_kind=0; $opt_kind <= $#hex_nums;) {

        $parse_ctr++;
        if ($parse_ctr > $max_parse_attempts) {
            print STDERR "    p0f() parse_ctr $parse_ctr > ",
                "max_parse_attempts $max_parse_attempts\n" if $debug;
            return [];
        }

        last OPT unless defined $hex_nums[$opt_kind+1];

        my $is_nop = 0;
        my $len = hex($hex_nums[$opt_kind+1]);
        if (hex($hex_nums[$opt_kind]) == $tcp_nop_type) {
            $debug_str .= 'NOP, ' if $debug;
            push @opts, {$tcp_nop_type => ''};
            $is_nop = 1;
        } elsif (hex($hex_nums[$opt_kind]) == $tcp_mss_type) {  ### MSS
            my $mss_hex = '';
            for (my $i=$opt_kind+2; $i < ($opt_kind+$len); $i++) {
                $mss_hex .= $hex_nums[$i];
            }
            my $mss = hex($mss_hex);
            push @opts, {$tcp_mss_type => $mss};
            $debug_str .= 'MSS: ' . hex($mss_hex) . ', ' if $debug;
        } elsif (hex($hex_nums[$opt_kind]) == $tcp_win_scale_type) {
            my $window_scale_hex = '';
            for (my $i=$opt_kind+2; $i < ($opt_kind+$len); $i++) {
                $window_scale_hex .= $hex_nums[$i];
            }
            my $win_scale = hex($window_scale_hex);
            push @opts, {$tcp_win_scale_type => $win_scale};
            $debug_str .= 'Win Scale: ' . hex($window_scale_hex) . ', ' if $debug;
        } elsif (hex($hex_nums[$opt_kind]) == $tcp_sack_type) {
            push @opts, {$tcp_sack_type => ''};
            $debug_str .= 'SACK, ' if $debug;
        } elsif (hex($hex_nums[$opt_kind]) == $tcp_timestamp_type) {
            my $timestamp_hex = '';
            for (my $i=$opt_kind+2; $i < ($opt_kind+$len) - 4; $i++) {
                $timestamp_hex .= $hex_nums[$i];
            }
            my $timestamp = hex($timestamp_hex);
            push @opts, {$tcp_timestamp_type => $timestamp};
            $debug_str .= 'Timestamp: ' . hex($timestamp_hex) . ', ' if $debug;
        } elsif (hex($hex_nums[$opt_kind]) == 0) {  ### End of option list
            last OPT;
        }
        if ($is_nop) {
            $opt_kind += 1;
        } else {
            if ($len == 0 or $len == 1) {
                ### this should never happen; it indicates a broken TCP stack
                ### or maliciously constructed options since the len field is
                ### not large enough to accomodate the TLV encoding
                my $msg = "broken $len-byte len field within TCP options " .
                    "string: $tcp_options from source IP: $src";
                print STDERR "    $msg\n" if $debug;
                &sys_log($msg);
                return [];
            }
            ### get to the next option-kind field
            $opt_kind += $len;
        }
    }
    if ($debug) {
        $debug_str =~ s/\,$//;
        print STDERR "[+] $debug_str\n" if $debug;
    }
    return \@opts;
}

sub parse_ip_options() {
    my $ip_opts_str = shift;

    my %ip_opts  = ();
    my @hex_nums = ();

    if (length($ip_opts_str) % 2 != 0) {  ### make sure length is a multiple of two
        print STDERR 'IP options length not a multiple of two.' if $debug;
        return '';
    }
    print STDERR "[+] parse_ip_options(): matched " if $debug;

    push @hex_nums, $1 while $ip_opts_str =~ m|(.{2})|g;

    OPT: for (my $i=0; $i <= $#hex_nums; $i++) {
        my $val = hex($hex_nums[$i]);

        for my $rfc_opt_val (keys %ip_options) {
            next unless $val == $rfc_opt_val;
            if ($ip_options{$rfc_opt_val}{'len'} ne '-1') {
                $i += $ip_options{$rfc_opt_val}{'len'}
                    unless $ip_options{$rfc_opt_val}{'len'} == 1;
            } else {
                return \%ip_opts if ($i+1 > $#hex_nums);
                ### subtract out the option and length fields
                my $pkt_opt_len = hex($hex_nums[$i+1]) - 2;
                if ($i + $pkt_opt_len > $#hex_nums) {
                    ### this should not happen unless the IP packet
                    ### was truncated (i.e. the length argument for
                    ### this option is past the IP options portion
                    ### of the header).
                    return \%ip_opts;
                }
                $i += $pkt_opt_len;
            }
            if ($debug) {
                printf STDERR ("$ip_options{$rfc_opt_val}{'sig_keyword'} " .
                    "(0x%x) ", $val) unless defined $ip_opts{$ip_options
                    {$rfc_opt_val}{'sig_keyword'}};
            }
            $ip_opts{$ip_options{$rfc_opt_val}{'sig_keyword'}} = '';
        }
    }
    print STDERR "\n" if $debug;

    return \%ip_opts;
}

sub posf() {
    my $pkt_hr = shift;

    if ($pkt_hr->{'is_ipv6'}) {
        &posf_ipv6($pkt_hr);
    } else {
        &posf_ipv4($pkt_hr);
    }
    return;
}

sub posf_ipv6() {
    my $pkt_hr = shift;
    return;
}

sub posf_ipv4() {
    my $pkt_hr = shift;

    my $src = $pkt_hr->{'src'};
    my $len = $pkt_hr->{'ip_len'};
    my $tos = $pkt_hr->{'tos'};
    my $ttl = $pkt_hr->{'ttl'};
    my $id  = $pkt_hr->{'ip_id'};
    my $win = $pkt_hr->{'win'};

    my $min_ttl;
    my $max_ttl;
    my $id_str;

    $posf{$src}{'len'}{$len}++;
    $posf{$src}{'tos'}{$tos}++;
    $posf{$src}{'ttl'}{$ttl}++;
    $posf{$src}{'win'}{$win}++;
    $posf{$src}{'ctr'}++;
    push @{$posf{$src}{'id'}}, $id;  ### need to maintain ordering

    print STDERR "[+] posf():  $src  LEN: $len, TOS: $tos, TTL: $ttl, ",
        "ID: $id, WIN: $win\n" if $debug;

    $id_str = &id_incr(\@{$posf{$src}{'id'}});
    for my $os (keys %posf_sigs) {
        if ($posf{$src}{'ctr'} >= $posf_sigs{$os}{'numpkts'}) {
            ($min_ttl, $max_ttl) = &ttl_range($posf{$src}{'ttl'});
            if (defined $posf{$src}{'win'}{$posf_sigs{$os}{'win'}}
#                    and defined $posf{$src}{'tos'}{$posf_sigs{$os}{'tos'}}
                    and defined $posf{$src}{'len'}{$posf_sigs{$os}{'len'}}
                    ### ttl's only decrease
                    and ($min_ttl > ($posf_sigs{$os}{'ttl'}-$max_hops))
                    and ($max_ttl <= $posf_sigs{$os}{'ttl'})
                    and $id_str eq $posf_sigs{$os}{'id'}) {
                $posf{$src}{'guess'} = $os;
                print STDERR "[+] posf(): matched OS: $os\n" if $debug;
                return;
            }
        }
    }
    return;
}

sub id_incr() {
    my $aref = shift;
    for (my $i=0; $i<$#$aref; $i++) {
        return 'RANDOM'
            unless ($aref->[$i] < $aref->[$i+1]
                and ($aref->[$i+1] - $aref->[$i]) < 1000);
    }
    return 'SMALLINCR';
}

sub ttl_range() {
    my $hr = shift;
    my $min_ttl = 256;
    my $max_ttl = 0;
    for my $ttl (keys %$hr) {
        $min_ttl = $ttl if $ttl < $min_ttl;
        $max_ttl = $ttl if $ttl > $max_ttl;
    }
    return $min_ttl, $max_ttl;
}

sub assign_sid_dl() {
    my ($sid, $dl) = @_;

    ### see if /etc/psad/snort_rule_dl assigns a DL (may be
    ### zero).
    if (defined $snort_rule_dl{$sid}) {
        $dl = $snort_rule_dl{$sid};
    }

    print STDERR "[+] assign_sid_dl(): snort_rule_dl ",
        "assigning SID $sid a danger level of ",
        "$dl\n" if $debug;

    return $dl;
}

sub add_fwsnort_sid() {
    my $pkt_hr = shift;

    my $sid = $pkt_hr->{'fwsnort_sid'};

    if (defined $fwsnort_sigs{$sid}) {

        ### see if we need to ignore this signature match
        my $dl = &assign_sid_dl($sid, 2);

        unless ($dl) {
            print "[+] add_fwsnort_sid(): ignoring fwsnort signature ",
                "match for SID: $sid (DL=0)\n" if $debug;
            return 0, $SIG_MATCH;
        }

        $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tot_protocols'} = 0
            unless defined $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tot_protocols'};

        $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{'tot_protocols'}++
            unless defined $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{$pkt_hr->{'proto'}};

        $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{$pkt_hr->{'proto'}}
            {'sid'}{$sid}{$pkt_hr->{'chain'}}{'pkts'}++;

        $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{$pkt_hr->{'proto'}}
            {'sid'}{$sid}{$pkt_hr->{'chain'}}{'is_fwsnort'} = 1;

        $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{$pkt_hr->{'proto'}}
            {'sid'}{$sid}{$pkt_hr->{'chain'}}{'time'} = time();

        $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{$pkt_hr->{'proto'}}
            {'sid'}{$sid}{$pkt_hr->{'chain'}}{'fwsnort_rnum'}
                = $pkt_hr->{'fwsnort_rnum'};

        $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{$pkt_hr->{'proto'}}
            {'sid'}{$sid}{$pkt_hr->{'chain'}}{'fwsnort_estab'}
                = $pkt_hr->{'fwsnort_estab'};

        $sig_sources{$sid}{$pkt_hr->{'src'}} = 1; ### is an fwsnort sid
        $top_sigs{$sid}++;
        $top_sig_counts{$pkt_hr->{'src'}}++;

        if ($pkt_hr->{'proto'} eq 'tcp' or $pkt_hr->{'proto'} eq 'udp') {

            $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{$pkt_hr->{'proto'}}
                {'sid'}{$sid}{$pkt_hr->{'chain'}}{'dp'}
                    = $pkt_hr->{'dp'};

            if ($pkt_hr->{'proto'} eq 'tcp') {
                $scan{$pkt_hr->{'src'}}{$pkt_hr->{'dst'}}{$pkt_hr->{'proto'}}
                    {'sid'}{$sid}{$pkt_hr->{'chain'}}{'flags'}
                        = $pkt_hr->{'flags'};
            }
        }

        return $dl, $SIG_MATCH;

    } else {
        print "[-] Found sid: $sid in packet, but no ",
            "corresponding fwsnort rule.\n" if $debug;
    }
    return 0, $NO_SIG_MATCH;
}

sub delete_old_scans() {

    my $current_time = time();

    print STDERR "[+] delete_old_scans()\n" if $debug;

    ### see if we need to timeout any old scans
    for my $src (keys %scan) {
        for my $dst (keys %{$scan{$src}}) {
            next unless defined $scan{$src}{$dst}{'s_time'};
            if (($current_time - $scan{$src}{$dst}{'s_time'})
                    >= $config{'SCAN_TIMEOUT'}) {
                print STDERR "    delete old scan $src -> $dst\n"
                    if $debug;

                delete $scan{$src}{$dst};

                if ($config{'MAX_SCAN_IP_PAIRS'} > 0) {
                    $scan_ip_pairs-- if $scan_ip_pairs > 0;
                }
            }
        }
    }
    return;
}

sub dshield_email_log() {
    ### dshield alert interval is in hours.  Check to see if there are more
    ### than 10,000 lines of log data (and if the last alert was sent more than
    ### two hours later than the previous alert), and if yes send the alert
    ### email.
    if (@dshield_data and ((time() - $last_dshield_alert)
            >= $dshield_alert_interval)
            or (($#dshield_data > 10000)
            and ((time() - $last_dshield_alert) >= 2*3600))) {
        my $dshield_version = $version;
        $dshield_version =~ s/^(\d+\.\d+)\.\d+/$1/;
        $dshield_version =~ s/-pre\d+//;
        my $subject = "FORMAT DSHIELD USERID $config{'DSHIELD_USER_ID'} " .
            "TZ $timezone psad Version $dshield_version";
        if ($config{'DSHIELD_USER_EMAIL'} eq 'NONE') {
            open MAIL, qq(| $cmds{'mail'} -s "$subject" ) .
                $config{'DSHIELD_ALERT_EMAIL'} or die '[*] Could not send ',
                'dshield alert email.';
            ### save this email to disk also
            open DSSAVE, "> $config{'DSHIELD_EMAIL_FILE'}" or die '[*] ',
                "Could not open $config{'DSHIELD_EMAIL_FILE'}: $!";
            if ($config{'DSHIELD_DL_THRESHOLD'} > 0) {
                for my $line (@dshield_data) {
                    if ($line =~ /^.*?($ipv4_re)/) {
                        my $src = $1;
                        if (defined $scan_dl{$src}
                                and ($scan_dl{$src}
                                    >= $config{'DSHIELD_DL_THRESHOLD'})) {
                            print MAIL $line;
                            print DSSAVE $line;
                        }
                    }
                }
            } else {
                print MAIL for @dshield_data;
                print DSSAVE for @dshield_data;
            }
            close MAIL;
            close DSSAVE;
        } else {
            open MAIL, "| $cmds{'sendmail'} -oi -t" or die '[*] Could not ',
                'send dshield alert email.';
            ### save this email to disk also
            open DSSAVE, "> $config{'DSHIELD_EMAIL_FILE'}" or die '[*] ',
                "Could not open $config{'DSHIELD_EMAIL_FILE'}: $!";
            print MAIL "From: $config{'DSHIELD_USER_EMAIL'}\n",
                "To: $config{'DSHIELD_ALERT_EMAIL'}\n",
                "Subject: $subject\n";
            print DSSAVE "From: $config{'DSHIELD_USER_EMAIL'}\n",
                "To: $config{'DSHIELD_ALERT_EMAIL'}\n",
                "Subject: $subject\n";
            if ($config{'DSHIELD_DL_THRESHOLD'} > 0) {
                for my $line (@dshield_data) {
                    if ($line =~ /^.*?($ipv4_re)/) {
                        my $src = $1;
                        if (defined $scan_dl{$src}
                                and ($scan_dl{$src}
                                    >= $config{'DSHIELD_DL_THRESHOLD'})) {
                            print MAIL $line;
                            print DSSAVE $line;
                        }
                    }
                }
            } else {
                print MAIL for @dshield_data;
                print DSSAVE for @dshield_data;
            }
            close MAIL;
            close DSSAVE;
        }

        &sys_log("sent $#dshield_data lines of log data to " .
            $config{'DSHIELD_ALERT_EMAIL'});

        ### store the current time
        $last_dshield_alert = time();

        ### increment stats counters
        $dshield_email_ctr++;
        $dshield_lines_ctr += $#dshield_data;

        ### clear the dshield data array so we don't re-send
        ### any old data.
        @dshield_data = ();

        ### Write Dshield stats to disk
        &write_dshield_stats();
    }
    return;
}

sub check_icmp_type() {
    my ($proto, $valid_types_hr, $type, $code) = @_;
    print STDERR "    check_icmp_type(type: $type, code: $code)\n" if $debug;
    if (not defined $valid_types_hr->{$type}) {
        print STDERR "        bad $proto type\n" if $debug;
        return $BAD_ICMP_TYPE;
    } elsif (not defined $valid_types_hr->{$type}->{'codes'}->{$code}) {
        print STDERR "        bad $proto code\n" if $debug;
        return $BAD_ICMP_CODE;
    }
    print STDERR "        valid $proto type/code\n" if $debug;
    return 0;
}

sub import_perl_modules() {

    my $mod_paths_ar = &get_mod_paths();

    if ($#$mod_paths_ar > -1) {  ### /usr/lib/psad/ exists
        push @$mod_paths_ar, @INC;
        splice @INC, 0, $#$mod_paths_ar+1, @$mod_paths_ar;
    }

    if ($debug) {
        print STDERR "[+] import_perl_modules(): The \@INC array:\n";
        print STDERR "$_\n" for @INC;
    }

    require IPTables::ChainMgr;
    require NetAddr::IP;
    require Date::Calc;
    require Unix::Syslog;
    require Cwd;
    require Storable if $store_file;

    Date::Calc->import(qw(Timezone This_Year Decode_Month
            Today Date_to_Time This_Year Mktime Localtime));
    Unix::Syslog->import(qw(:subs :macros));
    Storable->import(qw(retrieve store)) if $store_file;

    $imported_syslog_module = 1;

    return;
}

sub get_mod_paths() {

    my @paths = ();

    $config{'PSAD_LIBS_DIR'} = $lib_dir if $lib_dir;

    unless (-d $config{'PSAD_LIBS_DIR'}) {
        my $dir_tmp = $config{'PSAD_LIBS_DIR'};
        $dir_tmp =~ s|lib/|lib64/|;
        if (-d $dir_tmp) {
            $config{'PSAD_LIBS_DIR'} = $dir_tmp;
        } else {
            return [];
        }
    }

    opendir D, $config{'PSAD_LIBS_DIR'}
        or die "[*] Could not open $config{'PSAD_LIBS_DIR'}: $!";
    my @dirs = readdir D;
    closedir D;

    push @paths, $config{'PSAD_LIBS_DIR'};

    for my $dir (@dirs) {
        ### get directories like "/usr/lib/psad/x86_64-linux"
        next unless -d "$config{'PSAD_LIBS_DIR'}/$dir";
        push @paths, "$config{'PSAD_LIBS_DIR'}/$dir"
            if $dir =~ m|linux| or $dir =~ m|thread|
                or (-d "$config{'PSAD_LIBS_DIR'}/$dir/auto");
    }
    return \@paths;
}

sub psad_init() {

    %config = ();
    %cmds   = ();

    ### set umask to -rw-------
    umask 0077;

    ### turn off buffering
    $| = 1;

    $no_syslog_alerts = 1 if $analyze_mode or $status_mode or $test_mode;
    $no_email_alerts = 1 if $test_mode;
    $debug = 1 if $test_mode;

    ### import any override config files first
    &import_override_configs() if $override_config_str;

    ### import psad.conf
    &import_config($config_file);

    ### import FW_MSG_SEARCH strings
    &import_fw_search($config_file);

    ### expand any embedded vars within config values
    &expand_vars();

    ### pid file hash
    %pidfiles = (
        'psadwatchd'   => $config{'PSADWATCHD_PID_FILE'},
        'psad'         => $config{'PSAD_PID_FILE'},
        'psad_fw_read' => $config{'PSAD_FW_READ_PID_FILE'},
        'kmsgsd'       => $config{'KMSGSD_PID_FILE'},
    );

    ### dump configuration to STDOUT
    if ($dump_conf or $dump_ipt_policy) {
        my $rv = 0;
        my $rv_tmp = 0;
        $rv = &dump_conf() if $dump_conf;
        $rv_tmp = &dump_ipt_policy() if $dump_ipt_policy;
        $rv += $rv_tmp if $rv_tmp != 0;
        exit $rv;
    }

    &dump_conf() if $test_mode;

    ### make sure all necessary configuration variables
    ### are defined
    &required_vars();

    ### store the psad command line.
    $cmdline_file = $config{'PSAD_CMDLINE_FILE'};

    ### make sure the values in the config file make sense
    &validate_config();

    ### setup the appropriate iptables data file depending on whether
    ### SYSLOG_DAEMON is set to ulogd, or if ENABLE_SYSLOG_FILE is set
    ### to 'Y'
    unless ($benchmark or $fw_data_file) {
        if ($config{'SYSLOG_DAEMON'} =~ /ulog/i) {
            $fw_data_file = $config{'ULOG_DATA_FILE'};
        } elsif ($config{'ENABLE_SYSLOG_FILE'} eq 'Y') {
            $fw_data_file = $config{'IPT_SYSLOG_FILE'};
        } else {
            $fw_data_file = $config{'FW_DATA_FILE'};
        }
    }

    ### check to make sure the commands specified in the config section
    ### are in the right place, and attempt to correct automatically if not.
    ### (wget is only needed in --sig-update mode)
    my %cmd_exceptions = ('wget' => '');
    $cmd_exceptions{'ifconfig'} = '' if $config{'IFCFGTYPE'} =~ /iproute2/i;
    &check_commands(\%cmd_exceptions);

    ### import psad perl modules
    &import_perl_modules();

    ### download latest signatures from
    ### http://www.cipherdyne.org/psad/signatures
    exit &download_signatures() if $download_sigs;

    ### set some config variables based on command line input
    &handle_cmdline();

    $ipt_opts{'tmpdir'}     = $config{'PSAD_DIR'};
    $ipt_opts{'iptout_pat'} = $config{'IPT_OUTPUT_PATTERN'};
    $ipt_opts{'ipterr_pat'} = $config{'IPT_ERROR_PATTERN'};

    $ipt_opts{'debug'}   = 1 if $debug;
    $ipt_opts{'verbose'} = 1 if $verbose;

    ### build iptables block config hash out of IPT_AUTO_CHAIN keywords
    ### (we don't check ENABLE_AUTO_IDS here since someone may have turned
    ### it off but still want to run --Status checks or use --Flush).
    &build_ipt_config() unless $syslog_server;

    ### The --Kill command line switch was given.
    exit &stop_psad() if $kill;

    ### The --HUP command line switch was given.
    exit &hup() if $hup;

    ### The --USR1 command line switch was given.
    exit &usr1() if $usr1;

    ### The --Flush command line switch was given.
    exit &sockwrite_flush_auto_rules() if $flush_fw;

    ### the --Restart command line switch was given
    exit &restart() if $restart;

    ### list any existing iptables IPT_AUTO_CHAIN chains
    exit &ipt_list_auto_chains() if $fw_list_auto;

    ### add an IP/network to the psad auto blocking chains via the
    ### domain socket (note that &sockwrite_add_ipt_block_ip() calls
    ### &import_auto_dl() to make sure we don't add an IP that should
    ### be ignored).
    exit &sockwrite_add_ipt_block_ip() if $fw_block_ip;

    ### delete IP/network from psad auto blocking chains
    exit &sockwrite_rm_ipt_block_ip() if $fw_rm_block_ip;

    ### send a warning via syslog if the HOME_NET variable definition
    ### appears to include a subnet that is not directly connected to
    ### the local system.
    &validate_home_net();

    ### import icmp types and codes from psad_icmp_types; icmp "type"
    ### and "code" fields will be validated against the values in this
    ### file.
    &import_icmp_types('icmp', \%valid_icmp_types, $config{'ICMP_TYPES_FILE'})
        unless $no_icmp_types;
    &import_icmp_types('icmp6', \%valid_icmp6_types,
        $config{'ICMP6_TYPES_FILE'}) unless $no_icmp6_types;

    ### import p0f-based passive OS fingerprinting signatures
    &import_p0f_ipv4_sigs() unless $no_posf;

    ### import TOS-based passive OS fingerprinting signatures
    &import_posf_sigs() unless $no_posf;

    ### import IP protocols detail (derived from /etc/protocols)
    &import_protocol_strings();

    ### import auto_dl file for automatic ip/network danger
    ### level assignment
    &import_auto_dl() unless $no_auto_dl;

    ### parse snort rules if we enable psad to match on iptables log
    ### messages that include snort SID's (see "fwsnort":
    ### http://www.cipherdyne.org/fwsnort).
    &import_snort_rules() unless $no_snort_sids;

    ### import psad signatures (note that these signatures have been
    ### adapted from the Snort IDS and contain several keywords that
    ### were added by the psad project).
    &import_signatures() unless $no_signatures;

    ### the --Status command line switch was given
    exit &status() if $status_mode;

    ### there is a set of ports that should be ignored
    &parse_ignore_ports();

    ### there is a set of protocols that should be ignored
    &parse_ignore_protocols();

    ### there is a set of interfaces that should be ignored
    &parse_ignore_interfaces();

    ### enter iptables analysis mode.
    exit &analysis_mode() if $analyze_mode;

    ### enter CSV output mode.
    exit &csv_mode() if $csv_mode or $gnuplot_mode;

    ### enter benchmarking mode
    exit &benchmark_mode() if $benchmark;

    ### analyze the iptables policy and exit
    my $rv = &fw_analyze_mode();
    exit $rv if $fw_analyze;

    ### make sure we are setup to run
    &setup();

    ### dump config
    &dump_conf() if $debug;

    if ($restrict_ip_cmdline) {
        $restrict_ip = new NetAddr::IP $restrict_ip_cmdline
            or die "[*] Could not acquire NetAddr::IP object for $restrict_ip";
    }

    return;
}

sub validate_config() {

    &check_enable_vars_value();

    &is_digit_range('PORT_RANGE_SCAN_THRESHOLD', 0, 65535);
    &is_digit_range('TOP_SCANS_CTR_THRESHOLD', 0, 500);
    &is_digit_range('DSHIELD_ALERT_INTERVAL', 1, 24);
    &is_digit_range('TOP_PORTS_LOG_THRESHOLD', 0, 65535);
    &is_digit_range('STATUS_PORTS_THRESHOLD', 0, 65535);
    &is_digit_range('TOP_IP_LOG_THRESHOLD', 0, 10000);
    &is_digit_range('STATUS_IP_THRESHOLD', 0, 10000);

    ### it will be a long time before there are 100000 signatures
    &is_digit_range('TOP_SIGS_LOG_THRESHOLD', 0, 100000);
    &is_digit_range('STATUS_SIGS_THRESHOLD', 0, 10000);

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

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

    if ($config{'ENABLE_AUTO_IDS'} eq 'Y'
            and $config{'IPTABLES_BLOCK_METHOD'} eq 'N'
            and $config{'TCPWRAPPERS_BLOCK_METHOD'} eq 'N') {
        die 'config warning, ENABLE_AUTO_IDS=Y, but ' .
            'both IPTABLES_BLOCK_METHOD and TCPWRAPPERS_BLOCK_METHOD are ' .
            'set to N.';
    }
    if ($status_min_dl and $status_min_dl > 5) {
        die '[*] The --status-dl must be between 1 and 5.';
    }
    if ($no_kmsgsd and not $debug) {
        die '[*] The --no-kmsgsd option can only be used with --debug.';
    }

    if ($fw_del_chains and not $flush_fw) {
        die '[*] The --fw-del-chains option can only be used with --Flush.';
    }

    if ($fw_block_ip) {
        unless ($fw_block_ip =~ m|^\s*$ipv4_re\s*$|
                or $fw_block_ip =~ m|^\s*$ipv4_re/\d+\s*$|
                or $fw_block_ip =~ m|^\s*$ipv4_re/$ipv4_re\s*$|) {
            die '[*] The --fw-block-ip argument accepts ' .
                'an IP address or network.';
        }
    }

    if ($fw_rm_block_ip) {
        unless ($fw_rm_block_ip =~ m|^\s*$ipv4_re\s*$|
                or $fw_rm_block_ip =~ m|^\s*$ipv4_re/\d+\s*$|
                or $fw_rm_block_ip =~ m|^\s*$ipv4_re/$ipv4_re\s*$|) {
            die '[*] The --fw-rm-block-ip argument accepts ' .
                'an IP address or network.';
        }
    }

    if ($config{'ENABLE_SYSLOG_FILE'} eq 'Y') {
        die "[*] Cannot set IPT_SYSLOG_FILE and FW_DATA_FILE to point ",
            "at the same file." if $config{'IPT_SYSLOG_FILE'}
            eq $config{'FW_DATA_FILE'};
    }

    unless ($config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL7/i
            or $config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL6/i
            or $config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL5/i
            or $config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL4/i
            or $config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL3/i
            or $config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL2/i
            or $config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL1/i
            or $config{'SYSLOG_FACILITY'} =~ /LOG_LOCAL0/i) {
        die "[*] Unrecognized SYSLOG_FACILITY, see psad.conf";
    }

    unless ($config{'SYSLOG_PRIORITY'} =~ /LOG_INFO/i
            or $config{'SYSLOG_PRIORITY'} =~ /LOG_DEBUG/i
            or $config{'SYSLOG_PRIORITY'} =~ /LOG_NOTICE/i
            or $config{'SYSLOG_PRIORITY'} =~ /LOG_WARNING/i
            or $config{'SYSLOG_PRIORITY'} =~ /LOG_ERR/i
            or $config{'SYSLOG_PRIORITY'} =~ /LOG_CRIT/i
            or $config{'SYSLOG_PRIORITY'} =~ /LOG_ALERT/i
            or $config{'SYSLOG_PRIORITY'} =~ /LOG_EMERG/i) {
        die "[*] Unrecognized SYSLOG_PRIORITY, see psad.conf";
    }

    if ($analyze_mode or $gnuplot_mode or $csv_mode) {
        $fw_data_file = $config{'IPT_SYSLOG_FILE'}
            unless $fw_data_file;
    }

    if ($gnuplot_mode and not $csv_fields) {
        die "[*] Must specify which iptables fields to plot with the ",
            "--CSV-fields argument."
    }

    my $journalctl_is_running = 0;
    $journalctl_is_running = 1
        if &look_for_process(qr/^root\s.*systemd\-journald\b/);

    if ($config{'AUTO_DETECT_JOURNALCTL'} eq 'Y') {
        if ($journalctl_is_running) {
            $config{'ENABLE_FW_MSG_READ_CMD'} = 'Y';
            print STDERR "[*] journalctl appears to be running.\n" if $debug;
        } else {
            $config{'ENABLE_FW_MSG_READ_CMD'} = 'N';
            print STDERR "[*] journalctl appears to NOT be running.\n" if $debug;
        }
    } else {
        if ($config{'ENABLE_FW_MSG_READ_CMD'} eq 'Y') {
            die "[*] Could not find/execute FW_MSG_READ_CMD: $config{'FW_MSG_READ_CMD'}"
                unless -e $config{'FW_MSG_READ_CMD'} and -x $config{'FW_MSG_READ_CMD'};
            ### make sure systemd-journald is running and warn if not
            unless ($journalctl_is_running) {
                &sys_log('warning: it looks like systemd-journald is not running, ' .
                    'but ENABLE_FW_MSG_READ_CMD is enabled.');
            }
        } else {
            ### warn if systemd-journald is running since we likely won't see any
            ### firewall logs
            if ($journalctl_is_running) {
                &sys_log('warning: it looks like systemd-journald is running, ' .
                    'but ENABLE_FW_MSG_READ_CMD is not enabled.');
            }
        }
    }

    if ($config{'ENABLE_CUSTOM_SYSLOG_TS_RE'} eq 'Y') {
        ### validate a dummy regex match for syntax issues
        my $test_re = qr/$config{'CUSTOM_SYSLOG_TS_RE'}/;
        if ('teststr' =~ $test_re) {
            print STDERR "[+] Syslog parsing regex compiled.\n" if $debug;
        }
    }

    return;
}

sub open_fw_data() {

    if ($config{'ENABLE_FW_MSG_READ_CMD'} eq 'Y') {

        my $fwdata_fh = &fork_fw_read_cmd();

        $s = IO::Select->new();
        $s->add($fwdata_fh);

        $fwdata_fh->flush();

        return $fwdata_fh;

    } else {

        print STDERR "[+] Opening iptables data file: $fw_data_file\n"
            if $debug;

        open my $fwdata_fh, $fw_data_file or die '[*] Could not open ',
            "$fw_data_file: $!";
        return $fwdata_fh;
    }

    die "[*] Did not open a source of firewall log data";
}

sub reopen_fw_data() {
    my ($fwdata_fh, $truncate_flag) = @_;

    close $fwdata_fh;

    ### truncate fwdata file
    &truncate_file($fw_data_file) if $truncate_flag;

    open $fwdata_fh, $fw_data_file or die
        "[*] Could not open $fw_data_file: $!";

    return $fwdata_fh;
}

sub fork_fw_read_cmd() {

    $fw_read_cmd = $config{'FW_MSG_READ_CMD'};
    $fw_read_cmd .= " $config{'FW_MSG_READ_CMD_ARGS'} "
        if $config{'USE_FW_MSG_READ_CMD_ARGS'} eq 'Y';
    $fw_read_cmd =~ s/\s$//;

    print STDERR "[+] Reading iptables logs via: '$fw_read_cmd'\n"
        if $debug;

    ### Credit:
    ###   http://stackoverflow.com/questions/9214964/how-do-i-watch-a- \
    ###   running-programs-stdout-from-a-perl-program-that-called-it
    socketpair CMDA,CMDB,AF_UNIX,SOCK_STREAM,PF_UNSPEC;
    if (fork() == 0) {
        &write_pid($config{'PSAD_FW_READ_PID_FILE'});
        open my $fh, '-|', $fw_read_cmd;
        while (<$fh>) {
            print CMDB;
            CMDB->flush();
        }
        close $fh;
        exit $? >> 8;
    }
    return *CMDA;
}

sub check_enable_vars_value() {
    for my $var (keys %config) {
        next unless $var =~ /^ENABLE_/;
        ### make sure that all of the "ENABLE_" vars have a value of
        ### 'Y' or 'N'
        $config{$var} = uc($config{$var});
        unless ($config{$var} eq 'Y' or $config{$var} eq 'N'
                or $config{$var} eq 'YES' or $config{$var} eq 'NO') {
            die "[*] $var variable must be 'Y' or 'N'";
        }
    }
    return;
}

sub is_digit_range() {
    my ($key, $min, $max) = @_;
    die "[*] $key must be an integer >= $min and <= $max"
        unless $config{$key} =~ m|^\d+$| and $config{$key} >= $min
            and $config{$key} <= $max;
    return;
}

sub get_connected_subnets() {

    my @connected_subnets = ();

    if ($config{'IFCFGTYPE'} =~ /iproute2/i) {
        my @ip_out = @{&run_command($cmds{'ip'}, 'addr')};
        my $intf_name    = '';
        my $home_net_str = '';
        for my $line (@ip_out) {
            if ($line =~ /^\d+:\s+(\S+): </) {
                $intf_name = $1;
                next;
            }
            next if $intf_name eq 'lo';
            next if $intf_name =~ /dummy/i;
            if ($line =~ /^\s+inet.*?($ipv4_re)\/(\d+)/i) {
                push @connected_subnets, new NetAddr::IP($1, $2);
            } elsif ($line =~ /inet6\s(\S+)/) {
                push @connected_subnets, new6 NetAddr::IP($1);
            }
        }
    } else {
        my @ifconfig_out = @{&run_command($cmds{'ifconfig'}, '-a')};
        my $intf_name    = '';
        my $home_net_str = '';
        for my $line (@ifconfig_out) {
            if ($line =~ /^(\S+)\s+Link/) {
                $intf_name = $1;
                next;
            }
            next if $intf_name eq 'lo';
            next if $intf_name =~ /dummy/i;
            if ($line =~ /^\s+inet.*?:($ipv4_re).*:($ipv4_re)/i) {
                push @connected_subnets, new NetAddr::IP($1, $2);
            } elsif ($line =~ /^\s+inet6\saddr:\s+(\S+)/) {
                push @connected_subnets, new6 NetAddr::IP($1);
            }
        }
    }
    return \@connected_subnets;
}

sub validate_home_net() {

    @local_nets = ();

    return if $config{'HOME_NET'} eq 'any'
        and $config{'ENABLE_INTF_LOCAL_NETS'} eq 'N';

    my $connected_subnets_ar = &get_connected_subnets();

    if ($config{'ENABLE_INTF_LOCAL_NETS'} eq 'Y' and not $analyze_mode) {

        my $connected_str = '';
        for my $net (@$connected_subnets_ar) {
            push @local_nets, $net;
            $connected_str .= $net->network()->cidr() . ", ";
        }
        $connected_str =~ s|,\s*$||;

        $config{'HOME_NET'} = $connected_str;
        $config{'HOME_NET'} = 'any' unless $connected_str;

    } else {

        if ($config{'HOME_NET'} =~ /CHANGEME/) {
            &sys_log('config warning: the HOME_NET ' .
                'variable has not been set, defaulting to "any"');

            $config{'HOME_NET'} = 'any';
            return;
        }
        my @home_nets = split /\s*\,\s*/, $config{'HOME_NET'};
        my $found_one_net = 0;
        for my $net (@home_nets) {
            my $home_net = '';
            if ($net =~ m|($ipv4_re/$ipv4_re)|) {
                $home_net = new NetAddr::IP $1;
            } elsif ($net =~ m|($ipv4_re/\d+)|) {
                $home_net = new NetAddr::IP $1;
            } elsif ($net =~ m|($ipv4_re)|) {
                $home_net = new NetAddr::IP $1;
            } else {
                next;
            }
            push @local_nets, new NetAddr::IP $net;
            my $found = 0;
            for my $net (@$connected_subnets_ar) {
                $found = $found_one_net = 1
                    if $home_net->within($net);
            }
            unless ($found) {
                ### note that this might be ok if psad is running on a syslog
                ### server, but the most likely explanation is that there was a
                ### typo in the HOME_NET variable defintion.
                &sys_log('config warning: HOME_NET definition ' .
                    qq|in psad.conf contains "$home_net" which does not appear | .
                    "to be directly connected to the local system.");
            }
        }
        $config{'HOME_NET'} = 'any' unless $found_one_net;
    }
    return;
}

sub is_local() {
    my ($ip, $ip_obj) = @_;

    print STDERR "[+] is_local(): $ip..." if $debug;

    if ($test_mode) {
        print STDERR "(test mode enabled) no\n";
        return 0;
    }

    my $found = 0;
    for my $net (@local_nets) {
        if ($ip_obj->within($net)) {
            $found = 1;
            last;
        }
    }
    if ($debug) {
        $found == 0 ? print STDERR "no\n" : print STDERR "yes\n";
    }
    return $found;
}

sub import_ip_options() {

    %ip_options = ();

    open O, "< $config{'IP_OPTS_FILE'}" or die
        "[*] Couild not open IP options file $config{'IP_OPTS_FILE'}: $!";
    while (<O>) {
        next unless /\S/;
        next if /^\s*#/;
        ### 136  4   satid       Stream Identifier
        ### 145  -1  extproto    Extended Internet Proto
        if (/^\s*(\d+)\s+(\S+)\s+(\w+)\s+(.*)\s*/) {
            $ip_options{$1}{'len'}         = $2;
            $ip_options{$1}{'sig_keyword'} = $3;
            $ip_options{$1}{'desc'}        = $4;
        } else {
        }
    }
    close O;

    print STDERR "[+] IP options:\n", Dumper(\%ip_options)
        if $debug and $verbose;

    return;
}

sub import_fw_search() {
    my $config_file = shift;

    @fw_search = ();

    open F, "< $config_file" or die "[*] Could not open config ",
        "string file $config_file: $!";
    my @lines = <F>;
    close F;
    my $found_fw_search = 0;
    for my $line (@lines) {
        next unless $line =~ /\S/;
        next if $line =~ /^\s*#/;
        if ($line =~ /^\s*FW_MSG_SEARCH\s+(.*?);/) {
            push @fw_search, $1;
            $found_fw_search = 1;
        } elsif ($line =~ /^\s*FW_SEARCH_ALL\s+(\w+);/) {
            my $strategy = $1;
            if ($strategy eq 'Y' or $strategy eq 'N') {
                $config{'FW_SEARCH_ALL'} = $strategy;
            }
        }
    }
    unless (defined $config{'FW_SEARCH_ALL'}) {
        $config{'FW_SEARCH_ALL'} = 'Y';
    }

    unless ($config{'FW_SEARCH_ALL'} eq 'Y' or
            $config{'FW_SEARCH_ALL'} eq 'N') {
        $config{'FW_SEARCH_ALL'} = 'Y';
    }

    if ($config{'FW_SEARCH_ALL'} eq 'N' and not $found_fw_search) {
        push @fw_search, 'DROP';
    }
    return;
}

sub parse_ignore_ports() {

    ### zero out the hash since a HUP signal may have been received
    %ignore_ports = ();

    return if $config{'IGNORE_PORTS'} eq 'NONE';

    &parse_port_range(\%ignore_ports, $config{'IGNORE_PORTS'});

    return;
}

sub parse_port_range() {
    my ($hr, $line) = @_;

    my @fields = split /\s*,\s*/, $line;
    for my $field (@fields) {
        if ($field =~ m/(tcp|udp)\/(\d+)\s*-\s*(\d+)/i) {
            my $proto = lc($1);
            my $low   = $2;
            my $high  = $3;
            if ($low < $high) {
                my $existing_high = 0;
                if (defined $hr->{$proto}
                        and defined $hr->{$proto}->{'range'}
                        and defined $hr->{$proto}->{'range'}->{$low}) {
                    $existing_high = $hr->{$proto}->{'range'}->{$low};
                }
                if ($existing_high) {
                    if ($high > $existing_high) {
                        $hr->{$proto}->{'range'}->{$low} = $high;
                    }
                } else {
                    $hr->{$proto}->{'range'}->{$low} = $high;
                }
            }
        } elsif ($field =~ m/(tcp|udp)\/(\d+)/i) {
            my $proto = lc($1);
            my $port  = $2;
            $hr->{$proto}->{'port'}->{$port} = '';
        }
    }
    return;
}

sub parse_ignore_protocols() {

    ### zero out the hash since a HUP signal may have been received
    %ignore_protocols = ();

    return if $config{'IGNORE_PROTOCOLS'} eq 'NONE';

    my @protos = split /\s*,\s*/, $config{'IGNORE_PROTOCOLS'};
    for my $proto (@protos) {
        if ($proto =~ /\W/) {
            &sys_log('invalid protocol in IGNORE_PROTOCOLS var');
        } else {
            if ($proto =~ /^\d+$/) {
                ### IP protocol number
                $ignore_protocols{$proto} = '';
                ### add the string as well
                $ignore_protocols{lc($protocol_strings{$proto}{'name'})} = ''
                    if defined $protocol_strings{$proto};
            } else {
                $ignore_protocols{lc($proto)} = '';
                ### try to add the number as well
                for my $proto_num (keys %protocol_strings) {
                    if ($proto eq lc($protocol_strings{$proto_num}{'name'})) {
                        $ignore_protocols{$proto_num} = '';
                        last;
                    }
                }
            }
        }
    }
    return;
}

sub parse_ignore_interfaces() {

    ### zero out the hash since a HUP signal may have been received
    %ignore_interfaces = ();

    return if $config{'IGNORE_INTERFACES'} eq 'NONE';

    my @interfaces = split /\s*,\s*/, $config{'IGNORE_INTERFACES'};
    for my $intf (@interfaces) {
        if ($intf !~ /^[\w.:]+$/) {
            &sys_log('invalid interface in IGNORE_INTERFACES var');
        } else {
            $ignore_interfaces{$intf} = '';
        }
    }
    return;
}

sub import_snort_rules() {

    %fwsnort_sigs = ();

    for my $dir ($config{'SNORT_RULES_DIR'},
            $config{'FWSNORT_RULES_DIR'}) {
        next unless -d $dir;

        opendir D, $dir or die "[*] Could not open $dir: $!";
        my @rfiles = readdir D;
        closedir D;

        FILE: for my $rfile (@rfiles) {
            next FILE unless $rfile =~ /\.rules$/;
            if ($srules_type) {
                next FILE unless $rfile =~ /^${srules_type}\.rules$/;
            }
            my ($type) = ($rfile =~ /(\w+)\.rules/);

            open R, "< $dir/${rfile}" or
                die "[*] Could not open: ${srules_type}/${rfile}";

            while (<R>) {
                next unless /^\s*alert/;

                my $sid;  ### snort rule id
                if (/[\s;]sid:\s*(\d+)\s*;/) {
                    $sid = $1;
                } else {
                    next;
                }

                $fwsnort_sigs{$sid}{'msg'} = $1
                    if /msg:\s*\"(.*?)\"\s*;/;
                $fwsnort_sigs{$sid}{'is_psad_id'} = 0;

                if (/^\s*alert\s+(\w+)/) {
                    $fwsnort_sigs{$sid}{'proto'} = lc($1);
                }

                if (/[\s;]classtype:\s*(.*?)\s*;/) {
                    $fwsnort_sigs{$sid}{'classtype'} = $1;
                } else {
                    $fwsnort_sigs{$sid}{'classtype'} = '';
                }

                $fwsnort_sigs{$sid}{'priority'} = &convert_snort_priority($1)
                    if /[\s;]priority:\s*(\d+)\s*;/;

                ### import multiple content fields; someone could have built
                ### a series of custom iptables chains in order to detect
                ### multiple content strings.
                while (/[\s;](?:uri)?content:\s*\"(.*?)\"\s*;/g) {
                    push @{$fwsnort_sigs{$sid}{'content'}}, $1;
                }

                while (/[\s;]reference:\s*(.*?)\s*;/g) {
                    my $ref = $1;
                    if ($ref =~ /^(\w+),(\S+)/) {
                        ### reference:bugtraq,9732;
                        push @{$fwsnort_sigs{$sid}{'reference'}{lc($1)}}, $2;
                    }
                }

                next unless defined $fwsnort_sigs{$sid}{'msg'}
                    and defined $fwsnort_sigs{$sid}{'classtype'}
                    and defined $fwsnort_sigs{$sid}{'content'};
            }

            close R;
        }
    }

    ### import the Snort classification.config file
    &import_snort_class_priorities();

    ### import the reference.config file
    &import_snort_reference_config();

    ### import any specific SID -> DL mappings from the
    ### snort_rule_dl file
    &import_snort_rule_dl();

    print STDERR Dumper %fwsnort_sigs if $debug and $verbose;
    &sys_log("imported original Snort rules in " .
        "$config{'SNORT_RULES_DIR'}/ for reference info");
    return;
}

sub import_snort_class_priorities() {

    my $snort_class_file = "$config{'SNORT_RULES_DIR'}/classification.config";

    return unless -e $snort_class_file;
    open F, "< $snort_class_file" or die $!;
    while (<F>) {
        ### config classification: rpc-portmap-decode,Decode of an RPC Query,2
        if (/config\s+classification:\s+(\S+),.*(\d+)/) {
            ### the snort priority value can go from 1 to 10, with 1 being the
            ### worst offense and 10 being the least.  Most priorities are
            ### from 1 to 4.  We need to map these into the psad danger levels
            ### (reversed).  NOTE: the Snort engine does not enforce the 1-10
            ### range.
            $snort_class_dl{$1} = &convert_snort_priority($2);
        }
    }
    close F;
    &sys_log('imported Snort classification.config');
    return;
}

sub convert_snort_priority() {
    my $snort_priority = shift;
    my $psad_dl = 1;

    if ($snort_priority == 1) {
        $psad_dl = 5;
    } elsif ($snort_priority == 2) {
        $psad_dl = 4;
    } elsif ($snort_priority == 3) {
        $psad_dl = 3;
    } elsif ($snort_priority == 4) {
        $psad_dl = 2;
    }
    return $psad_dl;
}

sub import_snort_reference_config() {

    my $ref_file = "$config{'SNORT_RULES_DIR'}/reference.config";
    return unless -e $ref_file;

    open F, "< $ref_file" or die $!;
    while (<F>) {
        if (/^\s*config\s+reference:\s+(\w+)\s+(\S+)/) {
            ### config reference: bugtraq   http://www.securityfocus.com/bid/
            $snort_ref_baseurl{lc($1)} = $2;
        }
    }
    close F;
    return;
}

sub import_snort_rule_dl() {

    %snort_rule_dl = ();

    ### parse the snort_rule_dl file
    return unless -e $config{'SNORT_RULE_DL_FILE'};
    open F, "< $config{'SNORT_RULE_DL_FILE'}" or die $!;
    while (<F>) {
        next unless /^\s*\d/;
        if (/^\s*(\d+)\s+(\d+)/) {
            ### <sid>  <dl>
            my $sid = $1;
            my $dl  = $2;
            unless ($dl >= 0 and $dl < 6) {
                next;
            }
            $snort_rule_dl{$sid} = $dl;
        }
    }
    close F;
    return;
}

### for signatures that psad is able to detect with iptables logs that do
### not contain "SIDnnn" messages generated by fwsnort (and hence have no
### application layer matching criteria)

sub import_signatures() {

    ### import the ip_options file so that psad can make use of the
    ### ipopts keyword in Snort rules (requires --log-ip-options to
    ### iptables)
    &import_ip_options();

    ### undef so we don't leave old signatures around if
    ### we execute this code after receiving a HUP signal.
    %sigs = ();
    %sig_search = ();
    %sig_ip_objs = ();

    ### make sure no duplicate psad_id and sid fields exist
    my %psad_ids = ();
    my %sids = ();

    open SIGS, "< $config{'SIGS_FILE'}" or die
        "[*] Could not open the signatures file $config{'SIGS_FILE'}: $!";

    my $line_num = 0;
    my $sig_ctr  = 0;
    my $next_available_sid = 1;

    SIG: while (<SIGS>) {

        $line_num++;
        next SIG unless /\S/;
        next SIG if /^\s*#/;

        my %sig = ();

        ### alert tcp $HOME_NET 12345:12346 -> $EXTERNAL_NET any
        ### (msg:"BACKDOOR netbus active"; flow:from_server,established;
        ### content:"NetBus"; reference:arachnids,401; classtype:misc-activity;
        ### sid:109; rev:4; psad_dlevel:2)

        my $rule_hdr     = '';
        my $rule_options = '';

        if (m|^(.*?)\s+\((.*)\)|) {
            $rule_hdr     = $1;
            $rule_options = $2;
        } else {
            die "[*] import_signatures(): bad signature on line: ",
                "$line_num";
        }

        ### parse rule header (routine taken from fwsnort).
        if ($rule_hdr =~ m|^\s*alert\s+(\S+)\s+(\S+)\s+(\S+)
                            \s+(\S+)\s+(\S+)\s+(\S+)|x) {

            my $direction = $4;
            if ($direction eq '<>') {
                $sig{'bidir'} = 1;
            } else {
                $sig{'bidir'} = 0;
            }

            my $src = '';
            my $dst = '';
            if ($direction eq '<-') {
                $sig{'proto'} = lc($1);
                $src = $5;  ### switch src and dst
                $dst = $2;
                $sig{'sp'} = $3;
                $sig{'dp'} = $6;
            } else {
                $sig{'proto'} = lc($1);
                $src = $2;  ### normal src -> dst
                $dst = $5;
                $sig{'sp'} = $3;
                $sig{'dp'} = $6;
            }

            $sig{'src'} = &expand_sig_ips($src, $line_num);
            $sig{'dst'} = &expand_sig_ips($dst, $line_num);

            ### assign the source and destination port ranges
            &build_sig_int_range(\%sig, 'sp', 1, 65535, $line_num);
            &build_sig_int_range(\%sig, 'dp', 1, 65535, $line_num);

        } else {
            die "[*] import_signatures(): bad rule ",
                "header on line: $line_num";
        }

        ### make sure the signature does not contain any unsupported
        ### Snort rule options
        unless (&check_supported_options($rule_options, $line_num)) {
            next SIG;
        }

        ### parse rule options
        if ($rule_options =~ /[\s;]psad_id:\s*(\d+)\s*;/) {
            my $psad_id = $1;
            if (defined $psad_ids{$psad_id}) {
                die "[*] import_signatures(): Duplicate psad_id: $psad_id ",
                    qq|on line: $line_num|;
            } elsif (defined $sids{$psad_id}) {
                die "[*] import_signatures(): Duplicate psad_id: $psad_id ",
                    qq|to sid on line: $line_num|;
            }
            $psad_ids{$psad_id} = '';
            $sig{'psad_id'} = $psad_id;
            $next_available_sid = $psad_id if $psad_id > $next_available_sid;
        } else {
            my $msg = "[*] import_signatures(): could not find signature" .
                qq| "psad_id" on line: $line_num|;
            if ($config{'ENABLE_SNORT_SIG_STRICT'} eq 'Y') {
                die $msg;
            } else {
                &sys_log($msg);
                next SIG;
            }
        }

        ### original Snort sid
        if ($rule_options =~ /[\s;]sid:\s*(\d+)\s*;/) {
            my $sid = $1;
            if (defined $sids{$sid}) {
                die "[*] import_signatures(): Duplicate sid: $sid ",
                    qq|on line: $line_num|;
            } elsif (defined $psad_ids{$sid}) {
                die "[*] import_signatures(): Duplicate sid: $sid ",
                    qq|to psad_id on line: $line_num|;
            }
            $sids{$sid} = '';
            $sig{'sid'} = $sid;
            $sig{'is_psad_id'} = 0;
            $next_available_sid = $sid if $sid > $next_available_sid;
        } else {
            ### the signature was derived from several Snort rules
            $sig{'sid'} = $sig{'psad_id'};
            $sig{'is_psad_id'} = 1;
        }

        ### msg field
        if ($rule_options =~ /msg:\s*\"(.+?)\"\s*;/) {
            $sig{'msg'} = $1;
        } else {
            die "[*] import_signatures(): could not find ",
                qq|"msg" keyword on line: $line_num|;
        }

        ### classtype field
        if ($rule_options =~ /[\s;]classtype:\s*(.+?)\s*;/) {
            $sig{'classtype'} = $1;
        } else {
            $sig{'classtype'} = '';
        }

        ### reference field
        while ($rule_options =~ /[\s;]reference:\s*(.*?)\s*;/g) {
            my $ref = $1;
            if ($ref =~ /^(\w+),(\S+)/) {
                ### reference:bugtraq,9732;
                push @{$sig{'reference'}{lc($1)}}, $2;
            }
        }

        ### psad danger level
        $sig{'dl'} = 2;  ### default danger level
        if ($rule_options =~ /[\s;]psad_dl:\s*(\d+)/) {
            $sig{'dl'} = $1;
        } elsif ($sig{'classtype'}) {
            ### assign the danger level from the classification.config
            ### file if the psad_dl field does not exist
            if (defined $snort_class_dl{$sig{'classtype'}}) {
                $sig{'dl'} = $snort_class_dl{$sig{'classtype'}};
            }
        }

        ### see the signature was derived from a set of Snort rules
        if ($rule_options =~ /[\s;]psad_derived_sids:\s*(.+?)\s*;/) {
            $sig{'psad_derived_sids'} = [split /\s*,\s*/, $1];
        }

        ### sameip keyword
        if ($rule_options =~ /[\s;]sameip;/) {
            $sig{'sameip'} = 1;
        }

        ### psad_dsize keyword
        if ($rule_options =~ /[\s;]psad_dsize:\s*(.+?)\s*;/i) {
            $sig{'psad_dsize'} = $1;
            &build_sig_int_range(\%sig, 'psad_dsize', 1, 1514, $line_num);
        }

        ### psad_ip_len keyword
        if ($rule_options =~ /[\s;]psad_ip_len:\s*(.+?)\s*;/i) {
            $sig{'psad_ip_len'} = $1;
            ### technically, the minimum length must be $IP_HEADER_LEN
            &build_sig_int_range(\%sig, 'psad_ip_len', 1, 65536, $line_num);
        }

        ### dsize keyword
        if ($rule_options =~ /[\s;]dsize:\s*(.+?)\s*;/i) {
            $sig{'dsize'} = $1;
            &build_sig_int_range(\%sig, 'dsize', 1, 1514, $line_num);
        }

        ### ttl keyword
        if ($rule_options =~ /[\s;]ttl:\s*(.+?)\s*;/i) {
            $sig{'ttl'} = $1;
            &build_sig_int_range(\%sig, 'ttl', 1, 255, $line_num);
        }

        ### id keyword (for IP ID value)
        if ($rule_options =~ /[\s;]id:\s*(.+?)\s*;/i) {
            $sig{'id'} = $1;
            &build_sig_int_range(\%sig, 'id', 1, 65535, $line_num);
        }

        ### ipopts keyword (for IP options)
        if ($rule_options =~ /[\s;]ipopts:\s*(.+?)\s*;/i) {
            $sig{'ipopts'} = lc($1);

            ### make sure the IP option is defined in the ip_options
            ### file
            my $found = 0;
            for my $opt_val (keys %ip_options) {
                $found = 1
                    if $sig{'ipopts'} eq $ip_options{$opt_val}{'sig_keyword'};
            }
            unless ($found) {
                print STDERR qq|[-] Invalid argument "$sig{'ipopts'}" to |,
                    "ipopts keyword\n" if $debug;
            }
        }

        ### TCP keywords
        if ($sig{'proto'} eq 'tcp') {
            my $require_ack = 0;
            if ($rule_options =~ /[\s;]flow:\s*established\s*\;/i) {
                $require_ack = 1;
            }

            ### TCP flags
            if ($rule_options =~ /[\s;]flags:\s*(.+?)\s*;/) {
                my $sig_flags = $1;
                my $flags     = '';
                ### make flags identical to what iptables log messages
                ### would report (check in iptables flag reporting order).
                if ($sig_flags =~ /U/) {
                    if ($flags) {
                        $flags = 'URG ' . $flags;
                    } else {
                        $flags .= 'URG ';
                    }
                }
                if ($sig_flags =~ /A/ or $require_ack) {
                    $flags .= 'ACK ';
                }
                $flags .= 'PSH ' if $sig_flags =~ /P/;
                $flags .= 'RST ' if $sig_flags =~ /R/;
                $flags .= 'SYN ' if $sig_flags =~ /S/;
                $flags .= 'FIN ' if $sig_flags =~ /F/;

                ### if no flags are set iptables simply reports no flags
                ### at all instead of reporting "NULL".
                $flags = 'NULL' if $sig_flags =~ /N/;
                $flags =~ s/\s*$// if $flags;

                $sig{'flags'} = $flags;
            }

            ### seq keyword (TCP sequence number)
            if ($rule_options =~ /[\s;]seq:\s*(.+?)\s*;/i) {
                $sig{'seq'} = $1;
                &build_sig_int_range(\%sig, 'seq', 1,
                        4294967296, $line_num);
            }

            ### ack keyword (TCP acknowledgement number)
            if ($rule_options =~ /[\s;]ack:\s*(.+?)\s*;/i) {
                $sig{'ack'} = $1;
                &build_sig_int_range(\%sig, 'ack', 1,
                        4294967296, $line_num);
            }

            ### window keyword (TCP window size)
            if ($rule_options =~ /[\s;]window:\s*(.+?)\s*;/i) {
                $sig{'window'} = $1;
                &build_sig_int_range(\%sig, 'window', 1,
                        65535, $line_num);
            }

        } elsif ($sig{'proto'} eq 'udp') {
            ### no specific UDP header tests
        } elsif ($sig{'proto'} eq 'icmp') {

            ### ICMP keywords
            if ($rule_options =~ /[\s;]itype:\s*(.+?)\s*;/i) {
                $sig{'itype'} = $1;
                &build_sig_int_range(\%sig, 'itype', 1,
                        255, $line_num);
            }

            ### itype keyword (ICMP type)
            if ($rule_options =~ /[\s;]icode:\s*(.+?)\s*;/i) {
                $sig{'icode'} = $1;
                &build_sig_int_range(\%sig, 'icode', 1,
                        255, $line_num);
            }

            ### icmp_seq keyword (ICMP sequence value)
            if ($rule_options =~ /[\s;]icmp_seq:\s*(.+?)\s*;/i) {
                $sig{'icmp_seq'} = $1;
                &build_sig_int_range(\%sig, 'icmp_seq',
                        1, 255, $line_num);
            }

            ### icmp_id keyword (ICMP ID value)
            if ($rule_options =~ /[\s;]icmp_id:\s*(.+?)\s*;/i) {
                $sig{'icmp_id'} = $1;
                &build_sig_int_range(\%sig, 'icmp_id',
                        'icmp_id_s', 'icmp_id_e', 'icmp_id_neg',
                        1, 255, $line_num);
            }

        } elsif ($sig{'proto'} eq 'ip') {

            ### ip_proto keyword (IP protocol value)
            if ($rule_options =~ /[\s;]ip_proto:\s*(.+?)\s*;/i) {
                $sig{'ip_proto'} = $1;
                &build_sig_int_range(\%sig, 'ip_proto',
                        1, 255, $line_num);
            }
        } else {
            die "[*] import_signatures(): unsupported protocol: ",
                "$sig{'proto'} at line: $line_num";
        }

        ### add this signature into attributes cache
        $sigs{$sig{'sid'}} = \%sig;

        ### add this signature into the fast lookup cache
        for my $src (@{$sig{'src'}}) {

            for my $dst (@{$sig{'dst'}}) {

                if ($sig{'proto'} eq 'icmp' or $sig{'proto'} eq 'ip') {

                    $sig_search{$sig{'proto'}}{$src}{$dst}{$sig{'sid'}} = '';

                } elsif ($sig{'proto'} eq 'tcp' or $sig{'proto'} eq 'udp'
                        or $sig{'proto'} eq 'udplite') {

                    my $sp_type = 'norm';
                    $sp_type = 'neg' if $sig{'sp_neg'};
                    my $dp_type = 'norm';
                    $dp_type = 'neg' if $sig{'dp_neg'};

                    $sig_search{$sig{'proto'}}{$src}{$dst}{$sp_type}{$sig{'sp_s'}}
                        {$sig{'sp_e'}}{$dp_type}{$sig{'dp_s'}}{$sig{'dp_e'}}
                        {$sig{'sid'}} = '';
                }
            }
        }

        $sig_ctr++;
    }
    close SIGS;
    if ($get_next_rule_id) {
        $next_available_sid++;
        print "[+] Next available rule ID: $next_available_sid\n";
        exit 0;
    }
    if ($debug and $verbose) {
        print STDERR "[+] Main signatures hash:\n",
            Dumper(\%sig_search), Dumper(\%sigs);
    }
    &sys_log("imported $sig_ctr psad Snort signatures " .
        "from $config{'SIGS_FILE'}");
    return;
}

sub check_supported_options() {
    my ($rule_options, $line_num) = @_;
    for my $opt (@unsupported_snort_opts) {
        ### see if we match a regex belonging to an unsupported option
        if ($rule_options =~ m|[\s;]$opt:\s*.*?\s*;|) {
            my $msg = '[*] import_signatures(): Unsupported rule option: ' .
                    qq|"$opt" at line: $line_num|;
            if ($config{'ENABLE_SNORT_SIG_STRICT'} eq 'Y') {
                die $msg;
            } else {
                &sys_log($msg);
                return 0;
            }
        }
    }
    return 1;
}

sub import_icmp_types() {
    my ($proto, $type_hr, $file) = @_;

    open F, "< $file" or die "[*] Could not open $file: $!";
    my $icmp_type = -1;
    while (<F>) {
        next if /^\s*#/;
        if (/^(\d+)\s+(.*)/) {
            $icmp_type = $1;
            my $icmp_type_text = $2;
            if ($icmp_type_text =~ /unassigned/i) {
                $icmp_type = -1;
            }
            $type_hr->{$icmp_type}->{'text'} = $icmp_type_text;
            $type_hr->{$icmp_type}->{'codes'}{-1} = '';
            next;
        }
        if (/^\s+(\d+)\s+(.*)/ and $icmp_type > -1) {
            my $icmp_code      = $1;
            my $icmp_code_text = $2;
            next if $icmp_code_text =~ /unassigned/i;
            ### don't really need to add the icmp code text here since
            ### we validate against the icmp type first (i.e. an invalid
            ### icmp code is meaningless unless we first have a valid
            ### icmp type).
            $type_hr->{$icmp_type}->{'codes'}->{$icmp_code} = '';
        }
    }
    close F;
    print STDERR Dumper $type_hr if $debug and $verbose;
    &sys_log("imported valid $proto types and codes");
    return;
}

sub expand_sig_ips() {
    my ($ip_str, $line_num) = @_;

    my @arr = ();

    ### resolve any embedded vars
    if ($ip_str =~ m|\$.+\$|) {
        die "[*] import_signature(): Multiple embedded vars not supported ",
            "at line: $line_num";
    } elsif ($ip_str =~ m|\$(\w+)|) {
        my $sub_var = $1;
        if (defined $config{$sub_var}) {
            $ip_str =~ s|\$\w+|$config{$sub_var}|;
        } else {
            die qq|[*] import_signatures(): sub-var "$sub_var" at line: |,
                "$line_num not defined in psad.conf";
        }
    }

    if ($ip_str =~ m|,|) {
        my @ips = split /\s*,\s*/, $ip_str;
        for my $ip (@ips) {
            if ($ip =~ m|($ipv4_re/$ipv4_re)|
                    or $ip =~ m|($ipv4_re/\d+)|
                    or $ip =~ m|($ipv4_re)|) {
                push @arr, $1;
                $sig_ip_objs{$1} = new NetAddr::IP($1);
            } elsif ($ip =~ m|\:|) {
                push @arr, $ip;
                $sig_ip_objs{$ip} = new NetAddr::IP($ip)
                    or die "[*] NetAddr::IP error for $ip";
            }
        }

    } elsif ($ip_str =~ m|($ipv4_re/$ipv4_re)|
            or $ip_str =~ m|($ipv4_re/\d+)|
            or $ip_str =~ m|($ipv4_re)|) {
        push @arr, $1;
        $sig_ip_objs{$1} = new NetAddr::IP($1)
            or die "[*] NetAddr::IP error for $1";

    } elsif ($ip_str =~ m|\:|) {

        push @arr, $ip_str;
        $sig_ip_objs{$ip_str} = new NetAddr::IP($ip_str)
            or die "[*] NetAddr::IP error for $ip_str";

    } elsif ($ip_str eq 'any' or $ip_str =~ m|NOT_?USED|i) {
        ### handle NOT_USED case from older psad versions
        push @arr, 'any';

        ### this will match any IPv4 or IPv6 address
        $sig_ip_objs{'any'}
            = new6 NetAddr::IP('0000:0000:0000:0000:0000:0000:0000:0000/0');

    } else {
        die "[*] import_signatures(): Unrecognized src/dst: $ip_str ",
            "at line: $line_num";
    }
    return \@arr;
}

sub build_sig_int_range() {
    my ($sig_hr, $keyword, $range_start, $range_end, $line_num) = @_;

    my $start_key = "${keyword}_s";
    my $end_key   = "${keyword}_e";
    my $neg_key   = "${keyword}_neg";

    my $val = $sig_hr->{$keyword};

    ### resolve any embedded vars
    if ($val =~ m|\$.+\$|) {
        die "[*] import_signature(): Multiple embedded vars not supported ",
            "at line: $line_num";
    } elsif ($val =~ m|\$(\w+)|) {
        my $sub_var = $1;
        if (defined $config{$sub_var}) {
            $val =~ s|\$\w+|$config{$sub_var}|;
            $sig_hr->{$keyword} = $val;
        } else {
            die qq|[*] import_signatures(): sub-var "$sub_var" at line: |,
                "$line_num not defined in psad.conf";
        }
    }

    $sig_hr->{$start_key} = $range_start;
    $sig_hr->{$end_key}   = $range_end;

    if ($val =~ m|\!|) {
        $sig_hr->{$neg_key} = 1;
    } else {
        $sig_hr->{$neg_key} = 0;
    }
    $val =~ s|\!||;

    return if $val eq 'any';

    if ($val =~ m|^\s*(\d+)\s*:\s*(\d+)|) {
        $sig_hr->{$start_key} = $1;
        $sig_hr->{$end_key}   = $2;
    } elsif ($val =~ m|^\s*(\d+)\s*:|) {
        $sig_hr->{$start_key} = $1;
    } elsif ($val =~ m|^\s*:(\d+)|) {
        $sig_hr->{$end_key} = $1;
    } elsif ($val =~ m|^\s*\<=\s*(\d+)|) {
        $sig_hr->{$end_key} = $1;
    } elsif ($val =~ m|^\s*\<\s*(\d+)|) {
        $sig_hr->{$end_key} = $1-1;
    } elsif ($val =~ m|^\s*\>=\s*(\d+)|) {
        $sig_hr->{$start_key} = $1;
    } elsif ($val =~ m|^\s*\>\s*(\d+)|) {
        $sig_hr->{$start_key} = $1+1;
    } elsif ($val =~ m|^\s*(\d+)|) {
        $sig_hr->{$start_key} = $sig_hr->{$end_key} = $1;
    } else {
        die "[*] import_signatures(): Unrecognized value: ",
            "$val at line: $line_num";
    }
    return;
}

sub import_auto_dl() {

    %auto_dl = ();  ### undef so we don't leave old ips in %auto_dl

    my $i = 0;
    open F, "< $config{'AUTO_DL_FILE'}" or die '[*] Could not open ',
        "$config{'AUTO_DL_FILE'}: $!";
    while (<F>) {
        $i++;
        next unless /\S/;
        next if /^\s*#/;
        my $ip   = '';
        my $mask = '';
        my $dl   = '';
        my $opt_criteria = '';
        if (m|^\s*($ipv4_re)\s*/\s*($ipv4_re)\s+([0-5])\s*(.*);|) {
            $ip   = $1;
            $mask = $2;
            $dl   = $3;
            $opt_criteria = $4;
        } elsif (m|^\s*($ipv4_re)\s*/\s*(\d+)\s+([0-5])\s*(.*);|) {
            $ip   = $1;
            $mask = $2;
            $dl   = $3;
            $opt_criteria = $4;
        } elsif (m|^\s*($ipv4_re)\s+([0-5])\s*(.*);|) {
            $ip   = $1;
            $mask = '32';  ### single IP
            $dl   = $2;
            $opt_criteria = $3;
        } elsif (m|^\s*(\S+)\s+([0-5])\s*(.*);|) {
            my $str = $1;
            $dl           = $2;
            $opt_criteria = $3;
            if ($str =~ /\:/) {
                ### check to see if this is an IPv6 address
                if ($str =~ m|(\S+)/(\S+)|) {
                    $ip   = $1;
                    $mask = $2;
                } else {
                    $ip   = $str;
                    $mask = '128';
                }
            } else {
                ### check to see if it is a hostname
                my $hostname  = $str;
                my $iaddr = 0;
                $iaddr = inet_aton($hostname);
                unless ($iaddr) {
                    &sys_log(qq|could not resolve auto_dl "$hostname" | .
                        "to an IP at line $i");
                    next;
                }
                $ip = inet_ntoa($iaddr) or
                    &sys_log(qq|could not resolve auto_dl "$hostname" | .
                        "to an IP at line $i");
                $mask = '32';  ### single IP
            }
        } else {
            &sys_log("improperly formatted auto_dl line $i");
            next;
        }

        $auto_dl_ip_objs{$ip} = new NetAddr::IP($ip, $mask);
        unless (defined $auto_dl_ip_objs{$ip} and $auto_dl_ip_objs{$ip}) {
            &sys_log("auto_dl could not acquire NetAddr::IP object at line $i");
            next;
        }

        $auto_dl{$ip}{'mask'} = $mask;
        $auto_dl{$ip}{'dl'}   = $dl;

        if (m|icmp|i) {
            $auto_dl{$ip}{'proto'}{'icmp'}{'all'} = '';
        }

        ### check for optional port/protocol criteria
        if (/tcp/i or /udp/i) {
            &parse_port_range(\%{$auto_dl{$ip}{'proto'}}, $opt_criteria);
        }

        if (m|tcp|i and not defined $auto_dl{$ip}{'proto'}{'tcp'}) {
            $auto_dl{$ip}{'proto'}{'tcp'}{'all'} = '';
        }
        if (m|udplite|i and
                not defined $auto_dl{$ip}{'proto'}{'udplite'}) {
            $auto_dl{$ip}{'proto'}{'udplite'}{'all'} = '';
        }
        if (m|udp|i and not defined $auto_dl{$ip}{'proto'}{'udp'}) {
            $auto_dl{$ip}{'proto'}{'udp'}{'all'} = '';
        }

        unless ($ip and ($mask =~ /^0$/ or $mask)) {  ### allow a mask of "0"
            unless ($fw_block_ip) {
                my $subject = "$config{'MAIL_ERROR_PREFIX'} import warning: " .
                    "$config{'AUTO_DL_FILE'} error on line: $i";
                &send_mail($subject, '', $config{'EMAIL_ADDRESSES'},
                    $cmds{'mail'});
            }
        }
    }
    close F;

    if (%auto_dl) {

        ### don't write syslog message if we are running in --fw-block-ip
        ### mode
        unless ($fw_block_ip) {
            my $msg = "imported auto_dl file, got " . (keys %auto_dl) .
                " IP addrs/networks";
            print STDERR $msg, "\n" if $debug;
            &sys_log($msg);
        }
    }
    return;
}

sub import_p0f_ipv4_sigs() {

    %p0f_ipv4_sigs = ();

    my $p0f_file = $config{'P0F_FILE'};
    open P, "< $p0f_file" or die '[*] Could not open ',
        "$p0f_file: $!";
    my @lines = <P>;
    close P;
    my $os = '';
    for my $line (@lines) {
        chomp $line;
        next if $line =~ /^\s*#/;
        next unless $line =~ /\S/;

        ### S3:64:1:60:M*,S,T,N,W1:        Linux:2.5::Linux 2.5 (sometimes 2.4)
        ### 16384:64:1:60:M*,N,W0,N,N,T:   FreeBSD:4.4::FreeBSD 4.4
        ### 16384:64:1:44:M*:              FreeBSD:2.0-2.2::FreeBSD 2.0-4.1

        if ($line =~ /^(\S+?):(\S+?):(\S+?):(\S+?):(\S+?):\s+(.*)\s*/) {
            my $win_size = $1;
            my $ttl      = $2;
            my $frag_bit = $3;
            my $len      = $4;
            my $options  = $5;
            my $os       = $6;

            my $sig_str = "$win_size:$ttl:$frag_bit:$len:$options";
            ### don't know how to handle MTU-based window size yet
            unless ($win_size =~ /T/) {
                $p0f_ipv4_sigs{$len}{$frag_bit}{$ttl}{$win_size}{$options}{$os}
                    = $sig_str;
            }
        }
    }

    print STDERR Dumper %p0f_ipv4_sigs if $debug and $verbose;
    &sys_log('imported p0f-based passive OS fingerprinting signatures');
    return;
}

sub import_posf_sigs() {

    %posf_sigs = ();

    my $posf_file = $config{'POSF_FILE'};
    open P, "< $posf_file" or die '[*] Could not open ',
        "$posf_file: $!";
    my @lines = <P>;
    close P;
    my $os = '';
    for my $line (@lines) {
        chomp $line;
        next if ($line =~ /^\s*#/);
        next unless ($line =~ /\S/);
        if ($line =~ /^\s*OS\s+(.*);/) {
            $os = $1;
        } elsif ($line =~ /^\s*NUMPKTS\s+(\d+);/) {
            $posf_sigs{$os}{'numpkts'} = $1;
        } elsif ($line =~ /^\s*TOS\s+(\w+);/) {
            $posf_sigs{$os}{'tos'} = $1;
        } elsif ($line =~ /^\s*LEN\s+(\d+);/) {
            $posf_sigs{$os}{'len'} = $1;
        } elsif ($line =~ /^\s*TTL\s+(\d+);/) {
            $posf_sigs{$os}{'ttl'} = $1;
        } elsif ($line =~ /^\s*ID\s+(\w+);/) {
            $posf_sigs{$os}{'id'} = $1;
        } elsif ($line =~ /^\s*WINDOW\s+(\d+);/) {
            $posf_sigs{$os}{'win'} = $1;
        }
    }
    ### make sure each of the os signatures has all fields defined
    OS: for my $os (keys %posf_sigs) {
        unless (defined $posf_sigs{$os}{'numpkts'}) {
            &sys_log("$posf_file: missing " .
                "NUMPKTS for os: $os");
            delete $posf_sigs{$os};
            next OS;
        }
        unless (defined $posf_sigs{$os}{'tos'}) {
            &sys_log("$posf_file: missing " .
                "TOS for os: $os");
            delete $posf_sigs{$os};
            next OS;
        }
        unless (defined $posf_sigs{$os}{'len'}) {
            &sys_log("$posf_file: missing " .
                "LEN for os: $os");
            delete $posf_sigs{$os};
            next OS;
        }
        unless (defined $posf_sigs{$os}{'ttl'}) {
            &sys_log("$posf_file: missing " .
                "TTL for os: $os");
            delete $posf_sigs{$os};
            next OS;
        }
        unless (defined $posf_sigs{$os}{'id'}) {
            &sys_log("$posf_file: missing " .
                "ID for os: $os");
            delete $posf_sigs{$os};
            next OS;
        } else {
            unless ($posf_sigs{$os}{'id'} eq 'SMALLINCR'
                    || $posf_sigs{$os}{'id'} eq 'RANDOM') {
                &sys_log("$posf_file: ID must " .
                    "be either SMALLINCR or RANDOM for os: $os");
                delete $posf_sigs{$os};
                next OS;
            }
        }
        unless (defined $posf_sigs{$os}{'win'}) {
            &sys_log("$posf_file: missing " .
                "WINDOW for os: $os");
            delete $posf_sigs{$os};
            next OS;
        }
    }
    print STDERR Dumper %posf_sigs if $debug and $verbose;
    &sys_log('imported TOS-based passive OS fingerprinting signatures');
    return;
}

sub check_range() {
    my ($port, $start, $end) = @_;
    $start = $port if ($port < $start);
    $end   = $port if ($port > $end);
    return $start, $end;
}

### assign a danger level to each scan in the current interval.
sub assign_danger_level() {
    my ($curr_scan_hr, $curr_sigs_dl_hr, $curr_sids_dl_hr) = @_;

    SRC: for my $src (keys %$curr_scan_hr) {

        my $changed_dl = 0;

        print STDERR "[+] assign_danger_level(): source IP: $src (dl: ",
            "$scan_dl{$src})\n" if $debug;

        if (defined $curr_sigs_dl_hr->{$src}) {
            if ($scan_dl{$src} < $curr_sigs_dl_hr->{$src}) {
                $scan_dl{$src} = $curr_sigs_dl_hr->{$src};
                $changed_dl = 1;
            }
        }

        if (defined $curr_sids_dl_hr->{$src}) {
            if ($scan_dl{$src} < $curr_sids_dl_hr->{$src}) {
                $scan_dl{$src} = $curr_sids_dl_hr->{$src};
                $changed_dl = 1;
            }
        }

        DST: for my $dst (keys %{$curr_scan_hr->{$src}}) {
            my $absnum        = $scan{$src}{$dst}{'absnum'};
            my $tot_protocols = $scan{$src}{$dst}{'tot_protocols'};
            my $range = 0;
            my $s_port = 65535;
            my $e_port = 0;

            if ($changed_dl) {
                $scan{$src}{$dst}{'alerted'} = 0
                    if $config{'ALERT_ALL'} eq 'N';
            }

            ### calculate the range over _both_ tcp and udp
            for my $proto (qw(tcp udp udplite)) {
                next unless defined $scan{$src}{$dst}{$proto};
                next unless defined $scan{$src}{$dst}{$proto}{'abs_sp'};
                if ($s_port > $scan{$src}{$dst}{$proto}{'abs_sp'}) {
                    $s_port = $scan{$src}{$dst}{$proto}{'abs_sp'};
                }
                if ($e_port < $scan{$src}{$dst}{$proto}{'abs_ep'}) {
                    $e_port = $scan{$src}{$dst}{$proto}{'abs_ep'};
                }
            }
            if ($e_port) {
                $range = $e_port - $s_port;
            } else {  ### for icmp
                $range = $absnum;
            }

            ### if PORT_RANGE_SCAN_THRESHOLD is >= 1, then psad will not assign
            ### a danger level to repeated packets to the same port
            if ($absnum < $config{'DANGER_LEVEL1'}) {
                ### don't have enough packets to even reach danger level 1 yet.
                next DST;
            }
            if ($range >= $config{'PORT_RANGE_SCAN_THRESHOLD'}
                    or $tot_protocols >= $config{'PROTOCOL_SCAN_THRESHOLD'}) {
                if ($absnum < $config{'DANGER_LEVEL2'}) {
                    if ($scan_dl{$src} < 1) {
                        $scan{$src}{$dst}{'alerted'} = 0
                            if $config{'ALERT_ALL'} eq 'N';
                        $scan_dl{$src} = 1;
                    }
                } elsif ($absnum < $config{'DANGER_LEVEL3'}) {
                    if ($scan_dl{$src} < 2) {
                        $scan{$src}{$dst}{'alerted'} = 0
                            if $config{'ALERT_ALL'} eq 'N';
                        $scan_dl{$src} = 2;
                    }
                } elsif ($absnum < $config{'DANGER_LEVEL4'}) {
                    if ($scan_dl{$src} < 3) {
                        $scan{$src}{$dst}{'alerted'} = 0
                            if $config{'ALERT_ALL'} eq 'N';
                        $scan_dl{$src} = 3;
                    }
                } elsif ($absnum < $config{'DANGER_LEVEL5'}) {
                    if ($scan_dl{$src} < 4) {
                        $scan{$src}{$dst}{'alerted'} = 0
                            if $config{'ALERT_ALL'} eq 'N';
                        $scan_dl{$src} = 4;
                    }
                } elsif ($scan_dl{$src} < 5) {
                    $scan{$src}{$dst}{'alerted'} = 0
                            if $config{'ALERT_ALL'} eq 'N';
                    $scan_dl{$src} = 5;
                }
            }
        }
        print STDERR '[+] assign_danger_level(): DL (after assignment) = ',
            "$scan_dl{$src}\n" if $debug;
    }
    return;
}

sub assign_auto_danger_level() {
    my $pkt_hr = shift;

    ### see if the source should automatically be assigned a
    ### danger level
    NET: for my $net (keys %auto_dl) {
        my $dl   = $auto_dl{$net}{'dl'};
        my $mask = $auto_dl{$net}{'mask'};  ### may be a /32 (single IP)

        ### check to see if $pkt_hr->{'src'} is contained within an auto_dl network
        next NET unless $pkt_hr->{'s_obj'}->within($auto_dl_ip_objs{$net});

        ### $pkt_hr->{'src'} is part of an ignored network
        return 0 if $dl == 0;

        if ($scan_dl{$pkt_hr->{'src'}} < $dl) {
            if (not defined $auto_dl{$net}{'proto'}) {
                ### all protocols are applicable
                $scan_dl{$pkt_hr->{'src'}} = $dl;
                &sys_log('auto-assigned danger level: ' .
                    "$dl for IP: $pkt_hr->{'src'}");
                return $dl;
            } else {
                for my $proto (keys %{$auto_dl{$net}{'proto'}}) {
                    next unless $pkt_hr->{'proto'} eq $proto;
                    if (defined $auto_dl{$net}{'proto'}{$proto}{'port'}
                            or defined $auto_dl{$net}{'proto'}{$proto}{'range'}) {
                        if (&match_port(\%{$auto_dl{$net}{'proto'}{$proto}},
                                $pkt_hr->{'dp'})) {
                            $scan_dl{$pkt_hr->{'src'}} = $dl;
                            &sys_log('auto-assigned danger ' .
                                "level: $dl for IP: $pkt_hr->{'src'}");
                            return $dl;
                        }
                    } elsif (defined $auto_dl{$net}{'proto'}{$proto}{'all'}) {
                        ### we only require to match the protocol
                         $scan_dl{$pkt_hr->{'src'}} = $dl;
                         &sys_log('auto-assigned danger ' .
                             "level: $dl for IP: $pkt_hr->{'src'}");
                         return $dl;
                    }
                }
            }
        }
    }
    return -1;
}

sub check_scan_proto() {
    my ($proto, $scan_hr) = @_;
    for my $dst (keys %$scan_hr) {
        return 1 if defined $scan_hr->{$dst}->{$proto};
    }
    return 0;
}

sub write_global_packet_counters() {
    open P, "> $config{'PACKET_COUNTER_FILE'}" or
        die "[*] Could not open $config{'PACKET_COUNTER_FILE'}: $!";
    for my $proto (keys %protocols) {
        next unless defined $proto_ctrs{$proto};
        printf P "%8s: %d\n", $proto, $proto_ctrs{$proto};
    }
    close P;
    return;
}

sub write_prefix_counters() {
    open P, "> $config{'IPT_PREFIX_COUNTER_FILE'}" or
        die "[*] Could not open $config{'IPT_PREFIX_COUNTER_FILE'}: $!";
    for my $prefix (keys %ipt_prefixes) {
        my $count = $ipt_prefixes{$prefix};
        print P "$prefix: $count\n";
    }
    close P;
    return;
}

sub write_dshield_stats() {
    open D, "> $config{'DSHIELD_COUNTER_FILE'}" or
        die "[*] Could not open $config{'DSHIELD_COUNTER_FILE'}: $!";
    print D "total emails: $dshield_email_ctr\n",
        "total packets: $dshield_lines_ctr\n";
    close D;
    return;
}

sub write_src_packet_counters() {
    my ($hr, $tcp_absrange, $udp_absrange, $file) = @_;
    open P, "> $file" or
        die "[*] Could not open $file: $!";
    for my $chain (keys %$hr) {
        for my $intf (keys %{$hr->{$chain}}) {
            for my $proto (keys %protocols) {
                next unless defined $hr->{$chain}->{$intf}->{$proto};
                if ($proto eq 'tcp' and $tcp_absrange) {
                    print P "${chain}_${intf}_${proto}:  ",
                        "$hr->{$chain}->{$intf}->{$proto} [$tcp_absrange]\n";
                } elsif (($proto eq 'udp' or $proto eq 'udplite') and $udp_absrange) {
                    print P "${chain}_${intf}_${proto}:  ",
                        "$hr->{$chain}->{$intf}->{$proto} [$udp_absrange]\n";
                } else {
                    print P "${chain}_${intf}_${proto}:  ",
                        "$hr->{$chain}->{$intf}->{$proto}\n";
                }
            }
        }
    }
    close P;
    return;
}

sub collect_errors() {
    my $bad_packets_ar = shift;
    open ERR, ">> $config{'FW_ERROR_LOG'}" or die '[*] Could not open ',
        "$config{'FW_ERROR_LOG'}: $!";
    for my $line (@$bad_packets_ar) {
        print ERR $line;
    }
    close ERR;
    return;
}

sub log_top_scans() {

    ### top scanned ports
    open P, "> $config{'TOP_SCANNED_PORTS_FILE'}.tmp" or
        die "[*] Could not open $config{'TOP_SCANNED_PORTS_FILE'}: $!";
    print P "#\n# Format: <proto> <port> <packets>\n#\n\n";

    if (%top_tcp_ports) {
        print P "# Top scanned TCP ports:\n";
        my $ctr = 0;
        for my $dp (sort {$top_tcp_ports{$b} <=> $top_tcp_ports{$a}}
                keys %top_tcp_ports) {
            printf P "tcp %-5d $top_tcp_ports{$dp}\n", $dp;
            $ctr++;
            if ($config{'TOP_PORTS_LOG_THRESHOLD'} > 0) {
                last if $ctr >= $config{'TOP_PORTS_LOG_THRESHOLD'};
            }
        }
        print P "\n" if %top_udp_ports;
    }
    if (%top_udp_ports) {
        my $ctr = 0;
        print P "# Top scanned UDP ports:\n";
        for my $dp (sort {$top_udp_ports{$b} <=> $top_udp_ports{$a}}
                keys %top_udp_ports) {
            printf P "udp %-5d $top_udp_ports{$dp}\n", $dp;
            $ctr++;
            if ($config{'TOP_PORTS_LOG_THRESHOLD'} > 0) {
                last if $ctr >= $config{'TOP_PORTS_LOG_THRESHOLD'};
            }
        }
    }
    close P;
    move "$config{'TOP_SCANNED_PORTS_FILE'}.tmp",
        $config{'TOP_SCANNED_PORTS_FILE'};

    ### top signature matches
    open S, "> $config{'TOP_SIGS_FILE'}.tmp" or
        die "[*] Could not open $config{'TOP_SIGS_FILE'}: $!";
    print S "#\n# Format: <sid> \"<msg>\" <matches> <num_sources> ",
        "<sig_proto>\n#\n\n";
    my $ctr = 0;
    for my $sid (sort {$top_sigs{$b} <=> $top_sigs{$a}} keys %top_sigs) {
        my $found = 0;
        my $num_sources = keys %{$sig_sources{$sid}};
        if (defined $sigs{$sid} and defined $sigs{$sid}{'msg'}) {
            print S qq|$sid "$sigs{$sid}{'msg'}" $top_sigs{$sid} | .
                qq|$num_sources $sigs{$sid}{'proto'}\n|;
            $found = 1;
        } elsif (defined $fwsnort_sigs{$sid}
                and defined $fwsnort_sigs{$sid}{'msg'}) {
            print S qq|$sid "$fwsnort_sigs{$sid}{'msg'}" $top_sigs{$sid} | .
                qq|$num_sources $fwsnort_sigs{$sid}{'proto'}\n|;
            $found = 1;
        }
        $ctr++ if $found;
        if ($config{'TOP_SIGS_LOG_THRESHOLD'} > 0) {
            last if $ctr >= $config{'TOP_SIGS_LOG_THRESHOLD'};
        }
    }
    close S;
    move "$config{'TOP_SIGS_FILE'}.tmp",
        $config{'TOP_SIGS_FILE'};

    ### top attackers
    open A, "> $config{'TOP_ATTACKERS_FILE'}" or
        die "[*] Could not open $config{'TOP_ATTACKERS_FILE'}: $!";
    $ctr = 0;
    print A "#\n# Format: <IP> <DL> <total_packets> ",
        "<uniq_sigs> <sig_matches> <is_local>\n#\n\n";
    for my $src (sort {$scan_dl{$b} cmp $scan_dl{$a}} keys %scan_dl) {
        next unless $scan_dl{$src} >= $config{'MIN_DANGER_LEVEL'};
        next unless defined $top_packet_counts{$src}
                or defined $top_sig_counts{$src};
        my $str = sprintf "%-15s %d", $src, $scan_dl{$src};
        if (defined $top_packet_counts{$src}) {
            $str .= " $top_packet_counts{$src}";
        } else {
            $str .= ' 0';
        }
        my $uniq_sigs = 0;
        for my $sid (keys %sig_sources) {
            $uniq_sigs++ if defined $sig_sources{$sid}{$src};
        }
        $str .= " $uniq_sigs";
        if (defined $top_sig_counts{$src}) {
            $str .= " $top_sig_counts{$src}";
        } else {
            $str .= ' 0';
        }
        if (defined $local_src{$src}) {
            $str .= ' 1';
        } else {
            $str .= ' 0';
        }
        print A $str, "\n";
        $ctr++;
        if ($config{'TOP_IP_LOG_THRESHOLD'} > 0) {
            last if $ctr >= $config{'TOP_IP_LOG_THRESHOLD'};
        }
    }
    close A;
    return;
}

sub scan_logr() {
    my $curr_scan_hr = shift;

    return if $benchmark;

    if ($analyze_mode) {
        return unless $analyze_write_data;

        ### Log scan data
        print "[+] Writing $config{'PSAD_DIR'}/<IP> directories.\n";
        print "    This may take a while...\n" if ((keys %$curr_scan_hr) > 1000);
        if ($analysis_emails) {
            print "[+] Generating email alerts...\n";
            unless ($no_whois or $config{'ENABLE_WHOIS_LOOKUPS'} eq 'N') {
                print "[+] Issuing whois lookups (may take several seconds).\n";
            }
        }
    }

    SRC: for my $src (keys %$curr_scan_hr) {
        print STDERR "[+] scan_logr(): source IP: $src\n" if $debug;
        ### only send alerts for scans that are at least at
        ### danger level 1 or above.
        unless ($scan_dl{$src} >= $config{'MIN_DANGER_LEVEL'}) {
            print STDERR "    No alerts sent for $src; danger ",
                "level $scan_dl{$src} not high enough\n" if $debug;
            next SRC;
        }

        if ($config{'ENABLE_EMAIL_LIMIT_PER_DST'} eq 'N') {
            unless (defined $scan_email_ctrs{$src}{'email_ctr'}) {
                $scan_email_ctrs{$src}{'email_ctr'} = 0;
            } elsif ($config{'EMAIL_LIMIT'} > 0
                    and $scan_email_ctrs{$src}{'email_ctr'}
                    >= $config{'EMAIL_LIMIT'}) {
                ### ignore EMAIL_LIMIT if it is zero
                unless (defined $scan_email_ctrs{$src}{'stop_email'}
                        or $config{'EMAIL_LIMIT_STATUS_MSG'} eq 'N') {
                    &email_limit_reached($src, '');
                }
                &sys_log("email limit reached for src: $src");
                next SRC;
            }
            unless ($no_email_alerts) {
                $scan_email_ctrs{$src}{'email_ctr'}++;
            }
            if ($config{'EMAIL_THROTTLE'} > 1) {
                next SRC if (($scan_email_ctrs{$src}{'email_ctr'}
                        % $config{'EMAIL_THROTTLE'}) == 0);
            }
        }

        DST: for my $dst (keys %{$curr_scan_hr->{$src}}) {

            ### see if we have already sent an alert for $src
            ### (against $dst) for this danger level.
            if ($config{'ALERT_ALL'} eq 'N') {
                next DST if $scan{$src}{$dst}{'alerted'};
            }
            my $syslog_flags = '';
            my $src_dns_str  = '';
            my $dst_dns_str  = '';
            my $rdns         = '';
            my $src_subj     = '';
            my $dst_subj     = '';
            my $src_mac      = '';
            my $dst_mac      = '';
            my $syslog_range = '';
            my $tcp_newrange = '';
            my $tcp_absrange = '';
            my $udp_newrange = '';
            my $udp_absrange = '';
            my $tcp_newpkts  = 0;
            my $udp_newpkts  = 0;
            my $icmp_newpkts = 0;
            my $other_proto_newpkts = 0;
            my $tcp_f  = 0;
            my $udp_f  = 0;
            my $icmp_f = 0;
            my $scan_style_str = '';
            my $whois_info_ar;

            ### get the current danger level and the absolute number
            ### of packets used in the scan so far
            my $curr_dl = $scan_dl{$src};

            if ($config{'ENABLE_EMAIL_LIMIT_PER_DST'} eq 'Y') {
                unless (defined $scan_email_ctrs{$src}{$dst}{'email_ctr'}) {
                    $scan_email_ctrs{$src}{$dst}{'email_ctr'} = 0;
                } elsif ($config{'EMAIL_LIMIT'} > 0
                        and $scan_email_ctrs{$src}{$dst}{'email_ctr'}
                        >= $config{'EMAIL_LIMIT'}) {
                    ### ignore EMAIL_LIMIT if it is zero
                    unless (defined $scan_email_ctrs{$src}{$dst}{'stop_email'}
                            or $config{'EMAIL_LIMIT_STATUS_MSG'} eq 'N') {
                        &email_limit_reached($src, $dst);
                    }
                    &sys_log("email limit reached for src: $src " .
                        "against dst: $dst");
                    next DST;
                }
                unless ($no_email_alerts) {
                    $scan_email_ctrs{$src}{$dst}{'email_ctr'}++;
                }
                if ($config{'EMAIL_THROTTLE'} > 1) {
                    next DST if (($scan_email_ctrs{$src}{$dst}{'email_ctr'}
                            % $config{'EMAIL_THROTTLE'}) == 0);
                }
            }
            print STDERR "[+] scan_logr(): dst IP: $dst\n" if $debug;

            ### make $src directory here in /var/log/psad
            ### unless it already exists
            mkdir "$config{'PSAD_DIR'}/${src}", 0700
                unless -d "$config{'PSAD_DIR'}/${src}";
            my $src_dir = "$config{'PSAD_DIR'}/${src}";
            my $dl_file      = "${src_dir}/danger_level";
            my $posf_file    = "${src_dir}/os_guess";
            my $p0f_file     = "${src_dir}/p0f_guess";
            my $email_file   = "${src_dir}/${dst}_email_alert";
            my $log_sigs     = "${src_dir}/${dst}_signatures";
            my $s_time_file  = "${src_dir}/${dst}_start_time";
            my $pkt_ctr_file = "${src_dir}/${dst}_packet_ctr";
            my $ecount_file  = "${src_dir}/email_ctr";

            if ($config{'ENABLE_EMAIL_LIMIT_PER_DST'} eq 'Y') {
                $ecount_file = "${src_dir}/${dst}_email_ctr";
            }

            ### print the current danger level to the danger_level file.
            open DL, "> $dl_file" or die "[*] Could not open $dl_file: $!";
            print DL $curr_dl, "\n";
            close DL;

            ### write out the TOS-based os guess (if there is one).
            if (defined $posf{$src} and defined $posf{$src}{'guess'}) {
                open P, "> $posf_file" or
                    die "[*] Could not open $posf_file: $!";
                print P $posf{$src}{'guess'}, "\n";
                close P;
            }

            ### write out the p0f-based os guess(es) (if there is one).
            if (defined $p0f{$src}) {
                open P, "> $p0f_file" or
                    die "[*] Could not open $p0f_file: $!";
                for my $os (keys %{$p0f{$src}}) {
                    print P "$os\n";
                }
                close P;
            }

            ### write out the start time.
            open T, "> $s_time_file" or
                die "[*] Could not open $s_time_file: $!";
            print T $scan{$src}{$dst}{'s_time'}, "\n";
            close T;

            $src_mac = $curr_scan_hr->{$src}->{$dst}->{'s_mac'}
                if defined $curr_scan_hr->{$src}->{$dst}->{'s_mac'};
            $dst_mac = $curr_scan_hr->{$src}->{$dst}->{'d_mac'}
                if defined $curr_scan_hr->{$src}->{$dst}->{'d_mac'};

            if (defined $scan{$src}{$dst}{'tcp'}
                    and defined $scan{$src}{$dst}{'tcp'}{'abs_sp'}) {
                my $tcp_s_port
                    = $scan{$src}{$dst}{'tcp'}{'abs_sp'};
                my $tcp_e_port
                    = $scan{$src}{$dst}{'tcp'}{'abs_ep'};
                if ($tcp_s_port == $tcp_e_port) {
                    $tcp_absrange = $tcp_s_port;
                } else {
                    $tcp_absrange = "$tcp_s_port-$tcp_e_port";
                }
            }
            if (defined $curr_scan_hr->{$src}->{$dst}->{'tcp'}
                    and defined $curr_scan_hr->{$src}->{$dst}->{'tcp'}->{'strtp'}) {
                $tcp_f = 1;
                my $tcp_s_port
                    = $curr_scan_hr->{$src}->{$dst}->{'tcp'}->{'strtp'};
                my $tcp_e_port
                    = $curr_scan_hr->{$src}->{$dst}->{'tcp'}->{'endp'};
                if ($tcp_s_port == $tcp_e_port) {
                    $tcp_newrange = $tcp_s_port;
                } else {
                    $tcp_newrange = "$tcp_s_port-$tcp_e_port";
                }
                $tcp_newpkts =
                    $curr_scan_hr->{$src}->{$dst}->{'tcp'}->{'pkts'};
            }
            if (defined $scan{$src}{$dst}{'udp'}
                    and $scan{$src}{$dst}{'udp'}{'abs_sp'}) {
                my $udp_s_port
                    = $scan{$src}{$dst}{'udp'}{'abs_sp'};
                my $udp_e_port
                    = $scan{$src}{$dst}{'udp'}{'abs_ep'};
                if ($udp_s_port == $udp_e_port) {
                    $udp_absrange = $udp_s_port;
                } else {
                    $udp_absrange = "$udp_s_port-$udp_e_port";
                }
            }
            if (defined $curr_scan_hr->{$src}->{$dst}->{'udp'}
                    and $curr_scan_hr->{$src}->{$dst}->{'udp'}->{'strtp'}) {
                $udp_f = 1;
                my $udp_s_port
                    = $curr_scan_hr->{$src}->{$dst}->{'udp'}->{'strtp'};
                my $udp_e_port
                    = $curr_scan_hr->{$src}->{$dst}->{'udp'}->{'endp'};
                if ($udp_s_port == $udp_e_port) {
                    $udp_newrange = $udp_s_port;
                } else {
                    $udp_newrange = "$udp_s_port-$udp_e_port";
                }
                $udp_newpkts = $curr_scan_hr->{$src}->{$dst}->{'udp'}->{'pkts'};
            }
            if (defined $curr_scan_hr->{$src}->{$dst}->{'icmp'}) {
                $icmp_f = 1;
                $icmp_newpkts =
                    $curr_scan_hr->{$src}->{$dst}->{'icmp'}->{'pkts'};
            }

            for my $str (keys %{$curr_scan_hr->{$src}->{$dst}}) {
                next if $str eq 'tcp' or $str eq 'udp'
                    or $str eq 'udplite' or $str eq 'icmp'
                    or $str eq 'icmp6' or $str eq 'tot_protocols';
                next unless defined $scan{$src}{$dst}{$str};
                next unless defined $curr_scan_hr->{$src}->{$dst}->{$str}->{'pkts'};
                $other_proto_newpkts +=
                    $curr_scan_hr->{$src}->{$dst}->{$str}->{'pkts'};
            }

            ### write out the overall packet counters for $src.
            &write_src_packet_counters($scan{$src}{$dst}{'chain'},
                $tcp_absrange, $udp_absrange, $pkt_ctr_file);

            ### get reverse dns info
            $src_subj = $src;
            $dst_subj = $dst;
            unless ($no_rdns or $config{'ENABLE_DNS_LOOKUPS'} eq 'N') {
                $src_dns_str = &get_dns_info($src);
                if ($src_dns_str) {
                    $src_subj = $src_dns_str;
                } else {
                    $src_dns_str = '[No reverse dns info available]';
                }
                $dst_dns_str = &get_dns_info($dst);
                if ($dst_dns_str) {
                    $dst_subj = $dst_dns_str;
                } else {
                    $dst_dns_str = '[No reverse dns info available]';
                }
            }

            ### get whois info
            my $whois_which_ip_str = 'source IP';
            unless ($no_whois or $config{'ENABLE_WHOIS_LOOKUPS'} eq 'N') {
                my $lookup_ip = $src;  ### default

                ### we're most likely interested in the whois information for
                ### a non local IP address
                if ($config{'ENABLE_WHOIS_FORCE_SRC_IP'} eq 'N'
                        and &is_local($src, new NetAddr::IP($src))
                        and not &is_local($dst, new NetAddr::IP($dst))) {
                    $whois_which_ip_str = 'destination IP';
                    $lookup_ip = $dst;
                }

                $whois_info_ar = &get_whois_info($lookup_ip,
                                    "${src_dir}/${lookup_ip}_whois");

                if ($debug and $verbose) {
                    print STDERR for @$whois_info_ar;
                }
            }
            print STDERR "[+] scan_logr(): generating email.....\n"
                if $test_mode or $debug;

            ### get the absolute starting time for the scan and the
            ### current time
            my $s_time = '';
            my $abs_s_time = scalar localtime $scan{$src}{$dst}{'s_time'};

            if (not $analyze_mode and ((time() - $config{'CHECK_INTERVAL'}) <
                    $scan{$src}{$dst}{'s_time'})) {
                $s_time = $abs_s_time;
            } else {
                $s_time = scalar localtime((time()
                        - $config{'CHECK_INTERVAL'}));
            }
            my $time = scalar localtime();

            ### email file handle
            my $fh;

            ### open the email alert file
            if ($no_daemon) {
                $fh = *STDOUT;
            } else {
                open E, "> $email_file" or
                    die "[*] Could not open $email_file: $!";
                $fh = *E;
            }

            print $fh "=-=-=-=-=-=-=-=-=-=-=-= $time =-=-=-=-=-=-=-=",
                "-=-=-=-=\n\n\n";

            printf $fh "%${log_len}s%s", 'Danger level: ',
                "[$scan_dl{$src}] (out of 5)";

            if ($scan{$src}{$dst}{'tot_protocols'} > 1) {
                print $fh ' Multi-Protocol';
            }
            if (defined $auto_assigned_msg{$src}) {
                print $fh ' Auto-assigned';
                delete $auto_assigned_msg{$src};
            }
            print $fh "\n\n";

            if ($curr_scan_hr->{$src}->{$dst}->{'tot_protocols'}
                    >= $config{'PROTOCOL_SCAN_THRESHOLD'}) {
                printf $fh "%${log_len}s%s%s\n", 'IP Protocol scan: ',
                    "[$curr_scan_hr->{$src}->{$dst}->{'tot_protocols'}",
                    ' unique protocols, Nmap -sO]';
                $scan_style_str .= 'Nmap -sO IP protocol scan,';
            }

            if ($tcp_f) {
                printf $fh "%${log_len}s%s\n", 'Scanned TCP ports: ',
                    "[$tcp_newrange: $tcp_newpkts packets]";
                my $prefix = 'TCP flags: ';

                for my $flags (keys %{$curr_scan_hr->{$src}->
                        {$dst}->{'tcp'}->{'flags'}}) {

                    my $nmap_opts = '';
                    $syslog_flags .= "$flags ";
                    my $n_pkts = $curr_scan_hr->{$src}->{$dst}->
                        {'tcp'}->{'flags'}->{$flags};

                    ### FUTURE: replace this with a simple hash lookup
                    if ($flags eq 'SYN') {
                        $nmap_opts = '-sT or -sS';
                    } elsif ($flags eq 'FIN') {
                        $nmap_opts = '-sF';
                    } elsif ($flags eq 'URG PSH FIN') {
                        $nmap_opts = '-sX';
                    } elsif ($flags eq 'NULL') {
                        $nmap_opts = '-sN';
                    } elsif ($flags eq 'URG PSH SYN FIN') {
                        $nmap_opts = '-O';
                    }

                    if ($curr_scan_hr->{$src}->{$dst}->{'is_topera'}) {
                        $scan_style_str = "Topera $flags scan";
                        printf $fh "%${log_len}s%s\n", $prefix,
                            "[$flags: $n_pkts packets, Topera $flags scan]";
                    } elsif ($curr_scan_hr->{$src}->{$dst}->{'is_masscan'}) {
                        $scan_style_str = "Masscan $flags scan";
                        printf $fh "%${log_len}s%s\n", $prefix,
                            "[$flags: $n_pkts packets, Masscan $flags scan]";
                    } else {
                        if ($nmap_opts) {
                            printf $fh "%${log_len}s%s\n", $prefix,
                                "[$flags: $n_pkts packets, Nmap: $nmap_opts]";
                        } else {
                            printf $fh "%${log_len}s%s\n", $prefix,
                                "[$flags: $n_pkts packets]";
                        }
                        if ($scan_style_str) {
                            $scan_style_str .= " $nmap_opts scan,";
                        } else {
                            $scan_style_str = "Nmap $nmap_opts scan,";
                        }
                        $prefix = '';
                    }
                }
                if (defined $curr_scan_hr->{$src}->{$dst}->{'tcp'}->{'chain'}) {
                    &print_chains_and_prefixes(
                        $curr_scan_hr->{$src}->{$dst}->{'tcp'}->{'chain'}, $fh);
                }
                $syslog_flags =~ s/\s*$//;
                $syslog_range = "tcp: [$tcp_newrange]";
                $syslog_range .= " flags: $syslog_flags" if $syslog_flags;
            }
            if ($udp_f) {
                printf $fh "%${log_len}s%s\n", 'Scanned UDP ports: ',
                    "[$udp_newrange: $udp_newpkts packets, Nmap: -sU]";
                if (defined $curr_scan_hr->{$src}->{$dst}->{'udp'}->{'chain'}) {
                    &print_chains_and_prefixes(
                        $curr_scan_hr->{$src}->{$dst}->{'udp'}->{'chain'},
                        $fh);
                }
                $syslog_range = "udp: [$udp_newrange]";
                $scan_style_str .= ' -sU scan,';
            }
            if ($icmp_f) {
                printf $fh "%${log_len}s%s\n", 'icmp packets: ',
                    "[$icmp_newpkts]";
                if (defined $curr_scan_hr->{$src}->{$dst}->{'icmp'}->{'chain'}) {
                    &print_chains_and_prefixes(
                        $curr_scan_hr->{$src}->{$dst}->{'icmp'}->{'chain'},
                        $fh);
                }
            }
            $scan_style_str =~ s/\,$//;
            printf $fh "\n%${log_len}s%s\n", 'Source: ', $src;
            printf $fh "%${log_len}s%s\n", 'DNS: ', $src_dns_str
                unless $no_rdns or $config{'ENABLE_DNS_LOOKUPS'} eq 'N';
            if ($config{'ENABLE_MAC_ADDR_REPORTING'} eq 'Y') {
                printf $fh "%${log_len}s%s\n", 'MAC: ', $src_mac
                    if $src_mac;
            }
            unless ($no_posf) {
                if (defined $p0f{$src}) {  ### prefer p0f-based fingerprinting
                    ### any p0f fingerprint that contains a "@" is an
                    ### approximate match
                    my $found_exact_match = 0;
                    for my $os (keys %{$p0f{$src}}) {
                        if ($os !~ /\@/) {
                            $found_exact_match = 1;
                            last;
                        }
                    }
                    my $printed_guess_line = 0;
                    for my $os (keys %{$p0f{$src}}) {
                        if ($found_exact_match) {
                            next if $os =~ /\@/;
                        }
                        if ($printed_guess_line) {
                            printf $fh "%${log_len}s%s\n", ' ', $os;
                        } else {
                            printf $fh "%${log_len}s%s\n", 'OS guess: ',
                                $os;
                        }
                        $printed_guess_line = 1;
                    }
                } elsif (defined $posf{$src}{'guess'}) {
                    printf $fh "%${log_len}s%s\n", 'OS guess: ',
                        $posf{$src}{'guess'};
                }
            }
            printf $fh "\n%${log_len}s%s\n", 'Destination: ', $dst;
            printf $fh "%${log_len}s%s\n", 'DNS: ', $dst_dns_str
                unless $no_rdns or $config{'ENABLE_DNS_LOOKUPS'} eq 'N';
            if ($config{'ENABLE_MAC_ADDR_REPORTING'} eq 'Y') {
                printf $fh "%${log_len}s%s\n", 'MAC: ', $dst_mac
                    if $dst_mac;
            }
            print $fh "\n";

            ### print the overall stats since the scan began
            printf $fh "%${log_len}s%s\n", 'Overall scan start: ',
                $abs_s_time;

            if ($config{'ENABLE_EMAIL_LIMIT_PER_DST'} eq 'Y') {
                printf $fh "%${log_len}s%s\n", 'Total email alerts: ',
                    $scan_email_ctrs{$src}{$dst}{'email_ctr'};
            } else {
                printf $fh "%${log_len}s%s\n", 'Total email alerts: ',
                    $scan_email_ctrs{$src}{'email_ctr'};
            }

            if ($tcp_absrange) {
                printf $fh "%${log_len}s%s\n", 'Complete TCP range: ',
                    "[$tcp_absrange]";
            }
            if ($udp_absrange) {
                printf $fh "%${log_len}s%s\n", 'Complete UDP range: ',
                    "[$udp_absrange]";
            }
            if (defined $curr_scan_hr->{$src}->{$dst}->{'syslog_host'}) {
                my $syslog_hosts = '';
                $syslog_hosts .= "$_, " for keys
                    %{$curr_scan_hr->{$src}->{$dst}->{'syslog_host'}};
                $syslog_hosts =~ s/\,\s+$//;
                if ($syslog_hosts =~ /\,/) {
                    printf $fh "%${log_len}s%s\n", 'Syslog hostnames: ',
                        $syslog_hosts;
                } else {
                    printf $fh "%${log_len}s%s\n", 'Syslog hostname: ',
                        $syslog_hosts;
                }
            }
            printf $fh "\n";
            printf $fh "%${log_len}s\n", 'Global stats: ';

            printf $fh "%${log_len}s%-9s%-12s%-11s%-10s\n", '',
                 'chain:', 'interface:', 'protocol:', 'packets:';

            for my $chain (keys %{$scan{$src}{$dst}{'chain'}}) {
                for my $intf (keys %{$scan{$src}{$dst}{'chain'}{$chain}}) {
                    for my $proto (sort {$a cmp $b} keys %{$scan{$src}{$dst}{'chain'}{$chain}{$intf}}) {
                        my $pkts = $scan{$src}{$dst}{'chain'}{$chain}{$intf}{$proto};
                        if (defined $protocol_strings{$proto}) {
                            printf $fh "%${log_len}s%-9s%-12s%-11s%-10s\n", '', $chain,
                                $intf, $protocol_strings{$proto}{'name'}, $pkts;
                        } else {
                            printf $fh "%${log_len}s%-9s%-12s%-11s%-10s\n", '', $chain,
                                $intf, $proto, $pkts;
                        }
                    }
                }
            }

            ### print out any matched signatures to the email
            ### alert file and also to the signature log
            &scan_logr_signatures($src, $dst, $fh, $log_sigs);

            ### write a scan message to syslog
            my $syslog_str = 'scan detected ';
            $syslog_str .= "($scan_style_str): " if $scan_style_str;
            $syslog_str .= "$src -> $dst";
            $syslog_str .= " $syslog_range" if $syslog_range;
            $syslog_str .= " tcp pkts: $tcp_newpkts" if $tcp_newpkts;
            $syslog_str .= " udp pkts: $udp_newpkts" if $udp_newpkts;
            $syslog_str .= " icmp pkts: $icmp_newpkts" if $icmp_newpkts;
            $syslog_str .= " other proto pkts: $other_proto_newpkts"
                if $other_proto_newpkts;
            $syslog_str .= " DL: $curr_dl";

            &sys_log($syslog_str);

            unless ($no_whois or $config{'ENABLE_WHOIS_LOOKUPS'} eq 'N') {
                print $fh "\n[+] Whois Information ($whois_which_ip_str):\n";
                for my $line (@$whois_info_ar) {
                    print $fh $line;
                }
            }
            print $fh "\n=-=-=-=-=-=-=-=-=-=-=-= $time =-=-=-=-=-=-=-=",
                "-=-=-=-=\n";
            close $fh unless $no_daemon;
            if ($curr_dl >= $config{'EMAIL_ALERT_DANGER_LEVEL'}
                    and not $no_daemon) {
                unless ($analyze_mode and not $analysis_emails) {
                    my $subject;
                    if ($analyze_mode) {
                        $subject = "$config{'MAIL_ALERT_PREFIX'} " .
                            "DL$curr_dl (analysis " .
                            "mode) src: $src_subj dst: $dst_subj";
                    } else {
                        $subject = "$config{'MAIL_ALERT_PREFIX'} " .
                            "DL$curr_dl src: " .
                            "$src_subj dst: $dst_subj";
                    }
                    &send_mail($subject, $email_file,
                        $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});

                    ### print the number of email alerts we have sent
                    open E, "> $ecount_file" or die "[*] Could not open ",
                        "$ecount_file: $!";

                    if ($config{'ENABLE_EMAIL_LIMIT_PER_DST'} eq 'Y') {
                        print E $scan_email_ctrs{$src}{$dst}{'email_ctr'}, "\n";
                    } else {
                        print E $scan_email_ctrs{$src}{'email_ctr'}, "\n";
                    }
                    close E;

                    if ($config{'ENABLE_EXT_SCRIPT_EXEC'} eq 'Y') {
                        if ($config{'EXEC_EXT_SCRIPT_PER_ALERT'} eq 'Y') {
                            &exec_external_script($src, $config{'EXTERNAL_SCRIPT'});
                            $scan_ext_exec{$src} = '';
                        } else {
                            unless (defined $scan_ext_exec{$src}) {
                                &exec_external_script($src, $config{'EXTERNAL_SCRIPT'});
                                $scan_ext_exec{$src} = '';
                            }
                        }
                    }
                }
            }

            ### we have sent an alert for $dst
            if ($config{'ALERT_ALL'} eq 'N') {
                $scan{$src}{$dst}{'alerted'} = 1;
            }
        }
    }
    return;
}

sub scan_timeouts() {
    my $do_timeout = 0;
    if ($config{'PERSISTENCE_CTR_THRESHOLD'} == 0) {
        $do_timeout = 1;
    } elsif ($check_interval_ctr % $config{'PERSISTENCE_CTR_THRESHOLD'} == 0) {
        $do_timeout = 1;
    }

    &delete_old_scans() if $do_timeout;
    return;
}

sub scan_logr_signatures() {
    my ($src, $dst, $email_fh, $log_sigs_file) = @_;

    my @del_sigs = ();
    my @log_sigs = ();
    my $found_sid = 0;

    for my $proto (keys %protocols) {
        next unless defined $scan{$src}{$dst}{$proto};
        my $hr = $scan{$src}{$dst}{$proto};

        next unless (defined $hr->{'sid'}
                or defined $hr->{'invalid_type'}
                or defined $hr->{'invalid_code'});

        print $email_fh "\n\n[+] " . uc($proto) . " scan signatures:\n\n";
        print STDERR "[+] scan_logr_signatures(): src: $src dst: $dst ",
            "proto: $proto\n" if $debug;

        my $sid_ctr = 0;
        for my $sid (keys %{$hr->{'sid'}}) {
            $sid_ctr++;
            if ($sid_ctr <= $config{'SIG_SID_SYSLOG_THRESHOLD'}) {
                $found_sid = 1;
            }
            for my $chain (keys %{$hr->{'sid'}->{$sid}}) {

                my $sig_hr      = '';
                my $email_chain = $chain;
                my $is_fwsnort  = $hr->{'sid'}->{$sid}
                    ->{$chain}->{'is_fwsnort'};

                if ($is_fwsnort) {
                    next unless defined $fwsnort_sigs{$sid};
                    $sig_hr = $fwsnort_sigs{$sid};
                } else {
                    next unless defined $sigs{$sid};
                    $sig_hr = $sigs{$sid};
                }

                my $dp    = 0;
                my $flags = 'NA';
                if ($proto eq 'tcp' or $proto eq 'udp'
                        or $proto eq 'udplite') {
                    $dp = $hr->{'sid'}->{$sid}->{$chain}->{'dp'};
                    if ($proto eq 'tcp') {
                        $flags = $hr->{'sid'}->{$sid}->{$chain}->{'flags'};
                    }
                }

                my $pkts = $hr->{'sid'}->{$sid}->{$chain}->{'pkts'};

                ### string for the <ip>_signatures file
                push @log_sigs, "$hr->{'sid'}->{$sid}->{$chain}->{'time'} " .
                    qq|$sid $pkts "$sig_hr->{'msg'}" $chain $proto $dp "$flags" | .
                    "$is_fwsnort $sig_hr->{'is_psad_id'}";

                if ($config{'ENABLE_SIG_MSG_SYSLOG'} eq 'Y'
                        and $sid_ctr <= $config{'SIG_MSG_SYSLOG_THRESHOLD'}) {
                    my $sig_log_str = "src: $src signature match: " .
                        qq|"$sig_hr->{'msg'}" (sid: $sid) $proto|;

                    if ($proto eq 'tcp' or $proto eq 'udp'
                            or $proto eq 'udplite') {
                        $sig_log_str .= " port: $dp";
                    }

                    if ($is_fwsnort) {
                        $sig_log_str .= ' fwsnort';

                        if (defined $hr->{'sid'}->{$sid}->{$chain}
                                ->{'fwsnort_estab'}) {

                            if ($chain eq 'INPUT') {
                                $sig_log_str .= ' chain: FWSNORT_INPUT';
                                $email_chain = 'FWSNORT_INPUT';
                            } elsif ($chain eq 'FORWARD') {
                                $sig_log_str .= ' chain: FWSNORT_FORWARD';
                                $email_chain = 'FWSNORT_FORWARD';
                            } elsif ($chain eq 'OUTPUT') {
                                $sig_log_str .= ' chain: FWSNORT_OUTPUT';
                                $email_chain = 'FWSNORT_OUTPUT';
                            }

                            if ($hr->{'sid'}->{$sid}
                                    ->{$chain}->{'fwsnort_estab'}) {

                                $sig_log_str .= '_ESTAB';
                                $email_chain .= '_ESTAB';
                            }
                        }

                        if (defined $hr->{'sid'}->{$sid}->{$chain}
                                ->{'fwsnort_rnum'} and $hr->{'sid'}->{$sid}
                                ->{$chain}->{'fwsnort_rnum'}) {

                            $sig_log_str .= ' rule: ' .
                                $hr->{'sid'}->{$sid}->{$chain}
                                ->{'fwsnort_rnum'};
                        }
                    }

                    ### write the signature match to syslog
                    &sys_log($sig_log_str);
                }

                print $email_fh qq|   "$sig_hr->{'msg'}"\n|;

                if ($proto eq 'tcp' or $proto eq 'udp'
                        or $proto eq 'udplite') {
                    if ($chain eq 'INPUT') {
                        if (defined $local_ports{$proto}
                                and defined $local_ports{$proto}{$dp}) {
                            print $email_fh "       dst port:  $dp (server ",
                                  "bound to local port!)\n";
                            print $email_fh "       flags:     $flags\n"
                                if $proto eq 'tcp';
                        } else {
                            print $email_fh "       dst port:  $dp (no server ",
                                  "bound to local port)\n";
                            print $email_fh "       flags:     $flags\n"
                                if $proto eq 'tcp';
                        }
                    } else {
                        print $email_fh "       dst port:  $dp\n";
                        print $email_fh "       flags:     $flags\n"
                            if $proto eq 'tcp';
                    }
                }

                if ($is_fwsnort) {
                    for my $content (@{$sig_hr->{'content'}}) {
                        print $email_fh qq(       content:   "$content"\n);
                    }
                }
                my $sid_str = '';
                if ($sig_hr->{'is_psad_id'}) {
                    $sid_str = "       psad_id:   $sid";
                } else {
                    $sid_str = "       sid:       $sid";
                }
                if (defined $sig_hr->{'psad_derived_sids'}) {
                    $sid_str .= ' (derived from: ';
                    $sid_str .= "$_ " for @{$sig_hr->{'psad_derived_sids'}};
                    $sid_str =~ s|\s*$||;
                    $sid_str .= ')';
                }
                print $email_fh "$sid_str\n",
                    "       chain:     $email_chain\n",
                    "       packets:   $pkts\n";

                if ($sig_hr->{'classtype'}) {
                    print $email_fh "       classtype: $sig_hr->{'classtype'}\n";
                }
                if (defined $sig_hr->{'reference'}
                        and $sig_hr->{'reference'}) {
                    for my $reftype (keys %{$sig_hr->{'reference'}}) {
                        my $baseurl = '';
                        if (defined $snort_ref_baseurl{$reftype}) {
                            $baseurl = $snort_ref_baseurl{$reftype};
                        } else {
                            next;
                        }
                        for my $ref (@{$sig_hr->{'reference'}->{$reftype}}) {
                            print $email_fh "       reference: ($reftype) ",
                                  "${baseurl}$ref\n";
                        }
                    }
                }
                print $email_fh "\n";
            }
        }
        if (defined $hr->{'invalid_type'}) {
            for my $type (keys %{$hr->{'invalid_type'}}) {
                for my $chain (keys %{$hr->{'invalid_type'}->{$type}}) {
                    my $pkts = $hr->{'invalid_type'}->
                    {$type}->{$chain}->{'pkts'};
                    print $email_fh
                        qq|   Invalid ICMP type "$type" chain=$chain packets=$pkts\n|;
                }
            }
        }
        if (defined $hr->{'invalid_code'}) {
            for my $type (keys %{$hr->{'invalid_code'}}) {
                for my $code (keys %{$hr->{'invalid_code'}->{$type}}) {
                    for my $chain (keys %{$hr->{'invalid_code'}->{$type}->{$code}}) {
                        my $pkts = $hr->{'invalid_code'}->
                        {$type}->{$code}->{$chain}->{'pkts'};
                        if ($proto eq 'icmp') {
                            print $email_fh qq|   Invalid ICMP code "$code" for ICMP |,
                                qq|"$valid_icmp_types{$type}{'text'}" packet\n|,
                                "       chain=$chain packets=$pkts\n";
                         } elsif ($proto eq 'icmp6') { 
                            print $email_fh qq|   Invalid ICMP code "$code" for ICMP |,
                                qq|"$valid_icmp6_types{$type}{'text'}" packet\n|,
                                "       chain=$chain packets=$pkts\n";
                        }
                    }
                }
            }
        }
        push @del_sigs, $hr;
    }

    if (@log_sigs) {
        open LS, ">> $log_sigs_file.tmp" or
            die "[*] Could not open $log_sigs_file: $!";
        print LS "#\n# Format: <sig_time> <sid> <matches> \"<msg>\" <chain> ",
            "<proto> <dst port> \"<flags>\" <is_fwsnort> <is_psad>\n#\n\n";
        for my $str (@log_sigs) {
            print LS $str, "\n";
        }
        close LS;
        move "$log_sigs_file.tmp", $log_sigs_file;
    }
    unless ($config{'SHOW_ALL_SIGNATURES'} eq 'Y') {
        for my $hr (@del_sigs) {
            ### need to delete the current signature so it
            ### won't show up in the next alert
            delete $hr->{'sid'}
                if defined $hr->{'sid'};
            delete $hr->{'invalid_type'}
                if defined $hr->{'invalid_type'};
            delete $hr->{'invalid_code'}
                if defined $hr->{'invalid_code'};
        }
    }
    close LS;
    return;
}

sub print_chains_and_prefixes() {
    my ($chain_hr, $fh) = @_;
    for my $chain (keys %$chain_hr) {
        for my $prefix (keys %{$chain_hr->{$chain}}) {
            my $count = $chain_hr->{$chain}->{$prefix};
            if ($prefix eq '*noprfx*') {
                printf $fh "%${log_len}s%s\n", 'iptables chain: ',
                    "$chain, $count packets";
            } else {
                my $print_chain  = $chain;
                my $fwsnort_rnum = 0;
                if ($prefix =~ /$config{'SNORT_SID_STR'}/) {
                    if ($prefix =~ /\[(\d+)\]/) {
                        $fwsnort_rnum = $1;
                    }
                    if ($chain eq 'INPUT') {
                        $print_chain = 'FWSNORT_INPUT';
                    } elsif ($chain eq 'FORWARD') {
                        $print_chain = 'FWSNORT_FORWARD';
                    } elsif ($chain eq 'OUTPUT') {
                        $print_chain = 'FWSNORT_OUTPUT';
                    }
                    if ($prefix =~ /ESTAB/) {
                        $print_chain .= '_ESTAB';
                    }
                }
                printf $fh "%${log_len}s%s\n", 'iptables chain: ',
                    qq/$print_chain (prefix "$prefix"), $count packets/;
                if ($fwsnort_rnum) {
                    printf $fh "%${log_len}s%s\n", 'fwsnort rule: ',
                        $fwsnort_rnum;
                }
            }
        }
    }
    return;
}

sub exec_external_script() {
    my ($src, $cmd) = @_;

    $cmd =~ s/SRCIP/$src/;

    my $pid;
    local $SIG {'ALRM'} = sub {kill 15, $pid or die "[*] kill: $!";
        die "[*] External script timeout.\n"};
    eval {
        $pid = fork();

        die "Could not fork for external script: $!" unless defined $pid;

        unless ($pid) {
            exec qq{$cmd};
            die "script exec failed: $!";
        }
        alarm 30;

        waitpid $pid => 0;

        alarm 0;
    };
    return;
}

sub renew_auto_blocked_ips() {

    ### note that if we are renewing IP blocking rules, we just use
    ### the AUTO_BLOCK_TIMEOUT value initially and then the AUTO_BLOCK_DLN...
    ### values will take over as psad gets up and running
    my $timeout_str = '.';
    if ($config{'AUTO_BLOCK_TIMEOUT'} > 0) {
        $timeout_str = "for $config{'AUTO_BLOCK_TIMEOUT'} seconds.";
    } else {
        $timeout_str = '(unlimited time).';
    }

    if ($config{'IPTABLES_BLOCK_METHOD'} eq 'Y'
            and -e $config{'AUTO_BLOCK_IPT_FILE'}) {
        open B, "< $config{'AUTO_BLOCK_IPT_FILE'}" or
            die "[*] Could not open $config{'AUTO_BLOCK_IPT_FILE'}: $!";
        my @lines = <B>;
        close B;

        for my $line (@lines) {
            if ($line =~ /^\s*($ipv4_re)\s+(\d+)/) {
                my $ip = $1;
                my $orig_block_time = $2;

                if ($config{'AUTO_BLOCK_TIMEOUT'} == 0) {

                    ### set the DL here to the minimum currently required
                    $scan_dl{$ip} = $config{'AUTO_IDS_DANGER_LEVEL'};

                    ### block the IP address (note that checks are built
                    ### into this function to not add a duplicate rule)
                    &ipt_block($ip, 'renew');

                    ### reset the block time to the original time that
                    ### the rule was added so the rule does not stay
                    ### around longer than it should.
                    $auto_blocked_ips{$ip} = $orig_block_time;
                } else {
                    if ((time() - $orig_block_time)
                            > $config{'AUTO_BLOCK_TIMEOUT'}) {
                        ### timeout has expired, so we should remove any
                        ### existing blocking rule
                        &ipt_rm_block($ip);

                    } else {

                        ### set the DL here to the minimum currently required
                        $scan_dl{$ip} = $config{'AUTO_IDS_DANGER_LEVEL'};

                        ### block the IP address (note that checks are built
                        ### into this function to not add a duplicate rule)
                        &ipt_block($ip, 'renew');

                        $auto_blocked_ips{$ip} = $orig_block_time;
                    }
                }
            }
        }
    }
    if ($config{'TCPWRAPPERS_BLOCK_METHOD'} eq 'Y'
            && -e $config{'ETC_HOSTS_DENY_FILE'}) {
        open B, "< $config{'ETC_HOSTS_DENY_FILE'}" or
            die "[*] Could not open $config{'ETC_HOSTS_DENY_FILE'}: $!";
        my @lines = <B>;
        close B;
        for my $line (@lines) {
            if ($line =~ /^\s*($ipv4_re)\s+(\d+)/) {
                my $ip = $1;
                my $orig_block_time = $2;

                if ($config{'AUTO_BLOCK_TIMEOUT'} == 0) {

                    ### set the DL here to the minimum currently required
                    $scan_dl{$ip} = $config{'AUTO_IDS_DANGER_LEVEL'};

                    ### block the IP address (note that checks are built
                    ### into this function to not add a duplicate rule)
                    if (&tcpwr_test_block($ip)) {
                        $auto_blocked_ips{$ip} = $orig_block_time
                            unless defined $auto_blocked_ips{$ip};
                    } else {
                        &sys_log("renewing tcpwrappers auto-block " .
                            "against $ip $timeout_str");
                        &tcpwr_block($ip);
                        if ($config{'ENABLE_RENEW_BLOCK_EMAILS'} eq 'Y'
                                and defined $scan_dl{$ip}
                                and $scan_dl{$ip} >= $config{'EMAIL_ALERT_DANGER_LEVEL'}) {
                            &send_mail("$config{'MAIL_STATUS_PREFIX'} RENEWED " .
                                "tcpwrappers BLOCK against $ip $timeout_str", '',
                                $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});
                        }
                        $auto_blocked_ips{$ip} = $orig_block_time;
                    }
                } else {
                    if ((time() - $orig_block_time)
                            > $config{'AUTO_BLOCK_TIMEOUT'}) {
                        ### timeout has expired, so we should remove any
                        ### existing blocking rule
                        &tcpwr_rm_block($ip);

                    } else {

                        ### set the DL here to the minimum currently required
                        $scan_dl{$ip} = $config{'AUTO_IDS_DANGER_LEVEL'};

                        ### block the IP address (note that checks are built
                        ### into this function to not add a duplicate rule)
                        if (&tcpwr_test_block($ip)) {
                            $auto_blocked_ips{$ip} = $orig_block_time
                                unless defined $auto_blocked_ips{$ip};
                        } else {
                            &sys_log("renewing tcpwrappers auto-block " .
                                "against $ip $timeout_str");
                            &tcpwr_block($ip);
                            if ($config{'ENABLE_RENEW_BLOCK_EMAILS'} eq 'Y'
                                    and defined $scan_dl{$ip}
                                    and $scan_dl{$ip} >= $config{'EMAIL_ALERT_DANGER_LEVEL'}) {
                                &send_mail("$config{'MAIL_STATUS_PREFIX'} RENEWED " .
                                    "tcpwrappers BLOCK against $ip $timeout_str", '',
                                    $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});
                            }
                            $auto_blocked_ips{$ip} = $orig_block_time;
                        }
                    }
                }
            }
        }
    }
    return;
}

sub sockwrite_flush_auto_rules() {
    if (-e $config{'PSAD_PID_FILE'}) {
        if (&is_running($config{'PSAD_PID_FILE'})
                and $config{'ENABLE_AUTO_IDS'} eq 'Y') {
            print "[+] Flushing psad chains via running psad daemon within\n",
                "    $config{'CHECK_INTERVAL'} seconds.\n";
            die "[*] $config{'AUTO_IPT_SOCK'} file is missing. Did something ",
                "remove it?\n    You should stop psad, run the -F command ",
                "again, then restart psad." unless -e $config{'AUTO_IPT_SOCK'};
            ### open domain socket with running psad process
            my $sock = IO::Socket::UNIX->new($config{'AUTO_IPT_SOCK'})
                or die "[*] Could not acquire $config{'AUTO_IPT_SOCK'} ",
                "socket: $!";
            if ($fw_del_chains) {
                print $sock "flush delchains\n";
            } else {
                print $sock "flush\n";
            }
            close $sock;
            return $EXIT_SUCCESS;
        }
    }

    ### if we make it here then we have to flush manually because
    ### it looks like psad is not running.
    if ($fw_del_chains) {
        print "[+] Flushing and deleting psad chains.\n";
    } else {
        print "[+] Flushing psad chains.\n";
    }
    &flush_auto_blocked_ips();
    return $EXIT_SUCCESS;
}

sub flush_auto_blocked_ips() {

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

    &sys_log('flushing existing psad iptables ' .
        'auto-response chains');

    if (@ipt_config) {
        for my $hr (@ipt_config) {
            my $table      = $hr->{'table'};
            my $from_chain = $hr->{'from_chain'};
            my $to_chain   = $hr->{'to_chain'};

            my ($rv, $out_ar, $err_ar)
                = $ipt->chain_exists($table, $to_chain);

            if ($rv) {
                if ($fw_del_chains) {
                    ($rv, $out_ar, $err_ar) = $ipt->delete_chain($table,
                        $from_chain, $to_chain);
                    if ($rv) {
                        &sys_log("deleted $table table $to_chain chain");
                    } else {
                        &sys_log("could not delete $table " .
                            "table $to_chain chain");
                        &sys_log_mline($err_ar);
                    }
                } else {
                    ($rv, $out_ar, $err_ar)
                        = $ipt->flush_chain($table, $to_chain);
                    if ($rv) {
                        &sys_log("flushed: $to_chain");
                    } else {
                        &sys_log("could not flush: $to_chain");
                        &sys_log_mline($err_ar);
                    }
                }
            }
        }
    }

    ### zero out the in-memory cache of blocked addresses
    %auto_blocked_ips = ();

    if (-e $config{'AUTO_BLOCK_IPT_FILE'}) {
        ### we have removed the iptables block rules, so truncate
        ### the cache file.
        &truncate_file($config{'AUTO_BLOCK_IPT_FILE'});
    }

    if (-e $config{'AUTO_BLOCK_TCPWR_FILE'}) {
        my $found_blocked = 0;
        &sys_log("removing tcpwrapper auto-generated block rules.");
        open B, "< $config{'AUTO_BLOCK_TCPWR_FILE'}" or
            die "[*] Could not open $config{'AUTO_BLOCK_TCPWR_FILE'}: $!";
        my @lines = <B>;
        close B;
        for my $line (@lines) {
            if ($line =~ /($ipv4_re)/) {
                my $ip = $1;
                ### remove block rules for $ip if it has been blocked
                &tcpwr_rm_block($ip) if &tcpwr_test_block($ip);
                $found_blocked = 1;
            }
        }
        ### we have removed the tcpwrapper block rules, so truncate
        ### the cache file.
        &truncate_file($config{'AUTO_BLOCK_TCPWR_FILE'});
        unless ($found_blocked) {
            &sys_log("currently there are no auto-generated " .
                "tcpwrapper blocking rules in effect.");
        }
    }
    return;
}

sub get_auto_response_domain_sock() {

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

sub check_auto_response_sock() {

    ### we expect that the AUTO_IPT_SOCK file should exist
    ### in the filesystem.  If not, then something deleted it
    ### and we can recover by reopening it.
    return if -e $config{'AUTO_IPT_SOCK'};

    &sys_log("domain socket $config{'AUTO_IPT_SOCK'} does not " .
        "exist (a separate process must have deleted it), recreating it.");

    close $ipt_sock;

    ### reopen the socket
    &get_auto_response_domain_sock();

    return;
}

sub ipt_block() {
    my ($ip, $renewed_status) = @_;

    return unless $ip and $ip =~ /^$ipv4_re$/;

    ### see if the IP is already blocked
    if (defined $auto_blocked_ips{$ip}) {
        print STDERR "[-] ipt_block($ip) already blocked.\n" if $debug;
        return;
    }

    print STDERR "[+] ipt_block($ip)\n" if $debug;

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

    my $block_success   = 0;
    my $already_blocked = 0;

    my ($timeout, $timeout_str) = &get_block_timeout($scan_dl{$ip});

    if ($config{'IPTABLES_PREREQ_CHECK'} > 1) {
        $iptables_prereq_check++;
        $iptables_prereq_check = 1
            if $iptables_prereq_check == $config{'IPTABLES_PREREQ_CHECK'};
    }

    ### add block rule for $ip unless it is already blocked
    for my $hr (@ipt_config) {
        my $target     = $hr->{'target'};
        my $direction  = $hr->{'direction'};
        my $table      = $hr->{'table'};
        my $from_chain = $hr->{'from_chain'};
        my $to_chain   = $hr->{'to_chain'};
        my $jump_rule_position = $hr->{'jump_rule_position'};
        my $auto_rule_position = $hr->{'auto_rule_position'};

        my $src = '';
        my $dst = '';

        if ($config{'IPTABLES_PREREQ_CHECK'} == 1
                or $iptables_prereq_check == 1) {
            print STDERR "[+] iptables chains and jump rule check.\n"
                if $debug;

            ### make sure "to_chain" exists
            my ($rv, $out_ar, $err_ar)
                = $ipt->create_chain($table, $to_chain);

            unless ($rv) {
                my $msg = "could not create $table $to_chain chain";
                &sys_log($msg);
                &sys_log_mline($err_ar);
                print STDERR "[-] ipt_block(): $msg\n" if $debug;
                next;
            }

            unless ($test_mode) {
                ### add jump rule to the "to_chain" from the "from_chain"
                ($rv, $out_ar, $err_ar) = $ipt->add_jump_rule($table,
                    $from_chain, $jump_rule_position, $to_chain);

                unless ($rv) {
                    my $msg = "could not add jump rule to $to_chain chain";
                    &sys_log($msg);
                    &sys_log_mline($err_ar);
                    print STDERR "[-] ipt_block(): $msg\n" if $debug;
                    next;
                }
            }
        }

        if ($direction eq 'src' or $direction eq 'both') {
            $src = $ip;
            $dst = '0.0.0.0/0';
        } elsif ($direction eq 'dst') {
            $src = '0.0.0.0/0';
            $dst = $ip;
        }

        my ($rv, $num_chain_rules) = $ipt->find_ip_rule($src, $dst,
                $table, $to_chain, $target);

        if ($rv) {
            print STDERR "[-] Test1, IP rule ($src->$dst $to_chain) ",
                "already exists.\n" if $debug;
            $already_blocked = 1;
        } else {
            my ($rv, $out_ar, $err_ar) = $ipt->add_ip_rule($src, $dst,
                $auto_rule_position, $table, $to_chain, $target);
            if ($rv) {
                print STDERR "[+] Test1 block success.\n" if $debug;
                $block_success = 1;
            } else {
                my $msg = "could not add block rule for $src -> $dst";
                &sys_log($msg);
                &sys_log_mline($err_ar);
                print STDERR "[-] ipt_block(): $msg\n" if $debug;
            }
        }

        if ($direction eq 'both') {
            ### need to add reverse rule for FORWARD chain
            my $src2 = $dst;
            my $dst2 = $src;
            my ($rv, $num_chain_rules) = $ipt->find_ip_rule($src2,
                    $dst2, $table, $to_chain, $target);

            if ($rv) {
                print STDERR "[-] Test2, IP rule ($src2->$dst2 $to_chain) ",
                    "already exists.\n" if $debug;
                $already_blocked = 1;
            } else {
                my ($rv, $out_ar, $err_ar) = $ipt->add_ip_rule($src2, $dst2,
                    $auto_rule_position, $table, $to_chain, $target);
                if ($rv) {
                    print STDERR "[+] Test2 block success.\n" if $debug;
                    $block_success = 1;
                } else {
                    my $msg = "could not add block rule for $src2 -> $dst2";
                    &sys_log($msg);
                    &sys_log_mline($err_ar);
                    print STDERR "[-] ipt_block(): $msg\n" if $debug;
                }
            }
        }
    }
    if ($already_blocked) {
        &sys_log("block rule for IP: $ip already exists");
        print STDERR "[-] Block rule for IP: $ip already exists\n"
            if $debug;
    } elsif ($block_success) {

        ### make sure the ip is in the auto_blocked_ips cache (the ip
        ### may have come from the command line with --fw-block-ip
        ### instead of through the iptables log).  Also, don't re-define
        ### the block time if it has already been defined (note that we
        ### may instantiated multiple block actions in the for loop
        ### above).
        $auto_blocked_ips{$ip} = time()
            unless defined $auto_blocked_ips{$ip};

        my $mail_msg = "iptables auto-block against $ip $timeout_str";
        if ($renewed_status) {
            $mail_msg = "renewed $mail_msg";
        } else {
            $mail_msg = "added $mail_msg";
        }

        if ($config{'ENABLE_AUTO_IDS_EMAILS'} eq 'Y') {
            if ($renewed_status) {
                if ($config{'ENABLE_RENEW_BLOCK_EMAILS'} eq 'Y'
                        and defined $scan_dl{$ip}
                        and $scan_dl{$ip} >= $config{'EMAIL_ALERT_DANGER_LEVEL'}) {
                    &send_mail("$config{'MAIL_STATUS_PREFIX'} $mail_msg",
                        '', $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});
                }
            } else {
                if (defined $scan_dl{$ip}
                        and $scan_dl{$ip} >= $config{'EMAIL_ALERT_DANGER_LEVEL'}) {
                    &send_mail("$config{'MAIL_STATUS_PREFIX'} $mail_msg", '',
                        $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});
                }
            }
        }
        &sys_log($mail_msg);

        if ($config{'ENABLE_EXT_BLOCK_SCRIPT_EXEC'} eq 'Y') {
            &exec_external_script($ip, $config{'EXTERNAL_BLOCK_SCRIPT'});
        }

        ### write the ip out to the auto blocked file
        &diskwrite_blocked_ip($ip,
            $config{'AUTO_BLOCK_IPT_FILE'}, $renewed_status);

        print STDERR "[+] ipt_block(): added block for $ip\n"
            if $debug;
    } else {
        &sys_log("could not add iptables " .
            "block rule for: $ip");
        print STDERR "[-] Could not add iptables block rule for: $ip\n"
            if $debug;
    }
    return;
}

sub ipt_rm_block() {
    my $ip = shift;

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

    print STDERR "[+] ipt_rm_block($ip)\n" if $debug;

    ### delete block rule for $ip
    my $rm_block = 0;
    for my $hr (@ipt_config) {
        my $target    = $hr->{'target'};
        my $direction = $hr->{'direction'};
        my $table     = $hr->{'table'};
        my $to_chain  = $hr->{'to_chain'};

        my $src = '';
        my $dst = '';
        if ($direction eq 'src' or $direction eq 'both') {
            $src = $ip;
            $dst = '0.0.0.0/0';
        } elsif ($direction eq 'dst') {
            $src = '0.0.0.0/0';
            $dst = $ip;
        }

        my ($rv, $out_ar, $err_ar) = $ipt->delete_ip_rule($src, $dst,
            $table, $to_chain, $target);
        if ($rv) {
            $rm_block = 1;
        } else {
            my $msg = "could not delete rule for $src -> $dst";
            &sys_log($msg);
            &sys_log_mline($err_ar);
            print STDERR "[-] ipt_rm_block(): $msg\n" if $debug;
        }

        if ($direction eq 'both') {
            ### need to delete reverse rule for FORWARD chain
            my $src2 = $dst;
            my $dst2 = $src;
            ($rv, $out_ar, $err_ar) = $ipt->delete_ip_rule($src2, $dst2,
                $table, $to_chain, $target);
            if ($rv) {
                $rm_block = 1;
            } else {
                my $msg = "could not delete rule for $src -> $dst";
                &sys_log($msg);
                &sys_log_mline($err_ar);
                print STDERR "[-] ipt_rm_block(): $msg\n" if $debug;
            }
        }
    }

    ### delete the ip from the hash (if new packets are seen
    ### from the same ip, then the hash will be updated again
    ### in check_scan()).
    delete $auto_blocked_ips{$ip}
        if defined $auto_blocked_ips{$ip};

    &diskwrite_rm_blocked_ip($ip, $config{'AUTO_BLOCK_IPT_FILE'});

    if ($rm_block) {
        unless ($flush_fw) {
            ### don't send timeout email if we are manually flushing
            ### the auto-block rules from the command line with --Flush.
            &sys_log("removed iptables auto-block against $ip");
            if ($config{'ENABLE_AUTO_IDS_EMAILS'} eq 'Y'
                    and defined $scan_dl{$ip}
                    and $scan_dl{$ip} >= $config{'EMAIL_ALERT_DANGER_LEVEL'}) {
                &send_mail("$config{'MAIL_STATUS_PREFIX'} removed " .
                    "iptables block against $ip", '',
                    $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});
            }
        }
        print STDERR "[+] ipt_rm_block(): removed iptables block ",
            "against $ip\n" if $debug;

        return 1;
    }

    &sys_log('warning: could not remove iptables ' .
        "block rule for $ip");
    print STDERR "[-] Could not remove iptables block rule for $ip\n"
        if $debug;
    return 0;
}

sub ipt_list_auto_chains() {

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

    print "[+] Listing chains from IPT_AUTO_CHAIN keywords...\n";
    if ($config{'ENABLE_AUTO_IDS'} eq 'N') {
        print '[-] NOTE: ENABLE_AUTO_IDS is currently disabled ',
            "in $config_file\n";
    }
    print "\n";
    for my $hr (@ipt_config) {
        my $table    = $hr->{'table'};
        my $to_chain = $hr->{'to_chain'};

        my ($rv, $out_ar, $err_ar)
            = $ipt->chain_exists($table, $to_chain);

        if ($rv) {
            ($rv, $out_ar, $err_ar) =
                $ipt->run_ipt_cmd("$ipt->{'_cmd'} -t " .
                    "$table -n -L $to_chain -v");
            if ($rv and $out_ar) {
                print for @$out_ar;
            }
            print "\n";
        } else {
            print "[-] Table: $table, chain: $to_chain, does not exist\n";
        }
    }
    return $EXIT_SUCCESS;
}

sub check_ipt_cmd() {
    my $lines_ar = shift;

    my %uniq_cmds = ();
    for my $line (@$lines_ar) {
        chomp $line;
        next if defined $uniq_cmds{$line};
        $uniq_cmds{$line} = '';
        if ($line =~ /flush/i) {
            my $del_chains = 0;
            $del_chains = 1 if $line =~ /delchains/i;
            &flush_auto_blocked_ips($del_chains);
        } else {
            if ($line =~ m|add\s+($ipv4_re)\s*$|i
                    or $line =~ m|add\s+($ipv4_re/\d+)\s*$|i
                    or $line =~ m|add\s+($ipv4_re/$ipv4_re)\s*$|i) {
                my $ip_net = $1;

                my $ip_only = '';
                $ip_only = $1 if $line =~ /\s($ipv4_re)/;

                ### instantiate the blocking rule, force a DL value
                ### equal to the AUTO_IDS_DANGER_LEVEL setting
                $scan_dl{$ip_only} = $config{'AUTO_IDS_DANGER_LEVEL'};

                &ipt_block($1, '');
            } elsif ($line =~ m|del\s+($ipv4_re)\s*$|i
                    or $line =~ m|del\s+($ipv4_re/\d+)\s*$|i
                    or $line =~ m|del\s+($ipv4_re/$ipv4_re)\s*$|i) {
                ### remove the blocking rule
                &ipt_rm_block($1);
            }
        }
    }
    return;
}

### this only gets used when issuing --fw-block
### from the command line.
sub sockwrite_add_ipt_block_ip() {

    die "[*] --fw-block-ip takes either an IP or subnet as an argument."
        unless $fw_block_ip =~ /$ipv4_re/;

    my $block_ip   = '';
    my $block_mask = '';
    my $block_net  = '';

    if ($fw_block_ip =~ m|^\s*($ipv4_re)\s*$|) {
        $block_ip   = $1;
        $block_mask = '32';
        $block_net = new NetAddr::IP($1);
    } elsif ($fw_block_ip =~ m|^\s*($ipv4_re)/($ipv4_re)\s*$|) {
        $block_ip   = $1;
        $block_mask = $2;
        $block_net = new NetAddr::IP($1, $2);
    } elsif ($fw_block_ip =~ m|^\s*($ipv4_re)/(\d+)\s*$|) {
        $block_ip   = $1;
        $block_mask = $2;
        $block_net = new NetAddr::IP($1, $2);
    } else {
        die "[*] Badly formatted block IP: $fw_block_ip";
    }

    if ($block_net->masklen() != 32) {
        ### a subnet was given on the command line, so make
        ### sure we were also given a network address (iptables
        ### converts to the network address in -nL output)
        $fw_block_ip = $block_net->network()->cidr();
    }

    ### import auto_dl file
    &import_auto_dl();

    ### make sure $fw_block_ip is not supposed to be ignored
    NET: for my $net (keys %auto_dl) {
        my $dl   = $auto_dl{$net}{'dl'};
        my $mask = $auto_dl{$net}{'mask'};  ### may be a /32 (single IP)

        next NET unless $dl == 0;  ### only care about the ignored IPs/nets

        if ($block_net->within($auto_dl_ip_objs{$net})) {
            die "[*] $fw_block_ip overlaps with whitelisted ",
                "$net/$mask in $config{'AUTO_DL_FILE'}";
        }
    }

    if (-e $config{'PSAD_PID_FILE'}) {
        if ($config{'ENABLE_AUTO_IDS'} ne 'Y') {
            die "[*] ENABLE_AUTO_IDS is not set to 'Y', exiting.";
        }
        if (&is_running($config{'PSAD_PID_FILE'})) {
            print "[+] Writing $fw_block_ip to socket; psad will add the IP\n",
                "    within $config{'CHECK_INTERVAL'} seconds.\n";

            ### open domain socket with running psad process
            my $sock = IO::Socket::UNIX->new($config{'AUTO_IPT_SOCK'})
                or die "[*] Could not acquire $config{'AUTO_IPT_SOCK'} ",
                "socket: $!";
            print $sock "add $fw_block_ip\n";
            close $sock;
        } else {
            print "[-] There is no running psad process. Exiting.\n";
        }
    } else {
        print "[-] There is no running psad process. Exiting.\n";
    }
    return $EXIT_SUCCESS;
}

sub sockwrite_rm_ipt_block_ip() {

    die "[*] --fw-rm-block-ip takes an IP/subnet as an argument."
        unless $fw_rm_block_ip =~ /$ipv4_re/;

    my $rm_block_ip   = '';
    my $rm_block_mask = '';
    my $rm_block_net  = '';

    if ($fw_rm_block_ip =~ m|^\s*($ipv4_re)\s*$|) {
        $rm_block_ip   = $1;
        $rm_block_mask = '32';
        $rm_block_net = new NetAddr::IP($1);
    } elsif ($fw_rm_block_ip =~ m|^\s*($ipv4_re)/($ipv4_re)\s*$|) {
        $rm_block_ip   = $1;
        $rm_block_mask = $2;
        $rm_block_net = new NetAddr::IP($1, $2);
    } elsif ($fw_rm_block_ip =~ m|^\s*($ipv4_re)/(\d+)\s*$|) {
        $rm_block_ip   = $1;
        $rm_block_mask = $2;
        $rm_block_net = new NetAddr::IP($1, $2);
    } else {
        die "[*] Badly formatted rm block IP: $fw_rm_block_ip";
    }

    if ($rm_block_net->masklen() != '32') {
        ### a subnet was given on the command line, so make
        ### sure we were also given a network address (iptables
        ### converts to the network address in -nL output)
        $fw_rm_block_ip = $rm_block_net->network()->cidr();
    }

    if (-e $config{'PSAD_PID_FILE'}) {
        if ($config{'ENABLE_AUTO_IDS'} ne 'Y') {
            die "[*] ENABLE_AUTO_IDS is not set to 'Y', exiting.";
        }
        if (&is_running($config{'PSAD_PID_FILE'})) {
            print "[+] Writing $fw_rm_block_ip to socket; psad will remove the IP\n",
                "    within $config{'CHECK_INTERVAL'} seconds.\n";

            ### open domain socket with running psad process
            my $sock = IO::Socket::UNIX->new($config{'AUTO_IPT_SOCK'})
                or die "[*] Could not acquire $config{'AUTO_IPT_SOCK'} ",
                "socket: $!";
            print $sock "del $fw_rm_block_ip\n";
            close $sock;
            return $EXIT_SUCCESS;
        }
    }
    return $EXIT_SUCCESS;
}

sub tcpwr_test_block() {
    my $ip = shift;
    open T, "< $config{'ETC_HOSTS_DENY_FILE'}" or die "[*] Could not open ",
        "$config{'ETC_HOSTS_DENY_FILE'}: $!";
    my @lines = <T>;
    close T;
    for my $line (@lines) {
        chomp $line;
        return 1 if $line =~ /ALL:\s+$ip$/;
    }
    return 0;
}

sub tcpwr_block() {
    my $ip = shift;
    open T, ">> $config{'ETC_HOSTS_DENY_FILE'}" or die "[*] Could not open ",
        "$config{'ETC_HOSTS_DENY_FILE'}: $!";
    print T "ALL: $ip\n";
    close T;
    return;
}

sub tcpwr_rm_block() {
    my $ip = shift;
    my $rv = 0;
    open T, "< $config{'ETC_HOSTS_DENY_FILE'}" or die '[*] Could not open ',
        "$config{'ETC_HOSTS_DENY_FILE'}: $!";
    my @lines = <T>;
    close T;

    my $orig_perms = (stat($config{'ETC_HOSTS_DENY_FILE'}))[2] & 07777;

    open T, "> $config{'ETC_HOSTS_DENY_FILE'}.tmp" or die '[*] Could not open ',
        "$config{'ETC_HOSTS_DENY_FILE'}.tmp: $!";
    for my $line (@lines) {
        chomp $line;
        if ($line =~ /ALL:\s+$ip$/) {
            &diskwrite_rm_blocked_ip($ip, $config{'AUTO_BLOCK_TCPWR_FILE'});
            if ($config{'ENABLE_AUTO_IDS_EMAILS'} eq 'Y'
                    and defined $scan_dl{$ip}
                    and $scan_dl{$ip} >= $config{'EMAIL_ALERT_DANGER_LEVEL'}) {
                &send_mail("$config{'MAIL_STATUS_PREFIX'} removed " .
                    "tcpwrappers block against $ip (timeout expired).", '',
                    $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});
            }
            $rv = 1;
        } else {
            print T "$line\n";
        }
    }
    close T;

    ### set permissions on the tmp file to be identical to the original
    chmod $orig_perms, "$config{'ETC_HOSTS_DENY_FILE'}.tmp";

    move "$config{'ETC_HOSTS_DENY_FILE'}.tmp", $config{'ETC_HOSTS_DENY_FILE'}
        or die "[*] Could not move $config{'ETC_HOSTS_DENY_FILE'}.tmp -> ",
        "$config{'ETC_HOSTS_DENY_FILE'}";

    ### delete the ip from the hash (if new packets are seen
    ### from the same ip, then the hash will be updated again
    ### in check_scan()).
    delete $auto_blocked_ips{$ip}
        if defined $auto_blocked_ips{$ip};
    return $rv;
}

sub auto_psad_response() {
    my ($curr_scan_hr, $auto_block_regex_match_hr) = @_;

    print STDERR "[+] auto_psad_response()\n" if $debug;

    SRC: for my $src (keys %$curr_scan_hr) {

        ### make sure we are not attempting to block 0.0.0.0
        ### or 127.0.0.1 or any of the local interface IP's.
        next SRC if &auto_block_ignore_ip($src);

        if ($config{'ENABLE_AUTO_IDS_REGEX'} eq 'Y'
                and $config{'AUTO_BLOCK_REGEX'} ne 'NONE') {
            ### skip if AUTO_BLOCK_REGEX did not match --log-prefix
            unless (defined $auto_block_regex_match_hr->{$src}) {
                print STDERR "[+] Skipping IP from auto-block, ",
                    "AUTO_BLOCK_REGEX $config{'AUTO_BLOCK_REGEX'} ",
                    "did not match.\n" if $debug;
                next SRC;
            }
        }

        my $dl = $scan_dl{$src};

        ### We only want to block the IP once.  Currently this will block
        ### all traffic from the host to _all_ destinations that are
        ### protected by the firewall if the IP trips the $auto_psad_level
        ### threshold for _any_ destination.
        if ($dl >= $config{'AUTO_IDS_DANGER_LEVEL'}) {

            next SRC if defined $auto_blocked_ips{$src};

            my ($timeout, $timeout_str) = &get_block_timeout($dl);

            ### we have seen at least one packet logged by the firewall
            ### at this point
            if ($config{'IPTABLES_BLOCK_METHOD'} eq 'Y') {
                &ipt_block($src, '');
            }
            if ($config{'TCPWRAPPERS_BLOCK_METHOD'} eq 'Y') {
                &sys_log('initiating tcpwrappers auto-block ' .
                    "against $src $timeout_str");
                if ($config{'ENABLE_AUTO_IDS_EMAILS'} eq 'Y'
                        and defined $scan_dl{$src}
                        and $scan_dl{$src} >= $config{'EMAIL_ALERT_DANGER_LEVEL'}) {
                    &send_mail("$config{'MAIL_STATUS_PREFIX'} " .
                        "tcpwrappers AUTO-BLOCK against $src $timeout_str",
                        '', $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});
                }
                my $found = 0;
                open H, "< $config{'ETC_HOSTS_DENY_FILE'}" or die
                    "[*] Could not open $config{'ETC_HOSTS_DENY_FILE'}: $!";
                my @lines = <H>;
                close H;
                for my $line (@lines) {
                    chomp $line;
                    $found = 1 if $line =~ /ALL:\s+$src$/;
                }
                unless ($found) {
                    open H, ">> $config{'ETC_HOSTS_DENY_FILE'}" or die
                        "[*] Could not open $config{'ETC_HOSTS_DENY_FILE'}: $!";
                    print H "ALL: $src\n";
                    close H;
                    $auto_blocked_ips{$src} = time()
                        unless defined $auto_blocked_ips{$src};
                    ### write the ip out to the auto blocked file
                    &diskwrite_blocked_ip($src,
                        $config{'AUTO_BLOCK_TCPWR_FILE'}, '');
                }
            }
        }
    }
    return;
}

sub auto_block_ignore_ip() {
    my $ip = shift;
    for my $local_ip (keys %local_ips) {
        if ($ip eq $local_ip) {
            print STDERR "[+] Skipping local IP $ip from auto-block.\n"
                if $debug;
            return 1;
        }
    }
    ### matching the following two addresses is less likely (assuming
    ### iptables is not logging traffic from localhost) than matching
    ### a legitimate interface address
    if ($ip eq '127.0.0.1' or $ip eq '0.0.0.0' or $ip eq '0.0.0.0/0') {
        print STDERR "[+] Skipping IP $ip from auto-block.\n"
            if $debug;
        return 1;
    }
    return 0;
}

sub get_block_timeout() {
    my $dl = shift;

    my $timeout = $config{'AUTO_BLOCK_DL1_TIMEOUT'};
    if ($dl == 2) {
        $timeout = $config{'AUTO_BLOCK_DL2_TIMEOUT'};
    } elsif ($dl == 3) {
        $timeout = $config{'AUTO_BLOCK_DL3_TIMEOUT'};
    } elsif ($dl == 4) {
        $timeout = $config{'AUTO_BLOCK_DL4_TIMEOUT'};
    } elsif ($dl == 5) {
        $timeout = $config{'AUTO_BLOCK_DL5_TIMEOUT'};
    }

    my $timeout_str = "for $timeout seconds";
    $timeout_str = '(unlimited timeout)' if $timeout == $PERMANENT;

    print STDERR "[+] get_block_timeout() dl: $dl, $timeout, $timeout_str\n"
        if $debug;

    return ($timeout, $timeout_str);
}

sub timeout_auto_blocked_ips() {

    print STDERR "[+] timeout_auto_block_ips()\n" if $debug or $test_mode;

    for my $ip (keys %auto_blocked_ips) {
        my ($timeout, $timeout_str) = &get_block_timeout($scan_dl{$ip});
        next if $timeout == $PERMANENT;

        if ((time() - $auto_blocked_ips{$ip}) > $timeout) {

            ### remove all Netfiler blocking rules for $ip
            if ($config{'IPTABLES_BLOCK_METHOD'} eq 'Y') {
                &ipt_rm_block($ip);
            }

            ### remove all tcpwrapper blocking rules for $ip
            if ($config{'TCPWRAPPERS_BLOCK_METHOD'} eq 'Y') {
                &tcpwr_rm_block($ip);
            }
        }
    }
    return;
}

sub build_ipt_config() {

    @ipt_config = ();

    &make_psad_dirs() unless -d $config{'PSAD_DIR'};

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

    my $ctr = 1;

    VAR: while (defined $config{"IPT_AUTO_CHAIN$ctr"}) {
        my $value = $config{"IPT_AUTO_CHAIN$ctr"};

        my @block = split /\s*,\s*/, $value;
        if ($#block == 4 or $#block == 6) {
            my %hsh = ();
            if ($#block == 4) {
                ### DROP, src, filter, INPUT, PSAD_BLOCK_INPUT;
                %hsh = (
                    'target'     => $block[0],
                    'direction'  => $block[1],
                    'table'      => $block[2],
                    'from_chain' => $block[3],
                    'to_chain'   => $block[4],
                    'jump_rule_position' => 1,
                    'auto_rule_position' => 1
                );
                ### this is the old format; generate a warning
                my $msg = "the IPT_AUTO_CHAIN$ctr variable in psad.conf " .
                    "needs to be updated to set the jump rule position and " .
                    "the auto rule position; defaulting both to 1.";
                    &sys_log($msg);
                    print STDERR "[-] build_ipt_config(): $msg\n"
                        if $debug;
            } else {
                ### DROP, src, filter, INPUT, 1, PSAD_BLOCK_INPUT, 1;
                %hsh = (
                    'target'     => $block[0],
                    'direction'  => $block[1],
                    'table'      => $block[2],
                    'from_chain' => $block[3],
                    'jump_rule_position' => $block[4],
                    'to_chain'   => $block[5],
                    'auto_rule_position' => $block[6]
                );
            }
            unless ($hsh{'direction'} eq 'src' or
                        $hsh{'direction'} eq 'dst' or
                        $hsh{'direction'} eq 'both') {
                my $msg = "invalid direction $hsh{'direction'} " .
                    "in IPT_AUTO_CHAIN$ctr keyword";
                &sys_log($msg);
                print STDERR "[-] build_ipt_config(): $msg\n"
                    if $debug;
                next VAR;
            }
            if ($hsh{'from_chain'} eq $hsh{'to_chain'}) {
                my $msg = "cannot have identical from_chain and to_chain " .
                    "in IPT_AUTO_CHAIN$ctr keyword";
                &sys_log($msg);
                print STDERR "[-] build_ipt_config(): $msg\n"
                    if $debug;
                next VAR;
            }
            my ($rv, $out_ar, $err_ar)
                = $ipt->chain_exists($hsh{'table'}, $hsh{'from_chain'});

            if ($rv) {
                push @ipt_config, \%hsh;
            } else {
                my $msg = "invalid IPT_AUTO_CHAIN$ctr keyword, " .
                    "$hsh{'from_chain'} chain does not exist.";
                &sys_log($msg);
                print STDERR "[-] build_ipt_config(): $msg\n"
                    if $debug;
            }
        } else {
            my $msg = "invalid IPT_AUTO_CHAIN$ctr variable: $value";
            &sys_log($msg);
            print STDERR "[-] build_ipt_config(): $msg\n" if $debug;
        }
        $ctr++;
    }
    return;
}

### this is the main caching function that adds an IP upon a
### successful block.
sub diskwrite_blocked_ip() {
    my ($src, $file, $renewed_status) = @_;
    print STDERR "[+] diskwrite_blocked_ip($src, $file, $renewed_status)\n"
        if $debug;
    my @lines = ();
    my $skip_src = 0;
    if (-e $file) {
        open F, "< $file" or die "[*] Could not open ",
            "$file: $!";
        my @tmplines = <F>;
        close F;
        ### see if we have already written the ip to the block
        ### file (or update the time if $renewed_status)
        for my $line (@tmplines) {
            chomp $line;
            if ($line =~ /^\s*($ipv4_re)\s*$/) {  ### old format; update to include time
                my $tmpsrc = $1;
                push @lines, "$tmpsrc " . $auto_blocked_ips{$tmpsrc};
                $skip_src = 1 if $tmpsrc eq $src;
            } else {
                if ($renewed_status) {  ### must update the time to now
                    if ($line =~ m|^\s*$src\s|) {
                        push @lines, "$src " . $auto_blocked_ips{$src};
                        $skip_src = 1;
                    } else {
                        push @lines, $line;
                    }
                } else {
                    if ($line =~ m|^\s*$src\s+\d+|) {
                        return;  ### already blocked $src, do nothing
                    } else {
                        push @lines, $line;
                    }
                }
            }
        }
    }
    unless ($skip_src) {
        push @lines, "$src " . $auto_blocked_ips{$src};
    }

    return unless @lines;
    open B, "> ${file}.tmp" or
        die "[*] Could not write to $file: $!";
    print B $_, "\n" for @lines;
    close B;
    move "${file}.tmp", $file or die "[*] Could not move ",
        "${file}.tmp -> $file: $!";
    return;
}

### this gets called when we want to remove an IP from the disk
### cache
sub diskwrite_rm_blocked_ip() {
    my ($src, $file) = @_;
    print STDERR "[+] rm_blocked_ip($src, $file)\n" if $debug;
    return unless -e $file;

    open B, "< $file" or
        die "[*] Could not open $file: $!";
    my @lines = <B>;
    close B;

    return unless @lines;

    open W, "> ${file}.tmp" or
        die "[*] Could not open ${file}.tmp: $!";
    for my $line (@lines) {
        chomp $line;
        if ($line =~ /^\s*($ipv4_re)/) {
            print W $line, "\n" unless $src eq $1;
        }
    }
    close W;

    move "${file}.tmp", $file or die "[*] Could not move ",
        "${file}.tmp -> $file: $!";
    return;
}

sub email_limit_reached() {
    my ($src, $dst) = @_;
    my $subject = "$config{'MAIL_STATUS_PREFIX'} reached email message " .
        "limit for $src on $config{'HOSTNAME'}";
    $subject .= " ($dst)" if $dst;
    &send_mail($subject, '', $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});

    if ($dst) {
        $scan_email_ctrs{$src}{$dst}{'stop_email'} = 1;
    } else {
        $scan_email_ctrs{$src}{'stop_email'} = 1;
    }
    return;
}

sub print_scan() {  ### this should primarily be used for debugging
    my $scanfile = "$config{'PRINT_SCAN_HASH'}.$$";
    open PSCAN, "> $scanfile" or warn '[-] Could not open ',
        "$scanfile: $!" and return;
    print PSCAN "[+] Passive OS fingerprinting hash:\n",
        Dumper(\%posf),
        "[+] Scan danger level hash:\n",
        Dumper(\%scan_dl),
        "[+] Main scan hash:\n",
        Dumper(\%scan);
    close PSCAN;
    chmod 0600, $scanfile;
    return;
}

sub get_local_ips() {
    print STDERR "[+] get_local_ips()\n" if $debug;
    if ($config{'IFCFGTYPE'} =~ /iproute2/i) {
        print STDERR "[+] : Using IFCFGTYPE iproute2\n" if $debug;
        my @ips = @{&run_command($cmds{'ip'}, 'addr')};
        return unless @ips;
        for my $line (@ips) {
            if ($line =~ /inet\s+($ipv4_re)\/\d+\s/) {
                print STDERR "[+] : Adding $1 to local_ips\n" if $debug;
                $local_ips{$1} = '';
            } elsif ($line =~ /inet6\s(\S+)/) {
                print STDERR "[+] : Adding $1 to local_ips\n" if $debug;
                $local_ips{$1} = '';
            }
        }
    } else {
        print STDERR "[+] : Using IFCFGTYPE ifconfig\n" if $debug;
        my @ips = @{&run_command($cmds{'ifconfig'}, '-a')};
        return unless @ips;
        for my $line (@ips) {
            if ($line =~ /inet\s+.*?:($ipv4_re)\s/) {
                print STDERR "[+] : Adding $1 to local_ips\n" if $debug;
                $local_ips{$1} = '';
            } elsif ($line =~ /inet6\s+addr:\s+(\S+)/) {
                print STDERR "[+] : Adding $1 to local_ips\n" if $debug;
                $local_ips{$1} = '';
            }
        }
    }
    return;
}

sub get_listening_ports() {
    %local_ports = ();
    my @lines = @{&run_command($cmds{'netstat'}, '-an 2> /dev/null')};
    return unless @lines;
    for my $line (@lines) {
        next unless $line;
        chomp $line;
        if ($line =~ m/^\s*(tcp|udp)\s+\d+\s+\d+\s+\S+:(\d+)\s/) {
            ### $1 == protocol (tcp/udp), $2 == port number
            $local_ports{$1}{$2} = '';
        }
    }
    return;
}

sub get_dns_info() {
    my $ip = shift;
    my $dns_str = '';
    if (defined $dns_cache{$ip}
            and $dns_cache{$ip}{'ctr'}
            < $config{'DNS_LOOKUP_THRESHOLD'}) {
        $dns_str = $dns_cache{$ip}{'hostname'};
        $dns_cache{$ip}{'ctr'}++;
    } else {
        my $ipaddr = gethostbyname($ip);
        ### gethostbyaddr($ipaddr, AF_INET);
        if (defined $ipaddr) {
            my $dns_tmp = gethostbyaddr($ipaddr, 2);
            $dns_str = $dns_tmp if $dns_tmp;
            $dns_cache{$ip}{'ctr'}      = 0;
            $dns_cache{$ip}{'hostname'} = $dns_str;
        }
    }
    return $dns_str;
}

sub get_whois_info() {
    my ($ip, $whois_datafile) = @_;

    print STDERR "[+] get_whois_info() IP: $ip\n" if $debug;

    my @whois_data;
    if (defined $whois_cache{$ip}
            and $whois_cache{$ip} < $config{'WHOIS_LOOKUP_THRESHOLD'}
            and -e $whois_datafile) {
        $whois_cache{$ip}++;
    } else {
        $whois_cache{$ip} = 0;

        my $pid;

        local $SIG {'ALRM'} = sub {kill 15, $pid or die "[*] kill: $!";
            die "whois alarm"};
        eval {
            $pid = fork();

            die "Could not fork(): $!" unless defined $pid;

            unless ($pid) {

                ### perl invokes the shell because of the output
                ### redirect
                exec "$cmds{'whois'} $ip > $whois_datafile";

                die "whois $ip exec failed: $!";
            }
            alarm $config{'WHOIS_TIMEOUT'};

            waitpid $pid => 0;

            alarm 0;
        };

        if ($@) {
            system "$cmds{'killall'} $cmds{'whois'}";
            kill 9, $pid unless kill 15, $pid;
            print STDERR "[-] whois alarm on pid: $pid\n" if $debug;
            warn $@;
            $#whois_data = 0;
            @whois_data = ("Whois data not available!\n");
            unlink $whois_datafile;
            return \@whois_data;
        }
    }
    open W, "< $whois_datafile" or
        die "[*] Could not open $whois_datafile: $!";
    @whois_data = <W>;
    close W;

    if ($config{'ENABLE_WHOIS_FORCE_ASCII'} eq 'Y') {
        for my $line (@whois_data) {
            ### replace any non-ascii chars in whois output with 'NA'
            $line =~ s/[^\x20-\x7e]/NA/g;
        }
    }

    return \@whois_data;
}

sub stop_psad() {
    my $rv = $EXIT_SUCCESS;

    &sys_log('shutting down psad daemons');
    ### must kill psadwatchd first since if not, it might try to restart
    ### any of the other two daemons.
    for my $pidname (qw(psadwatchd kmsgsd psad psad_fw_read)) {
        my $pidfile = $pidfiles{$pidname};
        if (-e $pidfile) {
            my $pid = &is_running($pidfile);
            if ($pid) {
                print "[+] Stopping $pidname, pid: $pid\n";
                unless (kill 15, $pid) {
                    unless (kill 9, $pid) {
                        print "[*] psad: Could not kill ",
                            "$pidname, pid: $pid $!\n";
                        $rv = $EXIT_FAILURE;
                    }
                } else {
                    unlink $pidfile;
                }
            } else {
                my $print = 1;
                if ($pidname eq 'kmsgsd'
                        and ($config{'SYSLOG_DAEMON'} =~ /ulog/i
                        or $config{'ENABLE_SYSLOG_FILE'} eq 'Y')) {
                    $print = 0;
                }
                print "[-] psad: $pidname is not running on ",
                    "$config{'HOSTNAME'}\n" if $print;
            }
        } else {
            my $print = 1;
            if ($pidname eq 'kmsgsd'
                    and ($config{'SYSLOG_DAEMON'} =~ /ulog/i
                    or $config{'ENABLE_SYSLOG_FILE'} eq 'Y')) {
                $print = 0;
            }
            print "[-] psad: pid file $pidfile does not exist for ",
                "$pidname on $config{'HOSTNAME'}\n" if $print;
        }
    }
    return $rv;
}

sub restart() {
    my $cmdline = '';
    if (-e $cmdline_file) {
        open CMD, "< $cmdline_file" or die '[*] Could not open ',
            "$cmdline_file: $!";
        $cmdline = <CMD>;
        close CMD;
        chomp $cmdline;
    }

    ### stop any running psad daemons.
    &stop_psad();

    print "[+] Restarting psad daemons on $config{'HOSTNAME'}\n";
    if ($cmdline) {
        system "$cmds{'psad'} $cmdline";
    } else {
        system $cmds{'psad'};
    }
    return $EXIT_SUCCESS;
}

sub analysis_mode() {

    ($analysis_tokens_ar, $analysis_match_criteria_ar) = &analysis_fields()
        if $analysis_fields;

    &make_psad_dirs();

    unless (-d $config{'PSAD_DIR'}) {
        mkdir $config{'PSAD_DIR'} or die "[*] Could not mkdir ",
            "$config{'PSAD_DIR'}: $!";
    }

    if (-d $config{'ANALYSIS_MODE_DIR'}) {
        print "[+] Removing old $config{'ANALYSIS_MODE_DIR'} directory.\n";
        rmtree $config{'ANALYSIS_MODE_DIR'} or die "[*] Could not ",
            "remove $config{'ANALYSIS_MODE_DIR'}\n";
    }

    mkdir $config{'ANALYSIS_MODE_DIR'} or die "[*] Could not mkdir ",
        $config{'ANALYSIS_MODE_DIR'};

    ### change path for counter files, etc.
    for my $var (keys %config) {
        next if $var eq 'PSAD_DIR';
        next if $var eq 'ANALYSIS_MODE_DIR';
        next if $var eq 'ANALYSIS_OUTPUT_FILE';
        my $val = $config{$var};
        if ($val =~ m|$config{'PSAD_DIR'}/|) {
            $val =~ s|$config{'PSAD_DIR'}|$config{'ANALYSIS_MODE_DIR'}|;
            $config{$var} = $val;
        }
    }
    &make_psad_dirs();  ### one more time now that paths are updated

    ### setup to put all <ip> files in the ANALYSIS_MODE_DIR
    ### (by setting PSAD_DIR to ANALYSIS_MODE_DIR subroutines
    ### work more easily).
    $config{'PSAD_DIR'} = $config{'ANALYSIS_MODE_DIR'};

    ### build @local_nets array
    my $connected_subnets_ar = &get_connected_subnets();
    for my $net (@$connected_subnets_ar) {
        push @local_nets, $net;
    }

    my $fh = '';
    if ($pkts_from_stdin) {
        print "[+] Entering analysis mode.  Parsing STDIN\n";
        $fh = *STDIN;
    } else {
        print "[+] Entering analysis mode.  Parsing $fw_data_file\n";
        open MSGS, "< $fw_data_file" or die "[*] Could not open ",
            "$fw_data_file: $!";
        $fh = *MSGS;
    }
    my @ipt_msgs = ();
    my $pkt_ctr = 0;
    my $line_ctr = 0;
    PKT: while (<$fh>) {
        my $line = $_;
        $line_ctr++;
        if ($num_packets > 0) {
            last PKT if $pkt_ctr >= $num_packets;
        }
        if ($line =~ /IN.*OUT/) {
            if ($config{'FW_SEARCH_ALL'} eq 'Y') {
                push @ipt_msgs, $line;
                $pkt_ctr++;
            } else {
                if ($line =~ /$config{'SNORT_SID_STR'}/) {
                    push @ipt_msgs, $line;
                    $pkt_ctr++;
                } else {
                    for my $fw_search_str (@fw_search) {
                        if ($line =~ /$fw_search_str/) {
                            push @ipt_msgs, $line;
                            $pkt_ctr++;
                        }
                    }
                }
            }
        }
    }
    close $fh unless $pkts_from_stdin;

    print "[+] Found ", ($#ipt_msgs+1), " iptables log messages out of " .
        "$line_ctr total lines.\n";
    print "    This may take a while...\n" if $#ipt_msgs > 15000;

    ### analyze all packets
    &check_scan(\@ipt_msgs);

    print "\n[+] Finished --Analyze cycle.\n";

    return $EXIT_SUCCESS;
}

sub ipt_match_criteria() {
    my ($pkt_hr, $tokens_ar, $match_criteria_ar) = @_;

    my @matched_fields = ();
    my $gnuplot_comment_str = '';
    for (my $i=0; $i <= $#$tokens_ar; $i++) {
        my $tok = $tokens_ar->[$i];
        if ($match_criteria_ar) {
            my $match_hr = $match_criteria_ar->[$i];
            if (defined $match_hr->{'num'}) {
                return [], '' unless $pkt_hr->{$tok} =~ m|^\d+$|;
                if ($match_hr->{'negate'}) {
                    return [], '' if $pkt_hr->{$tok} == $match_hr->{'num'};
                } else {
                    return [], '' unless $pkt_hr->{$tok} == $match_hr->{'num'};
                }
            } elsif (defined $match_hr->{'gt'}) {
                return [], '' unless $pkt_hr->{$tok} =~ m|^\d+$|;
                if ($match_hr->{'negate'}) {
                    return [], '' unless $pkt_hr->{$tok} <= $match_hr->{'gt'};
                } else {
                    return [], '' unless $pkt_hr->{$tok} > $match_hr->{'gt'};
                }
            } elsif (defined $match_hr->{'lt'}) {
                return [], '' unless $pkt_hr->{$tok} =~ m|^\d+$|;
                if ($match_hr->{'negate'}) {
                    return [], '' unless $pkt_hr->{$tok} >= $match_hr->{'lt'};
                } else {
                    return [], '' unless $pkt_hr->{$tok} < $match_hr->{'lt'};
                }
            } elsif (defined $match_hr->{'str'}) {
                if ($match_hr->{'negate'}) {
                    return [], '' if $pkt_hr->{$tok} eq $match_hr->{'str'};
                } else {
                    return [], '' unless $pkt_hr->{$tok} eq $match_hr->{'str'};
                }
            } elsif (defined $match_hr->{'re'}) {
                if ($match_hr->{'negate'}) {
                    return [], '' if $pkt_hr->{$tok} =~ m|$match_hr->{'re'}|;
                } else {
                    return [], '' unless $pkt_hr->{$tok} =~ m|$match_hr->{'re'}|;
                }
            } elsif (defined $match_hr->{'net'} or defined $match_hr->{'ip'}) {
                my $net_or_ip_key = 'ip_obj';
                $net_or_ip_key = 'net_obj' if defined $match_hr->{'net'};
                if ($pkt_hr->{$tok} =~ m|$ipv4_re|
                        or $pkt_hr->{$tok} =~ m|$ipv6_re|) {
                    my $ip_match_obj = '';
                    if ($tok eq 'src') {
                        $ip_match_obj = $pkt_hr->{'s_obj'};
                    } elsif ($tok eq 'dst') {
                        $ip_match_obj = $pkt_hr->{'d_obj'};
                    }
                    if ($match_hr->{'negate'}) {
                        return [], '' if $ip_match_obj->within($match_hr->{$net_or_ip_key});
                    } else {
                        return [], '' unless $ip_match_obj->within($match_hr->{$net_or_ip_key});
                    }
                } else {
                    return [], '';
                }
            }
        }
        push @matched_fields, $pkt_hr->{$tok};
    }
    return \@matched_fields, $gnuplot_comment_str;
}

sub csv_mode() {

    if ($gnuplot_file_prefix) {
        $gnuplot_data_file = "$gnuplot_file_prefix.dat";
        $gnuplot_plot_file = "$gnuplot_file_prefix.gnu";
        $gnuplot_png_file  = "$gnuplot_file_prefix.png";
    }

    print "[+] Entering Gnuplot mode...\n" if $gnuplot_mode;

    ### see what we should be parsing out of the iptables logs
    my ($tokens_ar, $match_criteria_ar) = &csv_tokens();

    $csv_regex = qr/$csv_regex/ if $csv_regex;
    $csv_neg_regex = qr/$csv_neg_regex/ if $csv_neg_regex;

    my %csv_uniq_lines = ();

    if ($csv_start_line) {
        die "[*] Cannot have start line > end line."
            if $csv_start_line > $csv_end_line;
    }

    my $fh = '';
    if ($csv_stdin) {
        print "[+] Parsing iptables log messages from STDIN\n"
            if $gnuplot_mode;
        $fh = *STDIN;
    } else {
        print "[+] Parsing iptables log messages from file: $fw_data_file\n"
            if $gnuplot_mode;
        open MSGS, "< $fw_data_file" or die "[*] Could not open ",
            "$fw_data_file: $!";
        $fh = *MSGS;
    }
    my $ctr = 0;
    my $line_ctr = 0;

    if ($gnuplot_mode and $store_file and -e $store_file) {

        @gnuplot_data = @{retrieve($store_file)};

    } else {

        MSG: while (<$fh>) {
            my $pkt_str = $_;
            $line_ctr++;
            if ($csv_start_line) {
                next MSG unless $line_ctr >= $csv_start_line;
            }
            if ($csv_end_line) {
                last MSG if $line_ctr == $csv_end_line;
            }
            next MSG unless $pkt_str =~ /IN.*OUT/;
            my %pkt = %pkt_NF_init;
            if ($config{'FW_SEARCH_ALL'} eq 'Y') {
                my $rv = &parse_NF_pkt_str(\%pkt, $pkt_str);
                next MSG if $rv == $PKT_ERROR or $rv == $PKT_IGNORE;
            } else {
                if ($pkt_str =~ /$config{'SNORT_SID_STR'}/) {
                    my $rv = &parse_NF_pkt_str(\%pkt, $pkt_str);
                    next MSG if $rv == $PKT_ERROR or $rv == $PKT_IGNORE;
                } else {
                    for my $fw_search_str (@fw_search) {
                        if ($pkt_str =~ /$fw_search_str/) {
                            my $rv = &parse_NF_pkt_str(\%pkt, $pkt_str);
                            next MSG if $rv == $PKT_ERROR or $rv == $PKT_IGNORE;
                        }
                    }
                }
            }
            if ($csv_regex) {
                next MSG unless $pkt{'raw'} =~ m|$csv_regex|;
            }
            if ($csv_neg_regex) {
                next MSG unless $pkt{'raw'} !~ m|$csv_neg_regex|;
            }
            $pkt{'log_prefix'} =~ s/\W//g;
            $pkt{'log_prefix'} =~ s/\s//g;

            my ($matched_fields_ar, $gnuplot_comment_str)
                    = &ipt_match_criteria(\%pkt, $tokens_ar, $match_criteria_ar);

            next MSG unless $#$matched_fields_ar > -1;

            $ctr++;
            if ($csv_line_limit > 0) {
                last if $ctr >= $csv_line_limit;
            }

            if ($gnuplot_mode) {
                ### cache the data since IP addresses have to mapped to
                ### integers across the entire data set
                push @gnuplot_data, $matched_fields_ar;
            } else {

                my $str = '';

                ### here is where the output string is assembled
                $str .= $_ . $plot_separator for @$matched_fields_ar;
                $str =~ s/$plot_separator$//;

                if ($csv_print_uniq) {
                    $csv_uniq_lines{$str} = '';
                } else {
                    ### The CSV data is printed here unless
                    ### we are running with --CSV-unique-lines
                    ### or we are running in --gnuplot mode
                    print $str, "\n";
                }
            }
        }
        close $fh unless $csv_stdin;
    }

    if ($gnuplot_mode) {

        if ($store_file) {
            if (-e $store_file) {
                print "[+] Retrieved Gnuplot array from: $store_file\n";
            } else {
                ### store the @gnuplot_data array to disk for fast
                ### retrieval next time
                print "[+] Storing Gnuplot data to: $store_file\n";
                store(\@gnuplot_data, $store_file);
                chmod 0644, $store_file;
            }
        } else {
            print "[+] Parsed $line_ctr iptables log messages.\n";
        }
        ### print out the gnuplot data after appropriate
        ### integer conversions
        &gnuplot_write_data($tokens_ar);

        ### write out the gnuplot file
        &gnuplot_write_plot_file($tokens_ar);

    } elsif ($csv_print_uniq) {
        print "$_\n" for keys %csv_uniq_lines;
    }
    return $EXIT_SUCCESS;
}

sub gnuplot_header() {
    my @lines = ();
    push @lines, '#', '#'x$num_hash_marks, '#',
        "# Generated by psad v$version",
        "# Command line: 'psad @args_cp'",
        "# Time stamp:  " . localtime(),
        '#', '#'x$num_hash_marks, '#', '';
    return \@lines;
}

sub gnuplot_write_plot_file() {
    my $tokens_ar = shift;

    unless ($gnuplot_legend_title) {
        $gnuplot_legend_title = '(';
        for my $tok (@$tokens_ar) {
            $gnuplot_legend_title .= "$tok,";
        }
        $gnuplot_legend_title =~ s/,$//;
        $gnuplot_legend_title .= ')';
        $gnuplot_legend_title  =~ s/_//g;
    }

    my @tokens = split /\s+/, $csv_fields;
    if ($gnuplot_template_file) {
        print "[+] Using Gnuplot template file: $gnuplot_template_file\n";
        copy $gnuplot_template_file, $gnuplot_plot_file or die "[*] ",
            "Could not copy $gnuplot_template_file -> $gnuplot_plot_file: $!";
    } else {
        print "[+] Writing gnuplot directive file: $gnuplot_plot_file\n";
        open GP, "> $gnuplot_plot_file" or die "[*] Could not open ",
            "$gnuplot_plot_file: $!";
        print GP "$_\n", for @{&gnuplot_header()};
        unless ($gnuplot_title) {
            $gnuplot_title = "psad iptables log visualization: $csv_fields";
            $gnuplot_title =~ s/_//g;  ### some fonts used by Gnuplot don't like "-" chars
        }
        print GP "reset\n", qq|set title "$gnuplot_title"\n|;
        unless ($gnuplot_interactive) {
            if ($gnuplot_grayscale) {
                print GP "set terminal png transparent xffffff x000000 x606060 ",
                    "x606060 x606060 x606060 x606060 x606060 nocrop enhanced\n",
                    qq|set output "$gnuplot_png_file"\n|;
            } else {
                print GP "set terminal png transparent nocrop enhanced\n",
                    qq|set output "$gnuplot_png_file"\n|;
            }
        }
        if ($tokens_ar->[0] eq 'timestamp') {
            print GP "set xdata time\n",
                qq|set timefmt x "%s"\n|,
                qq|set format x "%m/%d"\n|,
                qq|set xlabel "time"\n|;
            if ($gnuplot_x_range) {
                die "[*] range argument must be formatted as <start>:<end>"
                    unless $gnuplot_x_range =~ /^\S+:\S+$/;
                $gnuplot_x_range =~ s/:/":"/;
                print GP qq|set xrange ["$gnuplot_x_range"]\n|;
            }
        } else {
            if ($gnuplot_x_label) {
                print GP qq|set xlabel "$gnuplot_x_label"\n|;
            } else {
                $tokens[0] =~ s/_//g;
                print GP qq|set xlabel "$tokens[0]"\n|;
            }
            if ($gnuplot_x_range) {
                die "[*] range argument must be formatted as <start>:<end>, ",
                    "e.g. 1:10" unless $gnuplot_x_range =~ /^\d+:\d+$/;
                print GP qq|set xrange [$gnuplot_x_range]\n|;
            }
        }
        if ($gnuplot_y_label) {
            print GP qq|set ylabel "$gnuplot_y_label"\n|;
        } else {
            $tokens[1] =~ s/_//g;
            print GP qq|set ylabel "$tokens[1]"\n|;
        }
        if ($gnuplot_y_range) {
                die "[*] range argument must be formatted as <start>:<end>, e.g. 1:10"
                unless $gnuplot_y_range =~ /^\d+:\d+$/;
            print GP qq|set yrange [$gnuplot_y_range]\n|;
        }
        if ($#$tokens_ar == 2 or $gnuplot_3d) {
            ### include zaxis
            if ($gnuplot_z_label) {
                print GP qq|set zlabel "$gnuplot_z_label"\n|;
            } else {
                if ($gnuplot_count_type) {
                    print GP qq|set zlabel "$gnuplot_count_type"\n|;
                } else {
                    $tokens[2] =~ s/_//g;
                    print GP qq|set zlabel "$tokens[2]"\n|;
                }
            }
            if ($gnuplot_z_range) {
                die "[*] range argument must be formatted as <start>:<end>, ",
                    "e.g. 1:10" unless $gnuplot_z_range =~ /^\d+:\d+$/;
                print GP qq|set zrange [$gnuplot_z_range]\n|;
            }
            unless ($gnuplot_graph_style) {
                $gnuplot_graph_style = 'points';
            }
            if ($gnuplot_view) {
                die "[*] View must be a coordinate pair such as 60,30"
                    unless $gnuplot_view =~ /^\d+,\d+/;
                print GP qq|set view $gnuplot_view\n|;
            }
            print GP qq|splot '$gnuplot_data_file' using 1:2:3 with | .
                "$gnuplot_graph_style title '$gnuplot_legend_title'\n";
        } else {
            unless ($gnuplot_graph_style) {
                $gnuplot_graph_style = 'linespoints';
            }
            print GP qq|plot '$gnuplot_data_file' using 1:2 with | .
                "$gnuplot_graph_style title '$gnuplot_legend_title'\n";
        }
        close GP;
    }
    chmod 0644, $gnuplot_plot_file;
    return;
}

sub gnuplot_write_data() {
    my $tokens_ar = shift;

    ### see how many years we need to go back
    &gnuplot_set_start_year($tokens_ar);

    ### resolve any IP addresses to minimal integers
    ### (this mapping preserves IP address subnet relationships
    ### in that IP's on the same subnet will appear close together
    ### in the plot).
    for my $aref (@gnuplot_data) {
        for (my $i=0; $i <= $#$tokens_ar; $i++) {
            my $tok = $tokens_ar->[$i];
            if ($tok eq 'src' or $tok eq 'dst') {

                ### add the IP into the ip2int cache
                &ip2int($aref->[$i]);
            }
        }
    }

    ### now that all IP addresses have been mapped into the cache
    ### we map each IP to a mimimal integer
    my $ip_ctr = 1;
    for my $ip (sort {$ip2int_cache{$a} <=> $ip2int_cache{$b}}
                keys %ip2int_cache) {
        unless (defined $gnuplot_ip2int{$ip}) {
            $gnuplot_ip2int{$ip} = $ip_ctr;
            $ip_ctr++;
        }
    }

    ### check to see if we are generating data counts instead of
    ### values (for example number of packets to ports instead
    ### of just the port values themselves)
    my @gnuplot_count_data = ();

    print "[+] Writing parsed iptables data to: $gnuplot_data_file\n";
    open GP, "> $gnuplot_data_file" or die "[*] Could not open ",
        "$gnuplot_data_file: $!";
    print GP "$_\n", for @{&gnuplot_header()};

    ### write gnuplot data out to stdout
    for my $aref (@gnuplot_data) {

        my @matched_fields = ();
        my $gnuplot_comment_str = '';
        for (my $i=0; $i <= $#$tokens_ar; $i++) {
            my $tok = $tokens_ar->[$i];
            my $val = $aref->[$i];

            my ($rv, $gnuplot_comment) = &gnuplot_value($tok, $val);
            push @matched_fields, $rv;
            $gnuplot_comment_str .= "$rv=$gnuplot_comment "
                if $gnuplot_comment;
        }
        next unless @matched_fields;

        if ($gnuplot_count_type) {
            push @matched_fields, $gnuplot_comment_str;
            push @gnuplot_count_data, \@matched_fields;
        } else {
            my $str = '';
            $str .= $_ . $plot_separator for @matched_fields;
            $str =~ s/$plot_separator$//;
            $str .= "  ### $gnuplot_comment_str" if $gnuplot_comment_str;
            print GP $str, "\n";
        }
    }

    if ($gnuplot_count_type) {
        &render_count_data(\@gnuplot_count_data, $tokens_ar, *GP);
    }
    close GP;
    chmod 0644, $gnuplot_data_file;
    return;
}

sub render_count_data() {
    my ($count_data_ar, $tokens_ar, $render_fh) = @_;

    my %render_count_data = ();
    my %render_comments   = ();
    my $start_time = '';
    my $end_time = '';
    my $time_interval_incr = 0;

    if ($gnuplot_count_type eq 'countday'
            or $gnuplot_count_type eq 'counthour'
            or $gnuplot_count_type eq 'countmin'
            or $gnuplot_count_type eq 'countdayuniq'
            or $gnuplot_count_type eq 'counthouruniq'
            or $gnuplot_count_type eq 'countminuniq') {

        $start_time = $count_data_ar->[0]->[0];
        $end_time   = $count_data_ar->[$#$count_data_ar]->[0];

        if ($gnuplot_count_type eq 'countday') {
            $time_interval_incr = 60 * 60 * 24;
            $gnuplot_count_type = 'count';
        } elsif ($gnuplot_count_type eq 'counthour') {
            $time_interval_incr = 60 * 60;
            $gnuplot_count_type = 'count';
        } elsif ($gnuplot_count_type eq 'countmin') {
            $time_interval_incr = 60;
            $gnuplot_count_type = 'count';
        } elsif ($gnuplot_count_type eq 'countdayuniq') {
            $time_interval_incr = 60 * 60 * 24;
            $gnuplot_count_type = 'countuniq';
        } elsif ($gnuplot_count_type eq 'counthouruniq') {
            $time_interval_incr = 60 * 60;
            $gnuplot_count_type = 'countuniq';
        } elsif ($gnuplot_count_type eq 'countminuniq') {
            $time_interval_incr = 60;
            $gnuplot_count_type = 'countuniq';
        }

    }

    for my $aref (@$count_data_ar) {
        my $x_axis = $aref->[0];
        my $y_axis = $aref->[1];
        my $z_axis = '';

        if ($time_interval_incr) {
            ($x_axis, $start_time) = &gnuplot_time_to_interval($x_axis, $start_time,
                $end_time, $time_interval_incr);
        }

        if ($gnuplot_count_type eq 'count') {

            if ($gnuplot_count_element == 1) {

                if ($gnuplot_3d) {
                    if ($#$aref == 2) {
                        $render_comments{$x_axis}{$y_axis} = $aref->[2];
                    }
                    $render_count_data{$x_axis}{$y_axis}++;
                } else {
                    if ($#$aref == 2) {
                        $render_comments{$x_axis} = $aref->[2];
                    }
                    $render_count_data{$x_axis}++;
                }

            } elsif ($gnuplot_count_element == 2) {

                $z_axis = $aref->[2];
                if ($#$aref == 3) {
                    $render_comments{$x_axis}{$y_axis} = $aref->[3];
                }
### FIXME
                $render_count_data{$x_axis}{$y_axis}{$z_axis}++;

            }

        } elsif ($gnuplot_count_type eq 'countuniq') {

            if ($gnuplot_count_element == 1) {

                if ($gnuplot_3d) {
                    if ($#$aref == 2) {
                        $render_comments{$x_axis}{$y_axis} = $aref->[2];
                    }
                    unless (defined $gnuplot_cache_uniq{$x_axis}) {
                        $render_count_data{$x_axis}{$y_axis}++;
                        $gnuplot_cache_uniq{$x_axis}{$y_axis} = '';
                    }
                    unless (defined $gnuplot_cache_uniq{$x_axis}{$y_axis}) {
                        $render_count_data{$x_axis}{$y_axis}++;
                        $gnuplot_cache_uniq{$x_axis}{$y_axis} = '';
                    }

                } else {
                    if ($#$aref == 2) {
                        $render_comments{$x_axis} = $aref->[2];
                    }

                    unless (defined $gnuplot_cache_uniq{$x_axis}) {
                        $render_count_data{$x_axis}++;
                        $gnuplot_cache_uniq{$x_axis}{$y_axis} = '';
                    }
                    unless (defined $gnuplot_cache_uniq{$x_axis}{$y_axis}) {
                        $render_count_data{$x_axis}++;
                        $gnuplot_cache_uniq{$x_axis}{$y_axis} = '';
                    }
                }

            } elsif ($gnuplot_count_element == 2) {

                $z_axis = $aref->[2];
                if ($#$aref == 3) {
                    $render_comments{$x_axis}{$y_axis} = $aref->[3];
                }

                unless (defined $gnuplot_cache_uniq{$x_axis}) {
                    $render_count_data{$x_axis}{$y_axis}++;
                    $gnuplot_cache_uniq{$x_axis}{$y_axis}{$z_axis} = '';
                }
                unless (defined $gnuplot_cache_uniq{$x_axis}{$y_axis}) {
                    $render_count_data{$x_axis}{$y_axis}++;
                    $gnuplot_cache_uniq{$x_axis}{$y_axis}{$z_axis} = '';
                }
                unless (defined $gnuplot_cache_uniq{$x_axis}{$y_axis}{$z_axis}) {
                    $render_count_data{$x_axis}{$y_axis}++;
                    $gnuplot_cache_uniq{$x_axis}{$y_axis}{$z_axis} = '';
                }

            }
        }
    }

    ### print the data to the .dat file now that it has been counted
    if ($gnuplot_count_type eq 'count') {

        if ($gnuplot_count_element == 1) {
            if ($gnuplot_3d) {

                &gnuplot_print_count_3d_data(\%render_count_data,
                    \%render_comments, $render_fh);

            } else {

                &gnuplot_print_count_2d_data(\%render_count_data,
                    \%render_comments, $render_fh);

            }
        } elsif ($gnuplot_count_element == 2) {
            for my $x_axis (sort {$a <=> $b} keys %render_count_data) {
                for my $y_axis (sort keys %{$render_count_data{$x_axis}}) {
                    for my $key (keys %{$render_count_data{$x_axis}{$y_axis}}) {
                        my $z_axis = $render_count_data{$x_axis}{$y_axis}{$key};
                        if (defined $render_comments{$x_axis}
                                and defined $render_comments{$x_axis}{$y_axis}) {
                            print $render_fh $x_axis . $plot_separator . $y_axis .
                                $plot_separator. $z_axis .
                                "  ### $render_comments{$x_axis}{$y_axis}", "\n";
                        } else {
                            print $render_fh $x_axis . $plot_separator .
                                $y_axis . $plot_separator . $z_axis, "\n";
                        }
                    }
                }
            }
        }

    } elsif ($gnuplot_count_type eq 'countuniq') {

        if ($gnuplot_count_element == 1) {

            if ($gnuplot_3d) {

                &gnuplot_print_count_3d_data(\%render_count_data,
                    \%render_comments, $render_fh);

            } else {

                &gnuplot_print_count_2d_data(\%render_count_data,
                    \%render_comments, $render_fh);

            }
        } elsif ($gnuplot_count_element == 2) {

            &gnuplot_print_count_3d_data(\%render_count_data,
                \%render_comments, $render_fh);

        }

    }

    return;
}

sub gnuplot_time_to_interval() {
    my ($time, $start_time, $end_time, $time_interval_incr) = @_;
    my $mapped_time = $time;

    if ($time <= $start_time) {
        $mapped_time = $start_time;
    } elsif ($time >= $end_time) {
        $mapped_time = $end_time;
    } else {
        while ($start_time < $time - $time_interval_incr) {
            $start_time += $time_interval_incr;
        }
        $mapped_time = $start_time;
    }

    return ($mapped_time, $start_time);
}

sub gnuplot_print_count_3d_data() {
    my ($data_hr, $comments_hr, $render_fh) = @_;

    for my $x_axis (sort {$a <=> $b}
                keys %$data_hr) {
        for my $y_axis (sort keys %{$data_hr->{$x_axis}}) {
            my $z_axis = $data_hr->{$x_axis}->{$y_axis};
            if (defined $comments_hr->{$x_axis} and
                    defined $comments_hr->{$x_axis}{$y_axis}) {
                print $render_fh $x_axis . $plot_separator .
                    $y_axis . $plot_separator . $z_axis .
                    "  ### $comments_hr->{$x_axis}->{$y_axis}",
                    "\n";
            } else {
                print $render_fh $x_axis . $plot_separator .
                    $y_axis . $plot_separator . $z_axis, "\n";
            }
        }
    }
    return;
}

sub gnuplot_print_count_2d_data() {
    my ($data_hr, $comments_hr, $render_fh) = @_;

    if ($gnuplot_sort_style eq 'time') {
        for my $x_axis (sort {$a <=> $b}
                    keys %$data_hr) {
            my $y_axis = $data_hr->{$x_axis};
            if (defined $comments_hr->{$x_axis}) {
                print $render_fh $x_axis . $plot_separator . $y_axis .
                    "  ### $comments_hr->{$x_axis}", "\n";
            } else {
                print $render_fh $x_axis . $plot_separator .
                    $y_axis, "\n";
            }
        }
    } elsif ($gnuplot_sort_style eq 'value') {
        for my $x_axis (sort {$data_hr->{$b} <=> $data_hr->{$a}}
                    keys %$data_hr) {
            my $y_axis = $data_hr->{$x_axis};
            if (defined $comments_hr->{$x_axis}) {
                print $render_fh $x_axis . $plot_separator . $y_axis .
                    "  ### $comments_hr->{$x_axis}", "\n";
            } else {
                print $render_fh $x_axis . $plot_separator .
                    $y_axis, "\n";
            }
        }
    } else {
        for my $x_axis (keys %$data_hr) {
            my $y_axis = $data_hr->{$x_axis};
            if (defined $comments_hr->{$x_axis}) {
                print $render_fh $x_axis . $plot_separator . $y_axis .
                    "  ### $comments_hr->{$x_axis}", "\n";
            } else {
                print $render_fh $x_axis . $plot_separator .
                    $y_axis, "\n";
            }
        }
    }
    return;
}

sub gnuplot_set_start_year() {
    my $tokens_ar = shift;

    return unless $csv_have_timestamp;

    my $timestamp_field = -1;
    for (my $i=0; $i <= $#$tokens_ar; $i++) {
        if ($tokens_ar->[$i] eq 'timestamp') {
            $timestamp_field = $i;
            last;
        }
    }
    ### calculate the starting year by looking at the most recent
    ### event and working backwards
    die unless $timestamp_field > -1;

    my ($today_year, $today_mon, $today_day) = Today();
    $gnuplot_year = $today_year;
    my $prev_month = 0;
    for (my $i=$#gnuplot_data; $i >= 0; $i--) {
        if ($gnuplot_data[$i]->[$timestamp_field] =~ /^\s*(\w+)\s+(\d+)\s+(\S+)/) {
            my $m_tmp = $1;  ### kludge for Decode_Month() call
            my $mon  = Decode_Month($m_tmp);
            my $day  = $2;
            my $time = $3;
            if ($gnuplot_year) {
                if ($prev_month < $mon) {
                    ### i.e., switched from Jan to Dec as we go backwards
                    ### in the log (but there could be a hole like Jan to
                    ### Oct as well, the key is that the new mon is less
                    ### than the previous one)
                    $gnuplot_year--;
                }
                $prev_month = $mon;
            } else {
                $prev_month = $mon;
                if ($today_mon < $mon) {
                    $gnuplot_year = $today_year - 1;
                } else {
                    $gnuplot_year = $today_year;
                }
            }
        }
    }
    return;
}

sub gnuplot_value() {
    my ($tok, $packet_val) = @_;

    my $rv = $packet_val;
    my $gnuplot_comment_str = '';

    if ($tok eq 'timestamp') {

        ### reformat timestamp (e.g. "Feb  1 00:00:27"
        ### becomes 02/02/04:03:00:17)
        if ($packet_val =~ /^\s*(\w+)\s+(\d+)\s+(\S+)/) {
            my $m_tmp = $1;  ### kludge for Decode_Month() call
            my $mon  = Decode_Month($m_tmp);
            my $day  = $2;
            my $time = $3;
            my $hour = 0;
            my $min  = 0;
            my $sec  = 0;
            if ($time =~ /(\d{2}):(\d{2}):(\d{2})/) {
                $hour = $1;
                $min  = $2;
                $sec  = $3;
            }
            $gnuplot_prev_mon = $mon unless $gnuplot_prev_mon;
            if ($mon < $gnuplot_prev_mon) {
                $gnuplot_year++;
            }
            $gnuplot_prev_mon = $mon;
            $rv = Mktime($gnuplot_year, $mon, $day, $hour, $min, $sec);
            $gnuplot_comment_str = $packet_val;
        }

    } else {

        ### see if this field is non-digit data, and map
        ### to a digit if so
        if (defined $gnuplot_non_digit_packet_fields{$tok}) {

            ### it is a non-digit value from the packet, so append a comment
            ### to the gnuplot data file that contains that original value.
            ### This allows the user to map integers back to their original
            ### value (say IP integers back to the dotted-quad notation).
            $gnuplot_comment_str = $packet_val;

            if ($gnuplot_non_digit_packet_fields{$tok} eq 'ip2int') {

                ### get the minimal IP integer from the %gnuplot_ip2int cache
                $rv = $gnuplot_ip2int{$packet_val};

            } elsif ($gnuplot_non_digit_packet_fields{$tok} eq 'proto2int') {

                ### convert protocol to integer
                $rv = &proto2int($packet_val);

            } elsif ($gnuplot_non_digit_packet_fields{$tok} eq 'intf2int') {

                ### convert interface to integer
                $rv = &intf2int($packet_val);

            } elsif ($gnuplot_non_digit_packet_fields{$tok} eq 'hashentry') {

                ### map the value to a digit
                unless (defined $gnuplot_non_digit_map{$tok}
                        and defined $gnuplot_non_digit_map{$tok}{'data'}
                        and defined $gnuplot_non_digit_map{$tok}
                        {'data'}{$packet_val}) {

                    unless (defined $gnuplot_non_digit_map{$tok}{'ctr'}) {
                       $gnuplot_non_digit_map{$tok}{'ctr'} = 0;
                    }

                    $gnuplot_non_digit_map{$tok}{'ctr'}++;

                    $gnuplot_non_digit_map{$tok}{'data'}{$packet_val}
                        = $gnuplot_non_digit_map{$tok}{'ctr'};
                }
                $rv = $gnuplot_non_digit_map{$tok}{'data'}{$packet_val};
            }
        }
    }
    return $rv, $gnuplot_comment_str;
}

sub ip2int() {
    my $ip = shift;
    my $ip_int = 0;
    unless (defined $ip2int_cache{$ip}) {
        # my @octets = split /\./, $ip;
        for (split /\./, $ip) {
            $ip_int = $ip_int*256 + $_;
        }
        $ip2int_cache{$ip} = $ip_int;
    }
    return;
}

sub proto2int() {
    my $proto = shift;
    my $rv = -1;
    if ($proto =~ /^\d+$/) {
        $rv = $proto;
    } elsif ($proto =~ /tcp/i) {
        $rv = 6;
    } elsif ($proto =~ /udp/i) {
        $rv = 17;
    } elsif ($proto =~ /icmp/i) {
        $rv = 1;
    }
    return $rv;
}

sub intf2int() {
    my $intf = shift;
    my $rv = -1;
    if ($intf =~ /(\d+)$/) {
        $rv = $1;
    }
    return $rv;
}

sub analysis_fields() {
    $csv_fields = $analysis_fields;
    return &csv_tokens();
}

sub csv_tokens() {

    my @tokens = ();
    my @match_criteria = ();

    if ($csv_fields) {
        my @tok_tmp = split /\s+/, $csv_fields;
        for my $tok_str (@tok_tmp) {
            my $token  = $tok_str;
            my $search = '';
            my $negate = 0;
            if ($tok_str =~ m|(\w+):(\S+)|) {
                $token  = $1;
                $search = $2;
            } else {
                if ($analysis_fields) {
                    die "[*] $tok_str requires a search criteria in -A mode.";
                }
            }
            $search =~ s/\,$//;
            if ($token eq 'timestamp') {
                $csv_have_timestamp = 1;
            }
            if ($search =~ /^not/) {
                $negate = 1;
                $search =~ s/^not//;
            }

            for my $count_type (qw/countabs countuniq
                    countday counthouruniq countminuniq countdayuniq
                    counthour countmin countday count/) {

                if ($search =~ /,$count_type$/ or $search =~ /^$count_type/) {

                    $search =~ s/,$count_type$//;
                    $search =~ s/^$count_type//;

                    die "[*] Counts against multiple fields are not supported."
                        if $gnuplot_count_type;

                    $gnuplot_count_type = $count_type;
                    $gnuplot_count_element = $#tokens + 1;

                    if ($count_type eq 'countday'
                            or $count_type eq 'counthour'
                            or $count_type eq 'countmin'
                            or $count_type eq 'countdayuniq'
                            or $count_type eq 'counthouruniq'
                            or $count_type eq 'countminuniq') {

                        $gnuplot_sort_style = 'time';
                        die "[*] The first search field must be 'timestamp' ",
                            "for time-based counts" if $#tokens == -1;
                        die "[*] The first search field must be 'timestamp' ",
                            "for time-based counts"
                            unless $tokens[0] eq 'timestamp';
                    }
                }
            }

            $token = 'src'   if $token eq 'SRC';
            $token = 'dst'   if $token eq 'DST';
            $token = 'sp'    if $token eq 'SPT';
            $token = 'dp'    if $token eq 'DPT';
            $token = 'proto' if $token eq 'PROTO';
            $token = 'tos'   if $token eq 'TOS';
            $token = 'win'   if $token eq 'WIN';
            $token = 'itype' if $token eq 'TYPE';
            $token = 'icode' if $token eq 'CODE';
            $token = 'ttl'   if $token eq 'TTL';
            $token = 'ip_id' if $token eq 'ID';
            $token = 'icmp_seq' if $token eq 'SEQ';
            $token = 'ip_len'   if $token eq 'LEN';
            $token = 'intf'     if $token eq 'IN' or $token eq 'OUT';
            unless (defined $pkt_NF_init{$token}) {
                print "[*] $token is not a valid packet field; valid ",
                    "fields are:\n";
                for my $key (sort keys %pkt_NF_init) {
                    print "    $key\n";
                }
                die;
            }
            push @tokens, $token;

            if ($search) {
                my %search_hsh = ('negate' => $negate);
                if ($search =~ m|^\d+$|) {
                    $search_hsh{'num'} = $search;
                } elsif ($search =~ m|^>(\d+)$|) {
                    $search_hsh{'gt'} = $1;
                    die "[*] $token value must be >= 0"
                        unless $1 >= 0;
                } elsif ($search =~ m|^<(\d+)$|) {
                    $search_hsh{'lt'} = $1;
                    die "[*] $token value must be >= 0"
                        unless $1 >= 0;
                } elsif ($search =~ m|^/(.*?)/$|) {
                    $search_hsh{'re'} = qr|$1|;
                } elsif ($search =~ m|^'(.*?)'$|) {
                    $search_hsh{'str'} = $1;
                } elsif ($search =~ m|^$ipv4_re/$ipv4_re$|) {
                    $search_hsh{'net'} = $search;
                    $search_hsh{'net_obj'} = new NetAddr::IP($search)
                        or die "[*] NetAddr::IP($search) error";
                } elsif ($search =~ m|^$ipv4_re/\d+$|) {
                    $search_hsh{'net'} = $search;
                    $search_hsh{'net_obj'} = new NetAddr::IP($search)
                        or die "[*] NetAddr::IP($search) error";
                } elsif ($search =~ m|^$ipv4_re$|) {
                    $search_hsh{'ip'} = $search;
                    $search_hsh{'ip_obj'} = new NetAddr::IP($search)
                        or die "[*] NetAddr::IP($search) error";
                } elsif ($search =~ m|\:|) {
                    ### see if this is an IPv6 address
                    if ($search =~ m|\/|) {
                        $search_hsh{'net'} = $search;
                        $search_hsh{'net_obj'} = new6 NetAddr::IP($search)
                            or die "[*] NetAddr::IP($search) error";
                    } else {
                        $search_hsh{'net'} = $search;
                        $search_hsh{'net_obj'} = new6 NetAddr::IP($search)
                            or die "[*] NetAddr::IP($search) error";
                    }
                } else {
                    die "[*] Unrecognized value for $token";
                }
                push @match_criteria, \%search_hsh;
            } else {
                push @match_criteria, {};
            }
        }
    } else {
        @tokens = (qw(
            timestamp
            src
            dst
            sp
            dp
            proto
            flags
            ip_len
            intf
            chain
            log_prefix
        ));
    }

    return \@tokens, \@match_criteria;
}

sub benchmark_mode() {

    my @fw_packets = ();

    print scalar localtime(), " [+] Entering benchmark mode.\n";

    if ($num_packets) {
        print scalar localtime(),
            " [+] Executing a $num_packets packet test.\n";
    } else {
        if ($fw_data_file) {
            print scalar localtime(), ' [+] The --packets command line ',
                "option was not specified.\n";
            print scalar localtime(),
                " [+] Defaulting to read the entire $fw_data_file file.\n";
        } else {
            print scalar localtime(), ' [+] The --packets command line ',
                "option was not specified.\n";
            print scalar localtime(),
                " [+] Defaulting to a 10,000 packet test.\n";
            $num_packets = 10000;
        }
    }

    ### initialize benchmarking test packets if we are running
    ### in benchmark mode
    if ($fw_data_file) {
        if ($num_packets) {
            print scalar localtime(), " [+] Creating $num_packets packet ",
                "array from $fw_data_file\n";
        } else {
            print scalar localtime(), " [+] Creating packet ",
                "array from complete $fw_data_file\n";
        }
        my $ctr = 0;
        open F, "< $fw_data_file" or die "[*] Could not open $fw_data_file: $!";
        while (<F>) {
            chomp;
            push @fw_packets, $_;
            $ctr++;
            last if $num_packets > 0 and $ctr >= $num_packets;
        }
        close F;
    } else {
        ### FIXME better random packet data tests, add IP and TCP options, etc.
        my $test_pkt = 'Feb 15 16:42:58 orthanc kernel: DROP IN=eth0 ' .
            'OUT= MAC=00:a0:cc:28:42:5a:00:03:6c:00:98:54:08:00 ' .
            'SRC=192.168.10.2 DST=192.168.10.1 LEN=48 TOS=0x00 PREC=0x00 ' .
            'TTL=110 ID=13383 DF PROTO=TCP SPT=1389 ';
        my $test_pktend = 'WINDOW=16384 RES=0x00 SYN URGP=0';

        print scalar localtime(), " [+] Creating packet array.\n";
        my $dp = 1000;
        for (my $i=0; $i <= $num_packets; $i++) {
            push @fw_packets, "$test_pkt DPT=$dp $test_pktend";
            $dp++ if $dp < 50000;
        }
    }

    my $b_time = time();
    print scalar localtime(), " [+] check_scan()\n" if $benchmark;
    &check_scan(\@fw_packets);

    print scalar localtime(), " [+] Packet creation and processing time: ",
        time() - $b_time, " sec.\n";
    print scalar localtime(), " [+] Exiting benchmark mode.\n";
    return $EXIT_SUCCESS;
}

sub fw_analyze_mode() {
    my $run_fw_check = 0;

    if ($fw_analyze) {
        $run_fw_check = 1;
    } else {
        ### if psad is running on a syslog server, do not check the firewall
        ### rules since they may not be local.  Also, do not check the
        ### firewall if psad is configured to parse all iptables messages.
        unless ($no_fwcheck or $syslog_server
                or $config{'ENABLE_FW_LOGGING_CHECK'} eq 'N') {
            $run_fw_check = 1;
        }
    }

    my $exit_status = $EXIT_SUCCESS;
    if ($run_fw_check) {
        my $opts = "-c $config_file ";
        $opts .= " --fw-analyze" if $fw_analyze;
        $opts .= " --fw-file $fw_file" if $fw_file;
        $opts .= " -L $lib_dir" if $lib_dir;
        $opts .= " --test-mode" if $test_mode;
        $opts .= " -O $override_config_str" if $override_config_str;
        $opts .= " --no-fw-search-all" if $config{'FW_SEARCH_ALL'} eq 'N';
        $exit_status = (system "$cmds{'fwcheck_psad'} $opts") >> 8;
    }
    return $exit_status;
}

### display the status of all four psad daemons
sub status() {

    my $rv = $EXIT_SUCCESS;

    for my $pidname (qw(psadwatchd kmsgsd psad_fw_read psad)) {
        my $pidfile = $pidfiles{$pidname};
        if (-e $pidfile) {
            my $pid = &is_running($pidfile);
            if ($pid) {
                print "[+] $pidname (pid: $pid)";
                ### FIXME: should probably just parse /proc instead of
                ### using ps
                my @ps_out = @{&run_command($cmds{'ps'}, 'auxww')};
                PS: for my $line (@ps_out) {
                    chomp $line;
                    if ($line =~ /^\S+\s+$pid\s+(\S+)\s+(\S+)/) {
                        print "  %CPU: $1  %MEM: $2\n";
                        print "    Running since: " .
                            localtime((stat($pidfile))[9]) . "\n";
                        ### print individual ip info
                        &status_psad_daemon() if $pidname eq 'psad';
                    }
                }
                print "\n";
            } else {
                my $print = 1;
                if ($pidname eq 'kmsgsd'
                        and ($config{'SYSLOG_DAEMON'} =~ /ulog/i
                        or $config{'ENABLE_SYSLOG_FILE'} eq 'Y')) {
                    $print = 0;
                }
                print "[-] psad: $pidname is not running on ",
                    "$config{'HOSTNAME'}\n" if $print;
                $rv = $EXIT_FAILURE;
            }
        } else {
            my $print = 1;
            if ($pidname eq 'kmsgsd'
                    and ($config{'SYSLOG_DAEMON'} =~ /ulog/i
                    or $config{'ENABLE_SYSLOG_FILE'} eq 'Y')) {
                $print = 0;
            }
            print "[-] psad: pid file $pidfile does not exist for ",
                "$pidname on $config{'HOSTNAME'}\n" if $print;
            if ($rv  eq 'psad') {
                $rv = $EXIT_FAILURE;
            }
        }
    }
    return $rv;
}

sub status_psad_daemon() {
    my $cmdline;

    ### get any command line args
    if (-e $cmdline_file) {
        open CMD, "< $cmdline_file" or die '[*] Could not open ',
            "$cmdline_file: $!";
        $cmdline = <CMD>;
        chomp $cmdline;
    }
    if ($cmdline) {
        print "    Command line arguments: $cmdline\n";
    } else {
        print "    Command line arguments: [none specified]\n";
    }
    print "    Alert email address(es): ",
        "$config{'EMAIL_ADDRESSES'}\n\n";

    ### build @local_nets array
    my $connected_subnets_ar = &get_connected_subnets();
    for my $net (@$connected_subnets_ar) {
        push @local_nets, $net;
    }

    ### import filesystem information in /var/log/psad/
    &import_filesystem_scan_data();

    ### print main status output to stdout
    &print_scan_status();

    return;
}

sub import_filesystem_scan_data() {

    ### import /var/log/psad/<ip> directories
    &import_ip_dirs();

    ### import global packet counters
    &import_packet_counters();

    ### import dshield stats
    &import_dshield_stats();

    ### import iptables prefix stats
    &import_ipt_prefixes();

    ### import top scanned ports
    &import_top_scanned_ports();

    ### import top signatures
    &import_top_sigs();

    ### import top attackers
    &import_top_attackers();

    return;
}

sub print_scan_status() {

    my @lines = ();
    push @lines, "[+] Version: psad v$version\n\n";

    ### print top signature matches
    push @lines, $_ for @{&print_top_sigs()};

    ### print top attackers
    push @lines, $_ for @{&print_top_attackers()};

    ### print top scanned ports
    push @lines, $_ for @{&print_top_scanned_ports()};

    ### print iptables prefixes
    push @lines, $_ for @{&print_ipt_prefixes()};

    ### print iptables prefixes
    unless ($analyze_mode) {
        push @lines, $_ for @{&print_dshield_stats()};

        ### print block status of IP addresses blocked by iptables
        if ($status_ip) {
            my $ar = &print_blocked_ip_status($status_ip);
            push @lines, $_ for @$ar;
        } else {
            my $ar = &print_blocked_ip_status('');
            push @lines, $_ for @$ar;
        }
    }

    ### print packet counters
    push @lines, $_ for @{&print_packet_counters()};

    return if $status_summary;

    push @lines, "[+] IP Status Detail:\n";

    my %uniq_srcs = ();
    my %uniq_dsts = ();

    my $printed = 0;
    for my $dl (qw/5 4 3 2 1/) {
        SRC: for my $src (sort keys %scan) {
            next SRC unless $scan_dl{$src} == $dl;
            my $dl = $scan_dl{$src};
            next SRC unless $dl >= $config{'MIN_DANGER_LEVEL'};
            if ($status_min_dl) {
                next unless $dl >= $status_min_dl;
            }
            $uniq_srcs{$src} = '';
            my $total_dsts = keys %{$scan{$src}};
            my $tot_pkts   = 0;
            my $uniq_sigs  = 0;
            my $tot_protocols = 0;
            for my $dst (keys %{$scan{$src}}) {
                if (defined $scan{$src}{$dst}{'tot_protocols'}) {
                    $tot_protocols += $scan{$src}{$dst}{'tot_protocols'};
                }
                next unless defined $scan{$src}{$dst}{'absnum'};
                $tot_pkts += $scan{$src}{$dst}{'absnum'};
            }
            for my $proto (keys %protocols) {
                for my $dst (keys %{$scan{$src}}) {
                    next unless defined $scan{$src}{$dst}{$proto}
                            and defined $scan{$src}{$dst}{$proto}{'sid'};
                    for my $sid (keys %{$scan{$src}{$dst}{$proto}{'sid'}}) {
                        $uniq_sigs++;
                    }
                }
            }

            ### source IP line
            my $src_str = "\nSRC:  $src, DL: $dl, Dsts: $total_dsts" .
                ", Pkts: $tot_pkts, Total protocols: $tot_protocols, " .
                "Unique sigs: $uniq_sigs";

            my $src_obj = new NetAddr::IP($src) or die "[*] NetAddr::IP($src) error";
            if ($src_obj->version() == 6) {
                $src_str = "\nSRC:  $src (" . $src_obj->short() .
                    "), DL: $dl, Dsts: $total_dsts" .
                    ", Pkts: $tot_pkts, Total protocols: $tot_protocols, " .
                    "Unique sigs: $uniq_sigs";
            }

            unless ($analyze_mode) {
                my $tot_alerts = 0;
                if ($config{'ENABLE_EMAIL_LIMIT_PER_DST'} eq 'Y') {
                    for my $dst (keys %{$scan{$src}}) {
                        $tot_alerts += $scan_email_ctrs{$src}{$dst}{'email_ctr'};
                    }
                } else {
                    $tot_alerts += $scan_email_ctrs{$src}{'email_ctr'};
                }
                $src_str .= ", Email alerts: $tot_alerts";
            }
            if (&is_local($src, $src_obj)) {
                $src_str .= ', Local IP';
            }
            $printed = 1;
            push @lines, "$src_str\n";
            if (defined $p0f{$src}) {
                push @lines, "    Source OS fingerprint(s):\n";
                for my $os (keys %{$p0f{$src}}) {
                    push @lines, "        $os\n";
                }
            } elsif (defined $posf{$src} and defined $posf{$src}{'guess'}) {
                push @lines, "    Source OS fingerprint:\n",
                    "        $posf{$src}{'guess'}\n";
            }
            next unless $total_dsts > 0;
            push @lines, "\n";

            DST: for my $dst (keys %{$scan{$src}}) {
                my $dst_str = "    DST: $dst";
                my $dst_obj = new NetAddr::IP($dst)
                    or die "[*] NetAddr::IP($dst) error";
                if ($dst_obj->version() == 6) {
                    $dst_str = "    DST: $dst (" . $dst_obj->short() . ')';
                }
                if (&is_local($dst, $dst_obj)) {
                    $dst_str .= ', Local IP';
                }
                push @lines, "$dst_str\n";
                $uniq_dsts{$dst} = '';

                if (defined $scan{$src}{$dst}{'chain'}) {
                    for my $chain (keys %{$scan{$src}{$dst}{'chain'}}) {
                        for my $intf (keys %{$scan{$src}{$dst}{'chain'}
                                    {$chain}}) {
                            my $tot_scanned_protocols = 0;
                            for my $proto (keys %{$scan{$src}{$dst}{'chain'}
                                        {$chain}{$intf}}) {
                                $tot_scanned_protocols++;
                                next unless $proto eq 'tcp' or $proto eq 'udp'
                                    or $proto eq 'udplite';
                                my $start_port = $scan{$src}{$dst}
                                        {$proto}{'abs_sp'};
                                my $end_port   = $scan{$src}{$dst}
                                        {$proto}{'abs_ep'};
                                my $ctr = $scan{$src}{$dst}{'chain'}{$chain}
                                        {$intf}{$proto};
                                if ($start_port == $end_port) {
                                    push @lines, "        Scanned ports: " .
                                        uc($proto) . " $start_port, Pkts: $ctr, " .
                                        "Chain: $chain, Intf: $intf\n";
                                } else {
                                    push @lines, "        Scanned ports: " .
                                        uc($proto) . " $start_port-$end_port, Pkts: " .
                                        "$ctr, Chain: $chain, Intf: $intf\n";
                                }
                            }
                            push @lines, "        Total scanned IP protocols: " .
                                "$tot_scanned_protocols, Chain: $chain, Intf: $intf\n";
                        }
                    }
                }

                ### signature matches
                for my $proto (keys %protocols) {
                    next unless defined $scan{$src}{$dst}{$proto}
                        and defined $scan{$src}{$dst}{$proto}{'sid'};

                    for my $sid (keys %{$scan{$src}{$dst}{$proto}{'sid'}}) {
                        my $msg = '[NA]';
                        if (defined $fwsnort_sigs{$sid}
                                    and defined $fwsnort_sigs{$sid}{'msg'}) {
                            $msg = $fwsnort_sigs{$sid}{'msg'};
                        } elsif (defined $sigs{$sid}
                                    and defined $sigs{$sid}{'msg'}) {
                            $msg = $sigs{$sid}{'msg'};
                        }

                        for my $chain (keys %{$scan{$src}{$dst}{$proto}
                                    {'sid'}{$sid}}) {

                            my $matches = $scan{$src}{$dst}{$proto}
                                {'sid'}{$sid}{$chain}{'pkts'};

                            my $sig_str = qq|        Signature match: "$msg"\n| .
                                "            " . uc($proto) .
                                ", Chain: $chain, Count: $matches";

                            if ($proto eq 'tcp' or $proto eq 'udp'
                                    or $proto eq 'udplite') {
                                my $dp = $scan{$src}{$dst}{$proto}
                                    {'sid'}{$sid}{$chain}{'dp'};
                                $sig_str .= ", DP: $dp";
                                if ($proto eq 'tcp') {
                                    my $flags = $scan{$src}{$dst}{$proto}
                                        {'sid'}{$sid}{$chain}{'flags'};
                                    $sig_str .= ", $flags";
                                }
                            }
                            $sig_str .= ", Sid: $sid";
                            push @lines, $sig_str, "\n";
                        }
                    }
                }

                ### icmp validation
                for my $proto ('icmp', 'icmp6') {
                    next unless defined $scan{$src}{$dst}{$proto};
                    if (defined $scan{$src}{$dst}{$proto}{'invalid_type'}) {
                        my $hr = $scan{$src}{$dst}{$proto}{'invalid_type'};
                        for my $type (keys %$hr) {
                            for my $chain (keys %{$hr->{$type}}) {
                                my $pkts = $hr->{$type}->{$chain}->{'pkts'};
                                push @lines, qq|        Invalid | . uc($proto) .
                                    qq| type: "$type" Chain: $chain, Packets: | .
                                    "$pkts\n";
                            }
                        }
                    }
                    if (defined $scan{$src}{$dst}{$proto}{'invalid_code'}) {
                        my $hr = $scan{$src}{$dst}{$proto}{'invalid_code'};
                        for my $type (keys %$hr) {
                            for my $code (keys %{$hr->{$type}}) {
                                for my $chain (keys %{$hr->{$type}->{$code}}) {
                                    my $pkts = $hr->{$type}->{$code}->{$chain}->{'pkts'};
                                    my $type_text = '';
                                    if ($proto eq 'icmp') {
                                        $type_text = $valid_icmp_types{$type}{'text'};
                                    } else {
                                        $type_text = $valid_icmp6_types{$type}{'text'};
                                    }
                                    push @lines, qq|        Invalid | . uc($proto) .
                                        qq| code: "$code" for | . uc($proto) .
                                        qq| "$type_text" packet | .
                                        qq|Chain: $chain, Packets: $pkts\n|;
                                }
                            }
                        }
                    }
                }
            }
        }
    }
    unless ($printed) {
        push @lines, "        [NONE]\n";
    }

    push @lines, "\n    Total scan sources: " . (keys %uniq_srcs) . "\n";
    push @lines, "    Total scan destinations: " . (keys %uniq_dsts) . "\n\n";

    my $out_file = $config{'STATUS_OUTPUT_FILE'};
    if ($analyze_mode) {
        $out_file = $config{'ANALYSIS_OUTPUT_FILE'};
    }

    open F, "> $out_file" or die "[*] Could not open $out_file: $!";
    for my $line (@lines) {
        print $line;
        print F $line;
    }
    close F;
    print "[+] These results are available in: $out_file\n";

    return;
}

sub print_blocked_ip_status() {
    my $specific_ip = shift;

    return unless -e $config{'AUTO_BLOCK_IPT_FILE'};

    unlink "$config{'AUTO_BLOCK_IPT_FILE'}.status"
        if -e "$config{'AUTO_BLOCK_IPT_FILE'}.status";

    copy $config{'AUTO_BLOCK_IPT_FILE'},
        "$config{'AUTO_BLOCK_IPT_FILE'}.status";

    open F, "< $config{'AUTO_BLOCK_IPT_FILE'}.status" or
        die "[*] $config{'AUTO_BLOCK_IPT_FILE'}.status: $!";
    my @lines = <F>;
    close F;

    unlink "$config{'AUTO_BLOCK_IPT_FILE'}.status";

    my @print_lines = ();
    if ($specific_ip) {
        push @print_lines,  "    iptables auto-blocking status for: $specific_ip: \n";
    } else {
        push @print_lines,  "    iptables auto-blocked IPs:\n";
    }

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

    my $found_line = 0;
    for my $line (@lines) {
        chomp $line;
        if ($line =~ /^\s*(\S+)/) {
            my $ip = $1;  ### this may be a subnet
            next unless $ip =~ /$ipv4_re/;
            if ($specific_ip) {
                next unless $ip eq $specific_ip;
            }
            my $timestamp = '';
            my $time_remain = 0;
            ### older versions do not have the timestamp
            if ($line =~ /^\s*\S+\s+(\d+)/) {
                $timestamp = $1;
                unless (defined $scan_dl{$ip}) {
                    ### set the DL here to the minimum currently required
                    $scan_dl{$ip} = $config{'AUTO_IDS_DANGER_LEVEL'};
                }
                my ($timeout, $timeout_str) = &get_block_timeout($scan_dl{$ip});
                if ($timeout > 0) {
                    $time_remain = $timeout - (time() - $timestamp);
                    $time_remain = 0 if $time_remain < 0;

                    push @print_lines,  "      $ip ($time_remain ",
                        "seconds remaining)\n";
                } else {
                    push @print_lines,  "      $ip (unlimited timeout)\n";
                }
            } else {
                push @print_lines,  "      $ip\n";
            }
            my $blocked = 0;
            for my $hr (@ipt_config) {
                if ($ipt->find_ip_rule(
                        $ip,
                        '0.0.0.0/0',
                        $hr->{'table'},
                        $hr->{'to_chain'},
                        $hr->{'target'})) {
                    $blocked = 1;
                    push @print_lines,  "            $hr->{'to_chain'}",
                        "($hr->{'target'})\n" if $verbose;
                }
            }
            $found_line = 1;

            if ($time_remain > 0) {
                ### we should see that the IP is still blocked
                unless ($blocked) {
                    push @print_lines,  '            [not currently blocked, sending ',
                        "cleanup message]\n";
                    system "$cmds{'psad'} --fw-rm-block-ip $ip";
                }
            } else {
                push @print_lines,  '            [expired timeout, sending ',
                    "cleanup message]\n";
                system "$cmds{'psad'} --fw-rm-block-ip $ip";
            }
        }
    }
    push @print_lines,  "        [NONE]\n"
        unless $found_line;
    push @print_lines,  "\n";
    return \@print_lines;
}

sub import_old_scans() {

    &import_filesystem_scan_data();

    &sys_log('imported ' . (keys %scan_dl) . ' scanning IP ' .
            'addresses from previous psad instance');
    return;
}

sub import_packet_counters() {
    return unless -e $config{'PACKET_COUNTER_FILE'};
    open F, "< $config{'PACKET_COUNTER_FILE'}" or
        die "[*] $config{'PACKET_COUNTER_FILE'}: $!";
    while (<F>) {
        if (/(\w+):\s+(\d+)/) {
            $proto_ctrs{$1} = $2;
        }
    }
    close F;
    return;
}

sub print_packet_counters() {
    my $str = "    Total protocol packet counters:\n";
    for my $proto (sort keys %protocols) {
        next unless defined $proto_ctrs{$proto};
        if (defined $protocol_strings{$proto}) {
            $str .= sprintf "%12s: %s\n", $protocol_strings{$proto}{'name'},
                "$proto_ctrs{$proto} pkts, ($protocol_strings{$proto}{'desc'})";
        } else {
            $str .= sprintf "%12s: %s\n", $proto, "$proto_ctrs{$proto} pkts";
        }
    }
    $str .= "\n";

    return [$str];
}

sub import_protocol_strings() {
    open F, "< $config{'PROTOCOLS_FILE'}" or die "[*] Could not ",
        "open $config{'PROTOCOLS_FILE'}: $!";
    while (<F>) {
        ### gre     47      GRE             # General Routing Encapsulation
        next if /^\s*#/;
        if (/^\s*(\S+)\s+(\d+)\s+\S+\s+#\s+(.*)/) {
            $protocol_strings{$2}{'name'} = $1;
            $protocol_strings{$2}{'desc'} = $3;
        }
    }
    close F;

    return;
}

sub import_dshield_stats() {
    if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
            and -e $config{'DSHIELD_COUNTER_FILE'}) {
        open DS, "< $config{'DSHIELD_COUNTER_FILE'}" or die "[*] Could not ",
            "open $config{'DSHIELD_COUNTER_FILE'}: $!";
        my @lines = <DS>;
        close DS;
        for my $line (@lines) {
            if ($line =~ /emails:\s+(\d+)/) {
                $dshield_email_ctr = $1;
            } elsif ($line =~ /packets:\s+(\d+)/) {
                $dshield_lines_ctr = $1;
            }
        }
    }
    return;
}

sub print_dshield_stats() {
    my @lines = ();
    if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
            and -e $config{'DSHIELD_COUNTER_FILE'}) {
        push @lines, "    DShield stats:\n";
        push @lines, "      total emails: $dshield_email_ctr\n";
        push @lines, "      total packets: $dshield_lines_ctr\n\n";
    }
    return \@lines;
}

sub import_ipt_prefixes() {
    if (-e $config{'IPT_PREFIX_COUNTER_FILE'}) {
        open F, "< $config{'IPT_PREFIX_COUNTER_FILE'}" or die "[*] Could not ",
            "open $config{'IPT_PREFIX_COUNTER_FILE'}: $!";
        while (<F>) {
            if (/^\s*(.*?):\s+(\d+)/) {
                my $prefix = $1;
                my $count  = $2;
                $ipt_prefixes{$prefix} = $count;
            }
        }
        close F;
    }
    return;
}

sub print_ipt_prefixes() {
    my @lines = ();
    push @lines, "[+] iptables log prefix counters:\n";
    if (%ipt_prefixes) {
        for my $prefix (keys %ipt_prefixes) {
            my $count = $ipt_prefixes{$prefix};
            push @lines, "      \"$prefix\": $count\n";
        }
    } else {
        push @lines, "        [NONE]\n";
    }
    push @lines, "\n";
    return \@lines;
}

sub import_ip_dirs() {

    opendir D, $config{'PSAD_DIR'} or
        die "[*] Could not open dir: $config{'PSAD_DIR'}: $!";
    my @files = readdir D;
    closedir D;

    my $import_ctr = 0;

    my $curr_pwd = getcwd();
    chdir $config{'PSAD_DIR'} or die $!;

    SRCIP: for my $src (@files) {
        next SRCIP unless ($src =~ /$ipv4_re/ and -d $src);
        ### define as many hash keys as we can (older versions
        ### of psad don't include several of these files).
        my $num_emails = 0;
        if (-e "${src}/danger_level") {
            open DL, "< ${src}/danger_level" or next SRCIP;
            my $dl = <DL>;
            close DL;
            chomp $dl;
            next SRCIP unless $dl >= 1;
            $scan_dl{$src} = $dl;  ### set the dl for $src
        }
        if (-e "${src}/os_guess") {
            open OS, "< ${src}/os_guess" or next SRCIP;
            my $os_guess = <OS>;
            close OS;
            chomp $os_guess;
            ### set the os guess for $src
            $posf{$src}{'guess'} = $os_guess;
        }
        if (-e "${src}/p0f_guess") {
            open OS, "< ${src}/p0f_guess" or next SRCIP;
            my @lines = <OS>;
            close OS;
            for my $line (@lines) {
                chomp $line;
                $p0f{$src}{$line} = '';
            }
        }
        opendir IPDIR, $src or next SRCIP;
        my @scan_files = readdir IPDIR;
        closedir IPDIR;

        ### get all of the destination ip addresses
        my %dst_ips;
        for my $scan_file (@scan_files) {
            next if $scan_file =~ /_whois/;  ### may be <src>_whois
            if ($scan_file =~ /($ipv4_re)/) {
                $dst_ips{$1} = '';
            }
        }
        for my $dst (keys %dst_ips) {
            my $email_ctr_file = '';
            if (-e "${src}/${dst}_email_ctr") {
                $email_ctr_file = "${src}/${dst}_email_ctr";
            } elsif (-e "${src}/email_ctr") {
                $email_ctr_file = "${src}/email_ctr";
            }
            if ($email_ctr_file) {
                open E, "< $email_ctr_file" or die "[*] Could not open ",
                    "$email_ctr_file: $!";
                $num_emails = <E>;
                close E;
                chomp $num_emails;
                if ($config{'ENABLE_EMAIL_LIMIT_PER_DST'} eq 'Y') {
                    $scan_email_ctrs{$src}{$dst}{'email_ctr'} = $num_emails;
                } else {
                    $scan_email_ctrs{$src}{'email_ctr'} = $num_emails;
                }
                $scan{$src}{$dst}{'alerted'} = 1;
            } else {
                if ($config{'ENABLE_EMAIL_LIMIT_PER_DST'} eq 'Y') {
                    $scan_email_ctrs{$src}{$dst}{'email_ctr'} = 0;
                } else {
                    $scan_email_ctrs{$src}{'email_ctr'} = 0;
                }
                $scan{$src}{$dst}{'alerted'}   = 0;
            }
            if (-e "${src}/${dst}_packet_ctr") {
                open PKTS, "< ${src}/${dst}_packet_ctr" or die $!;
                my @lines = <PKTS>;
                close PKTS;
                for my $line (@lines) {
                    my $chain;
                    my $intf;
                    my $pkts;
                    my $proto;
                    if ($line =~ /^(\w+)_(\w+)_icmp:\s+(\d+)/) {
                        $chain = $1;
                        $intf  = $2;
                        $pkts  = $3;
                        $chain = uc $chain if $chain eq 'input'
                                or $chain eq 'forward'
                                or $chain eq 'output';
                        $proto = 'icmp';
                        $scan{$src}{$dst}{'chain'}{$chain}{$intf}{$proto}
                            += $pkts;
                        $scan{$src}{$dst}{'absnum'} += $pkts;
                        $scan{$src}{$dst}{'tot_protocols'}++;
                    } elsif ($line =~ /^(\w+)_(\w+)_(tcp|udp):
                            \s+(\d+)\s+\[(\S+)\]/x) {
                        $chain = $1;
                        $intf  = $2;
                        $proto = $3;
                        $pkts  = $4;
                        $chain = uc $chain if $chain eq 'input'
                                or $chain eq 'forward'
                                or $chain eq 'output';
                        my $port_rng = $5;
                        if ($port_rng =~ /(\d+)\-(\d+)/) {
                            $scan{$src}{$dst}{$proto}{'abs_sp'} = $1;
                            $scan{$src}{$dst}{$proto}{'abs_ep'} = $2;
                        } elsif ($port_rng =~ /(\d+)/) {
                            $scan{$src}{$dst}{$proto}{'abs_sp'} = $1;
                            $scan{$src}{$dst}{$proto}{'abs_ep'} = $1;
                        }
                        $scan{$src}{$dst}{'chain'}{$chain}{$intf}{$proto}
                            += $pkts;
                        $scan{$src}{$dst}{'absnum'} += $pkts;
                        $scan{$src}{$dst}{'tot_protocols'}++;
                    } elsif ($line =~ /^(\w+)_(\w+)_(\d+):\s+(\d+)/) {
                        $chain = $1;
                        $intf  = $2;
                        $proto = $3;
                        $pkts  = $4;
                        $chain = uc $chain if $chain eq 'input'
                                or $chain eq 'forward'
                                or $chain eq 'output';
                        $scan{$src}{$dst}{'chain'}{$chain}{$intf}{$proto}
                            += $pkts;
                        $scan{$src}{$dst}{'absnum'} += $pkts;
                        $scan{$src}{$dst}{'tot_protocols'}++;
                    }
                }
            }
            if (-e "${src}/${dst}_start_time") {
                open ST, "< ${src}/${dst}_start_time" or next SRCIP;
                my $s_time = <ST>;
                close ST;
                chomp $s_time;
                $scan{$src}{$dst}{'s_time'} = $s_time;
            }
            if (-e "${src}/${dst}_signatures") {
                open F, "< ${src}/${dst}_signatures" or
                    die "[*] Could not open ",
                        "${src}/${dst}_signatures: $!";
                my @lines = <F>;
                close F;
                for my $line (@lines) {
                    ### Format: <sig time> <sid> <matches> "<msg>" <chain> \
                    ### <proto> <dst port> <flags> <is_fwsnort> <is_psad>
                    ### 1165099853 249 1 "DDOS mstream client to handler" \
                    ### INPUT tcp 15104 SYN 0 0
                    if ($line =~ /^\s*(\d+)\s+(\d+)\s+(\d+)\s+\"(.*?)\"
                            \s+(\w+)\s+(\w+)\s+(\d+)\s+\"(.*?)\"\s+(\d+)
                            \s+(\d+)/x) {
                        my $time    = $1;
                        my $sid     = $2;
                        my $matches = $3;
                        my $msg     = $4;
                        my $chain   = $5;
                        my $proto   = $6;
                        my $dp      = $7;
                        my $flags   = $8;
                        my $is_fwsnort = $9;
                        my $is_psad    = $10;

                        ### build up the %scan sid data
                        $scan{$src}{$dst}{$proto}{'sid'}{$sid}{$chain}
                            {'time'} = $time;
                        $scan{$src}{$dst}{$proto}{'sid'}{$sid}{$chain}
                            {'dp'} = $dp;
                        $scan{$src}{$dst}{$proto}{'sid'}{$sid}{$chain}
                            {'flags'} = $flags;
                        $scan{$src}{$dst}{$proto}{'sid'}{$sid}{$chain}
                            {'pkts'} = $matches;
                        $scan{$src}{$dst}{$proto}{'sid'}{$sid}{$chain}
                            {'is_fwsnort'} = $is_fwsnort;
                        $scan{$src}{$dst}{$proto}{'sid'}{$sid}{$chain}
                            {'is_psad'} = $is_psad;
                    }
                }
            }
        }
        $import_ctr++;
    }
    chdir $curr_pwd or die $!;

    return;
}

sub import_top_sigs() {
    return unless -e $config{'TOP_SIGS_FILE'};

    open F, "< $config{'TOP_SIGS_FILE'}" or die "[*] Could not ",
        "open $config{'TOP_SIGS_FILE'}: $!";
    while (<F>) {
        next unless /\S/;
        next if /^\s*#/;
        if (/^\s*(\d+)\s+\"(.*?)\"\s+(\d+)\s+(\d+)\s+(\w+)/) {
            my $sid = $1;
            my $msg = $2;
            my $matches = $3;
            my $sources = $4;
            my $proto   = $5;
            $top_sigs{$sid} = $matches;
            for (my $i=0; $i<$sources; $i++) {
                ### this is a hack since we can't recover
                ### the specific IP addresses
                $sig_sources{$sid}{$i} = '';
            }
        }
    }
    close F;
    return;
}

sub print_top_sigs() {
    my @lines = ();
    my $printed = 0;
    if ($config{'STATUS_SIGS_THRESHOLD'} > 0) {
        push @lines, "[+] Top $config{'STATUS_SIGS_THRESHOLD'} " .
            "signature matches:\n";
    } else {
        push @lines, "[+] Top signature matches:\n";
    }

    my $ctr = 0;
    for my $sid (sort {$top_sigs{$b} <=> $top_sigs{$a}} keys %top_sigs) {
        my $found = 0;
        my $num_sources = keys %{$sig_sources{$sid}};
        if (defined $sigs{$sid} and defined $sigs{$sid}{'msg'}) {
            push @lines, qq|      "$sigs{$sid}{'msg'}" | .
                qq|($sigs{$sid}{'proto'}),  | .
                qq|Count: $top_sigs{$sid},  Unique sources: | .
                qq|$num_sources,  Sid: $sid\n|;
            $found   = 1;
            $printed = 1;
        } elsif (defined $fwsnort_sigs{$sid}
                and defined $fwsnort_sigs{$sid}{'msg'}) {
            push @lines,  qq|      "$fwsnort_sigs{$sid}{'msg'}" | .
                qq|($fwsnort_sigs{$sid}{'proto'}),  | .
                qq|Count: $top_sigs{$sid},  Unique sources: | .
                qq|$num_sources,  Sid: $sid\n|;
            $found   = 1;
            $printed = 1;
        }
        $ctr++ if $found;
        if ($config{'STATUS_SIGS_THRESHOLD'} > 0) {
            last if $ctr >= $config{'STATUS_SIGS_THRESHOLD'};
        }
    }
    unless ($printed) {
        push @lines, "        [NONE]\n";
    }
    push @lines, "\n";
    return \@lines;
}

sub import_top_scanned_ports() {
    return unless -e $config{'TOP_SCANNED_PORTS_FILE'};

    open F, "< $config{'TOP_SCANNED_PORTS_FILE'}" or die "[*] Could not open ",
        "$config{'TOP_SCANNED_PORTS_FILE'}: $!";
    while (<F>) {
        next unless /\S/;
        next if /^\s*#\s*$/;
        next if /^\s*#\s*Format/;
        chomp;
        ### Format: <proto> <port> <packets>
        if (/^\s*(\w+)\s+(\d+)\s+(\d+)/) {
            my $proto = $1;
            my $port  = $2;
            my $count = $3;
            if ($proto eq 'tcp') {
                $top_tcp_ports{$port} = $count;
            } elsif ($proto eq 'udp') {
                $top_udp_ports{$port} = $count;
            } elsif ($proto eq 'udplite') {
                $top_udplite_ports{$port} = $count;
            }
        }
    }
    close F;
    return;
}

sub print_top_scanned_ports() {
    my @lines = ();
    my $printed = 0;
    if ($config{'STATUS_PORTS_THRESHOLD'} > 0) {
        push @lines, "[+] Top $config{'STATUS_PORTS_THRESHOLD'} scanned ports:\n";
    } else {
        push @lines, "[+] Top scanned ports:\n";
    }

    if (%top_tcp_ports) {
        my $ctr = 0;
        for my $dp (sort {$top_tcp_ports{$b} <=> $top_tcp_ports{$a}}
                keys %top_tcp_ports) {
            my $str = sprintf "      tcp %-5d $top_tcp_ports{$dp} packets\n", $dp;
            push @lines, $str;
            $printed = 1;
            $ctr++;
            if ($config{'STATUS_PORTS_THRESHOLD'} > 0) {
                last if $ctr >= $config{'STATUS_PORTS_THRESHOLD'};
            }
        }
    }

    if (%top_udp_ports) {
        my $ctr = 0;
        push @lines, "\n";
        for my $dp (sort {$top_udp_ports{$b} <=> $top_udp_ports{$a}}
                keys %top_udp_ports) {
            my $str = sprintf "      udp %-5d $top_udp_ports{$dp} packets\n", $dp;
            push @lines, $str;
            $printed = 1;
            $ctr++;
            if ($config{'STATUS_PORTS_THRESHOLD'} > 0) {
                last if $ctr >= $config{'STATUS_PORTS_THRESHOLD'};
            }
        }
    }
    unless ($printed) {
        push @lines, "        [NONE]\n";
    }
    push @lines, "\n";
    return \@lines;
}

sub import_top_attackers() {

    return unless -e $config{'TOP_ATTACKERS_FILE'};

    open F, "< $config{'TOP_ATTACKERS_FILE'}" or die "[*] Could not open ",
        "$config{'TOP_ATTACKERS_FILE'}: $!";
    while (<F>) {
        next unless /\S/;
        next if /^\s*#\s*$/;
        ###  Format: <IP> <DL> <total_packets> <uniq_sigs> <sig_matches> <is_local>
        if (/^\s*($ipv4_re)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d)/) {
            my $ip = $1;
            my $dl = $2;
            my $tot_pkts = $3;
            my $uniq_sigs = $4;
            my $sig_matches = $5;
            my $is_local = $6;

            ### do not add any IP from the top_attackers file
            ### that does not have a /var/log/psad/<ip>
            ### directory
            next unless defined $scan_dl{$ip};
            if (defined $scan_dl{$ip}) {
                $scan_dl{$ip} = $dl
                    if $scan_dl{$ip} < $dl;
            } else {
                $scan_dl{$ip} = $dl;
            }
            $local_src{$ip} = '' if $is_local;
            $top_packet_counts{$ip} = $tot_pkts;
            $top_sig_counts{$ip}    = $sig_matches;
        }
    }
    close F;
    return;
}

sub print_top_attackers() {
    my @lines = ();
    my $printed = 0;
    if ($config{'STATUS_IP_THRESHOLD'} > 0) {
        push @lines, "[+] Top $config{'STATUS_IP_THRESHOLD'} attackers:\n";
    } else {
        push @lines, "[+] Top attackers:\n";
    }

    my $ctr = 0;
    my %pre_sort_dl = ();
    my %ip_objs = ();

    for my $src (sort {$scan_dl{$b} cmp $scan_dl{$a}} keys %scan_dl) {
        if ($status_min_dl) {
            next unless $scan_dl{$src} >= $status_min_dl;
        } else {
            next unless $scan_dl{$src} >= $config{'MIN_DANGER_LEVEL'};
        }
        $pre_sort_dl{$scan_dl{$src}}{$src} = '';
    }

    my $ip6_short_len = 0;
    for my $dl (qw/5 4 3 2 1/) {
        next unless defined $pre_sort_dl{$dl};

        for my $src (sort keys %{$pre_sort_dl{$dl}}) {
            next unless defined $top_packet_counts{$src}
                    or defined $top_sig_counts{$src};

            my $ip_obj = new NetAddr::IP($src)
                or die "[*] NetAddr::IP $src error";

            $ip_objs{$src} = $ip_obj;
            if ($ip_obj->version() == 6) {
                if (length($ip_obj->short()) > $ip6_short_len) {
                    $ip6_short_len = length($ip_obj->short());
                }
            }
        }
    }

    for my $dl (qw/5 4 3 2 1/) {
        next unless defined $pre_sort_dl{$dl};

        for my $src (sort keys %{$pre_sort_dl{$dl}}) {
            next unless defined $top_packet_counts{$src}
                    or defined $top_sig_counts{$src};
            my $str = sprintf "      %-15s DL: %d", $src, $scan_dl{$src};
            if ($ip_objs{$src}->version() == 6) {
                $str = sprintf "      %s (%-${ip6_short_len}s) DL: %d", $src,
                    $ip_objs{$src}->short(), $scan_dl{$src};
            }
            if (defined $top_packet_counts{$src}) {
                $str .= ", Packets: $top_packet_counts{$src}";
            } else {
                $str .= ', Packets: 0';
            }
            if (defined $top_sig_counts{$src}) {
                $str .= ", Sig count: $top_sig_counts{$src}";
            } else {
                $str .= ', Sig count: 0';
            }
            if (defined $local_src{$src}) {
                $str .= ', (local IP)';
            }
            $ctr++;
            if ($config{'STATUS_IP_THRESHOLD'} > 0) {
                last if $ctr >= $config{'STATUS_IP_THRESHOLD'};
            }
            push @lines, $str, "\n";
            $printed = 1;
        }
    }
    unless ($printed) {
        push @lines, "        [NONE]\n";
    }
    push @lines, "\n";
    return \@lines;
}

sub remove_old_scans() {
    opendir D, $config{'PSAD_DIR'} or
        die "[*] Could not open dir: $config{'PSAD_DIR'}: $!";
    my @files = readdir D;
    closedir D;

    my $curr_pwd = getcwd();
    chdir $config{'PSAD_DIR'} or die $!;
    SRCIP: for my $src (@files) {
        next SRCIP unless ($src =~ /$ipv4_re/ and -d $src);
        rmtree $src or die
            "[*] Could not remove $config{'PSAD_DIR'}/$src: $!";
    }
    chdir $curr_pwd or die $!;
    return;
}

sub disk_check() {
    my $fwdata_fh = shift;

    ### See how we are doing on disk space, and remove data
    ### if necessary.
    if (&disk_space_exceeded() and $config{'ENABLE_SYSLOG_FILE'} ne 'Y') {
        $fwdata_fh = &reopen_fw_data($fwdata_fh, $TRUNCATE);
    }
    $last_disk_check = time();

    return $fwdata_fh;
}

sub fw_data_file_check() {
    my $fwdata_fh = shift;

    if ($fw_data_file_check_ctr == 10) {
        if (-e $fw_data_file) {
            my $size_tmp  = -s $fw_data_file;
            my $inode_tmp = (stat($fw_data_file))[1];
            if ($inode_tmp != $fw_data_file_inode
                    or $size_tmp < $fw_data_file_size) {

                &sys_log('[+]', "iptables syslog file $fw_data_file " .
                    "shrank or was rotated, so re-opening");

                $fwdata_fh = &reopen_fw_data($fwdata_fh, $NO_TRUNCATE);

                $skip_first_loop = 1;

                ### set file size and inode
                $fw_data_file_size  = $size_tmp;
                $fw_data_file_inode = $inode_tmp;
            }
        }
        $fw_data_file_check_ctr = 0;
    }
    return $fwdata_fh;
}

sub notifications() {
   my $num_packets = shift;

    ### Print the number of new packets we saw in FW_DATA_FILE if we are
    ### running in debug mode
    if ($debug) {
        print STDERR "[+] MAIN: number of new packets: $num_packets\n";
    }

    if ($die_msg) {
        &print_sys_msg($die_msg, "$config{'PSAD_ERR_DIR'}/psad.die");
        $die_msg = '';
    }

    if ($warn_msg) {
        &print_sys_msg($warn_msg, "$config{'PSAD_ERR_DIR'}/psad.warn");
        $warn_msg = '';
    }
    return;
}

sub usr1() {
    my $rv = $EXIT_SUCCESS;
    my $psad_pidfile = $pidfiles{'psad'};
    if (-e $psad_pidfile) {
        my $pid = &is_running($psad_pidfile);
        if ($pid) {  ### make sure psad is actually running
            if (kill 'USR1', $pid) {
                print "[+] USR1 signal sent to pid: $pid\n";
                for (my $try=0; $try<=20; $try++) {  ### limit attempts to 20
                    sleep 1;
                    print "[+] Checking for file: ",
                        "$config{'PSAD_DIR'}/scan_hash.${pid}\n";
                    if (-e "$config{'PSAD_DIR'}/scan_hash.${pid}") {
                        open U, "< $config{'PSAD_DIR'}/scan_hash.${pid}"
                            or print "[*] Sent psad pid $pid a USR1 ",
                                "signal, but could not open\n",
                                "\"$config{'PSAD_DIR'}/scan_hash.${pid}\n\""
                            and return $rv;
                        print while(<U>);
                        close U;
                        print "[+] Results available in: ",
                            "$config{'PSAD_DIR'}/scan_hash.${pid}\n";
                        last;
                    }
                }
            } else {
                print "[*] Could not send psad the USR1 signal on ",
                    "$config{'HOSTNAME'}\n";
                $rv = $EXIT_FAILURE;
            }
        } else {
            print "[-] psad is not running on $config{'HOSTNAME'}\n";
        }
    }
    return $rv;
}

sub usr1_handler() {
    $usr1_flag = 1;
    return;
}

sub usr1_print_scan() {
    $usr1_flag = 0;  ### clear the USR1 flag

    &sys_log('received USR1 signal, printing scan ' .
        "hashes to $config{'PSAD_DIR'}/scan_hash.$$");

    ### dump scan hash to filesystem
    &print_scan();

    return;
}

sub hup() {
    my $rv = $EXIT_SUCCESS;
    for my $pidname (qw(psadwatchd psad kmsgsd)) {
        my $pidfile = $pidfiles{$pidname};
        my $pid = &is_running($pidfile);
        if ($pid) {
            if (kill 'HUP', $pid) {
                print "[+] HUP signal sent to $pidname (pid: $pid)\n";
            } else {
                print "[*] Could not send $pidname ",
                    "(pid: $pid) a HUP signal.\n";
                $rv = $EXIT_FAILURE;
            }
        } else {
            my $print = 1;
            if ($pidname eq 'kmsgsd'
                    and ($config{'SYSLOG_DAEMON'} =~ /ulog/i
                    or $config{'ENABLE_SYSLOG_FILE'} eq 'Y')) {
                $print = 0;
            }
            print "[-] $pidname daemon not running.\n" if $print;
        }
    }
    return $rv;
}

sub hup_handler() {
    $hup_flag = 1;
    return;
}

sub hup_re_init() {
    my $fwdata_fh = shift;

    &sys_log('received HUP signal, re-importing psad.conf');

    print STDERR "[+] Received HUP signal, re-importing config...\n"
        if $debug;

    my $orig_fwdata = $fw_data_file;
    my $orig_ipt_sockfile = '';

    $orig_ipt_sockfile = $config{'AUTO_IPT_SOCK'}
        if $config{'ENABLE_AUTO_IDS'} eq 'Y';

    ### Re-import all used config files (psad.conf, auto_dl,
    ### posf, signatures) if we received a HUP signal.
    &psad_init();

    if ($orig_fwdata ne $fw_data_file) {
        $fwdata_fh = &reopen_fw_data($fwdata_fh, $NO_TRUNCATE);

        $skip_first_loop = 1;
    }

    if ($config{'ENABLE_AUTO_IDS'} eq 'Y') {
        if ($orig_ipt_sockfile ne $config{'AUTO_IPT_SOCK'}) {
            close $ipt_sock;

            &get_auto_response_domain_sock();

            $skip_first_loop = 1;
        }
    }
    $hup_flag = 0;  ### clear the HUP flag

    return $fwdata_fh;
}

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

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

sub archive_data() {

    my $curr_pwd = getcwd();
    chdir $config{'PSAD_DIR'} or die "[*] Could not chdir ",
        "$config{'PSAD_DIR'}: $!";
    unless (-d $config{'SCAN_DATA_ARCHIVE_DIR'}) {
        mkdir $config{'SCAN_DATA_ARCHIVE_DIR'}, 0700 or
            die "[*] Could not create dir: ",
            "$config{'SCAN_DATA_ARCHIVE_DIR'}: $!";
    }

    ### archive all of the old ip address directories since
    ### we are restarting psad (should add a way to import
    ### these directories back into memory)
    opendir D, $config{'PSAD_DIR'} or die "[*] Could not open dir: ",
        "$config{'PSAD_DIR'}: $!";
    my @files = readdir D;
    closedir D;

    IPDIR: for my $file (@files) {
        if ($file =~ /$ipv4_re/ and -d $file) {
            ### check for the danger level associated with this dir
            if (-e "$file/danger_level") {
                open F, "< $file/danger_level" or next IPDIR;
                my $dl = <F>;
                close F;
                chomp $dl;
                if ($dl >= $config{'MIN_ARCHIVE_DANGER_LEVEL'}) {
                    ### $file is an old scaning ip from
                    ### a previous psad execution
                    my $old_ipdir     = $file;
                    my $archive_ipdir =
                        "$config{'SCAN_DATA_ARCHIVE_DIR'}/$old_ipdir";
                    if (-d $archive_ipdir) {
                        rmtree $archive_ipdir;
                    }
                    move $old_ipdir, $archive_ipdir or die "[*] Could not ",
                        "move $old_ipdir -> $archive_ipdir";
                }
            }
        }
    }

    ### archive the fwdata file
    my $fwdata    = $fw_data_file;
    my $fwarchive = "$config{'SCAN_DATA_ARCHIVE_DIR'}/fwdata_archive";
    ### first see how big the archive file is and zero out if
    ### it is larger than about 10,000 lines
    if (-e $fwarchive && (-s $fwarchive) > 2367766) {  ### about 10,000 lines
        &truncate_file($fwarchive) unless $config{'ENABLE_SYSLOG_FILE'} eq 'Y';
    }
    unless (-e $fwdata) {
        chdir $curr_pwd or die $!;
        return;
    }
    open FW, "< $fwdata" or die "$fwdata exists but couldn't open it: $!";
    my @fwlines = <FW>;
    close FW;
    open AR, ">> $fwarchive" or die "Could not open $fwarchive: $!";
    print AR $_ for @fwlines;
    close AR;

    chdir $curr_pwd or die $!;
    return;
}

sub handle_cmdline() {

    if ($analysis_emails and not $analyze_mode) {
        die "[*] Can only specify --email-analysis flag ",
            "when run in --Analyze mode.";
    }

    ### be absolutely sure to disable auto-response for various
    ### offline modes
    $config{'ENABLE_AUTO_IDS'} = 'N'
        if ($analyze_mode and not $analyze_mode_auto_block)
            or $syslog_server or $benchmark or $status_mode;

    ### The -I switch was given
    $config{'CHECK_INTERVAL'} = $chk_interval if $chk_interval;

    ### The --snort-rdir switch was given
    $config{'SNORT_RULES_DIR'} = $snort_rules_dir if $snort_rules_dir;

    ### The --signatures switch was given
    $config{'SIGS_FILE'} = $sigs_file if $sigs_file;

    ### The --passive-os-file switch was given
    $config{'POSF_FILE'} = $posf_file if $posf_file;

    ### The --auto-dl switch was given
    $config{'AUTO_DL_FILE'} = $auto_dl_file if $auto_dl_file;

    ### make sure to go into status display mode if any of the following
    ### args were given.
    $status_mode = 1 if ($status_ip and not $status_mode);
    $status_mode = 1 if ($status_min_dl and not $status_mode);
    $status_mode = 1 if ($status_summary and not $status_mode);

    ### make sure to go into firewall analysis mode if a ruleset
    ### file was specified on the command line.
    $fw_analyze = 1 if $fw_file;

    ### disable whois and DNS lookups if we are running in -A mode.
    $no_whois = 1 if $analyze_mode and not $analysis_whois;
    $no_rdns = 1 if $analyze_mode and not $enable_analysis_dns;

    return;
}

sub make_psad_dirs() {
    for my $dir (qw(
        /var/lib
        /var/run
    )) {
        next if -d $dir;
        mkdir $dir, 0755 or die "[*] Could not mkdir $dir: $!";
    }

    for my $dir (qw(
        PSAD_DIR
        PSAD_RUN_DIR
        PSAD_FIFO_DIR
        PSAD_CONF_DIR
        CONF_ARCHIVE_DIR
        PSAD_ERR_DIR
    )) {
        next if -d $config{$dir};
        mkdir $config{$dir}, 0700 or
            die "[*] Could not mkdir $config{$dir}: $!";
    }
    return;
}

sub setup() {

    &make_psad_dirs();

    unless (-e $config{'PSAD_FIFO_FILE'} and -p $config{'PSAD_FIFO_FILE'}) {
        system "$cmds{'mknod'} -m 600 $config{'PSAD_FIFO_FILE'} p";
    }
    ### make sure the new whois path exists
    if (-x '/usr/bin/whois.psad' and not -x $cmds{'whois'}
            and '/usr/bin/whois.psad' ne $cmds{'whois'}) {
        move '/usr/bin/whois.psad', $cmds{'whois'} or die "[*] Could not ",
            "move /usr/bin/whois.psad -> $cmds{'whois'}";
    }

    $no_email_alerts  = 1 if $config{'ALERTING_METHODS'} =~ /no.?e?mail/i;
    $no_syslog_alerts = 1 if $config{'ALERTING_METHODS'} =~ /no.?syslog/i;

    ### initialize dshield alerting interval
    $dshield_alert_interval = 3600 * $config{'DSHIELD_ALERT_INTERVAL'};

    ### scale back the alerting interval from 24 hours by just enough
    ### to make sure that an alert will be sent each day.
    $dshield_alert_interval -= 1 + $config{'CHECK_INTERVAL'}
        if $config{'DSHIELD_ALERT_INTERVAL'} == 24;

    unless ($hup_flag) {
        my $truncate_or_create = 0;
        my $restart_kmsgsd     = 0;
        if ($config{'TRUNCATE_FWDATA'} eq 'Y'
                and $config{'ENABLE_SYSLOG_FILE'} ne 'Y') {
            $truncate_or_create = 1;
            $restart_kmsgsd     = 1;
        } else {
            unless (-e $fw_data_file) {
                $truncate_or_create = 1;
            }
        }

        ### create the iptables data file if it doesn't exist
        ### (this is better than dying because it isn't there).
        &truncate_file($fw_data_file) if $truncate_or_create;

        ### if we truncate fwdata then we have to restart
        ### any running kmsgsd process
        &restart_kmsgsd() if $restart_kmsgsd;

        ### unlink socket file if it exists from a previous run (only
        ### if we have not received a HUP signal)
        unlink $config{'AUTO_IPT_SOCK'} if -e $config{'AUTO_IPT_SOCK'};

        ### if we are not importing old scans, then remove old counter
        ### values
        if ($config{'IMPORT_OLD_SCANS'} eq 'N') {
            &truncate_file($config{'PACKET_COUNTER_FILE'});
            &truncate_file($config{'IPT_PREFIX_COUNTER_FILE'});
            &truncate_file($config{'DSHIELD_COUNTER_FILE'});
            &truncate_file($config{'TOP_SIGS_FILE'});
            &truncate_file($config{'TOP_SCANNED_PORTS_FILE'});
            &truncate_file($config{'TOP_ATTACKERS_FILE'});
        }

        if ($config{'ENABLE_SYSLOG_FILE'} ne 'Y') {
            chmod 0600, $fw_data_file;
        }
        chmod 0600, $config{'FW_ERROR_LOG'};
    }

    ### we assume that ulogd is properly configured (FIXME?)
    return if $config{'SYSLOG_DAEMON'} =~ /ulog/i;
    return if $config{'ENABLE_SYSLOG_FILE'} eq 'Y';

    die '[*] No system logger config file could be found.'
        unless (-e $config{'ETC_SYSLOG_CONF'}
                or -e $config{'ETC_RSYSLOG_CONF'}
                or -e $config{'ETC_SYSLOGNG_CONF'}
                or -e $config{'ETC_METALOG_CONF'});

    ### attempt to correct syslog config file if it is not configured
    ### correctly.
    my $syslog_conf = '';
    if ($config{'SYSLOG_DAEMON'} eq 'syslogd') {
        $syslog_conf = $config{'ETC_SYSLOG_CONF'};
    } elsif ($config{'SYSLOG_DAEMON'} eq 'rsyslogd') {
        $syslog_conf = $config{'ETC_RSYSLOG_CONF'};
    }

    if ($syslog_conf) {
        if (-e $syslog_conf) {
            unless (-e "$syslog_conf.orig") {
                copy $syslog_conf,
                    "$syslog_conf.orig" or die "[*] Could not ",
                    "copy $syslog_conf -> ",
                    "$syslog_conf.orig";
            }
            open RS, "< $syslog_conf" or
                die "[*] Unable to open $syslog_conf: $!";
            my @lines = <RS>;
            close RS;
            my $found = 0;
            for my $line (@lines) {
                if ($line =~ m/\|\s*$config{'PSAD_FIFO_FILE'}/) {
                    $found = 1;
                    last;
                }
            }
            unless ($found) {
                open SYSLOG, "> $syslog_conf" or
                    die "[*] Unable to open $syslog_conf: $!";
                ### this loop removes any old location for psadfifo
                for my $line (@lines) {
                    unless ($line =~ /psadfifo/i) {
                        print SYSLOG $line;
                    }
                }
                ### reinstate kernel logging to our named pipe
                print SYSLOG "\n### Send kern.info messages to psadfifo for ",
                    "analysis by kmsgsd\n";
                print SYSLOG "kern.info\t\t|$config{'PSAD_FIFO_FILE'}\n";
                close SYSLOG;
                &sys_log('reconfiguring syslogd to write ' .
                    "kern.info messages to $config{'PSAD_FIFO_FILE'}");
                system "$cmds{'killall'} -HUP syslogd";
            }
        } else {
            &send_mail("$config{'MAIL_ERROR_PREFIX'} " .
                "$syslog_conf does not " .
                "exist, check SYSLOG_DAEMON setting on $config{'HOSTNAME'}",
                '', $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});
        }
    } elsif ($config{'SYSLOG_DAEMON'} eq 'syslog-ng') {
        if (-e $config{'ETC_SYSLOGNG_CONF'}) {
            unless (-e "$config{'ETC_SYSLOGNG_CONF'}.orig") {
                copy $config{'ETC_SYSLOGNG_CONF'},
                    "$config{'ETC_SYSLOGNG_CONF'}.orig" or die "[*] Could not ",
                    "copy $config{'ETC_SYSLOGNG_CONF'} -> ",
                    "$config{'ETC_SYSLOGNG_CONF'}.orig";
            }
            open RS, "< $config{'ETC_SYSLOGNG_CONF'}" or
                die "[*] Unable to open $config{'ETC_SYSLOGNG_CONF'}: $!\n";
            my @lines = <RS>;
            close RS;

            my $found = 0;
            for my $line (@lines) {
                next if $line =~ /^\s*#/;
                if ($line =~ m/$config{'PSAD_FIFO_FILE'}/ or $line =~ /psadfifo/) {
                    $found = 1;
                    last;
                }
            }
            unless ($found) {
                open SYSLOGNG, ">> $config{'ETC_SYSLOGNG_CONF'}" or
                    die "[*] Unable to open $config{'ETC_SYSLOGNG_CONF'}: $!";
                print SYSLOGNG "\n",
                    qq|source psadsrc { unix-stream("/dev/log"); |,
                    qq|internal(); pipe("/proc/kmsg"); };\n|,
                    qq|filter f_psad { facility(kern) and match("IN=") |,
                    qq|and match("OUT="); };\n|,
                    'destination psadpipe { ',
                    "pipe(\"$config{'PSAD_FIFO_FILE'}\"); };\n",
                    'log { source(psadsrc); filter(f_psad); ',
                    "destination(psadpipe); };\n";
                close SYSLOGNG;

                &sys_log('reconfiguring syslog-ng to write ' .
                    "kern.info messages to $config{'PSAD_FIFO_FILE'}");
                system "$cmds{'killall'} -HUP syslog-ng";
            }
        } else {
            &send_mail("$config{'MAIL_ERROR_PREFIX'} " .
                "$config{'ETC_SYSLOGNG_CONF'} does not " .
                "exist, check SYSLOG_DAEMON setting on $config{'HOSTNAME'}",
                '', $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});
        }
    } elsif ($config{'SYSLOG_DAEMON'} eq 'metalog') {
         ### Metalog support added by Dennis Freise <cat@final-frontier.ath.cx>
        if (-e $config{'ETC_METALOG_CONF'}) {
            unless (-e "$config{'ETC_METALOG_CONF'}.orig") {
                copy $config{'ETC_METALOG_CONF'},
                    "$config{'ETC_METALOG_CONF'}.orig" or die "[*] Could not ",
                    "copy $config{'ETC_METALOG_CONF'} -> ",
                    "$config{'ETC_METALOG_CONF'}.orig";
            }
            open RS, "< $config{'ETC_METALOG_CONF'}" or
                die "[*] Unable to open $config{'ETC_METALOG_CONF'}: $!\n";
            my @lines = <RS>;
            close RS;

            my $found = 0;
            for my $line (@lines) {
                if ($line =~ m/psadpipe\.sh/) {
                    $found = 1;
                    last;
                }
            }
            unless ($found) {
                open METALOG, "> $config{'ETC_METALOG_CONF'}" or
                    die "[*] Unable to open $config{'ETC_METALOG_CONF'}: $!";
                print METALOG "\n",
                    "\nPSAD :\n",
                    "  facility = \"kern\"\n",
                    '  command  = ',
                    "\"/usr/sbin/psadpipe.sh\"\n";
                close METALOG;
                &sys_log('reconfiguring metalog to write ' .
                        "kern-facility messages to /usr/sbin/psadpipe.sh");

                open PIPESCRIPT, '> /usr/sbin/psadpipe.sh' or
                    die "[*] Unable to open /usr/sbin/psadpipe.sh: $!";
                print PIPESCRIPT "#!/bin/sh\n\n",
                    "echo \"\$3\" >> $config{'PSAD_FIFO_FILE'}\n";
                close PIPESCRIPT;
                chmod 0700, '/usr/sbin/psadpipe.sh';
                &sys_log('generated /usr/sbin/psadpipe.sh ' .
                        "which writes to $config{'PSAD_FIFO_FILE'}");

                ### Metalog seems to simply die on SIGHUP and SIGALRM, and I
                ### found no signal or option to reload it's config... :-(
                die '[*] All files written. You have to manually restart metalog! ',
                    'When done, start psad again.';
#          system "$cmds{'killall'} -HUP metalog";
            }
        } else {
            &send_mail("$config{'MAIL_ERROR_PREFIX'} " .
                "$config{'ETC_METALOG_CONF'} does not " .
                "exist, check SYSLOG_DAEMON setting on $config{'HOSTNAME'}",
                '', $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});
        }
    }

    return;
}

sub restart_kmsgsd() {

    return if $config{'ENABLE_SYSLOG_FILE'} eq 'Y';
    return if $no_kmsgsd or $config{'SYSLOG_DAEMON'} =~ /ulog/i;
    return unless -e $pidfiles{'kmsgsd'};

    my $pid = &is_running($pidfiles{'kmsgsd'});

    return unless $pid;

    &sys_log('restarting kmsgsd since TRUNCATE_FWDATA is enabled');
    kill 9, $pid unless kill 15, $pid;
    system $cmds{'kmsgsd'};

    $kmsgsd_started = 1;

    return;
}

sub get_scale_factor() {
    my $num_packets = shift;

    return 0 unless $analyze_mode;

    my $val = 0;

    if ($num_packets < 100) {
        $val = $num_packets;
    } else {
        $val = int($num_packets/10);
        if ($val < 100) {
            $val -= $val % 10;
        } elsif ($val < 1000) {
            $val -= $val % 100;
        } elsif ($val < 10000) {
            $val -= $val % 1000;
        } elsif ($val < 100000) {
            $val -= $val % 10000;
        } elsif ($val < 1000000) {
            $val -= $val % 100000;
        } else {
            $val = 50000;
        }
    }
    $val++;
    return $val;
}

sub truncate_file() {
    my $file = shift;
    open F, "> $file" or die "[*] Could not open $file: $!";
    close F;
    return;
}

sub disk_space_exceeded() {

    my $curr_pwd = getcwd();
    my @df_data = @{&run_command($cmds{'df'}, $config{'PSAD_DIR'})};
    my ($prcnt) = ($df_data[$#df_data] =~ /(\d+)%/);
    my $rv = 0;
    if ($config{'DISK_MAX_PERCENTAGE'} > 0
            and $prcnt > $config{'DISK_MAX_PERCENTAGE'}) {
        ### need to remove data
        $rv = 1;
        $rm_data_ctr++;
        &sys_log("disk partition associated with " .
            "$config{'PSAD_DIR'} exceeded " .
            "$config{'DISK_MAX_PERCENTAGE'} prct utilization.");
        &send_mail("$config{'MAIL_ERROR_PREFIX'} Exceeded max disk " .
            "utilization for $config{'PSAD_DIR'} on $config{'HOSTNAME'}",
            '', $config{'EMAIL_ADDRESSES'}, $cmds{'mail'});
        &sys_log("removing data in $config{'PSAD_DIR'}");
        if (-d $config{'SCAN_DATA_ARCHIVE_DIR'}) {
            ### remove the entire archive directory (we have run out of
            ### disk so keeping old scan directories around is the least
            ### of our worries).
            &sys_log("removing $config{'SCAN_DATA_ARCHIVE_DIR'} directory");
            rmtree $config{'SCAN_DATA_ARCHIVE_DIR'};
            mkdir $config{'SCAN_DATA_ARCHIVE_DIR'}, 0700;
        }
        opendir D, $config{'PSAD_DIR'} or
            die "[*] Could not open dir: $config{'PSAD_DIR'}: $!";
        my @ipdirs = readdir D;
        closedir D;

        chdir $config{'PSAD_DIR'} or die $!;
        for my $ipdir (@ipdirs) {
            if ($ipdir =~ /$ipv4_re/ and -d $ipdir) {
                opendir IP, $ipdir or die $!;
                my @scanfiles = readdir IP;
                closedir IP;

                for my $file (@scanfiles) {
                    if (-e "${ipdir}/$file" and $file =~ /_signatures/) {
                        unlink "${ipdir}/$file";
                    }
                }
            }
        }
        if ($rm_data_ctr > $config{'DISK_MAX_RM_RETRIES'}) {
            &sys_log("could not sufficiently reduce disk " .
                "utilization in $config{'PSAD_DIR'} partition.  " .
                "Stopping psad!");
            &send_mail("$config{'MAIL_ERROR_PREFIX'} Could not " .
                "reduce disk utilization on " .
                $config{'HOSTNAME'}, '', $config{'EMAIL_ADDRESSES'},
                $cmds{'mail'});
            &send_mail("$config{'MAIL_FATAL_PREFIX'} Stopping psad " .
                "on $config{'HOSTNAME'}!",
                '', $config{'EMAIL_ADDRESSES'},
                $cmds{'mail'});
            for my $pidname (qw(psadwatchd kmsgsd)) {
                my $pidfile = $pidfiles{$pidname};
                my $pid = &is_running($pidfile);
                if ($pid) {
                    unless (kill 15, $pid) {  ### attempt to stop with SIGTERM
                        kill 9, $pid;
                    }
                }
            }
            exit 1;
        }
    } else {
        ### the disk check interval was exceeded but the utilization is ok.
        $rm_data_ctr = 0;
    }
    chdir $curr_pwd or die $!;
    return $rv;
}

sub dump_conf() {
    my $fh = *STDOUT;
    $fh = *STDERR if $debug;

    ### uname output
    print $fh "[+] uname output:\n";
    my @uname_out = @{&run_command($cmds{'uname'}, '-a')};
    if (@uname_out) {
        for (@uname_out) {
            s/Linux\s+(\S+)\s/Linux (removed) /;
            print $fh $_;
        }
    }
    print $fh "\n";

    ### perl version (we assume perl is in the path)
    print $fh "[+] perl info:\n";
    my @perl_info = @{&run_command('perl', '-V')};
    if (@perl_info) {
        print $fh $_ for @perl_info;
    }
    print $fh "\n";

    print $fh "[+] syslog processes:\n";
    my @ps_out = @{&run_command($cmds{'ps'}, 'auxww')};
    if (@ps_out) {
        for (@ps_out) {
            print $fh $_ if m|syslog|i;
        }
    }
    print $fh "\n";

    print $fh "[+] psad processes:\n";
    my @ps_psad_out = @{&run_command($cmds{'ps'}, 'auxww')};
    if (@ps_psad_out) {
        for (@ps_psad_out) {
            print $fh $_ if m|psad|i;
        }
    }
    print $fh "\n";

    if ($config{'IFCFGTYPE'} =~ /iproute2/i) {
        print $fh "[+] ip addr output:\n";
        my @ip_out = @{&run_command($cmds{'ip'}, 'addr')};
        if (@ip_out) {
            for (@ip_out) {
                s/$ipv4_re/x.x.x.x/g;
                s/inet6\s+\S+/inet6 (removed)/;
                print $fh $_;
            }
        }
    } else {
        print $fh "[+] ifconfig output:\n";
        my @ifconfig_out = @{&run_command($cmds{'ifconfig'}, '-a')};
        if (@ifconfig_out) {
            for (@ifconfig_out) {
                s/$ipv4_re/x.x.x.x/g;
                s/inet6\s+addr:\s+\S+/inet6 addr: (removed)/;
                print $fh $_;
            }
        }
    }
    print $fh "\n";

    print $fh "\n[+] psad v$version\n\n";
    my $install_log = '/var/log/psad/install.log';
    if (-e $install_log) {
        print $fh "[+] $install_log exists.\n\n";
    } else {
        print $fh "[+] $install_log does NOT exist.\n\n";
    }

    print $fh "[+] Dumping psad config from: $config_file\n\n";
    for my $var (sort keys %config) {
        my $str = $config{$var};
        ### sanitize sensitive information
        $str = '(removed)' if $var eq 'DSHIELD_USER_EMAIL';
        $str = '(removed)' if $var eq 'DSHIELD_USER_ID';
        $str = '(removed)' if $var eq 'EMAIL_ADDRESSES';
        $str = '(removed)' if $var eq 'HOME_NET';
        $str = '(removed)' if $var eq 'HOSTNAME';
        $str = '(removed)' if $var eq 'EXTERNAL_NET';
        $str = '(removed)' if $var =~ m|SERVERS|;
        printf $fh "%-30s %s\n", "    $var", $str;
    }
    print $fh "\n[+] Command paths:\n\n";
    for my $var (sort keys %cmds) {
        printf $fh "%-30s %s\n", "[+] $var", $cmds{$var};
    }

    ### sometimes we exit after calling this function, and if not
    ### the return value is ignored
    return $EXIT_SUCCESS;
}

sub dump_ipt_policy() {
    my $rv = $EXIT_SUCCESS;

    my $fh = *STDOUT;
    $fh = *STDERR if $debug;

    if ($config{'ENABLE_IPV6_DETECTION'} eq 'Y') {
        print $fh "\n[+] ip6tables policy dump:\n";
        if (defined $cmds{'ip6tables'} and -x $cmds{'ip6tables'}) {
            my @ipt_ver = @{&run_command($cmds{'ip6tables'}, '-V')};
            if (@ipt_ver) {
                print $fh $_ for @ipt_ver;
                print "\n";
            }
            my @lines = @{&run_command($cmds{'ip6tables'}, '-v -n -L')};
            for my $line (@lines) {
                unless ($fw_include_ips) {
                    ### always include ::/0
                    $line =~ s|\s\:\:/0\s|___PsAd0Net___|g;
                    $line =~ s|\s([A-Fa-f0-9\:]{2,40}/\d{1,3})\s| ::/x |g;
                    $line =~ s|___PsAd0Net___| ::/0 |g;
                }
                print $fh $line;
            }
        } else {
            print $fh "[*] Could not find ip6tables command.\n";
            $rv = $EXIT_FAILURE;
        }
    }

    print $fh "\n[+] iptables policy dump:\n";
    if (defined $cmds{'iptables'} and -x $cmds{'iptables'}) {
        my @ipt_ver = @{&run_command($cmds{'iptables'}, '-V')};
        if (@ipt_ver) {
            print $fh $_ for @ipt_ver;
            print "\n";
        }
        my @lines = @{&run_command($cmds{'iptables'}, '-v -n -L')};
        for my $line (@lines) {
            unless ($fw_include_ips) {
                ### always include 0.0.0.0/0
                $line =~ s|0\.0\.0\.0/0|___PsAd0Net___|g;
                $line =~ s|0\.0\.0\.0|___PsAd0IP___|g;
                $line =~ s|($ipv4_re/\d+)|x.x.x.x/x|g;
                $line =~ s|($ipv4_re)|x.x.x.x|g;
                $line =~ s|___PsAd0Net___|0.0.0.0/0|g;
                $line =~ s|___PsAd0IP___|0.0.0.0|g;
            }
            print $fh $line;
        }
    } else {
        print $fh "[*] Could not find iptables command.\n";
        $rv = $EXIT_FAILURE;
    }

    return $rv;
}

sub sys_log_mline() {
    my $aref = shift;
    for (my $i=0; $i<5 && $i<=$#$aref; $i++) {
        &sys_log($aref->[$i]);
    }
    return;
}

### write a message to syslog
sub sys_log() {
    my $msg = shift;

    print STDERR "[+] syslog msg: $msg\n" if ($test_mode or $debug);

    return unless $imported_syslog_module;
    return if $no_syslog_alerts;

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

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

    closelog();
    return;
}

sub run_command() {
    my ($cmd_path, $args) = @_;
    my $cmd = $cmd_path;
    $cmd .= " $args" if $args;
    print STDERR "[+] run_command(): $cmd\n" if $debug;
    open CMD, "$cmd |" or die "[*] Could not ",
        "execute $cmd: $!";
    my @lines = <CMD>;
    close CMD;
    return \@lines;
}

sub download_signatures() {

    &archive_conf($config{'SIGS_FILE'});

    ### for wget
    &check_commands({'sendmail'=>'', 'mail'=>''});

    my $curr_pwd = getcwd();
    chdir '/tmp' or die $!;

    print "[+] Downloading latest signatures from:\n",
        "        $config{'SIG_UPDATE_URL'}\n";

    unlink 'signatures' if -e 'signatures';

    ### download the file
    system "$cmds{'wget'} $config{'SIG_UPDATE_URL'}";

    die "[*] Could not download signature file" unless -e 'signatures';

    unlink $config{'SIGS_FILE'} if -e $config{'SIGS_FILE'};
    move 'signatures', $config{'SIGS_FILE'};

    print
"[+] New signature file $config{'SIGS_FILE'} has been put in\n",
"    place. You can restart psad (or use 'psad -H') to import the\n",
"    new sigs.\n";

    chdir $curr_pwd or die $!;

    return $EXIT_SUCCESS;
}

sub date_time() {
    my $date_str = shift;

    my $time = time();

    my $date = $time;

    ### Feb 27 12:36:57
    if ($date_str =~ /^\s*(\w+)\s+(\d+)\s+(\d{2}):(\d{2}):(\d{2})/) {
        my $m_tmp = $1;  ### kludge for Decode_Month() call
        my $month = Decode_Month($m_tmp);
        my $day   = sprintf("%.2d", $2);
        my $hour  = $3;
        my $min   = $4;
        my $sec   = $5;

        $date = Date_to_Time(This_Year(), $month, $day, $hour, $min, $sec);

        if ($date > $time) {
            ### date is in the future because the iptables syslog message
            ### does not include the year - subtract one year
            $date -= 60*60*24*356;
        }
    }

    return $date;
}

sub archive_conf() {
    my $file = shift;

    my $curr_pwd = getcwd();
    chdir $config{'CONF_ARCHIVE_DIR'} or die $!;
    my ($filename) = ($file =~ m|.*/(.*)|);
    my $base = "${filename}.old";
    for (my $i = 5; $i > 1; $i--) {  ### keep five copies of old config files
        my $j = $i - 1;
        unlink "${base}${i}.gz" if -e "${base}${i}.gz";
        if (-e "${base}${j}.gz") {
            move "${base}${j}.gz", "${base}${i}.gz" or die "[*] Could not ",
                "move ${base}${j}.gz -> ${base}${i}.gz: $!";
        }
    }
    print "[+] Archiving original $file -> ${base}1\n";

    unlink "${base}1.gz" if -e "${base}1.gz";
    ### move $file into the archive directory
    copy $file, "${base}1" or die "[*] Could not copy ",
        "$file -> ${base}1: $!";

    system "$cmds{'gzip'} ${base}1";
    chdir $curr_pwd or die $!;

    return;
}

sub import_override_configs() {
    my @override_configs = split /,/, $override_config_str;
    for my $file (@override_configs) {
        die "[*] Override config file $file does not exist"
            unless -e $file;
        &import_config($file);
    }
    return;
}

sub import_config() {
    my $conf_file = shift;

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

sub expand_vars() {

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

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

sub is_root() {

    ### exceptions
    for my $var ($download_sigs,
            $analyze_mode,
            $get_next_rule_id,
            $gnuplot_mode,
            $csv_mode,
            $dump_conf,
            $status_mode,
            $benchmark,
    ) {
        return if $var;
    }

    $< == 0 and $> == 0 or
        die '[*] psad: You must be root (or equivalent ',
            "UID 0 account) to execute psad!  Exiting.";
}

### check to make sure all required varables are defined in the config
### this subroutine is passed different variables by each script that
### correspond to only those variables needed be each script).
sub defined_vars() {
    my $varnames_ar = shift;
    for my $var (@$varnames_ar) {
        unless (defined $config{$var}) {  ### missing var
            die "[*] The config file \"$config_file\" does not " .
                  "contain the\nvariable: \"$var\".  Exiting!";
        }
    }
    return;
}

### check paths to commands and attempt to correct if any are wrong.
sub check_commands() {
    my $exceptions_hr = shift;

    if ($no_whois or $config{'ENABLE_WHOIS_LOOKUPS'} eq 'N') {
        $exceptions_hr->{'whois'} = '';
    } else {
        unless (defined $cmds{'whois'}
                and -x $cmds{'whois'}) {
            ### try setting to normal /usr/bin/whois path, and let
            ### the code below work out the correct path if necessary
            $cmds{'whois'} = '/usr/bin/whois';
        }
    }

    my @path = (qw(
        /bin
        /sbin
        /usr/bin
        /usr/sbin
        /usr/local/bin
        /usr/local/sbin
    ));

    CMD: for my $cmd (keys %cmds) {
        next CMD if defined $exceptions_hr->{$cmd};

        ### both mail and sendmail are special cases, mail is not required
        ### if "nomail" is set in REPORT_METHOD, and sendmail is only
        ### required if DShield alerting is enabled and a DShield user
        ### email is set.
        if ($cmd eq 'mail') {
            next CMD if $config{'ALERTING_METHODS'} =~ /no.?e?mail/i;
        } elsif ($cmd eq 'sendmail') {
            next CMD unless ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
                    and $config{'DSHIELD_ALERT_EMAIL'} ne 'NONE');
        }

        if ($cmd eq 'ip6tables') {
            next CMD unless $config{'ENABLE_IPV6_DETECTION'} eq 'Y';
        }

        unless (-x $cmds{$cmd}) {
            my $found = 0;
            PATH: for my $dir (@path) {
                if (-x "${dir}/${cmd}") {
                    $cmds{$cmd} = "${dir}/${cmd}";
                    $found = 1;
                    last PATH;
                }
            }
            unless ($found) {
                unless (defined $exceptions_hr->{$cmd}) {
                    die "[*] Could not find $cmd, edit $config_file";
                }
            }
        }
        unless (-x $cmds{$cmd}) {
            unless (defined $exceptions_hr->{$cmd}) {
                die "[*] $cmd is located at ",
                    "$cmds{$cmd}, but is not executable\n",
                    "    by uid: $<";
            }
        }
    }

    unless ($no_whois or $config{'ENABLE_WHOIS_LOOKUPS'} eq 'N') {
        ### disable whois lookups if a suitable whois client could not
        ### be found.
        unless (defined $cmds{'whois'}
                and -x $cmds{'whois'}) {  ### we couldn't find whois_psad
            warn '[-] Could not locate whois binary, ',
                "disabling whois lookups.\n";
            $no_whois = 1;
        }
    }

    return;
}

sub is_running() {
    my $pidfile = shift or die '[*] Must supply a pid file.';
    return 0 unless -e $pidfile;
    open PIDFILE, "< $pidfile" or die "[*] Could not open $pidfile: $!";
    my $pid = <PIDFILE>;
    close PIDFILE;
    chomp $pid;
    return $pid if (kill 0, $pid);  ### pid is running
    return 0;
}

sub look_for_process() {
    my $process_re = shift;
    for (@{&run_command($cmds{'ps'}, 'auxww')}) {
        return 1 if /$process_re/;
    }
    return 0;
}

### make sure pid is unique
sub unique_pid() {
    my $pidfile = shift;
    if (&is_running($pidfile)) {
        my $msg = "Another $0 process is already running, exiting.";
        &sys_log($msg);
        die "[*] $msg";
    }
    return;
}

### write the pid to the pid file
sub write_pid() {
    my $pidfile = shift;
    open PIDFILE, "> $pidfile" or die "[*] Could not ",
        "open pidfile $pidfile: $!\n";
    print PIDFILE $$ . "\n";
    close PIDFILE;
    chmod 0600, $pidfile;
    return;
}

### write command line to cmd file
sub write_cmd_line() {
    my ($args_ar, $cmdline_file) = @_;
    open CMD, "> $cmdline_file";
    print CMD "@$args_ar\n";
    close CMD;
    chmod 0600, $cmdline_file;
    return;
}

### send mail message to all addresses contained in the
### EMAIL_ADDRESSES variable within psad.conf ($addr_str).
### TODO:  Would it be better to use Net::SMTP here?
sub send_mail() {
    my ($subject, $body_file, $addr_str, $mailCmd) = @_;
    return if $no_email_alerts;

    my @mail_body_lines = ();
    if ($body_file) {
        open F, "< $body_file" or die "[*] Could not open mail file: ",
            "$body_file: $!";
        @mail_body_lines = <F>;
        close F;
    }

    open MAIL, qq{| $mailCmd -s "$subject" $addr_str > /dev/null 2>&1} or die
        qq{[*] Could not send mail: $mailCmd -s "$subject" $addr_str: $!};
    if ($body_file and @mail_body_lines) {
        print MAIL for @mail_body_lines;
    }
    close MAIL;
    return;
}

### write a message to a file
sub print_sys_msg() {
    my ($msg, $file) = @_;
    open F, ">> $file" or die "[*] Could not open $file: $!";
    print F scalar localtime(), " psad v$version ",
        "pid: $$ $msg";
    close F;
    return;
}

sub getopt_wrapper() {
    ### make Getopts case sensitive
    Getopt::Long::Configure('no_ignore_case');

    die "[*] See 'psad -h' for usage information" unless (GetOptions(
        'signatures=s'      => \$sigs_file,       # Path to psad signatures file.
        'sig-update'        => \$download_sigs,   # Download the latest signatures from
                                                  # http://www.cipherdyne.org/psad/signatures
        'passive-os-sigs=s' => \$posf_file,       # Path to passive os fingerprinting
                                                  #   signatures.
        'snort-type=s'      => \$srules_type,     # Only process snort rules of
                                                  #   this type (e.g. "ddos" or
                                                  #   "backdoor").
        'snort-rdir=s'      => \$snort_rules_dir, # Specify a directory for snort
                                                  #   rules.
        'auto-dl=s'         => \$auto_dl_file,    # Path to psad auto IPs file for
                                                  #   auto-setting IP danger level.
        'use-store-file=s'  => \$store_file,      # Path to parsed data written to by Storable
        'Analyze-msgs'      => \$analyze_mode,    # Analysis mode for old iptables
                                                  #   messages in the psad fwdata file
                                                  #   (or messages file; see
                                                  #   --messages).
        'analysis-write-data' => \$analyze_write_data, # Write data to filesystem from
                                                       # -A mode (this can take a long
                                                       # time).
        'analyze-write-data'  => \$analyze_write_data,
        'analysis-auto-block' => \$analyze_mode_auto_block, # enable auto-blocking (if
                                                  # so configured) in -A mode.
        'analysis-fields=s' => \$analysis_fields, # Place a criteria on various fields
                                                  #   that are parsed from an iptables
                                                  #   logfile.
        'analyze-fields=s'  => \$analysis_fields, # Synonym.
        'stdin'             => \$pkts_from_stdin,
        'whois-analysis'    => \$analysis_whois,  # Issue whois lookups in analysis
                                                  #   mode.
        'dns-analysis'      => \$enable_analysis_dns,  # Issue DNS lookups in -A mode.
        'email-analysis'    => \$analysis_emails, # Send analysis mode emails.
        'messages-file=s'   => \$fw_data_file,    # Specify the path to file containing
                                                  #   old iptables messages (fwdata by
                                                  #   default).
        'get-next-rule-id'  => \$get_next_rule_id, # Show the next available signature ID.

        ### gnuplot options
        'gnuplot'                => \$gnuplot_mode,         # gnuplot mode.
        'gnuplot-dat-file=s'     => \$gnuplot_data_file,    # gnuplot .dat file.
        'gnuplot-plot-file=s'    => \$gnuplot_plot_file,    # gnuplot .gnu file.
        'gnuplot-png-file=s'     => \$gnuplot_png_file,     # gnuplot .gnu file.
        'gnuplot-interactive'    => \$gnuplot_interactive,  # launch gnuplot.
        'gnuplot-title=s'        => \$gnuplot_title,        # Set gnuplot title.
        'gnuplot-legend-titls=s' => \$gnuplot_legend_title, # Set gnuplot legend title.
        'gnuplot-x-label=s'      => \$gnuplot_x_label,
        'gnuplot-xlabel=s'       => \$gnuplot_x_label,
        'gnuplot-x-range=s'      => \$gnuplot_x_range,
        'gnuplot-xrange=s'       => \$gnuplot_x_range,
        'gnuplot-y-label=s'      => \$gnuplot_y_label,
        'gnuplot-ylabel=s'       => \$gnuplot_y_label,
        'gnuplot-y-range=s'      => \$gnuplot_y_range,
        'gnuplot-yrange=s'       => \$gnuplot_y_range,
        'gnuplot-z-label=s'      => \$gnuplot_z_label,
        'gnuplot-zlabel=s'       => \$gnuplot_z_label,
        'gnuplot-z-range=s'      => \$gnuplot_z_range,
        'gnuplot-zrange=s'       => \$gnuplot_z_range,
        'gnuplot-graph-style=s'  => \$gnuplot_graph_style,
        'gnuplot-sort-style=s'   => \$gnuplot_sort_style,
        'gnuplot-3d'             => \$gnuplot_3d,
        'gnuplot-3D'             => \$gnuplot_3d,
        'gnuplot-view=s'         => \$gnuplot_view,
        'gnuplot-grayscale'      => \$gnuplot_grayscale,
        'gnuplot-file-prefix=s'  => \$gnuplot_file_prefix,
        'gnuplot-template=s'     => \$gnuplot_template_file,

        'CSV'               => \$csv_mode,        # CSV mode.
        'CSV-fields=s'      => \$csv_fields,      # Specify list of CSV fields.
        'CSV-unique-lines'  => \$csv_print_uniq,  # Only print unique lines in CSV output.
        'CSV-max-lines=i'   => \$csv_line_limit,  # Limit the number of CSV output lines.
        'CSV-start-line=i'  => \$csv_start_line,  # Starting line in CSV file.
        'CSV-end-line=i'    => \$csv_end_line,    # Ending line in CSV file.
        'CSV-regex=s'       => \$csv_regex,       # Require additional regex match.
        'CSV-neg-regex=s'   => \$csv_neg_regex,   # Require additional negative regex
                                                  #   match.
        'CSV-stdin'         => \$csv_stdin,       # Acquire iptables log data from
                                                  #   stdin.
        'plot-separator'    => \$plot_separator,  # Specify separator character for plot
                                                  #   data (both gnuplot and CSV data).
        'debug'             => \$debug,           # Run in debug mode.
        'debug-sid=i'       => \$debug_sid,       # Debug a specific signature.
        'Dump-conf'         => \$dump_conf,       # Dump config and exit.
        'Interval=i'        => \$chk_interval,    # Set $chk_interval from the
                                                  #   command line.
        'interface=s'       => \$cmdl_interface,  # Specify the IN interface manually
                                                  #   and ignore packets on all others.
        'config=s'          => \$config_file,     # Specify path to configuration file.
        'Override-config=s' => \$override_config_str,
        'fw-analyze'        => \$fw_analyze,      # Analyze the firewall ruleset and
                                                  #   exit.
        'fw-file=s'         => \$fw_file,         # Analyze ruleset contained within
                                                  #   $fw_file instead of a running
                                                  #   policy.
        'fw-list-auto'      => \$fw_list_auto,    # Display iptables chains used by
                                                  #   psad in auto blocking code.
        'List'              => \$fw_list_auto,    # Synonym for --fw-list-auto
        'fw-block-ip=s'     => \$fw_block_ip,     # Add an IP/net to the psad auto-
                                                  #   blocking chains.  Then psad can
                                                  #   manage timeouts, etc.
        'fw-rm-block-ip=s'  => \$fw_rm_block_ip,  # Delete any block rule against an IP
        'fw-del-chains'     => \$fw_del_chains,   # Delete psad chains in addition to
                                                  #   flushing them (requires --F as
                                                  #   well).
        'X'                 => \$fw_del_chains,   # Synonym for --fw-del-chains.
        'fw-dump'           => \$dump_ipt_policy, # Dump the iptables policy
                                                  #   (requires -D as well).
        'fw-include-ips'    => \$fw_include_ips,  # Include all IPs/nets in iptables
                                                  # dump (--fw-dump) output.
        'log-server'        => \$syslog_server,   # We are running psad on a syslog
                                                  #   logging server.
        'Kill'              => \$kill,            # Kill all running psad processes.
                                                  #   (psadwatchd, psad, kmsgsd)
        'Restart'           => \$restart,         # Restart psad with all options of
                                                  #   the currently running psad
                                                  #   process.
        'Flush'             => \$flush_fw,        # Flush any rules that psad previously
                                                  #   added via the auto blocking code.
        'Status'            => \$status_mode,     # Display status of any currently
                                                  #   running psad processes.
        'status-ip=s'       => \$status_ip,       # Display status for a specific IP.
        'status-dl=i'       => \$status_min_dl,   # Display status for scans that have
                                                  #   reached at least this danger
                                                  #   level.
        'status-summary'    => \$status_summary,  # Only display status summary info.
        'restrict-ip=s'     => \$restrict_ip,     # Only process packets that have
                                                  #   either this IP as the src or dst.
        'Benchmark'         => \$benchmark,       # Run in benchmark mode.
        'packets=i'         => \$num_packets,     # Specify number of packets to use
                                                  #   in benchmark test or in -A mode.
        'USR1'              => \$usr1,            # Send an existing psad process a
                                                  # USR1 signal (useful for debugging).
        'HUP'               => \$hup,             # Send psad processes a HUP signal
                                                  #   to re-import config.
        'lib-dir=s'         => \$lib_dir,         # Specify path to psad lib directory.
        'no-snort-sids'     => \$no_snort_sids,   # Disable search for snort SID's
                                                  #   in iptables messages.
        'no-whois'          => \$no_whois,        # Do not issue whois lookups against
        'no-passiveos'      => \$no_posf,         # Do not attempt to passively
        'no-passive-os'     => \$no_posf,         # Do not attempt to passively
                                                  #   fingerprint the remote OS.
        'no-signatures'     => \$no_signatures,   # Disable signature processing.
        'no-icmp-types'     => \$no_icmp_types,   # Disable icmp type/code validation.
        'no-icmp6-types'    => \$no_icmp6_types,  # Disable icmp6 type/code validation.
        'no-auto-dl'        => \$no_auto_dl,      # Disable auto danger level
                                                  #   assignment.
        'no-daemon'         => \$no_daemon,       # Do not run as a daemon.
        'no-fwcheck'        => \$no_fwcheck,      # Do not check firewall rules.
        'no-rdns'           => \$no_rdns,         # Do not issue dns lookups against
                                                  #   scanning IP address.
        'no-netstat'        => \$no_netstat,      # Do not check to see if the
                                                  #   firewall is listening on
                                                  #   localport that has been scanned.
        'no-ipt-errors'     => \$no_ipt_errors,   # Do not write malformed packet.
                                                  #   messages to error log.
        'no-kmsgsd'         => \$no_kmsgsd,       # Do not start kmsgsd (used for
                                                  #   debugging).
        'test-mode'         => \$test_mode,       # Enable test mode (used by the
                                                  #   test suite).
        'verbose'           => \$verbose,         # Verbose output (for both alerts
                                                  #   and debug info).
        'Version'           => \$print_ver,       # Print the psad version and exit.
        'help'              => \$help,            # Display help.
    ));
    &usage(0) if $help;

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

sub required_vars() {
    my @required_vars = (qw(
        EMAIL_ADDRESSES CHECK_INTERVAL FW_DATA_FILE FW_ERROR_LOG
        HOME_NET SNORT_SID_STR ENABLE_AUTO_IDS IGNORE_CONNTRACK_BUG_PKTS
        SCAN_TIMEOUT DANGER_LEVEL1 DANGER_LEVEL2 DANGER_LEVEL3
        DANGER_LEVEL4 DANGER_LEVEL5 PORT_RANGE_SCAN_THRESHOLD ALERT_ALL
        EMAIL_LIMIT IPTABLES_BLOCK_METHOD TCPWRAPPERS_BLOCK_METHOD
        EMAIL_ALERT_DANGER_LEVEL PSAD_FIFO_FILE WHOIS_LOOKUP_THRESHOLD
        DNS_LOOKUP_THRESHOLD WHOIS_TIMEOUT SNORT_RULES_DIR HOSTNAME
        PACKET_COUNTER_FILE DSHIELD_COUNTER_FILE SCAN_DATA_ARCHIVE_DIR
        ENABLE_PERSISTENCE AUTO_BLOCK_IPT_FILE AUTO_BLOCK_TCPWR_FILE
        SIGS_FILE AUTO_DL_FILE AUTO_BLOCK_TIMEOUT EXTERNAL_SCRIPT
        ENABLE_EXT_SCRIPT_EXEC EXEC_EXT_SCRIPT_PER_ALERT
        ENABLE_DSHIELD_ALERTS SYSLOG_DAEMON DSHIELD_ALERT_INTERVAL
        DSHIELD_ALERT_EMAIL DSHIELD_USER_ID DSHIELD_USER_EMAIL
        DSHIELD_DL_THRESHOLD DISK_CHECK_INTERVAL DISK_MAX_PERCENTAGE
        DISK_MAX_RM_RETRIES ETC_HOSTS_DENY_FILE ETC_SYSLOG_CONF
        ETC_SYSLOGNG_CONF MIN_ARCHIVE_DANGER_LEVEL ANALYSIS_MODE_DIR
        IMPORT_OLD_SCANS ICMP_TYPES_FILE SHOW_ALL_SIGNATURES
        IPT_PREFIX_COUNTER_FILE IGNORE_PORTS ENABLE_SCAN_ARCHIVE
        EMAIL_LIMIT_STATUS_MSG P0F_FILE IGNORE_PROTOCOLS IPT_AUTO_CHAIN1
        AUTO_IPT_SOCK IGNORE_INTERFACES ALERTING_METHODS
        ULOG_DATA_FILE MAIL_ALERT_PREFIX MAIL_STATUS_PREFIX
        MAIL_ERROR_PREFIX MAIL_FATAL_PREFIX ENABLE_AUTO_IDS_EMAILS
        FLUSH_IPT_AT_INIT ENABLE_MAC_ADDR_REPORTING TRUNCATE_FWDATA
        PSAD_DIR PSAD_RUN_DIR PSAD_FIFO_DIR ENABLE_FW_LOGGING_CHECK
        ENABLE_RENEW_BLOCK_EMAILS DSHIELD_EMAIL_FILE AUTO_BLOCK_REGEX
        ENABLE_AUTO_IDS_REGEX IPTABLES_PREREQ_CHECK SNORT_RULE_DL_FILE
        IPT_OUTPUT_PATTERN IPT_ERROR_PATTERN PROC_FORWARD_FILE PSAD_CONF_DIR
        EXTERNAL_NET HTTP_SERVERS SMTP_SERVERS DNS_SERVERS SQL_SERVERS
        TELNET_SERVERS AIM_SERVERS HTTP_PORTS SHELLCODE_PORTS
        ORACLE_PORTS ENABLE_INTF_LOCAL_NETS ENABLE_SNORT_SIG_STRICT
        IP_OPTS_FILE SIG_UPDATE_URL CONF_ARCHIVE_DIR TOP_SIGS_FILE
        TOP_PORTS_LOG_THRESHOLD TOP_SIGS_LOG_THRESHOLD
        TOP_SCANNED_PORTS_FILE STATUS_OUTPUT_FILE TOP_ATTACKERS_FILE
        STATUS_PORTS_THRESHOLD STATUS_SIGS_THRESHOLD STATUS_IP_THRESHOLD
        ANALYSIS_OUTPUT_FILE TOP_IP_LOG_THRESHOLD PSAD_LIBS_DIR
        PSAD_PID_FILE PSAD_CMDLINE_FILE PSAD_ERR_DIR MIN_DANGER_LEVEL
        IGNORE_KERNEL_TIMESTAMP ENABLE_SIG_MSG_SYSLOG
        SIG_MSG_SYSLOG_THRESHOLD SIG_SID_SYSLOG_THRESHOLD
        PSADWATCHD_CHECK_INTERVAL PSADWATCHD_MAX_RETRIES SYSLOG_IDENTITY
        SYSLOG_FACILITY SYSLOG_PRIORITY ENABLE_EMAIL_LIMIT_PER_DST
        ENABLE_SYSLOG_FILE IPT_SYSLOG_FILE IPT_WRITE_FWDATA
        ETC_RSYSLOG_CONF IFCFGTYPE ENABLE_WHOIS_FORCE_ASCII
        ENABLE_WHOIS_FORCE_SRC_IP ENABLE_IPV6_DETECTION
        PERSISTENCE_CTR_THRESHOLD MAX_SCAN_IP_PAIRS INSTALL_ROOT
        ICMP6_TYPES_FILE PROTOCOL_SCAN_THRESHOLD PROTOCOLS_FILE
        AUTO_BLOCK_DL1_TIMEOUT AUTO_BLOCK_DL2_TIMEOUT
        AUTO_BLOCK_DL3_TIMEOUT AUTO_BLOCK_DL4_TIMEOUT
        AUTO_BLOCK_DL5_TIMEOUT EMAIL_THROTTLE EXPECT_TCP_OPTIONS
        ENABLE_PSADWATCHD ENABLE_EXT_BLOCK_SCRIPT_EXEC EXTERNAL_BLOCK_SCRIPT
        ENABLE_FW_MSG_READ_CMD FW_MSG_READ_CMD FW_MSG_READ_CMD_ARGS
        USE_FW_MSG_READ_CMD_ARGS CUSTOM_SYSLOG_TS_RE
        ENABLE_CUSTOM_SYSLOG_TS_RE FW_MSG_READ_MIN_PKTS ENABLE_DNS_LOOKUPS
        ENABLE_WHOIS_LOOKUPS PSAD_FW_READ_PID_FILE
    ));
    &defined_vars(\@required_vars);
    return;
}

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

psad: the Port Scan Attack Detector

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

Usage: psad [options]

Options:

    -A,  --Analyze-msgs           - Analyze iptables logfile and exit.
         --stdin                  - In --Analyze-msgs mode, acquire iptables
                                    log data from STDIN.
    -e,  --email-analysis         - Send emails for scans detected in
                                    offline analysis mode.
    -m,  --messages-file <file>   - Specify the path to the iptables logfile
                                    (for --Analyze-msgs mode).
    -i,  --interface <intf>       - Restrict detection to IN interface (for
                                    INPUT and FORWARD chains) or OUT
                                    interface (for OUPUT chain).
    --sig-update                  - Download the latest set of psad
                                    signatures from:
                                    http://www.cipherdyne.org/
    -w,  --whois-analysis         - Enable whois lookups when running in
                                    offline --Analyze-msgs mode.
    --dns-analysis                - Enable reverse DNS lookups in
                                    --Analyze-msgs mode.
    --fw-analyze                  - Analyze the local iptables ruleset and
                                    exit.
    --fw-list-auto                - List the contents of any iptables chains
                                    (for auto-blocking rules).
    --List                        - Synonym for --fw-list-auto (emulates
                                    iptables command line).
    --fw-block-ip  <ip>           - Add an IP/network to the auto-blocking
                                    chains.
    --fw-rm-block-ip  <ip>        - Remove an IP/network from the auto-
                                    blocking chains.
    --fw-file <rules file>        - Analyze the iptables ruleset contained
                                    within <rules file> instead of a running
                                    policy.
    --fw-del-chains               - Delete iptables chains used by psad for
                                    auto-blocking rules.
    -X                            - Synonym for --fw-del-chains (emulates
                                    iptables command line).
    --fw-dump                     - Dump a sanitized version of the local
                                    iptables policy.
    --fw-include-ips              - Include all IPs/nets in iptables dump
                                    (--fw-dump) output.
    --snort-rdir <rule dir>        - Path to snort rules directory.
    --debug,                      - Run psad in debugging mode.
    --debug-sid <sid>             - Debug a specific Snort rule.
    -D,  --Dump-conf              - Dump psad configuration on STDOUT and
                                    exit.
    -l,  --log-server             - psad is being run on a syslog logging
                                    server.
    -F,  --Flush                  - Remove any auto-generated firewall
                                    block rules (emulates iptables command
                                    line).
    -K,  --Kill                   - Kill all running psad processes.
    -R,  --Restart                - Restart all running psad processes.
    -S,  --Status                 - Displays the status of any currently
                                    running psad processes.
    --restrict-ip <IP or net>     - Only process packets that have this IP
                                    or network as the src or dst.
    --status-ip <IP address>      - View status for a specific IP.
    --status-dl <dl>              - Display status information for only
                                    those scans that have reach at least
                                    <dl> (from 1 to 5).
    --status-summary              - Only display summary status output in
                                    --Status and --Analyze modes.
    -B,  --Benchmark              - Run psad in benchmark mode.
    --packets <number>            - Specify number of packets to use in
                                    --Analyze (default is unlimited) or
                                    --Benchmark (default is 10,000) modes.
    -U,  --USR1                   - Send a running psad process a USR1
                                    signal (generates a dump of psad
                                    data structures on STDOUT).
    -H,  --HUP                    - Send all psad daemons a HUP signal to
                                    have them re-import configs.
    --get-next-rule-id            - Display the next available rule ID and
                                    exit.

    --gnuplot                     - Parse iptables log data and produce a
                                    file suitable for plotting with Gnuplot.
    --gnuplot-graph-style         - Set the Gnuplot graph style (e.g.
                                    "dots", "lines", "linespoints", etc.).
    --gnuplot-file-prefix         - Use a prefix for the .gnu, .dat, and
                                    .png files that are generated in Gnuplot
                                    mode.
    --gnuplot-interactive         - Do not add the terminal directive to the
                                    Gnuplot .gnu file, so when Gnuplot loads
                                    the file it will graph the data in an
                                    interactive window.
    --gnuplot-title               - Set the Gnuplot graph title.
    --gnuplot-legend-title        - Set the Gnuplot legend title.
    --gnuplot-x-label             - Set the x-axis label.
    --gnuplot-x-range             - Set the x-axis range.
    --gnuplot-y-label             - Set the y-axis label.
    --gnuplot-y-range             - Set the y-axis range.
    --gnuplot-z-label             - Set the z-axis label.
    --gnuplot-z-range             - Set the z-axis range.
    --gnuplot-sort-style          - Set the psad sorting style to either
                                    "time" or "value" (defaults to "value").
    --gnuplot-3D                  - Create three-dimensional Gnuplot graph.
    --gnuplot-view                - Set the viewing angle.
    --gnuplot-grayscale           - Only use grayscale colors.
    --gnuplot-template <file>     - Use a template file for all Gnuplot
                                    directives.
    --gnuplot-dat-file            - Specify path to .dat output file.
    --gnuplot-plot-file           - Specify path to .gnu output file.
    --gnuplot-png-file            - Specify path to .png output file.

    --CSV                         - Parse iptables log messages and dump
                                    fields to stdout in csv format.
    --CSV-fields <fields>         - Restrict --CSV output to a list of
                                    specfic fields.
    --CSV-unique-lines            - Only print unique lines in CSV output.
    --CSV-max-lines <num>         - Specify the maximum number of CSV output
                                    lines to print.
    --CSV-start-line <line>       - Starting line within iptables log file.
    --CSV-end-line <line>         - Ending line within iptables log file.
    --CSV-regex <regex>           - Require iptables log messages to match
                                    an additional regex in --CSV mode.
    --CSV-neg-regex <regex>       - Require iptables log messages to
                                    not match an additional regex in --CSV
                                    mode.
    --plot-separator <str>        - Specify a separator string between plot
                                    fields (in --gnuplot or --CSV plot
                                    modes (the default is a comma for CSV
                                    formatted output).

    --signatures <sigs file>      - Manually specify the path to the psad
                                    signatures file.
    --snort-type                  - Restrict psad to look for specific Snort
                                    sids such as those in ddos.rules or
                                    backdoor.rules.
    --passive-os-sigs <sigs file> - Manually specify the path to the passive
                                    os fingerprinting sigs.
    --auto-dl <dl file>           - Import auto-danger level file for
                                    automatic IP danger level increases or
                                    decreses.
    --analysis-write-data         - Write data to filesystem from -A mode
                                    (the disk IO involved in this step can
                                    take a long time).
    -c,  --config <config file>   - Use <config file> instead of the normal
                                    config file located at
                                    $config_file.
    -O, --Override-config <str>   - Allow config variables from the normal
                                    $config_file to be superseded with values
                                    from the specified file(s).
    -I,  --Interval <seconds>     - Configure the check interval from the
                                    command line to override the 5 second
                                    default.
    -v,  --verbose                - Run in verbose mode.
    -V,  --Version                - Print the psad version and exit.

    --no-snort-sids               - Disable examination for snort sids
                                    (such as those generated by fwsnort) in
                                    iptables log messages.
    --no-signatures               - Disable psad signature processing
                                    (independent of snort sid matching).
    --no-icmp-types               - Disable icmp type/code validation.
    --no-auto-dl                  - Disable auto danger level assignment.
    --no-daemon                   - Do not run as a daemon.
    --no-ipt-errors               - Do not write errors to the error log.
    --no-whois                    - Disable whois lookups.
    --no-fwcheck                  - Disable firewall rules verification.
    --no-rdns                     - Disable name resolution against scanning
                                    IP addresses.
    --no-kmsgsd                   - Disable startup of kmsgsd (useful for
                                    debugging with an existing file of
                                    iptables log messages).
    --no-netstat                  - Disable local port lookups for scan
                                    signatures.
    -h   --help                   - Display usage on STDOUT and exit.

_HELP_
    exit $exitcode;
}