#!/usr/bin/perl -wT
# login_sentry - blocks repeated failed login attempts
# Significant changes by Jesse Shrieve, version 2.2, 02/02/2006
# Originally by Victor Danilchenko, 09/22/2004 
# Please don't bother Victor about problems with this script
# as he has no involvement with the changes made to it.
#
# 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.
#
# Quick start:
# The configuration variables should be mostly self-explanatory.
# At a minimum, you'll probably need to change the email recipients.
#
#################################################################
# 
# 02/02/2006	 Jesse Shrieve <j@lumiere.net>  v2.2
#		 Match more log formats, including IPv4-mapped IPv6 addresses
#		  and sshd(pam_unix) lines.
#		 Fix -f argument not working due to taint restrictions.
#		 Disable metacharacters when regex grepping for $user.
#        
# 12/07/2005	 Jesse Shrieve <j@lumiere.net>  v2.1
#		 Minor regex improvements to match for log formats.
#
# 10/22/2004     Jesse Shrieve <j@lumiere.net>  v2.0
#		 Misc fixes so it actually works, especially
#		 email notices. Corrected SMTP helo strings.
#		 Taint mode on, taint fixes.
#
#		 Ripped out blacklist sharing (no longer listens
#		 on any network ports).  
#
#		 Optional hook for another app. Redaemonize.
#		 Writes pid to /var/run/$name.pid
#
#		 Added support for a few more types of log lines.
#		 Enable/disable postfix log line
#		 matching with $watch_postfix = 0
#		 Same for pwauth, dovecot.
#		 Must use PAM for dovecot, SASL for postfix.
#
#		 Code is very basic. For instance, there's no
#		 checking of SMTP server response, timing, etc.
#
#		 If you have questions about this version, please
#		 bug me, not Victor, about them.
#
# 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;
use Data::Dumper;
use POSIX;

$ENV{"PATH"} = '';
my $name = "login_sentry";

# Optionally set $externalapp to program to execute after each time
# hosts.deny is updated. I use this to convert hosts.deny into
# an apache formatted RewriteMap to 404 any requests from blocked hosts.
# Good idea if you have web services that check against passwd database.
#
my $externalapp = '';

my $pidfile = "/var/run/$name.pid";
my $hosts_deny = "/etc/hosts.deny";
my $hosts = {};
# Add extra penalty for failed logins against these usernames
my @bad_users = sort qw(root iceuser user test admin guest operator backup apache wwwrun www oracle cyrus horde irc mysql nobody server web daniel michael andrew jordan nicole nathan ssh a b c d fluffy);
my $baddies = join (", ", @bad_users);
my $tag = 'SENTRY';
my ($help, $file, $restart, $interval, $threshold, $duration, $penalty, $time_to_die);
my $lhost = (`/bin/hostname`)[0]; chomp $lhost;
my $shost = (split(/\./, $lhost))[0];
my $logger = '/usr/bin/logger';
my $logpriority = 'authpriv.warn';
my $daemon = 1;  # run as a daemon. set to 0 to run in foreground

my $watch_pwauth = 0;  # watch for pwauth log entries? 1 or 0
my $watch_postfix = 0; # watch for postfix SASL log entries?
my $watch_dovecot = 0; # watch for dovecot PAM imap/pop3 entries

# Logfile that contains all log lines to be matched. Depends on your syslog
# config. On some hosts /var/log/secure or /var/log/messages is sufficient.
# I use /var/log/all.
my @files = qw(/var/log/messages); 
my $file_default;
for (@files) { if (-e $_) { $file_default = $_; last;} }

my $interval_default = 10; # check the logfile how often?
my $threshold_default = 6; # how many failed logins
my $duration_default = "1 day"; # how long to block for
my $penalty_default = 1; # Size of extra penalty for users on @bad_users list

# regex for hosts never to block
#my $excluded_hosts_regexp = '(^example.host.com$)|(^10\.10\.10\.10$)'; 
my $excluded_hosts_regexp = '';

