#!/usr/bin/perl -w
#
################################################################################
#
# File: 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 kmsgsd which reads
#          firewall messages out of the /var/lib/psad/psadfifo named pipe
#          (syslog is reconfigured to write kern.info messages there
#          which include firewall messages).  For more information read
#          the psad man page or view the documentation provided at:
#          http://www.cipherdyne.org.
#
# Author: Michael Rash (mbr@cipherdyne.org)
#
# Credits: (see the CREDITS file bundled with the psad sources.)
#
# Version: 1.4.1
#
# Copyright (C) 1999-2002 Michael Rash (mbr@cipherdyne.org)
#
# License (GNU Public License):
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
#    USA
#
# TODO: (see the TODO file bundled with the psad sources.)
#
# Default Command Line Arguments:  As of the 1.0.0-pre3 release, psad by
#   by default will have the --signatures and --auto-dl options set even
#   if these options are not specified on the command line, and psad
#   will use the default locations for the signatures and auto_dl files.
#   The default file locations can be changed by manually specifying the
#   locations to these files with the --signatures and --auto-dl options.
#   The signature matching and the auto_dl danger level assignments can
#   be disabled by using the --no-signatures and --no-auto-dl options
#   respectively.  In addition, psad adheres to the following defaults:
#
#       -passive OS fingerprinting            = yes
#       -snort sid signature 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 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
#   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.
#   curr_sig  - Current signature.
#   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/<srcip>" for each new <srcip>
#   from which a scan is detected.  Under this directory several files are
#   created:
#
#       danger_level          - Overall danger level aggregated for all scans.
#       whois                 - Whois information for <srcip>.
#       email_count           - Total email alerts sent for <srcip>.
#       <destip>_email_alert  - The most recent email alert for <destip>.
#       <destip>_packet_ctr   - Packet counters for <destip>.
#       <destip>_signatures   - Signatures detected against <destip>.
#
#   Note that some of the files above contain the destination address since a
#   single source address may scan several destination addresses.
#
###############################################################################
#
# $Id: psad,v 1.495 2005/03/12 17:14:22 mbr Exp $
#

### modules used by psad
use lib '/usr/lib/psad';
use Psad;
use IPTables::ChainMgr;
use Net::IPv4Addr qw(ipv4_network ipv4_in_network ipv4_broadcast);
use File::Copy;
use File::Path;
use Date::Calc qw(Timezone This_Year Decode_Month);
use Socket;
use POSIX;
use IO::Handle;
use Data::Dumper;
use Getopt::Long 'GetOptions';
use strict;

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

### set the current psad version number
my $version = '1.4.1';

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

### default fw_search file where FW_MSG_SEARCH strings
### are set.  Both psad and kmsgsd reference this single
### file now instead of having FW_MSG_SEARCH appear in
### psad.conf and kmsgsd.conf.
my $fw_search_file = '/etc/psad/fw_search.conf';

### default config file for ALERTING_METHODS keyword, which
### is referenced by both psad and psadwatchd.  This keyword
### allows email alerting or syslog alerting (or both) to be
### disabled.
my $alerting_config_file = '/etc/psad/alert.conf';

### disable debugging by default
my $debug = 0;

my $flush_fw = 0;

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

### configuration hash
my %config = ();

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

### 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 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_sigs = ();

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

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

### cache all scan signatures (initialized by default)
my %sigs = ();

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

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

### cache signature messages, danger levels, etc.
my %sigs_attr = ();

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

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

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

### 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 = ();

### regex to match an ip address
my $ip_re = '(?:\d{1,3}\.){3}\d{1,3}';

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

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

### pid file hash
my %pidfiles;

### 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_msgs     = 0;
my $syslog_server    = 0;
my $kill             = 0;
my $restart          = 0;
my $status           = 0;
my $status_ip        = '';
my $status_sort_dl   = 0;
my $status_dl        = 0;
my $fw_list_auto     = 0;
my $fw_block_ip      = '';
my $fw_del_chains    = 0;
my $benchmark        = 0;
my $b_packets        = 0;
my $usr1             = 0;
my $hup              = 0;
my $usr1_flag        = 0;
my $hup_flag         = 0;
my $verbose          = 0;
my $ver              = 0;
my $help             = 0;
my $dump_conf        = 0;
my $status_brief     = 0;
my $chk_interval     = 0;
my $log_len          = 23;  ### used in scan_logr()
my $fw_analyze       = 0;
my $fw_file          = '';
my $rm_data_ctr      = 0;
my $analysis_emails  = 0;
my $analysis_whois   = 0;
my $netstat_lkup_ctr = 0;
my $warn_msg         = '';
my $die_msg          = '';
my $messages_file    = '/var/log/messages';
my $local_ips_lkup_ctr = 0;

### 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_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;

### these vars are controled by the alert.conf file
my $no_email_alerts  = 0;
my $no_syslog_alerts = 0;

### old command line options
my $oldarg_snort_sids;
my $oldarg_autoips;
my $oldarg_nerrs;
my $oldarg_nerrs2;
my $oldarg_rdns;
my $oldarg_nrdns;
my $oldarg_whois;
my $oldarg_nwhois;
my $oldarg_nlport;
my $oldarg_fwcheck;
my $oldarg_nfwchk;
my $oldarg_daemon;
my $oldarg_logserv;

### used in --Benchmark test
my $b_time;
my $test_pkt;
my $test_pktend;

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

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

my $mail_status_prefix = '[psad-status]';
my $mail_error_prefix  = '[psad-error]';
my $mail_fatal_prefix  = '[psad-fatal]';
my $mail_alert_prefix  = '[psad-alert]';

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

### make Getopts case sensitive
Getopt::Long::Configure('no_ignore_case');

&usage(1) unless (GetOptions(
    'signatures=s'      => \$sigs_file,       # Path to psad signatures file.
    '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.
    'Analyze-msgs'      => \$analyze_msgs,    # Analysis mode for old iptables
                                              #   messages in the psad fwdata file
                                              #   (or messages file; see
                                              #   --messages).
    'whois-analysis'    => \$analysis_whois,  # Issue whois lookups in analysis
                                              #   mode.
    'email-analysis'    => \$analysis_emails, # Send analysis mode emails.
    'messages-file=s'   => \$messages_file,   # Specify the path to file containing
                                              #   old iptables messages (fwdata by
                                              #   default).
    'debug'             => \$debug,           # Run in debug mode.
    'Dump-conf'         => \$dump_conf,       # Dump config and exit.
    'interval=i'        => \$chk_interval,    # Set $chk_interval from the
                                              #   command line.
    'config=s'          => \$config_file,     # Specify path to configuration file.
    'fw-search=s'       => \$fw_search_file,  # Specify path to fw_search.conf.
    '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 Netfilter chains used by
                                              #   psad in auto blocking code.
    'fw-block-ip=s'     => \$fw_block_ip,     # Add an IP/net to the psad auto-
                                              #   blocking chains.  Then psad can
                                              #   manage timeouts, etc.
    'fw-del-chains'     => \$fw_del_chains,   # Delete psad chains in addition to
                                              #   flushing them (requires --F as
                                              #   well).
    '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,          # Display status of any currently
                                              #   running psad processes.
    'status-ip=s'       => \$status_ip,       # Display status for a specific IP.
    'status-sort-dl'    => \$status_sort_dl,  # Sort by danger level instead of by
                                              #   IP address in --Status output.
    'status-dl=i'       => \$status_dl,       # Display status for scans that have
                                              #   reached at least this danger
                                              #   level.
    'status-brief'      => \$status_brief,    # Do not include number of email
                                              #   alerts or os guess in status
                                              #   output.
    'Benchmark'         => \$benchmark,       # Run in benchmark mode.
    'packets=i'         => \$b_packets,       # Specify number of packets to use
                                              #   in benchmark test.
    '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.
    '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
                                              #   fingerprint the remote OS.
    'no-signatures'     => \$no_signatures,   # Disable signature processing.
    'no-icmp-types'     => \$no_icmp_types,   # Disable icmp 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).
    'verbose'           => \$verbose,         # Verbose output (for both alerts
                                              #   and debug info).
    'Version'           => \$ver,             # Print the psad version and exit.
    'help'              => \$help,            # Display help.
    ### old args
    'Logging_server'    => \$oldarg_logserv, # old command line arg
    'no_fw_check'       => \$oldarg_nfwchk,  # old command line arg
    'snort-sids'        => \$oldarg_snort_sids, # old command line arg
    'reversedns'        => \$oldarg_rdns,    # old command line arg
    'no_errors'         => \$oldarg_nerrs,   # old command line arg
    'no-errors'         => \$oldarg_nerrs2,  # old command line arg
    'no_whois'          => \$oldarg_nwhois,  # old command line arg
    'no_rdns'           => \$oldarg_nrdns,   # old command line arg
    'no_localport'      => \$oldarg_nlport,  # old command line arg
));
&usage(0) if $help;

### Print the version number and exit if -V given on the command line.
if ($ver) {
    print "[+] psad v$version, by Michael Rash ",
        "<mbr\@cipherdyne.org>\n";
    exit 0;
}

### check for any old command line arguments
&check_old_cmdargs();

### 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).
$< == 0 && $> == 0 or
    die '[*] psad: You must be root (or equivalent ',
        "UID 0 account) to execute psad!  Exiting.\n";

### 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.
&Psad::unique_pid($config{'PID_FILE'})
    unless $fw_analyze or $benchmark;

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

### disable whois lookups if for some reason the whois client that is
### bundled with psad can't be found
unless ($no_whois) {
    unless (defined $cmds{'whois'}
            and -x $cmds{'whois'}) {  ### we couldn't find whois_psad
        warn '[-] Could not locate whois_psad binary.  ',
            "Disabling whois lookups.\n";
        $no_whois = 1;
    }
}

### 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 $benchmark) {
    my $opts = "-c $config_file --fw-search $fw_search_file";
    $opts .= " --fw-analyze" if $fw_analyze;
    $opts .= " --fw-file $fw_file" if $fw_file;
    $opts .= " --no-fw-search-all" if $config{'FW_SEARCH_ALL'} eq 'N';
    my $es = (system "$cmds{'fwcheck_psad'} $opts") >> 8;

    exit $es if $fw_analyze;  ### finished analyzing ruleset so exit.
}

### initialize benchmarking test packets if we are running
### in benchmark mode
if ($benchmark) {
    $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=10.0.0.1 DST=10.0.0.2 LEN=48 TOS=0x00 PREC=0x00 ' .
        'TTL=110 ID=13383 DF PROTO=TCP SPT=1389 ';
    $test_pktend = 'WINDOW=16384 RES=0x00 SYN URGP=0';
}

### daemonize psad unless running with --no-daemon or an
### analysis mode
unless ($no_daemon or $debug or $benchmark) {
    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
&Psad::writepid($config{'PID_FILE'})
    unless $benchmark;

### write the command line args used to start psad to $cmdline_file
&Psad::writecmdline(\@args_cp, $cmdline_file)
    unless $benchmark;

### psad _requires_ that kmsgsd is running to receive any data, 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.
unless ($benchmark or $fw_analyze) {
    system $cmds{'kmsgsd'} unless $no_kmsgsd;
    system $cmds{'psadwatchd'}
        unless $debug or $no_daemon;
}

### 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() if $config{'ENABLE_AUTO_IDS'} eq 'Y';

### Install signal handlers for debugging %scan with Data::Dumper,
### and for reaping zombie whois processes.  Only install signal
### handlers if we are not running in benchmark mode
unless ($benchmark or $fw_analyze) {
    $SIG{'__WARN__'} = \&warn_handler;
    $SIG{'__DIE__'}  = \&die_handler;
    $SIG{'CHLD'}     = \&REAPER;
    $SIG{'USR1'}     = \&usr1_handler;
    $SIG{'HUP'}      = \&hup_handler;
}

if ($benchmark) {
    print scalar localtime(), " [+] Entering benchmark mode.\n";
    $no_rdns  = 1;  ### turn off network related functions
    $no_whois = 1;
    if ($b_packets) {
        print scalar localtime(),
            " [+] Executing a $b_packets packet test.\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";
        $b_packets = 10000;
    }
}

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

unless ($benchmark) {
    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();
    }
}

unless ($fw_analyze or $benchmark) {
    ### 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();
}

### Get an open filehandle for the main firewall data file FW_DATA_FILE.
### All firewall drop/reject log messages are written to FW_DATA_FILE
### by kmsgsd.
open FWDATA, $config{'FW_DATA_FILE'} or die '[*] Could not open ',
    "$config{'FW_DATA_FILE'}: $!" unless $benchmark;

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

    ### scope and clear the firewall data array
    my @fw_packets = ();

    if ($hup_flag) {
        $hup_flag = 0;  ### clear the HUP flag

        &Psad::psyslog('psad', 'received HUP signal, ' .
            're-importing psad.conf') unless $no_syslog_alerts;

        my $orig_fwdata = $config{'FW_DATA_FILE'};

        ### Re-import all used config files (psad.conf, auto_dl,
        ### posf, signatures) if we received a HUP signal.
        &psad_init();

        if ($orig_fwdata ne $config{'FW_DATA_FILE'}) {
            close FWDATA;
            ### zero out the new fwdata file just in case (the path
            ### has changed).
            open FWDATA, "> $config{'FW_DATA_FILE'}" or die
                "[*] Could not open $config{'FW_DATA_FILE'}:$!";
            close FWDATA;

            ### re-open the fwdata file
            open FWDATA, $config{'FW_DATA_FILE'} or die
                "[*] Could not open $config{'FW_DATA_FILE'}: $!"
        }
    }

    ### See if we need to print out the %scan datastructure
    ### (we received a USR1 signal)
    if ($usr1_flag) {
        $usr1_flag = 0;  ### clear the USR1 flag

        &Psad::psyslog('psad', 'received USR1 signal, printing scan ' .
            "hashes to $config{'PSAD_DIR'}/scan_hash.$$")
            unless $no_syslog_alerts;

        &print_scan();
    }

    ### Get any new packets have been written to
    ### FW_DATA_FILE by kmsgsd for psad analysis.
    if ($benchmark) {
        $b_time = time();
        print scalar localtime(), " [+] Creating packet array.\n";
        my $dp = 1000;
        for (my $i=0; $i <= $b_packets; $i++) {
            push @fw_packets, "$test_pkt DPT=$dp $test_pktend";
            $dp++ if $dp < 50000;
        }
    } else {
        @fw_packets = <FWDATA>;
    }
    if (@fw_packets) {
        print scalar localtime(), " [+] check_scan()\n" if $benchmark;

        if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y' and not $benchmark) {
            ### 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++;

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

        unless ($benchmark or $analyze_msgs) {
            ### 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' and not $benchmark) {
        ### 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).
        if ($config{'AUTO_BLOCK_TIMEOUT'} > 0) {
            &timeout_auto_blocked_ips();
        }

        ### see if we need to add any IP address from the Netfilter cache
        ### file.
        &check_ipt_add_ip();
    }

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

    ### 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'}
            and not $benchmark) {
        ### See how we are doing on disk space, and remove data
        ### if necessary.
        if (&disk_space_exceeded()) {
            close FWDATA;

            ### truncate fwdata file
            open FWDATA, "> $config{'FW_DATA_FILE'}" or die
                "[*] Could not open $config{'FW_DATA_FILE'}: $!";
            close FWDATA;

            ### re-open the fwdata file
            open FWDATA, $config{'FW_DATA_FILE'} or die
                "[*] Could not open $config{'FW_DATA_FILE'}: $!";
        }
        $last_disk_check = time();
    }

    ### 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: $#fw_packets\n";
    }

    if ($benchmark) {
        print scalar localtime(), " [+] Packet creation and processing time: ",
            time() - $b_time, " sec.\n";
        print scalar localtime(), " [+] Exiting benchmark mode.\n";
        exit 0;
    }

    if ($die_msg) {
        &Psad::print_sys_msg($die_msg, "$config{'PSAD_DIR'}/errs/psad.die");
        $die_msg = '';
    }

    if ($warn_msg) {
        &Psad::print_sys_msg($warn_msg, "$config{'PSAD_DIR'}/errs/psad.warn");
        $warn_msg = '';
    }

    ### clearerr() on the FWDATA filehandle to be ready for new packets
    FWDATA->clearerr();

    ### sleep for the check interval seconds
    sleep $config{'CHECK_INTERVAL'};
}
exit 0;
###=========================================================###
######                    END MAIN                       ######
###=========================================================###

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

