Sam Pointer

I’ve been sorting through some old code, and apparently on the 10th of September 2008 at 08:49 I felt compelled to write a daemon in Perl that would add persistently connecting source IPs to hosts.deny if they continually abused sshd.

I remember doing this: I was between jobs and somebody somewhere whom I’ve long abandoned to my mail archives asked for it, and I had nothing better to do. So, for the sake of posterity, here is probably the last piece of significant Perl I ever wrote before making the move to Ruby - make of it what you will:

#!/usr/bin/perl -w
#
# ssh-deny.pl - A script to monitor log files and add persistent offenders to /etc/hosts.deny
#
# Author:       Sam Pointer
# Contact:      sam@outsidethe.net
# Version:      0.03
#
# Usage:
#
# Should a given IP address connect more than the specified number of times, add
# it to the TCP wrappers host.deny file.
#
# Note that this script simply parses the ssh_log file for the number of failures
# for a given IP address, tests that against a threshold, and adds a tcp wrappers
# rule if that threshold is exceeded. Therefore, if your log files roll around
# daily, more than $max_connections failure in that 24 hour period will cause a
# rule to be generated.
#
# It will look for and add a rule in the format:
#
#       sshd : 66.6.136.62 : deny
#
# See the hosts_access manpages or TCP Wrappers documentation for more information.
#
# Generally the script should be invoked as UID 0 (root user), due to the permissions
# set on the hosts.deny and log files to be scanned.
#
# The configuration option @exception_list contains a list of full or partial IP
# addresses that will never be blocked. See the example configuration for the format.
#
# When started the script will detach from the console and become a daemon. It can
# be terminated via a SIGHUP/signal 15.
#
# DISCLAIMER: USE THIS SCRIPT AT YOUR OWN RISK. NO WARRANTY IMPLIED OR GIVEN. TEST
# ON A NON-PRODUCTION BOX FIRST.
#
# I've tested this on my own machine and it works fine. Change the configuration below
# to some files you can offord to loose first. Only $deny_file is opened for writing,
# so to test I copied that to my home directory, set the path there and checked that
# the rules added were correct, without affecting my live /etc/hosts.deny file.

# -- Configuration ----------------------------
my $max_connections     = '3';                  # Maximum number of denied connections
my $failure_string      = 'Failed password';        # Always present on a failed connection
my $ssh_log             = '/var/log/secure';    # Log file to scan for failed connections
my $deny_file           = '/home/hosts.deny';    # Location of TCP Wrappers host.deny file
my $daemon_list         = 'ALL';                # daemon_list string to add to hosts.deny. See hosts_access(5)
my $sleep_period        = '30';                 # Value in seconds to sleep before parsing log again. Adjust to suit system load.

# A list of full or partial IP addresses to never block
my @exception_list      = ('192.168', '81.214.108.250');
# ---------------------------------------------

# Internal Global Variables
my ($record);
my (%failed, %blocked);
my $ip_regex = '\b(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\b';

# Perlisms
use strict;
use POSIX qw(setsid);                           # Required to daemonize the script

# Make ourselves into a daemon
daemonize();

# Loop perpetually as a daemon
while(1) {
        # Get a list of failed user IP addresses from the log file
        %failed = get_failed($ssh_log);

        # Get a list of what's already blocked
        %blocked = get_already_blocked($deny_file);

        # Move through the keys of our failure hash. Anything with
        # more than $max_connections should be written to the file,
        # providing it is not already blocked by a rule and is not in our exceptions list.
        open (DENYFILE, ">>$deny_file") || die "ssh-deny: Cannot open $deny_file for writing\n";

        foreach $record (keys(%failed)) {
                if ( ! $blocked{$record} && $failed{$record} > $max_connections) {
                        print DENYFILE "$daemon_list : $record \n";
                }
        }

        close DENYFILE;

        sleep $sleep_period;
}