# mail settings
my $helo = $shost;		# string used in SMTP HELO
my $mail_server = "localhost";	# smtp server to use
my $mailfrom = "root\@$lhost";  # MAIL FROM in notification emails
my @sysmail = ("root\@localhost"); # recipients to send notification emails to

sub help () {
    my $filr = " " x length($name);
    return << "EOT";
Usage: $name [-h | --help]
       $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> ]

help        Show this message
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
EOT
}

sub run_updates {

	if ($externalapp) {
		return system($externalapp);
	} else {
		return 0;
	}

}

sub log_msg {
	my $text = shift;
	system($logger, '-t', $name, '-p', $logpriority, $text);
}

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 $helo\n");
    print $socket ("MAIL FROM: <$mailfrom>\n");
    foreach my $rcpt (@users) {
        print $socket ("RCPT TO: <$rcpt>\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");
    sleep 3;
    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 process_line ($$) {
    my $line = shift;
    my $hosts = shift;
    chomp $line;

	# watch for failed ssh logins
    if ($line =~ /\bsshd\b.*(failed|accepted)\s+\S+\s+for\s+(?:illegal user\s+)?(\S+)\s+from\s+(?:::)?(?:\S+:)?(\S+)/i) {
		$hosts = handle_match($hosts, $1, $2, $3, 'ssh');
    } elsif ($line =~ /\bsshd\(pam_unix\).+?authentication\sfailure;.+?rhost=(\S+)?(?:.*?\s+user=(\S+))?\s*$/) {
		if (!defined $1) { return $hosts; }
		my $ip = $1;
		my $user = 'UNKNOWN';
		if (defined $2) { $user = $2;}

		$hosts = handle_match($hosts, 'failed', $user, $ip, 'ssh');
    } elsif ($line =~ /\bsshd\b.*Invalid user (\S+) from (\S+)/) {
		$hosts = handle_match($hosts, 'failed', $1, $2, 'ssh');
    }

	# watch for failed pwauth logins, if enabled
	if ($watch_pwauth) {

		if ($line =~ /\bpwauth\b.*(successful|failed) auth for user '(.+)' \(\S+\) via \S+ from \(\S+\) \((\S+)\)(?: \[sleep \ds\])?$/)
		{
			my $status = $1;
			my $user = $2;
			my $ip = $3;
			# handle_match wants accepted, not successful
			if ($status =~ /successful/) {
				$status = 'accepted';
			}
			$hosts = handle_match($hosts, $status, $user, $ip, 'pwauth');
		}
	} # if ($watch_pwauth) 

	# watch for postfix SASL auth failure messages
	if ($watch_postfix) {

		if ($line =~ /\bpostfix\/smtpd.*?:\swarning:\s[^\[]+\[([^\]]+)\]:\sSASL\s\w+\sauthentication failed\s*$/)
		{
			my $ip = $1;
			# we don't know the user, but we know it's a failure
			$hosts = handle_match($hosts, 'failed', 'unavailable', $ip, 'smtp');
		}
	} # if ($watch_postfix) {

	# watch for postfix AUTH success messages
	if ($watch_postfix) {
	
		if ($line =~ /\bpostfix\/smtpd.*?:\sclient=[^\[]+\[([^\]]+)\],\ssasl_method=\S+\ssasl_username=(\S+)\s*$/)
		{
			my $ip = $1;
			my $user = $2;
			# the username is discarded by handle_match on success, but we'll pass it anyway
			$hosts = handle_match($hosts, 'accepted', $user, $ip, 'smtp');
		}
	} # if ($watch_postfix)

	# watch for dovecot success messages
	if ($watch_dovecot) {

		if ($line =~ /\b(?:imap|pop3)-login:\sLogin:\s(\S+)\s\[([^\]]+)\]\s*$/) 
		{
			my $user = $1;
			my $ip = $2;

			$hosts = handle_match($hosts, 'accepted', $user, $ip, 'dovecot');
		}
	} # if ($watch_dovecot)

	# watch for dovecot failure messages
	if ($watch_dovecot) {

		if ($line =~ /\bdovecot\(pam_unix\).+?authentication\sfailure;.+?rhost=(\S+)?(?:.*?\s+user=(\S+))?\s*$/)
		{
			if (!defined $1) { return $hosts; }
			my $ip = $1;
			my $user = 'unavailable';
			if (defined $2) { $user = $2; }

			$hosts = handle_match($hosts, 'failed', $user, $ip, 'dovecot');
		}
	} # if ($watch_dovecot)
	
			
	
    return $hosts;
}