### 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_aref = shift;

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

    my $pkt_ctr = 0;
    my $print_scale_factor = 0;

    if ($analyze_msgs) {
        if ($#$fw_packets_aref < 100) {
            $print_scale_factor = $#$fw_packets_aref;
        } else {
            $print_scale_factor = int($#$fw_packets_aref/10);
            if ($print_scale_factor < 100) {
                $print_scale_factor -= $print_scale_factor % 10;
            } elsif ($print_scale_factor < 1000) {
                $print_scale_factor -= $print_scale_factor % 100;
            } elsif ($print_scale_factor < 10000) {
                $print_scale_factor -= $print_scale_factor % 1000;
            } elsif ($print_scale_factor < 100000) {
                $print_scale_factor -= $print_scale_factor % 10000;
            } elsif ($print_scale_factor < 1000000) {
                $print_scale_factor -= $print_scale_factor % 100000;
            } else {
                $print_scale_factor = 50000;
            }
        }
        $print_scale_factor++ if $print_scale_factor == 0;
    }

    #  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

    PKT: for my $pkt (@$fw_packets_aref) {
        my $src = '';
        my $dst = '';
        my $len = -1;
        my $tos = '';
        my $ttl = -1;
        my $id  = -1;
        my $proto = '';
        my $sp    = -1;
        my $dp    = -1;
        my $win   = -1;
        my $type  = -1;
        my $code  = -1;
        my $seq   = -1;
        my $flags = '';
        my $frag_bit = 0;
        my $sid   = 0;
        my $chain    = '';
        my $intf     = '';
        my $tcp_options = '';
        my $dshield_str = '';
        my $syslog_host = '';
        my $log_prefix  = '';

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

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

        ### see if we need to ignore this packet based on the
        ### IGNORE_PROTOCOLS config keyword.
        if (%ignore_protocols) {
            for my $proto (keys %ignore_protocols) {
                next PKT if $pkt =~ /\sPROTO=$proto\s/;
            }
        }

        ### get the in/out interface and iptables chain
        if ($pkt =~ /IN=(\S+)\s+OUT=\s/) {
            $intf = $1;
            $chain = 'INPUT';
        } elsif ($pkt =~ /IN=(\S+)\s+OUT=\S/) {
            $intf = $1;
            $chain = 'FORWARD';
        } elsif ($pkt =~ /IN=\s+OUT=(\S+)/) {
            $intf = $1;
            $chain = 'OUTPUT';
        }

        unless ($intf and $chain) {
            print STDERR "[-] err packet: could not determine ",
                "interface and chain.\n" if $debug;
            push @err_pkts, $pkt;
            next PKT;
        }

        if (%ignore_interfaces) {
            for my $ignore_intf (keys %ignore_interfaces) {
                next PKT if $intf eq $ignore_intf;
            }
        }

        ### get the syslog logging host for this packet
        if ($pkt =~ /(\S+)\s+kernel:/) {
            $syslog_host = $1;
        } elsif ($pkt =~ /^\s*\S+\s+\S+\s+\S+\s+(\S+)/) {
            ### parsed packet from the beginning where the time portion
            ### of the syslog message is
            $syslog_host = $1;
        }

        ### try to extract a snort sid (generated by fwsnort) from
        ### the packet
        unless ($no_snort_sids) {
            if ($pkt =~ /$config{'SNORT_SID_STR'}(\d+)\s*IN=/) {
                $sid = $1;
            }
        }

        unless ($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 =~ /$fw_search_str/;
            }
            next PKT unless $matched;
        }

        ### see if there is a logging prefix (used for scan email alert even
        ### if we are running with FW_SEARCH_ALL = Y).
        if ($pkt =~ /kernel:\s+(.*?)\s*IN=/) {
            $log_prefix = $1;
            if ($log_prefix =~ /\S/) {
                $ipt_prefixes{$log_prefix}++;
            }
        }

        ### 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 =~ /SRC=(\S+)\s+DST=(\S+)\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+
                    RES=\S+\s*(.*)\s+URGP=/x) {
            ($src, $dst, $len, $tos, $ttl, $id, $sp, $dp, $win, $flags) =
                ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10);
            if ($pkt =~ /\sRES=\S+\s*(.*)\s+URGP=/) {
                    $flags = $1;
            }
            $proto = 'tcp';
            $flags = 'NULL' unless $flags;  ### default to NULL
            if (!$sid && $config{'IGNORE_CONNTRACK_BUG_PKTS'} eq 'Y' &&
                    ($flags =~ /ACK/ || $flags =~ /RST/)) {
#                    $dp > 1024 && ($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;
                next PKT;
            }
            ### per page 595 of the Camel book, "if /blah1|blah2/"
            ### can be slower than "if /blah1/ || /blah2/
            unless ($flags !~ /WIN/ &&
                    $flags =~ /ACK/ ||
                    $flags =~ /SYN/ ||
                    $flags =~ /RST/ ||
                    $flags =~ /URG/ ||
                    $flags =~ /PSH/ ||
                    $flags =~ /FIN/ ||
                    $flags eq 'NULL') {
                print STDERR "[-] err packet: bad tcp flags.\n" if $debug;
                push @err_pkts, $pkt;
                next PKT;
            }
            $frag_bit = 1 if $pkt =~ /\sDF\s+PROTO/;
            ### don't pickup IP options if --log-ip-options is used
            ### (they appear before the PROTO= field).
            if ($pkt =~ /URGP=\S+\s+OPT\s+\((\S+)\)/) {
                $tcp_options = $1;
            }

            ### make sure we have a "reasonable" packet (note that nmap
            ### can scan port 0 and iptables can report this fact)
            unless ($src and $dst and $len >= 0 and $tos and $ttl >= 0
                    and $id >= 0 and $proto and $sp >= 0 and $dp >= 0
                    and $win >= 0 and $flags) {
                push @err_pkts, $pkt;
                next PKT;
            }
            $tcp_ctr++;

            if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
                    and not $benchmark
                    and not $analyze_msgs) {
                my $dflags = $flags;
                $dflags =~ s/\s/,/g;
                $dshield_str = "$src\t$sp\t$dst\t$dp\t$proto\t$dflags";
            }
        ### 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
        } elsif ($pkt =~ /SRC=(\S+)\s+DST=(\S+)\s+LEN=(\d+)\s+TOS=(\S+)
                          \s.*TTL=(\d+)\s+ID=(\d+)\s*.*\s+PROTO=UDP\s+
                          SPT=(\d+)\s+DPT=(\d+)/x) {
            ($src, $dst, $len, $tos, $ttl, $id, $sp, $dp) =
                ($1,$2,$3,$4,$5,$6,$7,$8);
            $proto = 'udp';

            ### make sure we have a "reasonable" packet (note that nmap
            ### can scan port 0 and iptables can report this fact)
            unless ($src and $dst and $len >= 0 and $tos and $ttl >= 0
                    and $id >= 0 and $proto and $sp >= 0 and $dp >= 0) {
                push @err_pkts, $pkt;
                next PKT;
            }
            $udp_ctr++;

            if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
                    and not $benchmark
                    and not $analyze_msgs) {
                $dshield_str = "$src\t$sp\t$dst\t$dp\t$proto";
            }
        } elsif ($pkt =~ /SRC=(\S+)\s+DST=(\S+)\s+LEN=(\d+).*
                          TTL=(\d+).*PROTO=ICMP\s+TYPE=(\d+)\s+
                          CODE=(\d+)\s+ID=(\d+)\s+SEQ=(\d+)/x) {
            ($src, $dst, $len, $ttl, $type, $code, $id, $seq) =
                ($1,$2,$3,$4,$5,$6,$7,$8);
            $proto = 'icmp';
            unless ($src and $dst and $len >= 0 and $ttl >= 0 and $proto
                    and $type >= 0 and $code >= 0 and $id >= 0
                    and $seq >= 0) {
                push @err_pkts, $pkt;
                next PKT;
            }
            $icmp_ctr++;

            if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
                    and not $benchmark
                    and not $analyze_msgs) {
                $dshield_str = "$src\t$type\t$dst\t$code\t$proto";
            }
        } 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;
            push @err_pkts, $pkt;
            next PKT;
        }

        ### If we made it here then we correctly matched packets
        ### that the firewall logged.
        print STDERR "[+] valid packet: $src -> $dst $proto\n" if $debug;

        ### 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{$src}) {
            $scan_dl{$src} = 0;
            $scan{$src}{$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) {
            if (&assign_auto_danger_level($src, $proto) == 0) {
                next PKT;
            }
        }

        if (%ignore_ports and $proto ne 'icmp') {
            next PKT if &ignore_port($dp, $proto);
        }

        if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
                and not $benchmark
                and not $analyze_msgs
                and $dshield_str) {
            if ($pkt =~ /^\s*(\w+)\s+(\d+)\s+(\S+)/) {
                my $month   = Decode_Month($1);
                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$dshield_str\n";
            }
        }

        ### see if we need to timeout any old scans
        if ($config{'ENABLE_PERSISTENCE'} eq 'N') {
            if (defined $scan{$src}{$dst}{'s_time'}) {
                if ((time() - $scan{$src}{$dst}{'s_time'})
                        >= $config{'SCAN_TIMEOUT'}) {
                    delete $scan{$src}{$dst};
                }
            }
        }

        if ($config{'ENABLE_AUTO_IDS'} eq 'Y'
                and not defined $auto_blocked_ips{$src}) {
            $auto_blocked_ips{$src}{'time'}    = time();
            $auto_blocked_ips{$src}{'blocked'} = 0;
        }

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

        ### increment hash values
        $scan{$src}{$dst}{'absnum'}++;
        $scan{$src}{$dst}{'chain'}{$chain}{$intf}{$proto}++;
        $curr_scan{$src}{$dst}{$proto}{'pkts'}++;
        $curr_scan{$src}{$dst}{$proto}{'flags'}{$flags}++
            if $flags;

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

        ### keep track of iptables chain and logging prefix (if there
        ### was one)
        $log_prefix = '*noprfx*' unless $log_prefix;
        $curr_scan{$src}{$dst}{$proto}{'chain'}
                {$chain}{$log_prefix}++;

        unless ($proto eq 'icmp') {
            ### initialize the start and end port for the scanned port range
            if (not defined $curr_scan{$src}{$dst}{$proto}{'strtp'}) {
                ### make sure the initial start port is not too low
                $curr_scan{$src}{$dst}{$proto}{'strtp'} = 65535;
                ### make sure the initial end port is not too high
                $curr_scan{$src}{$dst}{$proto}{'endp'} = 0;
            }
            if (not defined $scan{$src}{$dst}{$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{$src}{$dst}{$proto}{'abs_sp'} = 65535;
                ### make sure the initial end port is not too high
                $scan{$src}{$dst}{$proto}{'abs_ep'} = 0;
            }

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

        print STDERR Dumper $scan{$src}{$dst} if $debug;

        ### 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).
        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 ($proto eq 'tcp' and $flags =~ /SYN/) {
                if ($tcp_options) {  ### got the tcp options portion of the header

                    ### p0f based fingerprinting
                    &p0f($src, $len, $frag_bit, $ttl, $win, $tcp_options);

                } elsif (not defined $posf{$src}{'guess'}
                        and $scan{$src}{$dst}{'absnum'} < 100
                        and $proto eq 'tcp'
                        and $flags =~ /SYN/) {
                    &posf($src, $len, $tos, $ttl, $id, $win)
                }
            }
        }

        if ($sid and not $no_snort_sids) {
            ### found a snort sid in the packet log message
            my $dl = &add_snort_sid($src, $dst,
                $chain, $proto, $sid);
            $curr_sids_dl{$src} = $dl if $dl;
        } else {
            ### attempt to match any tcp/udp/icmp signatures in the
            ### main signatures hash
            unless ($no_signatures) {
                my $dl = &match_sigs($src, $dst, $chain, $sp,
                    $dp, $proto, $flags, $len, $ttl,
                    $type, $code, $id, $seq);
                $curr_sigs_dl{$src} = $dl if $dl;
            }
        }
    }

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

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

    ### Log and send email and syslog alerts
    if ($analyze_msgs) {
        print "[+] Writing $config{'PSAD_DIR'}/<ip> directories.\n";
        if ($analysis_emails) {
            print "[+] Generating email alerts.\n";
            unless ($no_whois) {
                print "[+] Issuing whois lookups (may take several seconds).\n";
            }
        }
    }
    &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)
        if $config{'ENABLE_AUTO_IDS'} eq 'Y';

    return;
}

sub match_sigs() {
    my ($src, $dst, $chain, $sp, $dp, $proto,
        $flags, $len, $ttl, $type, $code, $id, $seq) = @_;

    my $dl = 0;
    if ($proto eq 'tcp') {
        for my $sid (keys %{$sigs{'tcp'}}) {
            next unless defined $sigs{'tcp'}{$sid}{'flags'};
            if (&check_port($sp, $dp, $sigs{'tcp'}{$sid})
                    and $flags eq $sigs{'tcp'}{$sid}{'flags'}
                    and &check_src($chain, $src, $sigs{'tcp'}{$sid}{'src'})
                    and &check_dst($chain, $dst, $sigs{'tcp'}{$sid}{'dst'})) {
                ### future
#               && &check_misc_fields($sid, $proto, $len, $ttl)) {
                ### tripped a tcp signature
                print STDERR "[+] match_sigs(): matched tcp $dp,$sp,$flags, ",
                    "sid: $sid\n" if $debug;
                if ($dl < $sigs_attr{$sid}{'dl'}) {
                    $dl = $sigs_attr{$sid}{'dl'};
                }
                $scan{$src}{$dst}{$proto}{'curr_sig'}
                    {$sid}{$chain}{'dp'}{$dp}++;
                $scan{$src}{$dst}{$proto}{'curr_sig'}
                    {$sid}{$chain}{'flags'}{$dp} = $flags;
            }
        }
    } elsif ($proto eq 'udp') {
        for my $sid (keys %{$sigs{'udp'}}) {
            if (&check_src($chain, $src, $sigs{'udp'}{$sid}{'src'})
                    and &check_dst($chain, $dst, $sigs{'udp'}{$sid}{'dst'})
                    and &check_port($sp, $dp, $sigs{'udp'}{$sid})) {
#               && &check_misc_fields($sid, $proto, $len, $ttl)) {
                ### tripped a udp signature
                print STDERR "[+] match_sigs(): matched udp $dp,$sp, ",
                    "sid: $sid\n" if $debug;
                if ($dl < $sigs_attr{$sid}{'dl'}) {
                    $dl = $sigs_attr{$sid}{'dl'};
                }
                $scan{$src}{$dst}{$proto}{'curr_sig'}
                    {$sid}{$chain}{'dp'}{$dp}++;
            }
        }
    } elsif ($proto eq 'icmp') {
        ### check 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($type, $code);
        if ($type_code_rv == 1) {  ### bad type
            if ($dl < 2) {
                $dl = 2;  ### FIXME: hard-coded as dl 2 for now.
            }
            $scan{$src}{$dst}{'icmp'}{'invalid_type'}
                {$type}{$chain}{'pkts'}++;
        } elsif ($type_code_rv == 2) {
            if ($dl < 2) {
                $dl = 2;  ### FIXME: hard-coded as dl 2 for now.
            }
            $scan{$src}{$dst}{'icmp'}{'invalid_code'}
                {$type}{$code}{$chain}{'pkts'}++;
        }
        for my $sid (keys %{$sigs{'icmp'}}) {
            if (&check_src($chain, $src, $sigs{'icmp'}{$sid}{'src'})
                    and &check_dst($chain, $dst, $sigs{'icmp'}{$sid}{'dst'})
                    and &check_icmp_sig($sid, $ttl, $type, $code,
                        $id, $seq)) {
                print STDERR "[+] match_sigs(): matched icmp sid: $sid\n"
                    if $debug;
                if ($dl < $sigs_attr{$sid}{'dl'}) {
                    $dl = $sigs_attr{$sid}{'dl'};
                }
                $scan{$src}{$dst}{'icmp'}{'curr_sig'}
                    {$sid}{$chain}{'pkts'}++;
            }
        }
    }
    return $dl;
}

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

sub p0f() {
    my ($src, $len, $frag_bit, $ttl, $win, $tcp_options) = @_;

    print STDERR "[+] p0f(): $src len: $len, frag_bit: $frag_bit, " ,
        "ttl: $ttl, win: $win\n" if $debug;

    my ($options_aref) = &parse_tcp_options($tcp_options);

    return unless $options_aref;

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

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

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

                ### match tcp window size
                WIN: for my $sig_win_size (keys
                        %{$p0f_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 (($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_aref) {
                            if (defined $opt_hr->{$tcp_p0f_opt_types{'M'}}) {
                                my $mss_val = $opt_hr->{$tcp_p0f_opt_types{'M'}};
                                if ($win == $mss_val * $multiple) {
                                    $matched_win_size = 1;
                                }
                            }
                            last;
                        }
                    } elsif ($sig_win_size == $win) {
                        $matched_win_size = 1;
                    }

                    next WIN unless $matched_win_size;

                    TCPOPTS: for my $sig_opts (keys %{$p0f_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_aref->[$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_aref->[$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_aref->[$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_aref->[$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_aref->[$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_aref->[$i]->
                                            {$tcp_p0f_opt_types{$sig_letter}}
                                                == 0;
                                    }  ### else it is just "T" which matches
                                }

                            }
                        }
                        OS: for my $os (keys %{$p0f_sigs{$sig_len}
                                {$test_frag_bit}{$sig_ttl}{$sig_win_size}
                                {$sig_opts}}) {
                            my $sig = $p0f_sigs{$sig_len}
                                {$test_frag_bit}{$sig_ttl}{$sig_win_size}
                                {$sig_opts}{$os};
                            print STDERR "[+] os: $os, $sig\n" if $debug;
                            $p0f{$src}{$os} = '';
                        }
                    }
                }
            }
        }
    }
    return;
}

sub parse_tcp_options() {
    my $tcp_options = shift;
    my @opts = ();
    my @hex_nums = ();
    my $debug_str = '';

    if (length($tcp_options) % 2 != 0) {  ### make sure length a multiple of two
        print '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;
    }
    OPT: for (my $opt_kind=0; $opt_kind <= $#hex_nums;) {
        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 {
            ### 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 posf() {
    my ($src, $len, $tos, $ttl, $id, $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'}}
                    and ($min_ttl > ($posf_sigs{$os}{'ttl'}-$max_hops))  ### ttl's only decrease
                    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 $href = shift;
    my $min_ttl = 256;
    my $max_ttl = 0;
    for my $ttl (keys %$href) {
        $min_ttl = $ttl if $ttl < $min_ttl;
        $max_ttl = $ttl if $ttl > $max_ttl;
    }
    return $min_ttl, $max_ttl;
}

sub add_snort_sid() {
    my ($src, $dst, $chain, $proto, $sid) = @_;
    if (defined $snort_msgs{$sid}) {
        $scan{$src}{$dst}{$proto}{'sid'}{$sid}{$chain}++;
        ### FIXME: for now hardcode snort sid matches at
        ### a danger level of two
        return 2;
    }
    return 0;
}

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/;
        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.';
            if ($config{'DSHIELD_DL_THRESHOLD'} > 0) {
                for my $line (@dshield_data) {
                    if ($line =~ /^.*?($ip_re)/) {
                        if ($scan_dl{$1} >= $config{'DSHIELD_DL_THRESHOLD'}) {
                            print MAIL $line;
                        }
                    }
                }
            } else {
                print MAIL for @dshield_data;
            }
            close MAIL;
        } else {
            open MAIL, "| $cmds{'sendmail'} -oi -t" or die '[*] Could not ',
                'send dshield alert email.';
            print MAIL "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 =~ /^.*?($ip_re)/) {
                        if ($scan_dl{$1} >= $config{'DSHIELD_DL_THRESHOLD'}) {
                            print MAIL $line;
                        }
                    }
                }
            } else {
                print MAIL for @dshield_data;
            }
            close MAIL;
        }

        &Psad::psyslog('psad', "sent $#dshield_data lines of log data to " .
            $config{'DSHIELD_ALERT_EMAIL'}) unless $no_syslog_alerts;

        ### 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_src() {
    my ($chain, $src, $sig_src) = @_;
    return 1 if $sig_src eq 'any';
    if ($chain eq 'INPUT') {
        if ($sig_src eq 'EXTERNAL_NET') {
            ### scans that originate from the EXTERNAL_NET are
            ### included here if they are directed at the
            ### firewall itself.
            return 1;
        } elsif ($sig_src eq 'HOME_NET') {
            if (&check_ip_in_network($src, $config{'HOME_NET'})) {
                return 1;
            }
        } elsif (&check_ip_in_network($src, $sig_src)) {
            return 1;
        }
    } elsif ($chain eq 'FORWARD') {
        return 0 unless $config{'HOME_NET'} =~ /$ip_re/;
        if (&check_ip_in_network($src, $config{'HOME_NET'})) {
            if ($sig_src eq 'HOME_NET') {
                return 1;
            } elsif ($sig_src ne 'EXTERNAL_NET') {
                if (&check_ip_in_network($src, $sig_src)) {
                    return 1;
                }
            }
        } else {
            if ($sig_src eq 'EXTERNAL_NET') {
                return 1;
            } elsif ($sig_src eq 'HOME_NET') {
                return 0;
            } elsif (&check_ip_in_network($src, $sig_src)) {
                return 1;
            }
        }
    } elsif ($chain eq 'OUTPUT') {
        if ($sig_src eq 'HOME_NET') {
            ### if we are in the output chain then the packet
            ### was generated by the firewall and hence by
            ### definition part of the "home network".
            return 1;
        } elsif ($sig_src ne 'EXTERNAL_NET') {
            if (&check_ip_in_network($src, $sig_src)) {
                return 1;
            }
        }
    }
    return 0;
}

