#!/usr/bin/perl -w

# Copyright by Victor Danilchenko, 09/22/2004
# This  code may be distributed under the terms of GPL version 2,
# or at your option any subsequent version.
#
#################################################################
#
# The purpose of this script is to monitor the sshd logs, detect
# repeated failed login attempts, and blacklist the hosts whence
# such attempts originate.
#
# Supports Linux and OS/X
#
#################################################################
#
# Changelog:
# 09/22/2004      Victor Danilchenko  danilche@cs.umass.edu
#                 Added notification by mail capability, via
#                 direct SMTP injection
#
################################################################
#
# 10/05/2004      Victor Danilchenko  danilche@cs.umass.edu
#                 Added client/server functionality, via a
#                 separate listening child to communicate with
#                 the server
#
################################################################

use strict;
use Getopt::Long;
use Socket;
use IO::Seekable;
use IO::Socket;
use IO::Socket::INET;

my $name = "sshd_sentry";
my $pidfile = "/var/run/$name.pid";
my $hosts_deny = "/etc/hosts.deny";
my $hosts = {};
my @bad_users = sort qw(root user test admin guest operator backup apache www oracle cyrus horde irc mysql nobody server web);
my $baddies = join (", ", @bad_users);
my $tag = 'ROBOSENTRY';
my ($help, $file, $restart, $interval, $threshold, $duration, $penalty, $client_port, $server);
my $lhost = (`/bin/hostname`)[0]; chomp $lhost;
my $shost = (split(/\./, $lhost))[0];
my $cpid = 0; # PID of the listening child process
my $ppid = $$;

my @files = qw(/var/log/messages /var/log/system.log /var/adm/messages);
my $file_default;
for (@files) { if (-e $_) { $file_default = $_; last;} }

my $interval_default = 10;
my $threshold_default = 6;
my $duration_default = "1 day";
my $penalty_default = 1;
my $client_port_default = 6093;
my $server_port_default = $client_port_default + 1;

# Domain-specific options
my $domain = 'cs.umass.edu';
my $excluded_hosts_regexp = '(\.cs\.umass\.edu$)|(^128\.119\.24[01234567]\.\d+$)|(^128\.119\.4[01]\.\d+$)';
my $mail_server = "mail.$domain";
my @sysmail = ("sysscript\@$domain"); 

my $server_default = "sshd-sentry.$domain:$server_port_default";


sub help () {
    my $filr = " " x length($name);
    return << "EOT";
Usage: $name [-h | --help]
       $filr [-r | --restart ]
       $filr [-f | --file <log file name> ]
       $filr [-i | --interval <polling interval> ]
       $filr [-t | --threshold <threshold number of failures> ]
       $filr [-d | --duration <duration of time to disable host for> ]
       $filr [-p | --penalty <penalty for known-exploitable accounts> ]
       $filr [-c | --client_port <port> ]
       $filr [-s | --server <hostname:port> ]

help        Show this message
restart     Focibly restart $name, kill current process if needed
file        Specify the log file name to use
            default: $file_default 
interval    Number of seconds between polling of the log file 
            default: $interval_default
threshold   Number of detected failed logins, before the host is blocked.
            Notice that the user names which are commonly used in exploits
            ($baddies) count double.
            default: $threshold_default.
duration    Duration of time for which the host which went over the failure
            threshold should be blocked. Must be a number followed by units
            (e.g. '1 hr' or '3 days'). Unqualified number is treated as hours.
	    default: $duration_default
penalty     The extra points to count as authentication failures for accounts
            commonly used in exploits ($baddies)
            default: $penalty_default
client_port Port on which to listen for server distributing the updated
            list of attacking hosts
	    default: $client_port_default
server      Hostname:port which should be contacted to upload newly blacklisted
            hosts
	    default: $server_default
EOT
}