# -- Subroutines ------------------------------
sub get_already_blocked {
# This subroutine will parse $deny_file looking for all IPs
# in a rule that matches $daemon_list. These are returned as
# a hash for matching against later on

        # Local Variables
        my ($deny, $record);
        my (@fields);
        my (%already_denied);

        # We expect a deny file to be passed. Open or die.
        $deny = pop(@_);
        open (DENY, "$deny") || die "ssh-deny.pl: Cannot open $deny for reading\n";

        # Move through the file. For any rule that matches $daemon_list get the IPs
        while ($record = ) {
                @fields = split(/ /, $record);
                if ($fields[0] eq $daemon_list &&
                    $fields[2] =~ $ip_regex) {
                        $already_denied{$fields[2]}++;
                }
        }
        close DENY;
        return(%already_denied);
}


sub get_failed {
# This subroutine retrieves a list of failed logins and returns a hash of IPs, times, and
# failed connections.

        # Local Variable declarations
        my ($log, $record, $marked, $exception);
        my (@failure_records, @fields);
        my (%failure_stats);

        # We expect a path to be passed. Open the file or fail.
        $log = pop @_;
        open (LOG, "$log") || die "ssh-deny.pl: Cannot open $log for reading\n";

        # Iterate through the log file, selecting rows that have failed connections
        while ($record = ) {
                if ($record =~ $failure_string) {
                        push @failure_records, $record;
                }
        }

        # Close the log file
        close LOG;

        # Build a hash for each IP that has a connection
        while ($record = pop(@failure_records)) {
                @fields = split(/ /,$record);           # Field index 13 is the IP address
                $failure_stats{$fields[13]}++;          # Increase failure counter for IP
        }

        # If any of the failed connections are in our @exception_list (never block)
        # ensure that the IP is deleted from the hash so that they aren't blocked.
        foreach $exception (@exception_list) {
                foreach $marked (keys(%failure_stats)) {
                        if ($marked =~ /$exception/) {
                                delete $failure_stats{$marked};
                        }
                }
        }

        # Return our hash with IP addresses as keys, and counts for each IP address as values
        return(%failure_stats);
}

sub daemonize {
# This subroutine handles detaching the console, forking a new process, etc.
        chdir('/')                      || die "ssh-deny: Cannot chdir to /\n";
        open (STDIN, '/dev/null')       || die "ssh-deny: Cannot read /dev/null\n";

        # Uncomment the next two lines if you really don't want this to
        # echo anything out as a daemon. Probably best to leave it
        # so any error messages make it to the console.
        #open (STDOUT,'>>/dev/null')    || die "ssh-deny: Cannot write to /dev/null\n";
        #open (STDERR,'>>/dev/null')    || die "ssh-deny: Cannot write to /dev/null\n";

        defined(my $pid = fork)         || die "ssh-deny: Cannot fork\n";
        exit if $pid;
        setsid                          || die "ssh-deny: Cannot start a new session\n";
        umask 0;
}

For some reason I keep finding myself writing Perl code. In 2011. Over the last couple of months I’ve written enough Ruby to make my head spin, and yet, in a fix, I find myself back in the arms of Perl.

Recently I needed to parse some Apache virtual host configurations into some Nagios configuration file stanzas, a BIND zonefile and a hosts file for a project for my employer. Perl. On some private boxes not yet big enough to warrant a full Nagios installation I needed a script to run the CLI from the Clickatell SMS Gem in response to various /proc values. Perl.


Picture credit: reidrac

I like to think that my Perl is well written. I avoid implicits: $_, and the like, `use strict`, pass “-w” and declare all of my variables up-front. Sometimes I even entertain taint checking. It’s not perfect by any means, and not everybody’s style, but if you’re familiar with a C-like language you can probably read it. If you’ve written pseudo-code, you can read it. If you’re a patterns infected developer professional you’ll wince a bit. No FactoryFactories here. Objection orientation has its place, but it isn’t knocking up a quick 5 minute script to remove all of the commas from a YAML file driven by SOAP calls via wget in a panic.