sub check_dst() {
    my ($chain, $dst, $sig_dst) = @_;
    return 1 if $sig_dst eq 'any';
    if ($chain eq 'INPUT') {
        if ($sig_dst eq 'HOME_NET') {
            ### scans that appear on the external interface are
            ### included here since the firewall is considered
            ### part of the HOME_NET
            return 1;
        } elsif ($sig_dst eq 'EXTERNAL_NET') {
            if (not &check_ip_in_network($dst, $config{'HOME_NET'})) {
                return 1;
            }
        } elsif (&check_ip_in_network($dst, $sig_dst)) {
            return 1;
        }
    } elsif ($chain eq 'FORWARD') {
        if (&check_ip_in_network($dst, $config{'HOME_NET'})) {
            if ($sig_dst eq 'HOME_NET') {
                return 1;
            } elsif ($sig_dst ne 'EXTERNAL_NET') {
                if (&check_ip_in_network($dst, $sig_dst)) {
                    return 1;
                }
            }
        } else {
            if ($sig_dst eq 'EXTERNAL_NET') {
                return 1;
            } elsif ($sig_dst eq 'HOME_NET') {
                return 0;
            } elsif (&check_ip_in_network($dst, $sig_dst)) {
                return 1;
            }
        }
    } elsif ($chain eq 'OUTPUT') {
        if ($sig_dst eq 'HOME_NET') {
            if (&check_ip_in_network($dst, $config{'HOME_NET'})) {
                return 1;
            }
        } elsif ($sig_dst eq 'EXTERNAL_NET') {
            return 1;
        }
    }
    return 0;
}

sub check_ip_in_network() {
    my ($ip, $net) = @_;
    unless (defined $net and $net =~ /$ip_re/) {
        print STDERR "[-] check_ip_in_network(): bad network \"$net\".\n",
            if $debug;
        return 0;
    }
    ### we may have several networks in a comma separated
    ### list such as "[232.0.0.0/8,233.0.0.0/8,239.0.0.0/8]"
    if ($net =~ /\,/) {
        my @nets = split /\s*\,\s*/, $net;
        for my $n (@nets) {
            ### check if we have a normal subnet, a cidr subnet or if
            ### it is just a single ip address
            if ($n =~ m|($ip_re/$ip_re)|) {
                my $str = $1;
                if (ipv4_in_network($str, $ip)) {
                    print STDERR "[+] check_ip_in_network(): matched ",
                        "ip: $ip to net: $n\n" if $debug;
                    return 1;
                }
            } elsif ($n =~ m|($ip_re/\d+)|) {
                my $str = $1;
                if (ipv4_in_network($str, $ip)) {
                    print STDERR "[+] check_ip_in_network(): matched ",
                        "ip: $ip to net: $n\n" if $debug;
                    return 1;
                }
            } elsif ($n =~ m|($ip_re)|) {
                my $str = $1;
                if ($ip eq $str) {
                    print STDERR "[+] check_ip_in_network(): matched ",
                        "ip: $ip to ip: $n\n" if $debug;
                    return 1;
                }
            }
        }
    } elsif ($net =~ m|($ip_re/$ip_re)|) {
        my $str = $1;
        if (ipv4_in_network($str, $ip)) {
            print STDERR "[+] check_ip_in_network(): matched ip: $ip ",
                "to net: $net\n" if $debug;
            return 1;
        }
    } elsif ($net =~ m|($ip_re/\d+)|) {
        my $str = $1;
        if (ipv4_in_network($str, $ip)) {
            print STDERR "[+] check_ip_in_network(): matched ip: $ip ",
                "to net: $net\n" if $debug;
            return 1;
        }
    } elsif ($net =~ /($ip_re)/) {
        my $str = $1;
        if ($ip eq $str) {
            print STDERR "[+] check_ip_in_network(): matched ",
                "ip: $ip to ip: $net\n" if $debug;
            return 1;
        }
    }
    print STDERR "[+] check_ip_in_network(): Could not match ",
        "$ip within $net\n" if $debug;
    return 0;
}

sub check_port() {
    my ($sp, $dp, $sig_href) = @_;

    ### check dst port first
    if (defined $sig_href->{'dp'}) {
        if ($dp != $sig_href->{'dp'}) {
            return 0;
        }
    }
    if (defined $sig_href->{'dp_n'}) {
        if ($dp == $sig_href->{'dp_n'}) {
            return 0;
        }
    }
    if (defined $sig_href->{'dp_rng'}) {
        if (defined $sig_href->{'dp_rng'}->{'start'}) {
            if ($dp < $sig_href->{'dp_rng'}->{'start'}
                    or $dp > $sig_href->{'dp_rng'}->{'end'}) {
                return 0;
            }
        }
        if (defined $sig_href->{'dp_rng'}->{'nstart'}) {
            if ($dp > $sig_href->{'dp_rng'}->{'nstart'}
                    or $dp < $sig_href->{'dp_rng'}->{'nend'}) {
                return 0;
            }
        }
    }

    ### check src port
    if (defined $sig_href->{'sp'}) {
        if ($sp != $sig_href->{'sp'}) {
            return 0;
        }
    }
    if (defined $sig_href->{'sp_n'}) {
        if ($sp == $sig_href->{'sp_n'}) {
            return 0;
        }
    }
    if (defined $sig_href->{'sp_rng'}) {
        if (defined $sig_href->{'sp_rng'}->{'start'}) {
            if ($sp < $sig_href->{'sp_rng'}->{'start'}
                    or $sp > $sig_href->{'sp_rng'}->{'end'}) {
                return 0;
            }
        }
        if (defined $sig_href->{'sp_rng'}->{'nstart'}) {
            if ($sp > $sig_href->{'sp_rng'}->{'nstart'}
                    or $sp < $sig_href->{'sp_rng'}->{'nend'}) {
                return 0;
            }
        }
    }
    ### if we made it here, then we matched both
    ### the src and dst port criteria
    return 1;
}

sub check_icmp_sig() {
    my ($sid, $ttl, $type, $code, $icmp_id, $icmp_seq) = @_;
    ### check icmp type first
    if (defined $sigs{'icmp'}{$sid}{'type'}) {
        return 0 if ($sigs{'icmp'}{$sid}{'type'} != $type);
    }
    if (defined $sigs{'icmp'}{$sid}{'ttl'}) {
        return 0 if ($sigs{'icmp'}{$sid}{'ttl'} != $ttl);
    }
    if (defined $sigs{'icmp'}{$sid}{'code'}) {
        return 0 if ($sigs{'icmp'}{$sid}{'code'} != $code);
    }
    if (defined $sigs{'icmp'}{$sid}{'icmp_id'}) {
        return 0 if ($sigs{'icmp'}{$sid}{'icmp_id'} != $icmp_id);
    }
    if (defined $sigs{'icmp'}{$sid}{'seq'}) {
        return 0 if ($sigs{'icmp'}{$sid}{'icmp_seq'} != $icmp_seq);
    }
    ### if we got to this point then we matched the signature
    return 1;
}

sub check_icmp_type() {
    my ($type, $code) = @_;
    return 1 if not defined $valid_icmp_types{$type};
    return 2 if not defined $valid_icmp_types{$type}{'codes'}{$code};
    return 0;
}

sub check_misc_fields() {
    my ($msg, $proto, $len, $ttl) = @_;
    if (defined $sigs{$proto}{$msg}{'LEN'}) {
        return 0 if ($sigs{$proto}{$msg}{'LEN'} != $len);
    }
    if (defined $sigs{$proto}{$msg}{'TTL'}) {
        return 0 if ($sigs{$proto}{$msg}{'TTL'} != $ttl);
    }
    return 1;
}

sub psad_init() {

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

    ### turn off buffering
    $| = 1;

    ### import psad.conf
    &Psad::buildconf(\%config, \%cmds, $config_file);

    ### import alerting config (psadwatchd also references this file
    &Psad::buildconf(\%config, \%cmds, $alerting_config_file);

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

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

    ### import FW_MSG_SEARCH strings
    &import_fw_search();

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

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

    ### check to make sure the commands specified in the config section
    ### are in the right place, and attempt to correct automatically if not.
    &Psad::check_commands(\%cmds);

    ### the usage of the mail and sendmail commands depends on the reporting
    ### config.  I.e., we don't require that the mail command is installed
    ### if "nomail" is set in the ALERTING_METHODS keyword, and we only need
    ### sendmail if DShield alerting is enabled and there is a custom
    ### DShield user email.
    &check_mail_commands();

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

    ### build iptable 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_block_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;

    ### dump configuration to STDOUT
    exit &dump_conf() if $dump_conf;

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

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

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

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

    ### add an IP/network to the cache file used by a running psad
    ### process (note that &cache_file_add_ipt_block_ip() calls
    ### &import_auto_dl() to make sure we don't add an IP that should
    ### be ignored).
    exit &cache_file_add_ipt_block_ip() if $fw_block_ip;

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

    ### 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() unless $no_icmp_types;

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

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

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

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

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

    ### don't continue with init if we are running in firewall
    ### analysis mode or benchmarking mode
    return if $fw_analyze or $benchmark;

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

    ### make sure PSAD_DIR, FW_DATA_FILE, and /var/lib/psad/psadfifo, etc.
    ### actually exist
    &setup();

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

    return;
}

sub validate_config() {
    die '[*] PORT_RANGE_SCAN_THRESHOLD must be between 0 and 65535 '
        unless (($config{'PORT_RANGE_SCAN_THRESHOLD'} =~ m|^\d+$|)
            and 0 <= $config{'PORT_RANGE_SCAN_THRESHOLD'}
            and $config{'PORT_RANGE_SCAN_THRESHOLD'} < 65535);

    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;

    die '[*] DSHIELD_ALERT_INTERVAL must be between 1 and 24 '
        unless (($config{'DSHIELD_ALERT_INTERVAL'} =~ m|^\d+$|)
            and 0 < $config{'DSHIELD_ALERT_INTERVAL'}
            and $config{'DSHIELD_ALERT_INTERVAL'} < 25);
    if ($config{'ENABLE_AUTO_IDS'} eq 'Y'
            and $config{'IPTABLES_BLOCK_METHOD'} eq 'N'
            and $config{'TCPWRAPPERS_BLOCK_METHOD'} eq 'N') {
        &Psad::psyslog('psad', 'config warning, ENABLE_AUTO_IDS=Y, but ' .
            'both IPTABLES_BLOCK_METHOD and TCPWRAPPERS_BLOCK_METHOD are ' .
            'set to N.') unless $no_syslog_alerts;
    }
    if ($status_dl and $status_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*$ip_re\s*$|
                or $fw_block_ip =~ m|^\s*$ip_re/\d+\s*$|
                or $fw_block_ip =~ m|^\s*$ip_re/$ip_re\s*$|) {
            die '[-] The --fw-block-ip argument accepts ' .
                'an IP address or network.';
        }
    }

    return;
}

sub check_mail_commands() {
    my @paths = qw(
        /bin
        /sbin
        /usr/bin
        /usr/sbin
        /usr/local/bin
        /usr/local/sbin
    );
    unless ($config{'ALERTING_METHODS'} =~ /no?email/i) {
        ### make sure the mailCmd is executable
        my $found = 0;
        if (defined $cmds{'mail'}) {
            if (-x $cmds{'mail'}) {
                $found = 1;
            } else {
                for my $dir (@paths) {
                    $found = 1 if -x "$dir/$cmds{'mail'}";
                }
            }
        }
        die "[*] Cound not find the mail command anywhere. ",
            "Please edit $config_file" unless $found;
    }

    if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
            and $config{'DSHIELD_ALERT_EMAIL'} ne 'NONE') {
        my $found = 0;
        ### make sure the sendmailCmd is executable
        if (defined $cmds{'sendmail'}) {
            if (-x $cmds{'sendmail'}) {
                $found = 1;
            } else {
                for my $dir (@paths) {
                    $found = 1 if -x "$dir/$cmds{'sendmail'}";
                }
            }
        }
        die "[*] Cound not find the sendmail command anywhere. ",
            "Please edit $config_file" unless $found;
    }
    return;
}

sub validate_home_net() {
    open IFC, "$cmds{'ifconfig'} -a |" or die "[*] Could not execute ",
        "$cmds{'ifconfig'} -a: $!";
    my @ifconfig_out = <IFC>;
    close IFC;
    my @connected_subnets = ();
    my @connected_subnets_cidr = ();
    my $intf_name    = '';
    my $home_net_str = '';
    for my $line (@ifconfig_out) {
        if ($line =~ /^(\w+)\s+Link/) {
            $intf_name = $1;
            next;
        }
        next if $intf_name eq 'lo';
        next if $intf_name =~ /dummy/i;
        if ($line =~ /^\s+inet.*?:($ip_re).*:($ip_re)/i) {
            my $ip  = $1;
            my $msk = $2;
            my ($net_addr, $cidr_msk) = ipv4_network($ip, $msk);
            push @connected_subnets, "$net_addr/$msk";
            push @connected_subnets_cidr, "$net_addr/$cidr_msk";
        }
    }
    if ($config{'HOME_NET'} =~ /CHANGEME/) {
        if ($#connected_subnets >= 1) {
            ### so there are at least two interfaces
            &Psad::psyslog('psad', 'config warning; the HOME_NET ' .
                'variable has not been set; defaulting to a single ' .
                'interface config for signature matching.')
                unless $no_syslog_alerts;
        } else {
            ### the HOME_NET variable has not been set (should be set
            ### to "NOT_USED" since there is only one interface on the
            ### box
            &Psad::psyslog('psad', 'config warning; the HOME_NET ' .
                'variable has not been set; should probably be set to ' .
                'NOT_USED since it appears there is only one interface.')
                unless $no_syslog_alerts;
        }
        return;
    }
    my @home_nets = split /\s*\,\s*/, $config{'HOME_NET'};
    for my $home_net (@home_nets) {
        my $found = 0;
        for my $net (@connected_subnets) {
            $found = 1 if $home_net eq $net;
        }
        for my $net (@connected_subnets_cidr) {
            $found = 1 if $home_net eq $net;
        }
        if ($home_net ne 'NOT_USED' and not $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.
            &Psad::psyslog('psad', 'config warning; HOME_NET definition ' .
                "in psad.conf contains $home_net which does not appear to " .
                "be directly connected to the local system.")
                unless $no_syslog_alerts;
        }
    }
    return;
}