sub mail_to_users {
    my $text = shift;
    my $subject = shift;
    my @users = @_; @users = @sysmail unless @users;

    my $socket=IO::Socket::INET->new("$mail_server:25");
    #my $socket = \*STDOUT;
    print $socket ("HELO $shost.$domain\n");
    print $socket ("MAIL FROM: root\@$shost.$domain\n");
    print $socket ("RCPT TO: ", join ("\nRCPT TO: ", @users), "\n");
    print $socket ("DATA\n");
    print $socket ("To: ", join (",", @users), "\n");
    print $socket ("Subject: $subject\n\n");
    print $socket($text);
    print $socket ("\n.\nQUIT\n");
    close $socket;
}

sub die_with_mail($;@) {
    my $text = shift;
    my @users = @_; @users = @sysmail unless @users;
    my $subject = "$name died on $shost";
    mail_to_users ($text, $subject, @users);
    if (-t STDIN) { die $text;}
    else          { exit 1;   }
}

sub negotiate_pid ($) {
    my $restart = shift;
    # Negotiate over possible prior instances
    if (-s $pidfile) {
	# PID file exists and is not empty
	open (PID, $pidfile) or die_with_mail "Cannot read PID file $pidfile\n";
	chomp (my $pid = <PID>);
	close PID;
	die_with_mail "Corrupt PID file! (read '$pid' from it)\n" unless $pid =~ /^\d+$/;
	if (kill (0, $pid)) {
	    # The process is alive
	    if ($restart) {
		# We are gonna kill the current process
		kill (9, $pid);
		sleep 1;
		if (kill (0, $pid)) { die_with_mail "Cannot kill predecessor, PID $pid\n";}
		else                { unlink $pidfile; }
	    } else {
		# There's another instance already running, leave it alone.
		exit 1;
	    }
	} else {
	    # PID file exists but the process is dead, proceed
	    unlink $pidfile;
	}
    } elsif (-e $pidfile) {
	# PID file exists but it empty, ignore it.
	unlink $pidfile;
    }

    if (-e $pidfile) { die_with_mail "PID file $pidfile unepectedly exists!\n"; }
    elsif (open (PID, "> $pidfile")) {
	print PID "$$\n";
	close PID;
    } else { die_with_mail "Couldn't write my PID ($$) to $pidfile\n"; }

}

sub process_line ($$) {
    my $line = shift;
    my $hosts = shift;
    chomp $line;
    if ($line =~ /\bsshd\b.*(failed|accepted)\s+\S+\s+for\s+(?:illegal user\s+)?(\S+)\s+from\s+(?:\S+:)?(\S+)/i) {
	# matched line
	my ($result, $user, $host) = ($1, $2, $3);
	if ($host !~ /$excluded_hosts_regexp/) {
	    # print "$result $user from $host\n";
	    if ($result =~ /accepted/i) {
		# Successful login, validate this address
		delete $hosts->{$host};
	    } else {
		$hosts->{$host}->{users}->{$user}++;
		$hosts->{$host}->{count}++;
		# Count known-exploited users double
		$hosts->{$host}->{count}++ if grep (/^$user$/, @bad_users);
	    }
	}
    }
    return $hosts;
}

sub normalize_duration ($) {
    my $duration = shift()."h";
    $duration =~ s/\s//g;
    my ($num, $unit) = (lc($duration) =~ /^(\d+)(\w)/);
    return undef unless ($num && $unit);
    my $multiplier = 0;
    if    ($unit eq "s") { $multiplier = 1;}
    elsif ($unit eq "m") { $multiplier = 60;}
    elsif ($unit eq "h") { $multiplier = 60*60;}
    elsif ($unit eq "d") { $multiplier = 60*60*24;}
    elsif ($unit eq "w") { $multiplier = 60*60*24*7;}
    elsif ($unit eq "m") { $multiplier = 60*60*24*30;}
    elsif ($unit eq "y") { $multiplier = 60*60*24*365;}
    else                 { return undef;}
    return $num * $multiplier; 
}