I don’t think that anybody really pretends that Perl is the best thing to begin a new large-scale development project with today. But that doesn’t mean that Perl is down and out. Whilst Ruby gained frameworks and conferences and spawned religions, Perl sat there in it’s varied and glorious assorted version 5 point releases on nearly every UNIX-like box on the planet, just waiting for someone to ignore the framework bling and me-too bits and get stuck into good old text manipulation and nicking bits off of CPAN.

I’m by no means a language fanatic; I like all sorts. And I’ll tackle ActiveState or Strawberry if you force me, too. Perhaps it’s familiarity. Perhaps I simply don’t know Ruby or Python or anything else as well as I think I do. Or perhaps for your common or garden UNIX-style, “text as a univeral interface” basic string hackage, Perl is the crusty mig-welding old nutter who might just get you home?

I recently tried out Nic le Roux’s sched_downtime Perl script as a quick punt to getting recurring Nagios downtime working. Cool script, and it beats having to hand-roll something to append the the nagios.cmd command pipe file by hand. Why reinvent the wheel, right?

There’s a small problem with the script, on my 3.0.6 install of Nagios anyway, whereby the command string that is produced is missing a field, leading to the commands not being acted upon. See:

[1264767246] EXTERNAL COMMAND: SCHEDULE_SVC_DOWNTIME;sam;ssh;1264767600;1264768200;1;600;Sam;Testing service recurring scheduled downtime
[1264771220] EXTERNAL COMMAND: SCHEDULE_SVC_DOWNTIME;sam;ssh;1264771800;1264772400;1;0;600;Sam;Testing service recurring scheduled downtime

See the extra field there? The same is true of host scheduled downtime too. If we check the documentation we can see that the extra field is a ‘trigger_id’.

I’ve created a patch that will enable you to use the script against Nagios versions that expect the 3.x format command strings. My patch deals with the possibility of being able to trigger downtime based on other downtime events by conveniently ignoring it, and hardcoding a zero in that field. I didn’t need it, sorry!

 

This post documents my attempt to get PAR and PAR::Packer running under ActiveState Perl on Windows XP SP3 in order to produce a native Windows executable of a Perl script. We use this to compile some custom cross-platform Nagios modules.

The first key thing is to start with ActiveState build 5.10.0.1004 or greater, as this fixes a YAML parsing problem that prevents CPAN modules from being installed. PAR::Packer isn’t in the ActiveState repository, so we’ll need to use CPAN to get some of the bits that we need.

• ActiveState Perl

Once that’s done its thing, you’ll need to grab a copy of Microsoft Nmake 1.5. Running the .exe will unpack nmake.exe, nmake.err and README.TXT into the root of C:. You will need to copy these three files into c:\perl\bin. Nmake is needed to build CPAN modules.

• Nmake 1.5

At this point I used the ActiveState Perl Package Manager to update all of the modules that had updates, also electing to install any packages required to satisfy dependencies.

Next, I used CPANPLUS to install PAR::Packer, as it’s not in the default ActiveState repository used by the Perl Package Manager. From a prompt:

cpanp
...
i PAR::Packer

confirming the installation of the module dependencies. At this point you might want to put the kettle on as there are a bunch of build/test tasks to run whilst all of the modules install.

It was here that the build failed for me. I realised I’d neglected to install MinGW to do the native binary compliation, unless you’ve got Microsoft Visual Studio 6.0 that is - in which case it is preferred.

• MinGW one-click installer

You will need to manually select to install the g++ component, along with the base install. Once this is installed, add C:\MinGW\bin (assuming you took the defaults) to your system %PATH%, close and reopen your command prompt to get the new value, and re-try the cpanp steps.

This should give you a completed installation. Just to check:

pp
...
Set up gcc environment - 3.4.5 (mingw-vista special r3)
C:\Perl\site\bin/pp: No input files specified

Ready to go.

pp -o myprogram.exe myprogram.pl