sub import_fw_search() {
    open F, "< $fw_search_file" or die "[*] Could not open fw search ",
        "string file $fw_search_file: $!";
    my @lines = <F>;
    close F;
    for my $line (@lines) {
        next unless $line =~ /\S/;
        next if $line =~ /^\s*#/;
        if ($line =~ /^\s*FW_MSG_SEARCH\s+(.*?);/) {
            push @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'}) {
        &Psad::psyslog('psad', 'defaulting missing ' .
            "FW_SEARCH_ALL variable in $fw_search_file to Y.")
            unless $no_syslog_alerts;
        $config{'FW_SEARCH_ALL'} = 'Y';
    }

    unless ($config{'FW_SEARCH_ALL'} eq 'Y' or
            $config{'FW_SEARCH_ALL'} eq 'N') {
        &Psad::psyslog('psad', 'setting FW_SEARCH_ALL to Y.')
            unless $no_syslog_alerts;
        $config{'FW_SEARCH_ALL'} = 'Y';
    }
    return;
}

sub parse_ignore_ports() {

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

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

    my @fields = split /\s*,\s*/, $config{'IGNORE_PORTS'};
    for my $field (@fields) {
        if ($field =~ m/(tcp|udp)\/(\d+)\s*-\s*(\d+)/) {
            my $proto = $1;
            my $low   = $2;
            my $high  = $3;
            if ($low < $high) {
                my $existing_high = 0;
                if (defined $ignore_ports{$proto}
                        and defined $ignore_ports{$proto}{'range'}
                        and defined $ignore_ports{$proto}{'range'}{$low}) {
                    $existing_high = $ignore_ports{$proto}{'range'}{$low};
                }
                if ($existing_high) {
                    if ($high > $existing_high) {
                        $ignore_ports{$proto}{'range'}{$low} = $high;
                    }
                } else {
                    $ignore_ports{$proto}{'range'}{$low} = $high;
                }
            }
        } elsif ($field =~ m/(tcp|udp)\/(\d+)/) {
            my $proto = $1;
            my $port  = $2;
            $ignore_ports{$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'} ne 'NONE';

    my @protos = split /\s*,\s*/, $config{'IGNORE_PROTOCOLS'};
    for my $proto (@protos) {
        if ($proto =~ /\W/) {
            &Psad::psyslog('psad', 'invalid protocol in IGNORE_PROTOCOLS var')
                unless $no_syslog_alerts;
        } else {
            if ($proto =~ /^\d+$/) {
                $ignore_protocols{$proto} = '';
            } else {
                $ignore_protocols{uc($proto)} = '';
            }
        }
    }
    return;
}

sub parse_ignore_interfaces() {

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

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

    my @interfaces = split /\s*,\s*/, $config{'IGNORE_INTERFACES'};
    for my $intf (@interfaces) {
        if ($intf =~ /\W/) {
            &Psad::psyslog('psad', 'invalid interface in IGNORE_INTERFACES var')
                unless $no_syslog_alerts;
        } else {
            $ignore_interfaces{$intf} = '';
        }
    }
    return;
}

sub import_snort_rules() {
    opendir D, $config{'SNORT_RULES_DIR'}
        or die "[*] Could not open $config{'SNORT_RULES_DIR'}";
    my @rfiles = readdir D;
    closedir D;
    shift @rfiles; shift @rfiles;

    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, "< ${config{'SNORT_RULES_DIR'}}/${rfile}" or
            die "[*] Could not open: ${srules_type}/${rfile}";
        my @lines = <R>;
        close R;
        RULE: for my $line (@lines) {
            next RULE unless $line =~ /^\s*alert/;
            chomp $line;
            my $msg;
            my $sid;  ### snort rule id
            my $classtype;
            my $content;

            $msg = $1 if $line =~ /msg:\s*\"(.*?)\"\s*;/;
            if ($line =~ /[\s;]sid:\s*(\d+)\s*;/) {
                $sid = $1;
            }
            $classtype = $1 if $line =~ /[\s;]classtype:\s*(.*?)\s*;/;
            $content = $1 if $line =~ /[\s;]uricontent:\s*\"(.*?)\"\s*;/;
            $content = $1 if $line =~ /[\s;]content:\s*\"(.*?)\"\s*;/;
            if ($msg && $sid && $classtype) {
                $snort_msgs{$sid}{'classtype'} = $classtype;
                $snort_msgs{$sid}{'msg'}       = $msg;
                if ($content) {
                    $snort_msgs{$sid}{'content'} = $content;
                }
            }
        }
    }
    print STDERR Dumper %snort_msgs if $debug and $verbose;
    &Psad::psyslog('psad', 'imported Snort rules')
        unless $no_syslog_alerts;
    return;
}

sub import_signatures() {
    ### undef %sigs so we don't leave old signatures around if
    ### we execute this code after receiving a HUP signal.
    %sigs = ();
    open SIGS, "< $config{'SIGS_FILE'}" or die
        "[*] Could not open the signatures file $config{'SIGS_FILE'}: $!";
    my @lines = <SIGS>;
    close SIGS;
    SIG: for my $line (@lines) {
        chomp $line;
        next SIG unless $line;
        next SIG if $line =~ /^\s*#/;

        ### 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;
        my $src;
        my $dst;
        my $sp;
        my $dp;
        my $proto  = '';
        my $bidir  = 0;
        my $msg    = '';
        my $dlevel = 2;  ### default all signatures to danger level 2
        my $sid    = 0;

        if ($line =~ m|^(.*?)\s+\((.*)\)|) {
            $rule_hdr     = $1;
            $rule_options = $2;
        } else {
            print STDERR "[-] import_signatures(): bad signature: $line\n"
                if $debug;
            next SIG;
        }

        ### 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 '<>') {
                ### FIXME
                $bidir = 1;
            }
            if ($direction eq '<-') {
                $proto = $1;
                $src   = $5;  ### switch src and dst
                $sp    = $3;
                $dst   = $2;
                $dp    = $6;
            } else {
                $proto = $1;
                $src   = $2;  ### normal src -> dst
                $sp    = $3;
                $dst   = $5;
                $dp    = $6;
            }
        } else {
            print STDERR "[-] import_signatures(): bad rule ",
                "header: $line\n" if $debug;
            next SIG;
        }

        ### parse rule options
        if ($rule_options =~ /[\s;]sid:\s*(\d+)\s*;/) {
            $sid = $1;
        } else {
            print STDERR "[-] import_signatures(): could not find ",
                "sid: $line\n" if $debug;
            next SIG;
        }
        if ($rule_options =~ /msg:\s*\"(.*?)\"\s*;/) {
            $msg = $1;
        } else {
            print STDERR "[-] import_signatures(): could not find ",
                "msg: $line\n" if $debug;
            next SIG;
        }
        if ($rule_options =~ /psad_dlevel:\s*(\d+)/) {
            $dlevel = $1;
        } else {
            print STDERR "[-] import_signatures(): could not find ",
                "dlevel: $line\n" if $debug;
            next SIG;
        }

        ### add the signature message string to the %sig_attr cache
        $sigs_attr{$sid}{'dl'}  = $dlevel;
        $sigs_attr{$sid}{'msg'} = $msg;

        ### assign source and destination
        $sigs{$proto}{$sid}{'src'} = $src;
        $sigs{$proto}{$sid}{'dst'} = $dst;

            ### future
#            my $ttl   = '';
#            if ($options =~ /ttl:\s*(\d+)/i) {
#                $sigs{$proto}{$sid}{'TTL'} = $1;
#            }

        if ($proto eq 'tcp') {
            my $flags = '';
            my $sig_flags;
            my $sig_flow = '';

            if ($rule_options =~ /flow:\s*(.*?)\s*\;/i) {
                $sig_flow = $1;
                ### flags can also be deduced from the "flow" field in
                ### snort signatures.
                if ($sig_flow =~ /established/) {
                    $flags .= 'ACK ';
                }
            }

            if ($rule_options =~ /[\s;]flags:\s*(.*?)\s*;/) {
                $sig_flags = $1;
                ### 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/ and $flags !~ /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;

            $sigs{'tcp'}{$sid}{'flags'} = $flags
                if $flags;

            ### assign the source and destination port ranges
            &build_sig_ports($sid, 'tcp', $sp, $dp);

            unless (defined $sigs{'tcp'}{$sid}{'flags'}
                    and defined $sigs{'tcp'}{$sid}{'src'}
                    and defined $sigs{'tcp'}{$sid}{'dst'}) {
                delete $sigs_attr{$sid} if defined $sigs_attr{$sid};
                delete $sigs{'tcp'}{$sid} if defined $sigs{'tcp'}{$sid};
                next SIG;
            }
        } elsif ($proto eq 'udp') {

            ### assign the source and destination port ranges
            &build_sig_ports($sid, 'udp', $sp, $dp);

            unless (defined $sigs{'udp'}{$sid}{'src'}
                    and defined $sigs{'udp'}{$sid}{'dst'}) {
                delete $sigs_attr{$sid} if defined $sigs_attr{$sid};
                delete $sigs{'udp'}{$sid} if defined $sigs{'udp'}{$sid};
                next SIG;
            }
        } elsif ($proto eq 'icmp') {
            if ($rule_options =~ /ttl:\s*(\d+)/i) {
                $sigs{'icmp'}{$sid}{'ttl'} = $1;
            }
            if ($rule_options =~ /itype:\s*(\d+)/i) {
                $sigs{'icmp'}{$sid}{'type'} = $1;
            }
            if ($rule_options =~ /icode:\s*(\d+)/i) {
                $sigs{'icmp'}{$sid}{'code'} = $1;
            }
            if ($rule_options =~ /icmp_seq:\s*(\d+)/i) {
                $sigs{'icmp'}{$sid}{'icmp_seq'} = $1;
            }
            if ($rule_options =~ /icmp_id:\s*(\d+)/i) {
                $sigs{'icmp'}{$sid}{'icmp_id'} = $1;
            }
        } else {
            print STDERR "[-] import_signatures(): bad protocol: $line\n"
                if $debug;
            delete $sigs_attr{$sid} if defined $sigs_attr{$sid};
            delete $sigs{$proto}{$sid} if defined $sigs{$proto}{$sid};
            next SIG;
        }
    }
    if ($debug) {
        print STDERR "[-] main signatures hash:\n";
        print STDERR Dumper %sigs if $verbose;
        print STDERR Dumper "[-] signature attributes hash:\n";
        print STDERR Dumper %sigs_attr if $verbose;
    }
    &Psad::psyslog('psad', 'imported psad-1.3 signatures')
        unless $no_syslog_alerts;
    return;
}

sub import_icmp_types() {
    %valid_icmp_types = ();
    open TYPES, "< $config{'ICMP_TYPES_FILE'}" or die
        "[*] Could not open $config{'ICMP_TYPES_FILE'}: $!";
    my @lines = <TYPES>;
    close TYPES;
    my $icmp_type = -1;
    for my $line (@lines) {
        next if $line =~ /^\s*#/;
        if ($line =~ /^(\d+)\s+(.*)/) {
            $icmp_type      = $1;
            my $icmp_type_text = $2;
            if ($icmp_type_text =~ /unassigned/i) {
                $icmp_type = -1;
            }
            $valid_icmp_types{$icmp_type}{'text'} = $icmp_type_text;
            next;
        }
        if ($icmp_type > -1 and $line =~ /^\s+(\d+)\s+(.*)/) {
            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).
            $valid_icmp_types{$icmp_type}{'codes'}{$icmp_code} = '';
        }
    }
    print STDERR Dumper %valid_icmp_types if $debug and $verbose;
    &Psad::psyslog('psad', 'imported valid icmp types and codes')
        unless $no_syslog_alerts;
    return;
}

sub build_sig_ports() {
    my ($sid, $proto, $sp, $dp) = @_;

    if ($sp =~ /\d/) {
        if ($sp =~ /:/) {
            my ($start, $end) = split /:/, $sp;
            $start = 1 unless $start;
            $end = 65535 unless $end;
            if ($sp =~ /!/) {
                $start =~ s/\D//g;
                $end   =~ s/\D//g;
                $sigs{$proto}{$sid}{'sp_rng'}{'nstart'} = $start;
                $sigs{$proto}{$sid}{'sp_rng'}{'nend'}   = $end;
            } else {
                $sigs{$proto}{$sid}{'sp_rng'}{'start'} = $start;
                $sigs{$proto}{$sid}{'sp_rng'}{'end'}   = $end;
            }
        } elsif ($sp =~ /!/) {
            ### e.g: "!123"
            $sp =~ s/\D//g;
            $sigs{$proto}{$sid}{'sp_n'} = $sp;
        } else {
            ### just a single source port
            $sigs{$proto}{$sid}{'sp'} = $sp;
        }
    } elsif ($sp eq 'any') {
        $sigs{$proto}{$sid}{'sp_any'} = '';
    }

    if ($dp =~ /\d/) {
        if ($dp =~ /:/) {
            my ($start, $end) = split /:/, $dp;
            $start = 1 unless $start;
            $end = 65535 unless $end;
            if ($dp =~ /!/) {
                $start =~ s/\D//g;
                $end   =~ s/\D//g;
                $sigs{$proto}{$sid}{'dp_rng'}{'nstart'} = $start;
                $sigs{$proto}{$sid}{'dp_rng'}{'nend'}   = $end;
            } else {
                $sigs{$proto}{$sid}{'dp_rng'}{'start'} = $start;
                $sigs{$proto}{$sid}{'dp_rng'}{'end'}   = $end;
            }
        } elsif ($dp =~ /!/) {
            ### e.g: "!123"
            $dp =~ s/\D//g;
            $sigs{$proto}{$sid}{'dp_n'} = $dp;
        } else {
            ### just a single source port
            $sigs{$proto}{$sid}{'dp'} = $dp;
        }
    } elsif ($dp eq 'any') {
        $sigs{$proto}{$sid}{'dp_any'} = '';
    }
    return;
}

sub import_auto_dl() {
    %auto_dl = ();  ### undef so we don't leave old ips in %auto_dl
    open A, "< $config{'AUTO_DL_FILE'}" or die '[*] Could not open ',
        "$config{'AUTO_DL_FILE'}: $!";
    my @lines = <A>;
    close A;
    my $i = 1;
    for my $line (@lines) {
        $i++;
        next unless $line =~ /\S/;
        next if $line =~ /^\s*#/;
        my $ip   = '';
        my $mask = '';
        my $dl   = '';
        if ($line =~ m|^\s*($ip_re)\s*/\s*($ip_re)\s+([0-5])|) {
            $ip   = $1;
            $mask = $2;
            $dl   = $3;
        } elsif ($line =~ m|^\s*($ip_re)\s*/\s*(\d+)\s+([0-5])|) {
            $ip   = $1;
            $mask = $2;
            $dl   = $3;
        } elsif ($line =~ m|^\s*($ip_re)\s+([0-5])|) {
            $ip   = $1;
            $mask = '32';  ### single IP
            $dl   = $2;
        }

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

        ### check for optional protocol (any combination of tcp, udp
        ### or icmp is allowed)
        if ($line =~ m|tcp|i) {
            push @{$auto_dl{$ip}{'proto'}}, 'tcp';
        }
        if ($line =~ m|udp|i) {
            push @{$auto_dl{$ip}{'proto'}}, 'udp';
        }
        if ($line =~ m|icmp|i) {
            push @{$auto_dl{$ip}{'proto'}}, 'icmp';
        }
        unless ($ip and $mask) {
            unless ($fw_block_ip) {
                my $subject = "$mail_error_prefix import warning: " .
                    "$config{'AUTO_DL_FILE'} error on line: $i";
                &Psad::sendmail($subject, '', $config{'EMAIL_ADDRESSES'},
                    $cmds{'mail'}) unless $no_email_alerts;
            }
        }
    }
    if (%auto_dl) {
        my $ip_ctr = 0;
        my $net_ctr = 0;
        for my $ip (keys %auto_dl) {
            my $mask = $auto_dl{$ip}{'mask'};
            if ($mask eq '32') {
                $ip_ctr++;
            } else {
                $net_ctr++;
            }
        }
        ### don't write syslog message if we are running in --fw-block-ip
        ### mode
        unless ($fw_block_ip) {
            &Psad::psyslog('psad', "imported auto_dl, got $ip_ctr " .
                "IP addresses and $net_ctr networks")
                unless $no_syslog_alerts;
        }
    }
    return;
}

sub import_p0f_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_sigs{$len}{$frag_bit}{$ttl}{$win_size}{$options}{$os}
                    = $sig_str;
            }
        }
    }

    print STDERR Dumper %p0f_sigs if $debug and $verbose;
    &Psad::psyslog('psad',
        'imported p0f-based passive OS fingerprinting signatures')
        unless $no_syslog_alerts;
    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'}) {
            &Psad::psyslog('psad', "$posf_file: missing " .
                "NUMPKTS for os: $os") unless $no_syslog_alerts;
            delete $posf_sigs{$os};
            next OS;
        }
        unless (defined $posf_sigs{$os}{'tos'}) {
            &Psad::psyslog('psad', "$posf_file: missing " .
                "TOS for os: $os") unless $no_syslog_alerts;
            delete $posf_sigs{$os};
            next OS;
        }
        unless (defined $posf_sigs{$os}{'len'}) {
            &Psad::psyslog('psad', "$posf_file: missing " .
                "LEN for os: $os") unless $no_syslog_alerts;
            delete $posf_sigs{$os};
            next OS;
        }
        unless (defined $posf_sigs{$os}{'ttl'}) {
            &Psad::psyslog('psad', "$posf_file: missing " .
                "TTL for os: $os") unless $no_syslog_alerts;
            delete $posf_sigs{$os};
            next OS;
        }
        unless (defined $posf_sigs{$os}{'id'}) {
            &Psad::psyslog('psad', "$posf_file: missing " .
                "ID for os: $os") unless $no_syslog_alerts;
            delete $posf_sigs{$os};
            next OS;
        } else {
            unless ($posf_sigs{$os}{'id'} eq 'SMALLINCR'
                    || $posf_sigs{$os}{'id'} eq 'RANDOM') {
                &Psad::psyslog('psad', "$posf_file: ID must " .
                    "be either SMALLINCR or RANDOM for os: $os")
                    unless $no_syslog_alerts;
                delete $posf_sigs{$os};
                next OS;
            }
        }
        unless (defined $posf_sigs{$os}{'win'}) {
            &Psad::psyslog('psad', "$posf_file: missing " .
                "WINDOW for os: $os") unless $no_syslog_alerts;
            delete $posf_sigs{$os};
            next OS;
        }
    }
    print STDERR Dumper %posf_sigs if $debug and $verbose;
    &Psad::psyslog('psad',
        'imported TOS-based passive OS fingerprinting signatures')
        unless $no_syslog_alerts;
    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\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 $range;
            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) {
                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'}) {
                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 ($src, $scan_proto) = @_;

    ### 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 $src is contained within an auto_dl network
        next NET unless ipv4_in_network("$net/$mask", $src);

        ### $src is part of an ignored network
        return 0 if $dl == 0;

        if ($scan_dl{$src} < $dl) {
            if (not defined $auto_dl{$net}{'proto'}) {
                ### all protocols are applicable
                $scan_dl{$src} = $dl;
                &Psad::psyslog('psad', 'auto-assigned danger level: ' .
                    "$dl for IP: $src") unless $no_syslog_alerts;
                return $dl;
            } else {
                for my $proto (@{$auto_dl{$net}{'proto'}}) {
                    if ($scan_proto eq $proto) {
                        $scan_dl{$src} = $dl;
                        &Psad::psyslog('psad', 'auto-assigned danger ' .
                            "level: $dl for IP: $src")
                            unless $no_syslog_alerts;
                        return $dl;
                    }
                }
            }
        }
    }
    return -1;
}

sub net_overlap() {
    my ($net, $mask, $block_ip, $block_mask) = @_;

    my ($block_net_addr, $block_net_mask) =
        ipv4_network($block_ip, $block_mask);
    my $block_net_br = ipv4_broadcast("$block_net_addr/$block_net_mask");

    if (ipv4_in_network("$net/$mask", $block_net_addr)) {
        return 1;
    }
    if (ipv4_in_network("$net/$mask", $block_net_br)) {
        return 1;
    }
    return 0;
}

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