sub process_hosts ($) {
    my $hosts = shift;
    my ($peername, $peerport) = split (/:/, $server); 
    open (DENY, ">> $hosts_deny") or die_with_mail "Cannot write to $hosts_deny\n";
    my $expo = time() + normalize_duration($duration);
    for my $host (keys %$hosts) {
	if ($hosts->{$host}->{count} >= $threshold) {
	    my @users = keys %{$hosts->{$host}->{users}};
	    my $utemp = $users[0];
	    if (@users == 1 && getpwnam($utemp) && ! grep (/^$utemp$/, @bad_users)) {
		next unless ($hosts->{$host}->{count} >= 2 * $threshold);
	    }

	    # Too many authentication failures for the host
	    my $time =  scalar (localtime($expo)); $time =~ s/^\w+\s+//;
	    $time =~ s/:/\./g;
	    my $str = sprintf ("ALL : %-18s \# $tag %i (expires %s)\n", $host, $expo, $time);
	    printf DENY $str;
	    #mail_to_users("Inserting deny string:\n$str\n".
			  #", #"Object contents:\n".ObjectContents ($hosts->{$host}, 3),
			  #"$shost: Blocking $host");
	    delete $hosts->{$host};

	    # Submit the blacklisted host to the server
	    if (my $socket = IO::Socket::INET->new(PeerAddr => $peername,
						   PeerPort => $peerport,
						   Proto => 'tcp',
						   Type => SOCK_STREAM,
						   Timeout => 1)) {
		print $socket "$client_port:$host\n";
		close $socket;
	    }
	}
    }
    close DENY;
    return $hosts;
}

sub expire_denials () {
    # expire old entries in $hosts_deny
    open (DENY, $hosts_deny) or die_with_mail "Cannot read $hosts_deny\n";
    my @data = <DENY>;
    my @new = ();
    my $change = 0;

    my $indices = {};

    for my $line (@data) {
	if ($line =~ /\#.*\b$tag\b\s+(\d+)/) {
	    # Our line, process it
	    my $expo = $1;
	    if ($expo > time()) {
		# this entry has future timestamp, decide what to do with it
		my $host = ($line =~ /^[^:]+:\s*([^:\s]+)/)[0];
		if ($indices->{$host}) {
		    # We already saw a line for this host, decide which line to keep
		    if ($expo > $indices->{$host}->{expo}) {
			# the new entry has a greater expiration time, keep it
			$new[$indices->{$host}->{index}] = $line;
		    } # else do nothing and skip this line, keep the one we had
		    $change = 1; # We merged two entries into one, must dump the data
		} else {
		    # This is the first time we see a record for this host, keep it
		    $indices->{$host}->{index} = @new;
		    $indices->{$host}->{expo} = $expo;
		    push (@new, $line);
		}
	    } else {
		# print "Reaping: $line";
		$change = 1;      # We reaped an entry, set the change flag
	    }
	} else {
	    push @new, $line;
	}
    }

    if ($change) {
	# We changed the contents, write them back to file
	my ($mode, $uid, $gid) = (stat($hosts_deny))[2,4,5];
	open (DENY, "> $hosts_deny") or die_with_mail "Cannot write to $hosts_deny\n";
	print DENY @new; #"Deny:\n\n", @new,"\n\n"; exit 0;
	close DENY;
	chown ($uid, $gid, $hosts_deny);
	chmod ($mode, $hosts_deny);
    }
}

sub CLEANER {
    # Clean up the listening child before exiting
    kill ('INT', $cpid) if $cpid;
    unlink $pidfile;
    exit 1;
}