sub handle_match ($$) {
    my $hosts = shift;
    my $result = shift;
	my $user = shift;
	my $host = shift;
	my $method = shift;

	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}++;
			$hosts->{$host}->{lastmethod} = $method;
			# Count known-exploited users double
			$hosts->{$host}->{count}++ if grep (/^\Q$user\E$/, @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;
    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 %s (expires %s)\n", $host, $expo, $hosts->{$host}->{lastmethod}, $time);
	    printf DENY $str;
	    log_msg("Denying connections from $host (count: " . $hosts->{$host}{'count'} . 
		", lastmethod: " . $hosts->{$host}->{lastmethod} . ", expires $time)");
	    mail_to_users("Inserting deny string:\n$str\n" .
			  "Object contents:\n" . Dumper($hosts->{$host}),
			  "$shost: Blocking $host");
	    delete $hosts->{$host};

	}
    }
    close DENY;
	run_updates();
    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;
	run_updates();
	chown ($uid, $gid, $hosts_deny);
	chmod ($mode, $hosts_deny);
    }
}

# handle signals
sub signal_handler {

	$time_to_die = 1;

}

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

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

# untaint the file arg
if (defined $file) {
	$file =~ /(.*)/;
	$file = $1;
}

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

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

# daemonize
if($daemon)
{
	my ($pid) = fork;
	exit if $pid;
	die "Couldn't fork: $!\n" unless defined ($pid);
	POSIX::setsid() or die "Can't start a new session: $!\n";
	open(PIDFILE, ">$pidfile");
	print PIDFILE "$$\n";
	close(PIDFILE);
}

# trap fatal signals
$time_to_die = 0;
$SIG{INT}  = $SIG{TERM} = $SIG{HUP} = \&signal_handler;


	    my $inode = (stat($file))[1];
            unless (open (LOG, $file)) {
                log_msg("Cannot read log file '$file'");
                exit 1;
            }
                                                                                                 
            log_msg("Starting as daemon, using logfile: $file");
	    
	    for (;;) {
		# Spin infinitely, polling $file every $interval seconds;

		if ($time_to_die) { # if it's time to exit
                    log_msg("Received signal, daemon exiting.");
                    unlink $pidfile;
                    exit 0;
                 }
		
		while (my $line = <LOG>) {
		
		if ($line =~ /\bsshd\b/)                    { $hosts = process_line ($line, $hosts); } # parse SSH log
		if ($watch_pwauth && $line =~ /\bpwauth\b/) { $hosts = process_line ($line, $hosts); } # parse pwauth log
		if ($watch_postfix && $line =~ /\bpostfix.*?SASL \w+ authentication failed\s*$/) { $hosts = process_line ($line, $hosts); }
		if ($watch_postfix && $line =~ /\bpostfix.*?sasl_method=.*?sasl_username=/) { $hosts = process_line ($line, $hosts); }
		if ($watch_dovecot && $line =~ /\b(?:imap|pop3)-login:\sLogin:/) { $hosts = process_line ($line, $hosts); }
		if ($watch_dovecot && $line =~ /\bdovecot\(pam_unix\).*?authentication failure/) { $hosts = process_line ($line, $hosts); }

		} # while <LOG>
		$hosts = process_hosts ($hosts);   # See if any hosts need blacklisting
		expire_denials ();                 # Reap expired blacklist entries
		
		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();
		}
		} # for (;;)