sub write_global_packet_counters() {
    open P, "> $config{'PACKET_COUNTER_FILE'}" or
        die "[*] Could not open $config{'PACKET_COUNTER_FILE'}: $!";
    print P "tcp:  $tcp_ctr\n",
        "udp:  $udp_ctr\n",
        "icmp: $icmp_ctr\n";
    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 qw(tcp udp icmp) {
                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' 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_aref = shift;
    open ERR, ">> $config{'FW_ERROR_LOG'}" or die '[*] Could not open ',
        "$config{'FW_ERROR_LOG'}: $!";
    for my $line (@$bad_packets_aref) {
        print ERR $line;
    }
    close ERR;
    return;
}

sub scan_logr() {
    my $curr_scan_hr = shift;

    return if $benchmark;
    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.
        next SRC unless $scan_dl{$src} >= 1;

        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 $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 $tcp_f  = 0;
            my $udp_f  = 0;
            my $icmp_f = 0;
            my $whois_info_aref;

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

            unless (defined $scan{$src}{$dst}{'email_ctr'}) {
                $scan{$src}{$dst}{'email_ctr'} = 1;
            } elsif ($config{'EMAIL_LIMIT'} > 0
                    and $scan{$src}{$dst}{'email_ctr'}
                    > $config{'EMAIL_LIMIT'}) {
                ### ignore EMAIL_LIMIT if it is zero
                unless (defined $scan{$src}{$dst}{'stop_email'}
                        or $config{'EMAIL_LIMIT_STATUS_MSG'} eq 'N') {
                    &email_limit_reached($src, $dst);
                }
                next DST;
            }
            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}", 0500
                unless -d "$config{'PSAD_DIR'}/${src}";
            my $src_dir = "$config{'PSAD_DIR'}/${src}";
            my $ecount_file  = "${src_dir}/email_count";
            my $dl_file      = "${src_dir}/danger_level";
            my $posf_file    = "${src_dir}/os_guess";
            my $p0f_file     = "${src_dir}/p0f_guess";
            my $whois_file   = "${src_dir}/whois";
            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";

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

            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'};
            }

            if (($tcp_f and $udp_f) or ($tcp_f and $icmp_f) or
                    ($udp_f and $icmp_f)) {
                $scan{$src}{$dst}{'multiproto'} = '';
            }

            ### 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) {
                $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
            unless ($no_whois) {
                $whois_info_aref = &get_whois_info($src, $whois_file);
            }
            print STDERR "[+] scan_logr(): generating email.....\n"
                if $debug;

            ### get the absolute starting time for the scan and the
            ### current time
            my $abs_s_time = '';
            if ($analyze_msgs) {
                $abs_s_time = $scan{$src}{$dst}{'s_time'};
            } else {
                $abs_s_time = scalar localtime $scan{$src}{$dst}{'s_time'};
            }
            my $s_time = '';
            if (not $analyze_msgs 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 (defined $scan{$src}{$dst}{'multiproto'}) {
                print $fh ' Multi-Protocol';
            }
            if (defined $auto_assigned_msg{$src}) {
                printf $fh ' Auto-assigned';
                delete $auto_assigned_msg{$src};
            }
            print $fh "\n\n";

            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 ($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]";
                    }
                    $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_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
                    );
                }

            }
            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
                    );
                }
            }
            printf $fh "\n%${log_len}s%s\n", 'Source: ', $src;
            printf $fh "%${log_len}s%s\n", 'DNS: ', $src_dns_str
                unless $no_rdns;

            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;
            print $fh "\n";

            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;
                }
            }
            print $fh "\n";
            unless ($analyze_msgs) {
                printf $fh "%${log_len}s%s\n", 'Current interval: ',
                    "$s_time (start)";
                printf $fh "%${log_len}s%s\n\n", '', "$time (end)";
            }
            ### print the overall stats since the scan began
            printf $fh "%${log_len}s%s\n", 'Overall scan start: ',
                $abs_s_time;
            printf $fh "%${log_len}s%s\n", 'Total email alerts: ',
                $scan{$src}{$dst}{'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]";
            }
            printf $fh "\n   %-9s%-13s%-7s%-7s%-7s\n", 'chain:', 'interface:',
                'tcp:', 'udp:', 'icmp:';
            for my $chain (keys %{$scan{$src}{$dst}{'chain'}}) {
                for my $intf (keys %{$scan{$src}{$dst}{'chain'}{$chain}}) {
                    my $tot_tcp  = 0;
                    my $tot_udp  = 0;
                    my $tot_icmp = 0;
                    $tot_tcp = $scan{$src}{$dst}{'chain'}{$chain}{$intf}{'tcp'}
                        if defined $scan{$src}{$dst}{'chain'}{$chain}{$intf}{'tcp'};
                    $tot_udp = $scan{$src}{$dst}{'chain'}{$chain}{$intf}{'udp'}
                        if defined $scan{$src}{$dst}{'chain'}{$chain}{$intf}{'udp'};
                    $tot_icmp = $scan{$src}{$dst}{'chain'}{$chain}{$intf}{'icmp'}
                        if defined $scan{$src}{$dst}{'chain'}{$chain}{$intf}{'icmp'};
                    printf $fh "   %-9s%-13s%-7s%-7s%-7s\n", $chain,
                        $intf, $tot_tcp, $tot_udp, $tot_icmp;
                }
            }
            ### 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
            &Psad::psyslog('psad', "scan detected: $src -> $dst " .
                "$syslog_range tcp=$tcp_newpkts udp=$udp_newpkts " .
                "icmp=$icmp_newpkts dangerlevel: $curr_dl")
                unless $no_syslog_alerts;

            unless ($no_whois) {
                print $fh  "\n[+] Whois Information:\n";
                for my $line (@$whois_info_aref) {
                    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_msgs and not $analysis_emails) {
                    my $subject;
                    if ($analyze_msgs) {
                        $subject = "$mail_alert_prefix DL$curr_dl (analysis " .
                            "mode) src: $src_subj dst: $dst_subj";
                    } else {
                        $subject = "$mail_alert_prefix DL$curr_dl src: " .
                            "$src_subj dst: $dst_subj";
                    }
                    &Psad::psyslog('psad', "sending email alert to: " .
                        "$config{'EMAIL_ADDRESSES'}\n")
                        unless $no_syslog_alerts;
                    &Psad::sendmail($subject, $email_file,
                        $config{'EMAIL_ADDRESSES'}, $cmds{'mail'})
                        unless $no_email_alerts;
                    $scan{$src}{$dst}{'email_ctr'}++;

                    ### print the number of email alerts we have sent
                    open E, "> $ecount_file" or die "[*] Could not open ",
                        "$ecount_file: $!";
                    print E $scan{$src}{$dst}{'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);
                        } else {
                            &exec_external_script($src) unless
                                defined $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_logr_signatures() {
    my ($src, $dst, $email_fh, $log_sigs) = @_;
    my $dst_ip_is_local = 0;
    $dst_ip_is_local = 1 if defined $local_ips{$dst};
    open LS, ">> $log_sigs" or die "[*] Could not open $log_sigs: $!";
    for my $proto qw(tcp udp icmp) {
        next unless defined $scan{$src}{$dst}{$proto};
        next unless (defined $scan{$src}{$dst}{$proto}{'curr_sig'}
            or defined $scan{$src}{$dst}{$proto}{'sid'}
            or defined $scan{$src}{$dst}{$proto}{'invalid_type'}
            or defined $scan{$src}{$dst}{$proto}{'invalid_code'});
        print $email_fh "\n\n[+] $proto scan signatures:\n\n";
        print LS "\n\n[+] $proto scan signatures\n\n";
        print STDERR "[+] scan_logr_signatures(): src: $src dst: $dst ",
            "proto: $proto\n" if $debug;
        for my $sid (keys %{$scan{$src}{$dst}{$proto}{'sid'}}) {
            for my $chain (keys %{$scan{$src}{$dst}{$proto}{'sid'}{$sid}}) {
                my $msg = $snort_msgs{$sid}{'msg'};
                my $classtype = $snort_msgs{$sid}{'classtype'};
                my $pkts = $scan{$src}{$dst}{$proto}{'sid'}{$sid}{$chain};
                my $content = '';
                if (defined $snort_msgs{$sid}{'content'}) {
                    $content = $snort_msgs{$sid}{'content'};
                }
                print $email_fh qq(   "$msg"\n);
                print LS qq(   "$msg"\n);
                print $email_fh "       classtype: $classtype\n";
                print LS "       classtype: $classtype\n";
                print $email_fh "       sid:       $sid\n";
                print LS "       sid:       $sid\n";
                if ($content) {
                    print $email_fh qq(       content:   "$content"\n);
                    print LS qq(       content:   "$content"\n);
                }
                print $email_fh "       chain:     $chain\n";
                print LS "       chain:     $chain\n";
                print $email_fh "       packets:   $pkts\n\n";
                print LS "       packets:   $pkts\n\n";
            }
        }
        if (defined $scan{$src}{$dst}{$proto}{'invalid_type'}) {
            for my $type (keys %{$scan{$src}{$dst}{$proto}{'invalid_type'}}) {
                for my $chain (keys %{$scan{$src}{$dst}{$proto}
                        {'invalid_type'}{$type}}) {
                    my $pkts = $scan{$src}{$dst}{$proto}
                        {'invalid_type'}{$type}{$chain}{'pkts'};
                    print $email_fh
                        qq(   Invalid ICMP type "$type" chain=$chain packets=$pkts\n);
                    print LS
                        qq(   Invalid ICMP type "$type" chain=$chain packets=$pkts\n);
                }
            }
        }
        if (defined $scan{$src}{$dst}{$proto}{'invalid_code'}) {
            for my $type (keys %{$scan{$src}{$dst}{$proto}{'invalid_code'}}) {
                for my $code (keys %{$scan{$src}{$dst}
                        {$proto}{'invalid_code'}{$type}}) {
                    for my $chain (keys %{$scan{$src}{$dst}{$proto}
                            {'invalid_code'}{$type}{$code}}) {
                        my $pkts = $scan{$src}{$dst}{$proto}{'invalid_code'}
                            {$type}{$code}{$chain}{'pkts'};
                        print $email_fh "   Invalid ICMP code \"$code\" for ICMP ",
                            "\"$valid_icmp_types{$type}{'text'}\" packet\n",
                            "       chain=$chain packets=$pkts\n";
                        print LS "   Invalid ICMP code \"$code\" for ICMP ",
                            "\"$valid_icmp_types{$type}{'text'}\" packet\n",
                            "       chain=$chain packets=$pkts\n";
                    }
                }
            }
        }
        for my $sid (keys %{$scan{$src}{$dst}{$proto}{'curr_sig'}}) {
            my $msg = $sigs_attr{$sid}{'msg'};

            for my $chain (keys %{$scan{$src}{$dst}{$proto}{'curr_sig'}{$sid}}) {
                if ($proto eq 'tcp' or $proto eq 'udp') {
                    for my $dp (keys %{$scan{$src}{$dst}{$proto}{'curr_sig'}
                            {$sid}{$chain}{'dp'}}) {
                        my $flags = '';
                        my $pkts = $scan{$src}{$dst}{$proto}{'curr_sig'}
                            {$sid}{$chain}{'dp'}{$dp};
                        if (defined $scan{$src}{$dst}{$proto}{'curr_sig'}
                                {$sid}{$chain}{'flags'} and defined $scan{$src}{$dst}
                                    {$proto}{'curr_sig'}{$sid}{$chain}{'flags'}{$dp}) {
                            $flags = $scan{$src}{$dst}{$proto}{'curr_sig'}
                                        {$sid}{$chain}{'flags'}{$dp};
                        }

                        if ($dst_ip_is_local) {
                            ### check local ports here since we know the
                            ### destination is a local ip address
                            if (defined $local_ports{$proto}{$dp}) {
                                if ($flags) {
                                    print $email_fh "   \"$msg\"\n",
                                        "        sid=$sid chain=$chain packets=$pkts dp=$dp flags=[$flags] ",
                                        "** Your machine is listening on $proto port: $dp!\n";
                                    print LS "   \"$msg\"\n",
                                        "        sid=$sid chain=$chain packets=$pkts dp=$dp flags=[$flags] ",
                                        "** Your machine is listening on $proto port: $dp!\n";
                                } else {
                                    print $email_fh "   \"$msg\"\n",
                                        "        sid=$sid chain=$chain packets=$pkts dp=$dp ",
                                        "** Your machine is listening on $proto port: $dp!\n";
                                    print LS "   \"$msg\"\n",
                                        "        sid=$sid chain=$chain packets=$pkts dp=$dp ",
                                        "** Your machine is listening on $proto port: $dp!\n";
                                }
                            } else {
                                if ($flags) {
                                    print $email_fh "   \"$msg\"\n",
                                        "        sid=$sid chain=$chain packets=$pkts dp=$dp flags=[$flags] ",
                                        "No local server on $proto/$dp\n";
                                    print LS "   \"$msg\"\n",
                                        "        sid=$sid chain=$chain packets=$pkts dp=$dp flags=[$flags] ",
                                        "No local server on $proto/$dp\n";
                                } else {
                                    print $email_fh "   \"$msg\"\n",
                                        "        sid=$sid chain=$chain packets=$pkts dp=$dp No local ",
                                        "server on $proto/$dp\n";
                                    print LS "   \"$msg\"\n",
                                        "        sid=$sid chain=$chain packets=$pkts dp=$dp No local ",
                                        "server on $proto/$dp\n";
                                }
                            }
                        } else {
                            if ($flags) {
                                print $email_fh "   \"$msg\"\n",
                                    "       sid=$sid chain=$chain packets=$pkts dp=$dp flags=[$flags]\n";
                                print LS "   \"$msg\"\n",
                                    "       sid=$sid chain=$chain packets=$pkts dp=$dp flags=[$flags]\n";
                            } else {
                                print $email_fh "   \"$msg\"\n",
                                    "       sid=$sid chain=$chain packets=$pkts dp=$dp\n";
                                print LS "   \"$msg\"\n",
                                    "       sid=$sid chain=$chain packets=$pkts dp=$dp\n";
                            }
                        }
                    }
                } else {
                    my $pkts = $scan{$src}{$dst}{'icmp'}
                        {'curr_sig'}{$sid}{$chain}{'pkts'};
                    print $email_fh qq(   "$msg" sid=$sid chain=$chain packets=$pkts\n);
                    print LS qq(   "$msg" sid=$sid chain=$chain packets=$pkts\n);
                }
                ### signature logging with syslog is not yet supported
                ### (requires a message for each matched signature).
#            if ($sigmatch =~ /^(\".*\")/) {
#                $syslog_sig_title = "signature=$1";
#            }
            }
        }
        ### need to delete the current signature so it
        ### won't show up in the next alert
        unless ($config{'SHOW_ALL_SIGNATURES'} eq 'Y') {
            delete $scan{$src}{$dst}{$proto}{'curr_sig'}
                if defined $scan{$src}{$dst}{$proto}{'curr_sig'};
            delete $scan{$src}{$dst}{$proto}{'sid'}
                if defined $scan{$src}{$dst}{$proto}{'sid'};
            delete $scan{$src}{$dst}{$proto}{'invalid_type'}
                if defined $scan{$src}{$dst}{$proto}{'invalid_type'};
            delete $scan{$src}{$dst}{$proto}{'invalid_code'}
                if defined $scan{$src}{$dst}{$proto}{'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 {
                printf $fh "%${log_len}s%s\n", 'Iptables chain: ',
                    qq/$chain (prefix "$prefix"), $count packets/;
            }
        }
    }
    return;
}

sub exec_external_script() {
    my $src = shift;
    $scan_ext_exec{$src} = '';
    my $cmd = $config{'EXTERNAL_SCRIPT'};
    $cmd =~ s/SRCIP/$src/;
    my $pid;
    if ($pid = fork()) {
        local $SIG{'ALRM'} = sub {die "[*] External script timeout.\n"};
        alarm 30;  ### the external script should be finished in 30 secs.
        eval {
            waitpid($pid, 0);
        };
        alarm 0;
        if ($@) {
            kill 9, $pid;
        }
    } else {
        die "[*] Could not fork for external script: $!" unless defined $pid;
        exec qq{$cmd};
    }
    return;
}

sub renew_auto_blocked_ips() {
    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 =~ /($ip_re)/) {
                my $ip = $1;

                ### block the IP address (note that checks are built into
                ### this function)
                if (&ipt_block($ip, 'renew')) {

                    ### set the auto-block start time here since
                    ### renew_auto_blocked_ips() is only called
                    ### at startup.
                    $auto_blocked_ips{$ip}{'time'}    = time();
                    $auto_blocked_ips{$ip}{'blocked'} = 1;
                }
            }
        }
    }
    if ($config{'TCPWRAPPERS_BLOCK_METHOD'} eq 'Y'
            && -e $config{'ETC_HOSTS_DENY'}) {
        open B, "< $config{'ETC_HOSTS_DENY'}" or
            die "[*] Could not open $config{'ETC_HOSTS_DENY'}: $!";
        my @lines = <B>;
        close B;
        for my $line (@lines) {
            if ($line =~ /($ip_re)/) {
                my $ip = $1;
                unless (&tcpwr_test_block($ip)) {
                    &Psad::psyslog('psad', "renewing tcpwrappers auto-block " .
                        "against $ip $timeout_str")
                        unless $no_syslog_alerts;
                    &tcpwr_block($ip);
                    &Psad::sendmail("$mail_status_prefix RENEWED tcpwrappers " .
                        "BLOCK against $ip $timeout_str", '',
                        $config{'EMAIL_ADDRESSES'}, $cmds{'mail'})
                        unless $no_email_alerts;
                }
                $auto_blocked_ips{$ip}{'time'}    = time();
                $auto_blocked_ips{$ip}{'blocked'} = 1;
            }
        }
    }
    return;
}

sub flush_auto_blocked_ips() {

    my $ipt = new IPTables::ChainMgr(
        'iptables' => $cmds{'iptables'}
    ) or die '[*] Could not acquire IPTables::ChainMgr object.';

    if ($fw_del_chains) {
        print "[+] Flushing and deleting Netfilter IPT_AUTO_CHAIN chains...\n";
    } else {
        print "[+] Flushing Netfilter IPT_AUTO_CHAIN chains...\n";
    }
    if (&Psad::pidrunning($config{'PID_FILE'})) {
        print "    WARNING: psad is currently running, so flushing the ",
            "chains may\n    cause some warning syslog messages to appear.\n";
    }
    if (@ipt_block_config) {
        for my $block_hr (@ipt_block_config) {
            my $table      = $block_hr->{'table'};
            my $from_chain = $block_hr->{'from_chain'};
            my $to_chain   = $block_hr->{'to_chain'};

            if ($ipt->chain_exists($table, $to_chain)) {
                if ($fw_del_chains) {
                    my ($rv, $status_msg) = $ipt->delete_chain($table,
                        $from_chain, $to_chain);
                    if ($rv) {
                        print "[+] $status_msg\n";
                    } else {
                        print "[-] $status_msg\n";
                    }
                } else {
                    if ($ipt->flush_chain($table, $to_chain)) {
                        print "[+] Flushed: $to_chain.\n";
                    } else {
                        print "[-] Could not flush: $to_chain\n";
                    }
                }
            } else {
                print "[-] Chain: $to_chain does not exist.\n";
            }
        }
    } else {
        print "[-] No valid IPT_AUTO_CHAIN keywords.\n";
    }

    if (-e $config{'AUTO_BLOCK_IPT_FILE'}) {
        ### we have removed the iptables block rules, so truncate
        ### the cache file.
        open T, "> $config{'AUTO_BLOCK_IPT_FILE'}" or
            die "[*] Could not truncate $config{'AUTO_BLOCK_IPT_FILE'}: $!";
        close T;
    }

    if (-e $config{'AUTO_BLOCK_TCPWR_FILE'}) {
        my $found_blocked = 0;
        print "[+] Removing tcpwrapper auto-generated block rules.\n";
        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 =~ /($ip_re)/) {
                my $ip = $1;
                ### remove block rules for $ip if it has been blocked
                &tcpwr_remove_block($ip) if &tcpwr_test_block($ip);
                $found_blocked = 1;
            }
        }
        ### we have removed the tcpwrapper block rules, so truncate
        ### the cache file.
        open T, "> $config{'AUTO_BLOCK_TCPWR_FILE'}" or
            die "[*] Could not truncate $config{'AUTO_BLOCK_TCPWR_FILE'}: $!";
        close T;
        unless ($found_blocked) {
            print "[-] Currently there are no auto-generated ".
                "tcpwrapper blocking rules in effect.\n";
        }
    }
    exit 0;
}