sub handle_callbacks () {
    # This function is the essence of the spawned listener child
    # Listen to the remote server's callbacks, process them, then listen again

    # Get the IP address of the server -- will only speak to them.
    my $svraddr = (split(/:/, $server))[0];

    # Create the server object
    my $svrsock = IO::Socket::INET->new
	(LocalPort => $client_port, Type => SOCK_STREAM, Reuse => 1, Listen => 5)
	or die "Couldn't listen on port $client_port: $@\n";

    while (my $client = $svrsock->accept()) {
	if ($svraddr ne inet_ntoa($client->peeraddr())) {
	    # Connection not from the server! Stop this!
	    print $client "You are not authorized to speak to me, go away.\n";
	    close $client;
	    next;
	}

	while (my $line = <$client>) {
	    chomp $line;
	    my ($host, $expo) = split (/\s+/, $line);
	    if ($host !~  /$excluded_hosts_regexp/ && $expo =~ /^\d+$/ && open (DENY, ">> $hosts_deny")) {
		my $time =  scalar (localtime($expo)); $time =~ s/^\w+\s+//; $time =~ s/:/\./g;
		printf DENY ("ALL : %-18s \# remote $tag %i (expires %s)\n", $host, $expo, $time);
		close DENY;
	    }
	}
	close $client;
	die "My parent died unexpectedly, will commit seppuku now!\n" unless kill (0, $ppid);
    }
}

#############################
#                           #
#   Execution begins here   #
#                           #
#############################

GetOptions ("help"            => \$help,
            "file:s"          => \$file,
	    "restart"         => \$restart,
	    "threshold=i"     => \$threshold,
	    "interval=i"      => \$interval,
	    "duration=s"      => \$duration,
	    "penalty=i"       => \$penalty,
	    "client_port=i"   => \$client_port,
	    "server=s"        => \$server,
);

if ($help) { print help(); exit 0;}

negotiate_pid($restart);

# Activate $<option>_default values
eval "no strict 'vars'; \$$_ ||= \$${_}_default"
    for qw(file interval threshold duration penalty client_port server);
die_with_mail "Bad duration spec ($duration)\n" unless normalize_duration ($duration);

# Normalize the server address to ip:port form
my ($host, $port) = split(/:/, $server); $port ||= $client_port;
$host = inet_ntoa(scalar gethostbyname ($host)) unless $host =~ /^(\d+\.){3}\d+$/;
$server = "$host:$port";

for (;;) {
    # This will only loop if the listening child dies unexpectedly
    my $fork = fork();
    if (defined $fork) {
	if ($fork) {
	    # We are the parent
	    $cpid = $fork;
	    
	    $SIG{CHLD} = 'IGNORE'; #\&REAPER;
	    $SIG{$_} = \&CLEANER for qw(INT TERM __DIE__ ABRT ALRM PIPE BUS HUP KILL QUIT);

	    # Make the initial contact with the server
	    if (my $socket = IO::Socket::INET->new(PeerAddr => $host,
						   PeerPort => $port,
						   Proto => 'tcp',
						   Type => SOCK_STREAM,
						   Timeout => 1)) {
		print $socket "$client_port:\n";
		close $socket;
	    }
	    
	    my $inode = (stat($file))[1];
	    open (LOG, $file) or die_with_mail "Cannot read log file '$file'\n";
	    
	    for (;;) {
		# Spin infinitely, polling $file every $interval seconds;
		# pop out to restart the listening child if it vanishes
		
		while (<LOG>) { $hosts = process_line ($_, $hosts) if /\bsshd\b/;} # parse SSH log
		$hosts = process_hosts ($hosts);   # See if any hosts need blacklisting
		expire_denials ();                 # Reap expired blacklist entries
		
		unless (kill (0, $cpid)) {
		    # The listening child vanished, we must re-spawn it.
		    # Pop out of the inner loop, fork the child, and return.
		    $SIG{$_} = 'DEFAULT' for qw(INT TERM __DIE__ ABRT ALRM PIPE BUS HUP KILL QUIT CHLD);
		    close LOG;
		    last;
		}
		my $new_inode = (stat($file))[1];
		if ($new_inode && ($inode != $new_inode)) {
		    # logs have been rotated! Open the new log file, don't sleep or reset EOF
		    close LOG;
		    open (LOG, $file) or die_with_mail "Cannot reopen rotated log file '$file'\n";
		    $inode = $new_inode;
		} else {
		    # the logs have not been rotated
		    sleep $interval;
		    LOG->clearerr();
		}
	    }
	} else {
	    # we are the child
	    handle_callbacks ();
	    exit 0;
	}
    } else {
	die "Cannot spawn the listening child ($!).\n";
    }
}