sub ipt_block() {
    my ($ip, $renewed_status) = @_;

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

    my $ipt = new IPTables::ChainMgr(
        'iptables' => $cmds{'iptables'}
    ) or die '[*] Could not acquire IPTables::ChainMgr object.';

    my $block_success = 0;

    my $timeout_str = '';
    if ($config{'AUTO_BLOCK_TIMEOUT'} > 0) {
        $timeout_str = "for $config{'AUTO_BLOCK_TIMEOUT'} seconds";
    } else {
        $timeout_str = '(unlimited timeout)';
    }

    ### add block rule for $ip unless it is already blocked
    for my $block_hr (@ipt_block_config) {
        my $target     = $block_hr->{'target'};
        my $direction  = $block_hr->{'direction'};
        my $table      = $block_hr->{'table'};
        my $from_chain = $block_hr->{'from_chain'};
        my $to_chain   = $block_hr->{'to_chain'};

        ### make sure "to_chain" exists
        my ($rv, $status_msg) = $ipt->create_chain($table, $to_chain);

        unless ($rv) {
            &Psad::psyslog('psad', $status_msg) unless $no_syslog_alerts;
            print STDERR "[-] ipt_block(): $status_msg\n" if $debug;
            next;
        }

        ### add jump rule to the "to_chain" from the "from_chain"
        ($rv, $status_msg) = $ipt->add_jump_rule($table,
            $from_chain, $to_chain);

        unless ($rv) {
            &Psad::psyslog('psad', $status_msg) unless $no_syslog_alerts;
            print STDERR "[-] ipt_block(): $status_msg\n" if $debug;
            next;
        }

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

        if ($src and $dst) {
            unless ($ipt->find_ip_rule($src, $dst,
                    $table, $to_chain, $target)) {
                ($rv, $status_msg) = $ipt->add_ip_rule($src, $dst,
                    $config{'IPTABLES_AUTO_RULENUM'}, $table,
                    $to_chain, $target);
                if ($rv) {
                    $block_success = 1;
                } else {
                    &Psad::psyslog('psad', $status_msg)
                        unless $no_syslog_alerts;
                    print STDERR "[-] ipt_block(): $status_msg\n" if $debug;
                }
            }
        } else {
            next;
        }

        if ($direction eq 'both') {
            ### need to add reverse rule for FORWARD chain
            my $src2 = $dst;
            my $dst2 = $src;
            unless ($ipt->find_ip_rule($src2, $dst2, $table,
                $to_chain, $target)) {

                ($rv, $status_msg) = $ipt->add_ip_rule($src2, $dst2,
                    $config{'IPTABLES_AUTO_RULENUM'}, $table,
                    $to_chain, $target);
                if ($rv) {
                    $block_success = 1;
                } else {
                    &Psad::psyslog('psad', $status_msg)
                        unless $no_syslog_alerts;
                    print STDERR "[-] ipt_block(): $status_msg\n" if $debug;
                }
            }
        }
    }
    if ($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 Netfilter log).
        unless (defined $auto_blocked_ips{$ip}) {
            $auto_blocked_ips{$ip}{'time'}    = time();
            $auto_blocked_ips{$ip}{'blocked'} = 1;
        }

        my $mail_msg = "iptables auto-block against $ip $timeout_str";
        if ($renewed_status) {
            $mail_msg = "renewed $mail_msg";
        } else {
            $mail_msg = "added $mail_msg";
        }

        &Psad::sendmail("$mail_status_prefix $mail_msg", '',
            $config{'EMAIL_ADDRESSES'}, $cmds{'mail'})
            unless $no_email_alerts;
        &Psad::psyslog('psad', $mail_msg) unless $no_syslog_alerts;

        ### write the ip out to the auto blocked file
        print STDERR "[+] ipt_block(): added block for $ip\n"
            if $debug;
        &cache_file_write_blocked_ip($ip, $config{'AUTO_BLOCK_IPT_FILE'});
    } else {
        &Psad::psyslog('psad', "could not add iptables " .
            "block rule for: $ip") unless $no_syslog_alerts;
        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(
        'iptables' => $cmds{'iptables'}
    ) 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 $block_hr (@ipt_block_config) {
        my $target     = $block_hr->{'target'};
        my $direction  = $block_hr->{'direction'};
        my $table      = $block_hr->{'table'};
        my $to_chain   = $block_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;
        }

        if ($src and $dst) {
            if ($ipt->find_ip_rule($src, $dst, $table, $to_chain, $target)) {
                my ($rv, $status_msg) = $ipt->delete_ip_rule($src, $dst,
                    $table, $to_chain, $target);
                if ($rv) {
                    $rm_block = 1;
                } else {
                    &Psad::psyslog('psad', $status_msg)
                        unless $no_syslog_alerts;
                    print STDERR "[-] ipt_rm_block(): $status_msg\n" if $debug;
                }
            }
        } else {
            next;
        }

        if ($direction eq 'both') {
            ### need to delete reverse rule for FORWARD chain
            my $src2 = $dst;
            my $dst2 = $src;
            if ($ipt->find_ip_rule($src2, $dst2, $table, $to_chain, $target)) {
                my ($rv, $status_msg) = $ipt->delete_ip_rule($src2, $dst2,
                    $table, $to_chain, $target);
                if ($rv) {
                    $rm_block = 1;
                } else {
                    &Psad::psyslog('psad', $status_msg)
                        unless $no_syslog_alerts;
                    print STDERR "[-] ipt_rm_block(): $status_msg\n" if $debug;
                }
            }
        }
    }

    if ($rm_block) {
        if (not $flush_fw) {
            ### don't send timeout email if we are manually flushing
            ### the auto-block rules from the command line with --Flush.
            &Psad::psyslog('psad', "removed iptables auto-block against " .
                "$ip (timeout expired).") unless $no_syslog_alerts;
            &Psad::sendmail("$mail_status_prefix removed iptables block " .
                "against $ip (timeout expired).", '',
                $config{'EMAIL_ADDRESSES'}, $cmds{'mail'})
                unless $no_email_alerts;
        }
        print STDERR "[+] ipt_rm_block(): removed iptables block ",
            "against $ip (timeout expired).\n" if $debug;
        &cache_file_rm_blocked_ip($ip, $config{'AUTO_BLOCK_IPT_FILE'});
    } else {
        if ($flush_fw) {
            &Psad::psyslog('psad', 'could not remove iptables ' .
                "block rule for $ip") unless $no_syslog_alerts;
        }
        print STDERR "[-] Could not remove iptables block rule for $ip.\n"
            if $debug;
    }
    return;
}

sub ipt_list_auto_chains() {

    my $ipt = new IPTables::ChainMgr(
        'iptables' => $cmds{'iptables'}
    ) 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 $block_hr (@ipt_block_config) {
        my $table      = $block_hr->{'table'};
        my $to_chain   = $block_hr->{'to_chain'};

        if ($ipt->chain_exists($table, $to_chain)) {
            my ($rv, $output_aref) =
                $ipt->run_ipt_cmd_output("$cmds{'iptables'} -t " .
                    "$table -n -L $to_chain -v");

            if ($rv and $output_aref) {
                print for @$output_aref;
            }
            print "\n";
        } else {
            print "[-] Table: $table, chain: $to_chain, does not exist\n";
        }
    }
    return 0;
}

sub check_ipt_add_ip() {
    if (-e $config{'AUTO_IPT_ADD_IP_FILE'}) {
        open F, "< $config{'AUTO_IPT_ADD_IP_FILE'}" or die "[*] Could ",
            "not open $config{'AUTO_IPT_ADD_IP_FILE'}: $!";
        my @lines = <F>;
        close F;

        my $ipt = new IPTables::ChainMgr(
            'iptables' => $cmds{'iptables'}
        ) or die "[*] Could not acquire IPTables::ChainMgr object.";

        for my $ip (@lines) {
            chomp $ip;
            if ($ip =~ m|^\s*$ip_re\s*$|
                or $ip =~ m|^\s*$ip_re/\d+\s*$|
                or $ip =~ m|^\s*$ip_re/$ip_re\s*$|) {

                &Psad::psyslog('psad',
                    "adding $ip from cache file to psad chains")
                    unless $no_syslog_alerts;

                ### instantiate the blocking rule
                &ipt_block($ip, '');
            }
        }
        unlink $config{'AUTO_IPT_ADD_IP_FILE'} or die $!;
    }
    return;
}

sub cache_file_add_ipt_block_ip() {
    unless ($config{'ENABLE_AUTO_IDS'} eq 'Y') {
        print "[-] ENABLE_AUTO_IDS is not enabled. Exiting.\n";
        return 0;
    }

    my $block_ip   = '';
    my $block_mask = '';
    if ($fw_block_ip =~ m|^\s*($ip_re)\s*$|) {
        $block_ip   = $1;
        $block_mask = '32';
    } elsif ($fw_block_ip =~ m|^\s*($ip_re)/(.*)\s*$|) {
        $block_ip   = $1;
        $block_mask = $2;  ### CIDR or regular
    }

    ### 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 unless $dl == 0;  ### only care about the ignored IPs/nets

        if (&net_overlap($net, $mask, $block_ip, $block_mask)) {
            die "[*] $fw_block_ip overlaps with whitelisted ",
                "$net/$mask in $config{'AUTO_DL_FILE'}";
        }
    }


    if (-e $config{'PID_FILE'}) {
        if (&Psad::pidrunning($config{'PID_FILE'})) {
            print "[+] Writing $fw_block_ip to cache file. Psad will add the IP\n",
                "    within $config{'CHECK_INTERVAL'} seconds.\n";
            open F, "> $config{'AUTO_IPT_ADD_IP_FILE'}.tmp" or die "[*] Could ",
                "not open $config{'AUTO_IPT_ADD_IP_FILE'}.tmp: $!";
            print F $fw_block_ip, "\n";
            close F;
            if (-e $config{'AUTO_IPT_ADD_IP_FILE'}) {
                unlink $config{'AUTO_IPT_ADD_IP_FILE'} or die $!;
            }
            move "$config{'AUTO_IPT_ADD_IP_FILE'}.tmp",
                $config{'AUTO_IPT_ADD_IP_FILE'} or die $!;
        } else {
            print "[-] There is no running psad process. Exiting.\n"
        }
    } else {
        print "[-] There is no running psad process. Exiting.\n"
    }
    return 0;
}

sub tcpwr_test_block() {
    my $ip = shift;
    open T, "< $config{'ETC_HOSTS_DENY'}" or die "[*] Could not open ",
        "$config{'ETC_HOSTS_DENY'}: $!";
    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'}" or die "[*] Could not open ",
        "$config{'ETC_HOSTS_DENY'}: $!";
    print T "ALL: $ip\n";
    close T;
    return;
}

sub tcpwr_remove_block() {
    my $ip = shift;
    open T, "< $config{'ETC_HOSTS_DENY'}" or die '[*] Could not open ',
        "$config{'ETC_HOSTS_DENY'}: $!";
    my @lines = <T>;
    close T;
    open T, "> $config{'ETC_HOSTS_DENY'}.tmp" or die '[*] Could not open ',
        "$config{'ETC_HOSTS_DENY'}.tmp: $!";
    for my $line (@lines) {
        chomp $line;
        if ($line =~ /ALL:\s+$ip$/) {
            &cache_file_rm_blocked_ip($ip, $config{'AUTO_BLOCK_TCPWR_FILE'});
            &Psad::sendmail("$mail_status_prefix removed tcpwrappers block " .
                "against $ip (timeout expired).", '',
                $config{'EMAIL_ADDRESSES'}, $cmds{'mail'})
                unless $no_email_alerts;
        } else {
            print T "$line\n";
        }
    }
    close T;
    move "$config{'ETC_HOSTS_DENY'}.tmp", $config{'ETC_HOSTS_DENY'} or die
        "[*] Could not move $config{'ETC_HOSTS_DENY'}.tmp -> ",
        "$config{'ETC_HOSTS_DENY'}";
    return;
}

sub auto_psad_response() {
    my $curr_scan_hr = shift;

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

    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 interface ips.
        next if &auto_block_ignore_ip($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'}
                and $auto_blocked_ips{$src}{'blocked'} == 0) {
            my $timeout_str = '';
            if ($config{'AUTO_BLOCK_TIMEOUT'} > 0) {
                $timeout_str = "for $config{'AUTO_BLOCK_TIMEOUT'} seconds.";
            } else {
                $timeout_str = '(unlimited timeout).';
            }
            ### 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') {
                &Psad::psyslog('psad', 'initiating tcpwrappers auto-block ' .
                    "against $src $timeout_str") unless $no_syslog_alerts;
                &Psad::sendmail("$mail_status_prefix tcpwrappers AUTO-BLOCK " .
                    "against $src $timeout_str", '',
                    $config{'EMAIL_ADDRESSES'}, $cmds{'mail'})
                    unless $no_email_alerts;
                my $found = 0;
                open H, "< $config{'ETC_HOSTS_DENY'}" or die
                    "[*] Could not open $config{'ETC_HOSTS_DENY'}: $!";
                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'}" or die
                        "[*] Could not open $config{'ETC_HOSTS_DENY'}: $!";
                    print H "ALL: $src\n";
                    close H;
                    ### write the ip out to the auto blocked file
                    &cache_file_write_blocked_ip($src,
                        $config{'AUTO_BLOCK_TCPWR_FILE'});
                }
            }
            print STDERR "[+] setting blocked = 1 for $src\n" if $debug;
            ### don't try to block again
            $auto_blocked_ips{$src}{'blocked'} = 1;
        } elsif ($debug) {
            print STDERR "[+] blocked value for $src: ",
                "$auto_blocked_ips{$src}{'blocked'}\n";
        }
    }
    return;
}

sub auto_block_ignore_ip() {
    my $ip = shift;
    for my $local_ip (keys %local_ips) {
        return 1 if $ip eq $local_ip;
    }
    ### matching the following two addresses is less likely (assuming
    ### iptables is not logging traffic from localhost) than matching
    ### a legitimate interface address
    return 1 if $ip eq '127.0.0.1';
    return 1 if $ip eq '0.0.0.0';
    return 0;
}

sub timeout_auto_blocked_ips() {
    print STDERR "[+] timeout_auto_block_ips()\n" if $debug;
    return if $config{'AUTO_BLOCK_TIMEOUT'} == 0;
    for my $ip (keys %auto_blocked_ips) {
        if ((time() - $auto_blocked_ips{$ip}{'time'})
                > $config{'AUTO_BLOCK_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_remove_block($ip);
            }

            ### 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};
        }
    }
    return;
}

sub build_ipt_block_config() {

    my $ipt = new IPTables::ChainMgr(
        'iptables' => $cmds{'iptables'}
    ) 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"};

        ### DROP, src, filter, INPUT, PSAD_BLOCK_INPUT;
        my @block = split /\s*,\s*/, $value;
        if ($#block == 4) {
            my %hsh = (
                'target'     => $block[0],
                'direction'  => $block[1],
                'table'      => $block[2],
                'from_chain' => $block[3],
                'to_chain'   => $block[4]
            );
            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";
                &Psad::psyslog('psad', $msg) unless $no_syslog_alerts;
                print STDERR "[-] build_ipt_block_config(): $msg\n"
                    if $debug;
                next VAR;
            }
            if ($ipt->chain_exists($hsh{'table'}, $hsh{'from_chain'})) {
                push @ipt_block_config, \%hsh;
            } else {
                my $msg = "invalid IPT_AUTO_CHAIN$ctr keyword, " .
                    "$hsh{'from_chain'} chain does not exist.";
                &Psad::psyslog('psad', $msg) unless $no_syslog_alerts;
                print STDERR "[-] build_ipt_block_config(): $msg\n"
                    if $debug;
            }
        } else {
            my $msg = "invalid IPT_AUTO_CHAIN$ctr variable: $value";
            &Psad::psyslog('psad', $msg) unless $no_syslog_alerts;
            print STDERR "[-] build_ipt_block_config(): $msg\n" if $debug;
        }
        $ctr++;
    }
    return;
}

sub cache_file_write_blocked_ip() {
    my ($src, $file) = @_;
    print STDERR "[+] cache_file_write_blocked_ip($src, $file)\n" if $debug;
    if (-e $file) {
        open F, "< $file" or die "[*] Could not open open ",
            "$file: $!";
        my @lines = <F>;
        close F;
        ### see if we have already written the ip to the block
        ### file.
        for my $line (@lines) {
            chomp $line;
            return if $line eq $src;  ### already blocked $src
        }
        open B, ">> $file" or
            die "[*] Could not append to $file";
        print B "$src\n";
        close B;
    } else {
        open B, "> $file" or
            die "[*] Could not create $file";
        print B "$src\n";
        close B;
    }
    return;
}

sub cache_file_rm_blocked_ip() {
    my ($src, $file) = @_;
    print STDERR "[+] rm_blocked_ip($src, $file)\n" if $debug;
    if (-e $file) {
        open B, "< $file" or
            die "[*] Could not open $file: $!";
        my @lines = <B>;
        close B;
        open W, "> ${file}.tmp" or
            die "[*] Could not open ${file}.tmp: $!";
        for my $line (@lines) {
            chomp $line;
            print W $line, "\n" unless $line eq $src;
        }
        close W;
        move "${file}.tmp", $file or die "[*] Could not move ",
            "${file}.tmp -> $file";
    }
    return;
}

sub email_limit_reached() {
    my ($src, $dst) = @_;
    my $subject = "$mail_status_prefix email message limit for $src has " .
        "been reached on $config{'HOSTNAME'} ($dst)";
    &Psad::sendmail($subject, '', $config{'EMAIL_ADDRESSES'}, $cmds{'mail'})
        unless $no_email_alerts;
    $scan{$src}{$dst}{'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";
    print PSCAN Dumper \%posf;
    print PSCAN "[+] Scan danger level hash:\n";
    print PSCAN Dumper %scan_dl;
    print PSCAN "[+] Main scan hash:\n";
    print PSCAN Dumper \%scan;
    close PSCAN;
    chmod 0600, $scanfile;
    return;
}

sub get_local_ips() {
    print STDERR "[+] get_local_ips()\n" if $debug;
    open IFC, "$cmds{'ifconfig'} -a |" or die "[*] Could not execute ",
        "$cmds{'ifconfig'} -a: $!";
    my @ips = <IFC>;
    close IFC;
    return unless @ips;
    for my $line (@ips) {
        if ($line =~ /inet\s+.*?:($ip_re)\s/) {
            $local_ips{$1} = '';
        }
    }
    return;
}

sub get_listening_ports() {
    %local_ports = ();
    open NETS, "$cmds{'netstat'} -an 2> /dev/null |" or
        die "[*] Could not execute $cmds{'netstat'} -an: $!";
    my @lines = <NETS>;
    close NETS;
    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;
    my $rdns;
    if ($ip =~ /$ip_re/) {
        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;
            ### my $rdns = gethostbyaddr($ipaddr, AF_INET);
            if ($rdns = gethostbyaddr $ipaddr, 2) {
                $dns_str = $rdns;
            } else {
                $dns_str = '';
            }
            $dns_cache{$ip}{'ctr'}      = 0;
            $dns_cache{$ip}{'hostname'} = $dns_str;
        }
    } else {
        ### $ipaddr was already reported as
        ### a host name by iptables (does this actually
        ### happen?)
        $dns_str  = $ip;
    }
    return $dns_str;
}

sub get_whois_info() {
    my ($ip, $whois_datafile) = @_;
    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;
        eval {
            local $SIG{'ALRM'} = sub {die "whois alarm\n"};
            alarm $config{'WHOIS_TIMEOUT'};
            system "$cmds{'whois'} $ip > $whois_datafile 2> /dev/null";
            alarm 0;
        };
        if ($@) {
            ### die unless $@ eq "whois alarm\n";
            ### warn "$@: $?";  ### let the warning handler save the error.
            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;
    return \@whois_data;
}

sub REAPER {
    my $pid;
    $pid = waitpid(-1, WNOHANG);
#   if (WIFEXITED($?)) {
#       print STDERR "[+] **  Process $pid exited.\n";
#   }
    $SIG{'CHLD'} = \&REAPER;
    return;
}

sub stop_psad() {
    my $rv = 0;

    &Psad::psyslog('psad', 'shutting down psad daemons')
        unless $no_syslog_alerts;
    ### 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) {
        my $pidfile = $pidfiles{$pidname};
        if (-e $pidfile) {
            my $pid = &Psad::pidrunning($pidfile);
            if ($pid) {
                print "[+] Stopping $pidname, pid: $pid\n";
                unless (kill 15, $pid) {
                    kill 9, $pid or print "[*] psad: Could not kill ",
                        "$pidname, pid: $pid $!\n";
                    $rv = 1;
                }
            } else {
                print "[-] psad: $pidname is not running on ",
                    "$config{'HOSTNAME'}\n";
                $rv = 1;
            }
        } else {
            print "[-] psad: pid file $pidfile does not exist for ",
                "$pidname on $config{'HOSTNAME'}\n";
            $rv = 1;
        }
    }
    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 0;
}

sub analysis_mode() {

    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'};

    ### 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'};

    print "[+] Entering analysis mode.  Parsing $messages_file\n";
    open MSGS, "< $messages_file" or die "[*] Could not open ",
        "$messages_file: $!";
    my @lines = <MSGS>;
    close MSGS;
    my @ipt_msgs;
    for my $line (@lines) {
        if ($line =~ /IN.*OUT/) {
            if ($config{'FW_SEARCH_ALL'} eq 'Y') {
                push @ipt_msgs, $line;
            } else {
                if ($line =~ /$config{'SNORT_SID_STR'}/) {
                    push @ipt_msgs, $line;
                } else {
                    for my $fw_search_str (@fw_search) {
                        if ($line =~ /$fw_search_str/) {
                            push @ipt_msgs, $line;
                        }
                    }
                }
            }
        }
    }
    print "[+] Found $#ipt_msgs iptables messages out of ",
        "$#lines total lines.\n";
    &check_scan(\@ipt_msgs);
    print "[+] Displaying status output.\n";
    &status_psad_daemon();
    print "\n[+] Finished --Analyze cycle.\n";
    return 0;
}

### display the status of all four psad daemons
sub status() {

    ### print the status of a specific ip address
    &status_ip() if $status_ip;

    my $rv = 0;   ### assume psad is not running and test...
    for my $pidname qw(psadwatchd kmsgsd psad) {
        my $pidfile = $pidfiles{$pidname};
        if (-e $pidfile) {
            my $pid = &Psad::pidrunning($pidfile);
            if ($pid) {
                print "[+] $pidname (pid: $pid)";
                ### FIXME: should probably just parse /proc instead of
                ### using ps
                open PS, "$cmds{'ps'} auxww |" or die "[*] Could not ",
                    "execute: $cmds{'ps'} auxww: $!";
                my @ps_out = <PS>;
                close PS;
                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";
                $rv = 1;
            } else {
                print "[-] psad: $pidname is not running on ",
                    "$config{'HOSTNAME'}\n";
            }
        } else {
            print "[-] psad: pid file $pidfile does not exist for ",
                "$pidname on $config{'HOSTNAME'}\n";
        }
    }
    return $rv;
}

sub status_psad_daemon() {
    my $cmdline;
    if (not $analyze_msgs) {
        ### 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";
    }
    ### sort and print the scan source ips
    my %scan_srcs;
    my %scan_os;
    my %scan_alerts;
    chdir $config{'PSAD_DIR'} or
        die "[*] Could not chdir $config{'PSAD_DIR'}: $!";
    opendir D, $config{'PSAD_DIR'} or
        die "[*] Could not open dir: $config{'PSAD_DIR'}: $!";
    my @files = readdir D;
    closedir D;
    if (@files and $#files > 1) {
        shift @files; shift @files;
        for my $file (@files) {
            if ($file =~ /$ip_re/ and -d $file) {
                ### $file is a current scan source ip
                my $src_ipdir = $file;
                my $dl = 0;
                if (-e "${src_ipdir}/danger_level") {
                    open F, "< ${src_ipdir}/danger_level" or
                        die "[*] Could not open ",
                            "${src_ipdir}/danger_level: $!";
                    $dl = <F>;
                    close F;
                    chomp $dl;
                }
                opendir D, $src_ipdir or die "[*] Could not open dir: ",
                    "$src_ipdir: $!";
                my @ipdirfiles = readdir D;
                closedir D;
                if (@ipdirfiles and $#ipdirfiles > 1) {
                    shift @ipdirfiles; shift @ipdirfiles;
                    FILE: for my $file (@ipdirfiles) {
                        my $dst;
                        if ($file =~ /p0f_guess/ and -e "${src_ipdir}/p0f_guess") {
                            open F, "< ${src_ipdir}/p0f_guess" or die "[*] Could not ",
                                "open ${src_ipdir}/p0f_guess: $!";
                            my $os = <F>;
                            close F;
                            chomp $os;
                            $scan_os{$src_ipdir} = $os;
                            next FILE;
                        } elsif ($file =~ /os_guess/ and -e "${src_ipdir}/os_guess") {
                            open F, "< ${src_ipdir}/os_guess" or die "[*] Could not ",
                                "open ${src_ipdir}/os_guess: $!";
                            my $os = <F>;
                            close F;
                            chomp $os;
                            $scan_os{$src_ipdir} = $os;
                            next FILE;
                        }
                        if ($file =~ /email_count/ and -e "${src_ipdir}/email_count") {
                            open F, "< ${src_ipdir}/email_count" or die "[*] Could not ",
                                "open ${src_ipdir}/email_count: $!";
                            my $email_count = <F>;
                            close F;
                            chomp $email_count;
                            $scan_alerts{$src_ipdir} = $email_count;
                            next FILE;
                        }
                        if ($file =~ /($ip_re)_packet_ctr/) {
                            $dst = $1;
                        } else {
                            next FILE;
                        }
                        if (-e "${src_ipdir}/${dst}_packet_ctr") {
                            open F, "< ${src_ipdir}/${dst}_packet_ctr" or
                                die "[*] Could not open ",
                                    "${src_ipdir}/${dst}_packet_ctr: $!";
                            my @lines = <F>;
                            close F;
                            for my $line (@lines) {
                                if ($line =~ /^(\w+)_(\w+)_(\w+):\s+(\d+)/) {
                                    my $chain = $1;
                                    my $intf  = $2;
                                    my $proto = $3;
                                    my $ctr   = $4;
                                    $chain = uc $chain if $chain eq 'input'
                                            or $chain eq 'forward'
                                            or $chain eq 'output';
                                    if ($status_sort_dl) {
                                        $scan_srcs{$dl}{$src_ipdir}{$dst}
                                            {$chain}{$intf}{$proto} = $ctr;
                                    } else {
                                        $scan_srcs{$src_ipdir}{$dst}{'dl'}
                                            = $dl;
                                        $scan_srcs{$src_ipdir}{$dst}
                                            {$chain}{$intf}{$proto} = $ctr;
                                    }
                                }
                            }
                        }
                    }
                }
            }
        }
    }
    print STDOUT "\n";

    my $src_ctr = 0;
    my $dst_ctr = 0;
    if (%scan_srcs) {
        if ($status_brief) {
            printf "    %-16s%-16s%-8s%-7s%-6s%-6s%-7s%-5s\n", 'src:', 'dst:',
                'chain:', 'intf:', 'tcp:', 'udp:', 'icmp:', 'dl:';
        } else {
            printf "    %-16s%-16s%-8s%-7s%-6s%-6s%-7s%-5s%-9s%s\n", 'src:', 'dst:',
                'chain:', 'intf:', 'tcp:', 'udp:', 'icmp:', 'dl:', 'alerts:', 'os_guess:';
        }
        my %uniq_srcs = ();
        my %uniq_dsts = ();
        if ($status_sort_dl) {
            my $found_equal_status = 0;
            for my $dl (sort {$b <=> $a} keys %scan_srcs) {
                if ($status_dl) {
                    next unless $dl >= $status_dl;
                }
                $found_equal_status = 1;
                for my $src (keys %{$scan_srcs{$dl}}) {
                    for my $dst (keys %{$scan_srcs{$dl}{$src}}) {
                        for my $chain qw(INPUT FORWARD OUTPUT) {
                            next unless defined
                                $scan_srcs{$dl}{$src}{$dst}{$chain};
                            for my $intf (keys
                                    %{$scan_srcs{$dl}{$src}{$dst}{$chain}}) {
                                my $tcp_ctr  = 0;
                                my $udp_ctr  = 0;
                                my $icmp_ctr = 0;
                                $tcp_ctr = $scan_srcs{$dl}{$src}
                                {$dst}{$chain}{$intf}{'tcp'}
                                    if defined $scan_srcs{$dl}{$src}
                                            {$dst}{$chain}{$intf}{'tcp'};
                                $udp_ctr = $scan_srcs{$dl}{$src}{$dst}
                                {$chain}{$intf}{'udp'}
                                    if defined $scan_srcs{$dl}{$src}
                                            {$dst}{$chain}{$intf}{'udp'};
                                $icmp_ctr = $scan_srcs{$dl}{$src}
                                {$dst}{$chain}{$intf}{'icmp'}
                                    if defined $scan_srcs{$dl}{$src}
                                            {$dst}{$chain}{$intf}{'icmp'};
                                if ($status_brief) {
                                    printf "    %-16s%-16s%-8s%-7s%-6s%-6s%-7s%-5s\n",
                                        $src, $dst, $chain, $intf, $tcp_ctr,
                                        $udp_ctr, $icmp_ctr, $dl;
                                } else {
                                    my $alerts   = 0;
                                    my $os_guess = '-';
                                    $alerts = $scan_alerts{$src}
                                        if defined $scan_alerts{$src};
                                    $os_guess = $scan_os{$src}
                                        if defined $scan_os{$src};
                                    printf "    %-16s%-16s%-8s%-7s%-6s%-6s%-7s%-5s%-9s%s\n",
                                        $src, $dst, $chain, $intf, $tcp_ctr,
                                        $udp_ctr, $icmp_ctr, $dl, $alerts, $os_guess;
                                }
                            }
                        }
                        $uniq_dsts{$dst} = '';
                    }
                    $uniq_srcs{$src} = ''
                }
                unless ($found_equal_status) {
                    print STDOUT "    [No level $status_dl scans detected]\n";
                }
            }
        } else {
            my $found_equal_status = 0;
            for my $src (sort keys %scan_srcs) {
                for my $dst (keys %{$scan_srcs{$src}}) {
                    my $dl = $scan_srcs{$src}{$dst}{'dl'};
                    if ($status_dl) {
                        next unless $dl >= $status_dl;
                    }
                    $found_equal_status = 1;
                    for my $chain qw(INPUT FORWARD OUTPUT) {
                        next unless defined
                            $scan_srcs{$src}{$dst}{$chain};
                        for my $intf (keys
                                %{$scan_srcs{$src}{$dst}{$chain}}) {
                            my $tcp_ctr = 0;
                            my $udp_ctr = 0;
                            my $icmp_ctr = 0;
                            $tcp_ctr = $scan_srcs{$src}
                            {$dst}{$chain}{$intf}{'tcp'}
                                if defined $scan_srcs{$src}
                                        {$dst}{$chain}{$intf}{'tcp'};
                            $udp_ctr = $scan_srcs{$src}{$dst}
                            {$chain}{$intf}{'udp'}
                                if defined $scan_srcs{$src}
                                        {$dst}{$chain}{$intf}{'udp'};
                            $icmp_ctr = $scan_srcs{$src}
                            {$dst}{$chain}{$intf}{'icmp'}
                                if defined $scan_srcs{$src}
                                        {$dst}{$chain}{$intf}{'icmp'};
                            if ($status_brief) {
                                printf "    %-16s%-16s%-8s%-7s%-6s%-6s%-7s%-5s\n",
                                    $src, $dst, $chain, $intf, $tcp_ctr,
                                    $udp_ctr, $icmp_ctr, $dl;
                            } else {
                                my $alerts   = 0;
                                my $os_guess = '-';
                                $alerts = $scan_alerts{$src}
                                    if defined $scan_alerts{$src};
                                $os_guess = $scan_os{$src}
                                    if defined $scan_os{$src};
                                printf "    %-16s%-16s%-8s%-7s%-6s%-6s%-7s%-5s%-9s%s\n",
                                    $src, $dst, $chain, $intf, $tcp_ctr,
                                    $udp_ctr, $icmp_ctr, $dl, $alerts, $os_guess;
                            }
                        }
                    }
                    $uniq_dsts{$dst} = '';
                }
                $uniq_srcs{$src} = '';
            }
            unless ($found_equal_status) {
                print STDOUT "    [No level $status_dl scans detected]\n";
            }
        }
        $src_ctr++ for keys %uniq_srcs;
        $dst_ctr++ for keys %uniq_dsts;
    } else {
        print STDOUT "    [No scans detected]\n";
    }
    if (not $analyze_msgs) {
        if ($config{'ENABLE_DSHIELD_ALERTS'} eq 'Y'
                and -e $config{'DSHIELD_COUNTER_FILE'}) {
            print "\n    DShield stats:\n";
            open F, "< $config{'DSHIELD_COUNTER_FILE'}" or
                die "[*] $config{'DSHIELD_COUNTER_FILE'}: $!";
            print STDOUT "        $_" while (<F>);
            close F;
        }
    }

    ### print block status of IP addresses blocked by iptables
    unless ($analyze_msgs) {
        &print_blocked_ip_status();
    }

    if ($analyze_msgs) {
        if (%ipt_prefixes) {
            print "\n    Iptables prefix counters:\n";
            for my $prefix (keys %ipt_prefixes) {
                my $count = $ipt_prefixes{$prefix};
                print "        \"$prefix\": $count\n";
            }
        } else {
            print "        [NONE]\n";
        }
    } else {
        if (-e $config{'IPT_PREFIX_COUNTER_FILE'}) {
            print "\n    Iptables prefix counters:\n";
            open F, "< $config{'IPT_PREFIX_COUNTER_FILE'}" or
                die "[*] $config{'IPT_PREFIX_COUNTER_FILE'}: $!";
            my @lines = <F>;
            close F;
            if (@lines) {
                for my $line (@lines) {
                    if ($line =~ /^\s*(.*):\s*(\d+)/) {
                        print "        \"$1\": $2\n";
                    }
                }
            } else {
                print STDOUT "        [NONE]\n";
            }
        }
    }

    print "\n    Total scan sources: $src_ctr\n",
        "    Total scan destinations: $dst_ctr\n";
    if ($analyze_msgs) {
        print "\n    Total packet counters:\n",
            "        tcp: $tcp_ctr\n",
            "        udp: $udp_ctr\n",
            "        icmp: $icmp_ctr\n";
    } else {
        if (-e $config{'PACKET_COUNTER_FILE'}) {
            print "\n    Total packet counters:\n";
            open F, "< $config{'PACKET_COUNTER_FILE'}" or
                die "[*] $config{'PACKET_COUNTER_FILE'}: $!";
            print STDOUT "        $_" while (<F>);
            close F;
        }
    }
    return;
}

sub print_blocked_ip_status() {
    if (-e $config{'AUTO_BLOCK_IPT_FILE'}) {
        open F, "< $config{'AUTO_BLOCK_IPT_FILE'}" or
            die "[*] $config{'AUTO_BLOCK_IPT_FILE'}: $!";
        my @lines = <F>;
        close F;
        print "\n    Iptables auto-blocked IPs:\n";
        my $ipt = new IPTables::ChainMgr(
            'iptables' => $cmds{'iptables'}
        ) or die "[*] Could not acquire IPTables::ChainMgr object.";

        my $found_line = 0;
        for my $line (@lines) {
            chomp $line;
            if ($line =~ /^\s*($ip_re)/) {
                my $ip    = $1;
                print "        $ip";
                my $blocked = 0;
                for my $block_hr (@ipt_block_config) {
                    if ($ipt->find_ip_rule($ip, '0.0.0.0/0',
                            $block_hr->{'table'},
                            $block_hr->{'to_chain'},
                            $block_hr->{'target'})) {
                        $blocked = 1;
                        print " $block_hr->{'to_chain'}($block_hr->{'target'})";
                    }
                }
                $found_line = 1;
                unless ($blocked) {
                    print ' [NONE]';
                }
                print "\n";
            }
        }
        print "        [NONE]\n"
            unless $found_line;
    }
    return;
}

sub status_ip() {
    my $rv = 0;
    my @match_ip;
    die "[*] $config{'FW_DATA_FILE'} does not exist yet.  Exiting."
        unless -e $config{'FW_DATA_FILE'};
    die "[*] No data yet in $config{'FW_DATA_FILE'}.  Exiting."
        unless -s $config{'FW_DATA_FILE'} > 0;
    die "[*] No scans from $status_ip have been detected.\n",
        "    See 'psad --Status' for a complete list."
        unless -d "$config{'PSAD_DIR'}/$status_ip";
    open FW, "< $config{'FW_DATA_FILE'}" or die "[*] Could not open ",
        "$config{'FW_DATA_FILE'}: $!";
    while (<FW>) {
        push @match_ip, $_ if $_ =~ /SRC=$status_ip\s/
            || $_ =~ /DST=$status_ip\s/;
    }
    close FW;
    die "[*] Could not match $status_ip to packets in ",
        "$config{'FW_DATA_FILE'}.  Exiting." unless @match_ip;
    open D, "> $config{'PSAD_DIR'}/$status_ip/fwdata" or
        die "[*] Could not open $config{'PSAD_DIR'}/$status_ip/fwdata";
    for my $line (@match_ip) {
        print D $line;
    }
    for (my $i=$#match_ip; $i>=$#match_ip-10; $i--) {
        print STDOUT $match_ip[$i] if defined $match_ip[$i];
    }
    print STDOUT "\n[+] The above packet output shows up to 10 of the ",
        "most recently\n    logged packets for $status_ip.\n",
        "[+] All packets logged by iptables specifically ",
        "for $status_ip\n    can be viewed here: ",
        "$config{'PSAD_DIR'}/$status_ip/fwdata\n";

    opendir D, "$config{'PSAD_DIR'}/$status_ip" or
        die "[*] Could not open dir: $config{'PSAD_DIR'}/$status_ip: $!";
    my @ipdirfiles = readdir D;
    closedir D;
    shift @ipdirfiles; shift @ipdirfiles;
    for my $file (@ipdirfiles) {
        my $dst;
        if ($file =~ /($ip_re)_packet_ctr/) {
            $dst = $1;
        } else {
            next;
        }
        if (-e "$config{'PSAD_DIR'}/$status_ip/${dst}_packet_ctr") {
            print STDOUT "[+] Packet counters against dst: $dst:\n";
            open F, "< $config{'PSAD_DIR'}/$status_ip/${dst}_packet_ctr" or
                die "[*] Could not open $config{'PSAD_DIR'}/$status_ip/",
                    "${dst}_packet_ctr: $!";
            print STDOUT "        $_" for <F>;
            close F;
        }
    }
    if (-e "$config{'PSAD_DIR'}/$status_ip/email_count") {
        open F, "< $config{'PSAD_DIR'}/$status_ip/email_count" or
            die "[*] Could not open $config{'PSAD_DIR'}/$status_ip/",
                "email_count: $!";
        my $ec = <F>;
        close F;
        chomp $ec;
        print STDOUT "[+] Email alerts sent: $ec\n";
    }
    if (-e "$config{'PSAD_DIR'}/$status_ip/danger_level") {
        open F, "< $config{'PSAD_DIR'}/$status_ip/danger_level" or
            die "[*] Could not open $config{'PSAD_DIR'}/$status_ip/",
                "danger_level: $!";
        my $dl = <F>;
        close F;
        chomp $dl;
        print STDOUT "[+] Current danger level: $dl\n";
    }
    exit $rv;
}

sub import_old_scans() {
    opendir D, $config{'PSAD_DIR'} or
        die "[*] Could not open dir: $config{'PSAD_DIR'}: $!";
    my @files = readdir D;
    closedir D;
    shift @files; shift @files;
    my $import_ctr = 0;
    chdir $config{'PSAD_DIR'} or die $!;
    SRCIP: for my $src (@files) {
        next SRCIP unless ($src =~ /$ip_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;
            $scan_dl{$src} = $dl;  ### set the dl for $src
        }
        if (-e "${src}/email_count") {
            open E, "< ${src}/email_count" or next SRCIP;
            $num_emails = <E>;
            close E;
            chomp $num_emails;
        }
        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;
        shift @scan_files; shift @scan_files;
        ### get all of the destination ip addresses
        my %dst_ips;
        for my $scan_file (@scan_files) {
            if ($scan_file =~ /($ip_re)/) {
                $dst_ips{$1} = ''
            }
        }
        for my $dst (keys %dst_ips) {
            ### we have probably already sent alerts for these
            ### ips since we are importing data from a previous run.
            $scan{$src}{$dst}{'alerted'} = 1;
            if (-e "${src}/${dst}_packet_ctr") {
                open PKTS, "< ${src}/${dst}_packet_ctr" or next SRCIP;
                my @lines = <PKTS>;
                close PKTS;
                if ($num_emails) {
                    $scan{$src}{$dst}{'email_ctr'} = $num_emails;
                }
                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';
                    } 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;
                }
            }
            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;
            }
        }
        $import_ctr++;
    }
    ### import global packet counters
    if (-e $config{'PACKET_COUNTER_FILE'}) {
        open CF, "< $config{'PACKET_COUNTER_FILE'}" or die "[*] Could not ",
            "open $config{'PACKET_COUNTER_FILE'}: $!";
        my @lines = <CF>;
        close CF;
        for my $line (@lines) {
            if ($line =~ /tcp:\s+(\d+)/) {
                $tcp_ctr = $1;
            } elsif ($line =~ /udp:\s+(\d+)/) {
                $udp_ctr = $1;
            } elsif ($line =~ /icmp:\s+(\d+)/) {
                $icmp_ctr = $1;
            }
        }
    }
    ### 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;
            }
        }
    }
    ### import iptables prefix stats
    if (-e $config{'IPT_PREFIX_COUNTER_FILE'}) {
        open F, "< $config{'IPT_PREFIX_COUNTER_FILE'}" or die "[*] Could not ",
            "open $config{'IPT_PREFIX_COUNTER_FILE'}: $!";
        my @lines = <F>;
        close F;
        for my $line (@lines) {
            if ($line =~ /^\s*(.*?):\s+(\d+)/) {
                my $prefix = $1;
                my $count = $2;
                $ipt_prefixes{$prefix} = $count;
            }
        }
    }

    if ($import_ctr) {
        &Psad::psyslog('psad',
            "imported $import_ctr scanning IP addresses from previous psad run")
            unless $no_syslog_alerts;
    }
    return;
}

sub remove_old_scans() {
    opendir D, $config{'PSAD_DIR'} or
        die "[*] Could not open dir: $config{'PSAD_DIR'}: $!";
    my @files = readdir D;
    closedir D;
    shift @files; shift @files;
    chdir $config{'PSAD_DIR'} or die $!;
    SRCIP: for my $src (@files) {
        next SRCIP unless ($src =~ /$ip_re/ and -d $src);
        rmtree $src or die
            "[*] Could not remove $config{'PSAD_DIR'}/$src: $!";
    }
    return;
}

sub usr1() {
    my $rv = 0;
    my $psad_pidfile = $pidfiles{'psad'};
    if (-e $psad_pidfile) {
        my $pid = &Psad::pidrunning($psad_pidfile);
        if ($pid) {  ### make sure psad is actually running
            if (kill 'USR1', $pid) {
                $rv = 1;
                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";
            }
        } else {
            print "[-] psad is not running on $config{'HOSTNAME'}\n";
        }
    }
    return $rv;
}

sub usr1_handler() {
    $usr1_flag = 1;
    return;
}

sub hup() {
    my $rv = 0;
    for my $pidname qw(psadwatchd psad kmsgsd) {
        my $pidfile = $pidfiles{$pidname};
        my $pid = &Psad::pidrunning($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 = 1;
            }
        } else {
            print "[-] $pidname daemon not running.\n";
            $rv = 1;
        }
    }
    return $rv;
}

sub hup_handler() {
    $hup_flag = 1;
    return;
}

sub die_handler() {
    $die_msg = shift;
    return;
}

### write all warnings to a logfile
sub warn_handler() {
    $warn_msg = shift;
    return;
}

sub archive_data() {
    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'}, 0500 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;
    shift @files; shift @files;

    IPDIR: for my $file (@files) {
        if ($file =~ /$ip_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    = $config{'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
        open F, "> $fwarchive" or die '[*] Could not open ',
            "$fwarchive: $!";
        close F;
    }
    unless (-e $fwdata) {
        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;
    ### zero out $FW_DATA_FILE
    open F, "> $fwdata" or die '[*] Could not open ',
        "$fwdata: $!";
    close F;
    return;
}

sub check_old_cmdargs() {
    if ($oldarg_snort_sids) {
        print "[-] The --snort-sids capability is enabled by\n",
            "default (see the --no-snort-sids option).\n";
        &usage(1);
    }
    &print_old_arg('auto-ips', 'auto-dl') if $oldarg_autoips;
    &print_old_arg('Logging_server', 'log-server') if $oldarg_logserv;
    &print_old_arg('no_errors', 'no-ipt-errors') if $oldarg_nerrs;
    &print_old_arg('no-errors', 'no-ipt-errors') if $oldarg_nerrs2;
    &print_old_arg('reversedns', 'no-rdns') if $oldarg_rdns;
    &print_old_arg('no_rdns', 'no-rdns') if $oldarg_nrdns;
    &print_old_arg('whois', 'no-whois') if $oldarg_whois;
    &print_old_arg('no_whois', 'no-whois') if $oldarg_nwhois;
    &print_old_arg('no_localport', 'no-netstat') if $oldarg_nlport;
    &print_old_arg('no_fw_check', 'no-fwcheck') if $oldarg_nfwchk;
    &print_old_arg('Daemon', 'no-daemon') if $oldarg_daemon;
    return;
}

sub print_old_arg() {
    my ($oldarg, $newarg) = @_;
    print qq([*] The "$oldarg" option has been changed to "$newarg"\n);
    &usage(1);  ### this exits
}

sub handle_cmdline() {

    if ($analysis_emails and not $analyze_msgs) {
        print "[*] Can only specify --email-analysis flag ",
            "when run in --Analyze mode.";
        &usage(1);
    }

    ### be absolutely sure to disable auto-response for various
    ### offline modes
    $config{'ENABLE_AUTO_IDS'} = 'N'
        if $analyze_msgs or $syslog_server or $benchmark;

    ### 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 = 1 if ($status_ip and not $status);
    $status = 1 if ($status_sort_dl and not $status);
    $status = 1 if ($status_dl and not $status);
    $status = 1 if ($status_brief and not $status);

    ### 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 lookups if we are running in -A mode.
    $no_whois = 1 if $analyze_msgs and not $analysis_whois;

    return;
}

sub setup() {

    ### 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 (-d $config{'PSAD_DIR'}) {
        mkdir $config{'PSAD_DIR'}, 0500 or
            die "[*] Could not mkdir $config{'PSAD_DIR'}: $!";
    }
    unless (-d $config{'ERROR_DIR'}) {
        mkdir $config{'ERROR_DIR'}, 0500 or
            die "[*] Could not mkdir $config{'ERROR_DIR'}: $!";
    }

    unless (-e $config{'PSAD_FIFO'}) {
        system "$cmds{'mknod'} -m 600 $config{'PSAD_FIFO'} p";
    }
    ### make sure the new whois path exists
    if (-x '/usr/bin/whois.psad' && ! -x $cmds{'whois'}
            && '/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?email/i;
    $no_syslog_alerts = 1 if $config{'ALERTING_METHODS'} =~ /no?syslog/i;

    die '[*] No system logger config file could be found.'
        unless (-e $config{'ETC_SYSLOG_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.
    if ($config{'SYSLOG_DAEMON'} eq 'syslogd') {
        if (-e $config{'ETC_SYSLOG_CONF'}) {
            unless (-e "$config{'ETC_SYSLOG_CONF'}.orig") {
                copy $config{'ETC_SYSLOG_CONF'},
                    "$config{'ETC_SYSLOG_CONF'}.orig" or die "[*] Could not ",
                    "copy $config{'ETC_SYSLOG_CONF'} -> ",
                    "$config{'ETC_SYSLOG_CONF'}.orig";
            }
            open RS, "< $config{'ETC_SYSLOG_CONF'}" or
                die "[*] Unable to open $config{'ETC_SYSLOG_CONF'}: $!";
            my @lines = <RS>;
            close RS;
            my $found = 0;
            for my $line (@lines) {
                if ($line =~ m/\|\s*$config{'PSAD_FIFO'}/) {
                    $found = 1;
                    last;
                }
            }
            unless ($found) {
                open SYSLOG, "> $config{'ETC_SYSLOG_CONF'}" or
                    die "[*] Unable to open $config{'ETC_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 '### Send kern.info messages to psadfifo for ',
                    "analysis by kmsgsd\n";
                print SYSLOG "kern.info\t\t|$config{'PSAD_FIFO'}\n";
                close SYSLOG;
                &Psad::psyslog('psad', 'reconfiguring syslogd to write ' .
                    "kern.info messages to $config{'PSAD_FIFO'}")
                    unless $no_syslog_alerts;
                system "$cmds{'killall'} -HUP syslogd";
            }
        } else {
            &Psad::sendmail("$mail_error_prefix $config{'ETC_SYSLOG_CONF'} does not " .
                "exist, check SYSLOG_DAEMON setting on $config{'HOSTNAME'}",
                '', $config{'EMAIL_ADDRESSES'}, $cmds{'mail'})
                unless $no_email_alerts;
        }
    }
    if ($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) {
                if ($line =~ m/$config{'PSAD_FIFO'}/) {
                    $found = 1;
                    last;
                }
            }
            unless ($found) {
                open SYSLOGNG, "> $config{'ETC_SYSLOGNG_CONF'}" or
                    die "[*] Unable to open $config{'ETC_SYSLOGNG_CONF'}: $!";
                ### this loop removes any old location for psadfifo
                for my $line (@lines) {
                    unless ($line =~ /psadfifo/i) {
                        print SYSLOGNG $line;
                    }
                }
                print SYSLOGNG "\n",
                    'destination psadpipe { pipe(',
                    "\"$config{'PSAD_FIFO'}\"); };\n",
                    "filter f_kerninfo { facility(kern); };\n",
#                    "filter f_kerninfo { facility(kern) ",
#                    "and level(info); };\n",
                    'log { source(src); ',
                    "filter(f_kerninfo); destination(psadpipe); };\n";
                close SYSLOGNG;
                &Psad::psyslog('psad', 'reconfiguring syslog-ng to write ' .
                    "kern.info messages to $config{'PSAD_FIFO'}")
                    unless $no_syslog_alerts;
                system "$cmds{'killall'} -HUP syslog-ng";
            }
        } else {
            &Psad::sendmail("$mail_error_prefix $config{'ETC_SYSLOGNG_CONF'} does not " .
                "exist, check SYSLOG_DAEMON setting on $config{'HOSTNAME'}",
                '', $config{'EMAIL_ADDRESSES'}, $cmds{'mail'})
                unless $no_email_alerts;
        }
    }
    ### Metalog support added by Dennis Freise <cat@final-frontier.ath.cx>
    if ($config{'SYSLOG_DAEMON'} eq 'metalog') {
        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;
                &Psad::psyslog('psad', 'reconfiguring metalog to write ' .
                        "kern-facility messages to /usr/sbin/psadpipe.sh")
                    unless $no_syslog_alerts;

                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'}\n";
                close PIPESCRIPT;
                chmod 0700, '/usr/sbin/psadpipe.sh';
                &Psad::psyslog('psad', 'generated /usr/sbin/psadpipe.sh ' .
                        "which writes to $config{'PSAD_FIFO'}")
                    unless $no_syslog_alerts;

                ### 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 {
            &Psad::sendmail("$mail_error_prefix $config{'ETC_METALOG_CONF'} does not " .
                "exist, check SYSLOG_DAEMON setting on $config{'HOSTNAME'}",
                '', $config{'EMAIL_ADDRESSES'}, $cmds{'mail'})
                unless $no_email_alerts;
        }
    }

    ### make sure the permissions on these files is 0600
    for my $file ($config{'FW_DATA_FILE'}, $config{'FW_ERROR_LOG'}) {
        open F, "> $file" or die "[*] Could not open $file: $!";
        close F;
        chmod 0600, $file;
    }
    return;
}

sub disk_space_exceeded() {
    open DF, "$cmds{'df'} $config{'PSAD_DIR'} |" or die "[*] Could not ",
        "execute: $cmds{'df'} $config{'PSAD_DIR'}: $!";
    my @df_data = <DF>;
    close DF;
    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++;
        &Psad::psyslog('psad', "disk partition associated with " .
            "$config{'PSAD_DIR'} exceeded " .
            "$config{'DISK_MAX_PERCENTAGE'} prct utilization.")
            unless $no_syslog_alerts;
        &Psad::sendmail("$mail_error_prefix Exceeded max disk utilization for " .
            "$config{'PSAD_DIR'} on $config{'HOSTNAME'}", '',
            $config{'EMAIL_ADDRESSES'}, $cmds{'mail'})
            unless $no_email_alerts;
        &Psad::psyslog('psad', "removing data in $config{'PSAD_DIR'}")
            unless $no_syslog_alerts;
        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).
            &Psad::psyslog('psad',
                "removing $config{'SCAN_DATA_ARCHIVE_DIR'} directory")
                unless $no_syslog_alerts;
            rmtree $config{'SCAN_DATA_ARCHIVE_DIR'};
            mkdir $config{'SCAN_DATA_ARCHIVE_DIR'}, 0500;
        }
        opendir D, $config{'PSAD_DIR'} or
            die "[*] Could not open dir: $config{'PSAD_DIR'}: $!";
        my @ipdirs = readdir D;
        closedir D;
        shift @ipdirs; shift @ipdirs;
        chdir $config{'PSAD_DIR'} or die $!;
        for my $ipdir (@ipdirs) {
            if ($ipdir =~ /$ip_re/ and -d $ipdir) {
                opendir IP, $ipdir or die $!;
                my @scanfiles = readdir IP;
                closedir IP;
                shift @scanfiles; shift @scanfiles;
                for my $file (@scanfiles) {
                    if (-e "${ipdir}/$file" and $file =~ /_signatures/) {
                        unlink "${ipdir}/$file";
                    }
                }
            }
        }
        if ($rm_data_ctr > $config{'DISK_MAX_RM_RETRIES'}) {
            &Psad::psyslog('psad', "could not sufficiently reduce disk " .
                "utilization in $config{'PSAD_DIR'} partition.  " .
                "Stopping psad!") unless $no_syslog_alerts;
            &Psad::sendmail("$mail_error_prefix Could not reduce disk utilization on " .
                $config{'HOSTNAME'}, '', $config{'EMAIL_ADDRESSES'},
                $cmds{'mail'}) unless $no_email_alerts;
            &Psad::sendmail("$mail_fatal_prefix Stopping psad on $config{'HOSTNAME'}!",
                '', $config{'EMAIL_ADDRESSES'}, $cmds{'mail'}) unless $no_email_alerts;
            for my $pidname qw(psadwatchd kmsgsd) {
                my $pidfile = $pidfiles{$pidname};
                my $pid = &Psad::pidrunning($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;
    }
    return $rv;
}

sub dump_conf() {
    if ($debug) {
        print STDERR "[+] Dumping psad config from: $config_file\n";
    } else {
        print STDOUT "[+] Dumping psad config from: $config_file\n";
    }
    for my $var (sort keys %config) {
        if ($debug) {
            printf STDERR "%-30s %s\n", "[+] $var", $config{$var};
        } else {
            printf STDOUT "%-30s %s\n", "[+] $var", $config{$var};
        }
    }
    if ($debug) {
        print STDERR "\n[+] Command paths:\n\n";
    } else {
        print STDOUT "\n[+] Command paths:\n\n";
    }
    for my $var (sort keys %cmds) {
        if ($debug) {
            printf STDERR "%-30s %s\n", "[+] $var", $cmds{$var};
        } else {
            printf STDOUT "%-30s %s\n", "[+] $var", $cmds{$var};
        }
    }
    return 0;
}

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 WHOIS_LOOKUP_THRESHOLD
        DNS_LOOKUP_THRESHOLD WHOIS_TIMEOUT SNORT_RULES_DIR HOSTNAME
        PACKET_COUNTER_FILE DSHIELD_COUNTER_FILE SCAN_DATA_ARCHIVE_DIR
        PROC_FORWARD_FILE 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 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_ADD_IP_FILE IGNORE_INTERFACES ALERTING_METHODS
    );
    &Psad::defined_vars(\%config, $config_file, \@required_vars);
    return;
}

sub usage() {
    my $exitcode = shift;
    print <<_HELP_;

psad; the Port Scan Attack Detector
[+] Version: $version
[+] By Michael Rash (mbr\@cipherdyne.org, http://www.cipherdyne.org)

Usage: psad [-a <auto ips file>] [-c <config file>] [-l] [-i <interval>]
       [-h] [-B] [-A] [-F] [-S] [-K] [-R] [-U] [-v] [-V] [-o] [-p] [-D]
       [-d] [--signatures <sig file>] [--passive-os-sigs <posf file>]
       [--snort-type <type>] [--snort-rdir <rules dir>] [--fw-analyze]
       [--fw-file <file>] [--fw-search <file>] [--fw-list-auto]
       [--fw-block-ip <ip] [-m <messages file>] [--interval <seconds>]
       [--status-brief] [--status-ip <ip>] [--status-sort-dl]
       [--no-fwcheck] [--no-daemon] [--no-rdns] [--no-whois]
       [--no-netstat] [--no-ipt-errors] [--no-passiveos]
       [--no-snort-sids] [--no-signatures] [--no-kmsgsd]

Options:
    --signatures <sigs file>      - Manually specify the path to the
                                    psad signatures file.
    --passive-os-sigs <sigs file> - Manually specify the path to the
                                    passive os fingerprinting sigs.
    --snort-type                  - Enable psad to look for specific
                                    snort sids such as those in
                                    ddos.rules or backdoor.rules.
    --interval                    - Configure the check interval from
                                    the command line to override the 15
                                    second default.
    -a,  --auto-dl <dl file>      - Import auto-danger level file for
                                    automatic IP danger level
                                    increases/decreses.
    -c,  --config <config file>   - Use <config file> instead of the
                                    normal config file located at
                                    $config_file.
    -A,  --Analyze-msgs           - Analyze iptables logfile and exit.
    -e,  --email-analysis         - Send emails for scans detected in
                                    offline analysis mode.
    -w,  --whois-analysis         - Enable whois lookups when running
                                    in offline analysis mode.
    -m,  --messages-file <file>   - Specify the path to the iptables
                                    logfile (use in conjunction with
                                    --Analyze-msgs).
    --fw-search <file>            - Use <file> instead of the normal
                                    fw-search file: $fw_search_file.
    --fw-analyze                  - Analyze the local iptables ruleset
                                    and exit.
    --fw-list-auto                - List the contents of any Netfilter
                                    chains use for auto-blocking rules.
    --fw-block-ip  <ip>           - Add an IP/network to 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 Netfilter chains used by
                                    psad for auto-blocking rules.
    -snort-rdir <rule dir>        - Path to snort rules directory.
    -d,  --debug                  - Run psad in debugging mode.
    -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.
    -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.
    --status-ip <ip address>      - View status for a specific IP.
    --status-sort-dl              - Sort --Status output by danger level
                                    instead of by IP address.
    --status-dl <dl>              - Display status information for only
                                    those scans that have reach at least
                                    <dl> (from 1 to 5).
    --status-brief                - Do not include number of email alerts
                                    or OS guess in --Status output.
    -B,  --Benchmark              - run psad in benchmark mode.
    --packets <number>            - Specify number of packets to use in
                                    benchmark test (default is 10,000).
    -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.
    -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 messages.
    --no-signatures               - Disable psad signature processing
                                    (indendent 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 messages).
    --no-netstat                  - Disable local port lookups for scan
                                    signatures.
    -h   --help                   - Display usage on STDOUT and exit.

_HELP_
    exit $exitcode;
}
