#!/usr/bin/perl

# This cheak is based on code from the Debian/OpenSSL Weak Key Detector
# written by Florian Weimer <fw@deneb.enyo.de>. 
# The code has been modified and enhanced by Alexander Wirt 
# <formorer@debian.org> to use it as a nagios check. 
#
# Copyright (c) 2008, Florian Weimer <fw@deneb.enyo.de> for the original 
# Debian/OpenSSL Weak Key Detector 
# (http://security.debian.org/project/extra/dowkd/dowkd.pl.gz)
#
# Copyright (c) 2008, Alexander Wirt <formorer@debian.org> for check_weakkeys
#
# Copyright (c) 2008 Peter Palfrader <peter@palfrader.org>
#
# Permission to use, copy, modify, and/or distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#

=pod

=head1 NAME

B<check_weakkeys> - checks system for weak ssh keys 

=cut

=head1 SYNOPSIS

B<check_weakkeys> [options]

=cut

=head1 DESCRIPTION

B<check_weakkeys> checks for all users if there id_rsa, id_dsa or
authorized_key files if they contain weak ssh keys created by a Debian with a
broken libssl (see DSA-1571 for more informations). Optionally <check_weakkeys>
can spit out a warning of there are any DSA keys left in key or authorized_key
files. To work it needs a database of precomputed hashes of known weak keys.
This file is expected as an bdb database with the hash (like
03:a2:f0:46:7f:13:9f:5f:96:71:a9:b8:a0:1c:01:05) as key. See <gen_fprdb> for
such a database generator.  <check_weakkeys> outputs his data to STDOUT or to a
file. It meaned to be picked up by an nagios check like B<dsa-check-statusfile>
from Peter Palfrader. 

=cut

=head1 OPTIONS

=over 4

=item B<-h, --help>

Prints out a brief help

=item B<-s, --statusfile> "statusfile"

Use 'F<statusfile>' instead of 'F<STDOUT>'. 

=item B<-f, --fprdb> "database" (default: /var/lib/dsa/ssh-weak-keys.db)

Use 'F<database>' instead of 'F</var/lib/dsa/ssh-weak-keys.db>'
as fingerprint database. 

=item B<-n, --dsa_nowarn> 

Don't warn for DSA keys

=back 

=cut

use strict;
use warnings;

use File::Temp;
use BerkeleyDB;
use Pod::Usage;
use Getopt::Long;
use IPC::Open3;

my $fprdb_fname = "/var/lib/dsa/ssh-weak-keys.db" ;
my ($outfile, $help);
my $dsa_nowarn = 0;
my $debian_org = 1;

GetOptions(     'help|h' => \$help, #Help function
		'statusfile|s=s' => \$outfile, 
		'fprdb|f=s' => \$fprdb_fname,
		'n|dsa_nowarn' => \$dsa_nowarn,
		'd|debian-org!' => \$debian_org,
);

pod2usage(1) if $help;

my $fh; 
if ($outfile) {
	open ($fh, '>', $outfile) 
		or die "Could not open statusfile '$outfile' for writing: $!";
} else {
	$fh = *STDOUT; 
}

my %fpr_hash;
tie %fpr_hash, 'BerkeleyDB::Btree',
	-Filename   => $fprdb_fname,
	-Flags      => DB_RDONLY
		or die "Cannot open fingerprint db $fprdb_fname: $! $BerkeleyDB::Error\n";


my ($weak_keys,$checked_keys) = 0;
my $dsa_keys = 0;
my $weird_keyfiles = 0;
my $text = '';
my %key_sizes;


if ($debian_org) {
	&from_debianorg_places;
} else {
	&from_user_all;
}
&from_ssh_host(qw(localhost));

my $status="OK";
if ($weak_keys) {
	$status = "CRITICAL";
} elsif ($dsa_keys && ! $dsa_nowarn  ||  $weird_keyfiles) {
	$status = "WARNING";
}

print $fh "$status\n";
print $fh "Checked $checked_keys keys - $weak_keys weak - $dsa_keys dsa keys\n";
print $fh "Sizes: ";
foreach my $size (sort(keys(%key_sizes))) {
	print $fh "$size:$key_sizes{$size} ";
}

print $fh "\n";
print $fh "$text" if $text;



sub safe_backtick (@) {
    my @args = @_;

    my ($wtr, $fh, $err);

    open3($wtr,$fh,$err, @args)
	or die "error: failed to spawn $args[0]: $!\n";
    my @result;
    if (wantarray) {
	@result = <$fh>;
    } else {
	local $/;
	@result = scalar(<$fh>);
    }
    close $fh;
    $? == 0 or return undef;
    if (wantarray) {
	return @result;
    } else {
	return $result[0];
    }
}

sub ssh_fprint_file ($) {
    my $name = shift;
    my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
    defined $data or return ();
    my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
    return @data if @data == 2;
    return ();
}

sub ssh_fprint_check ($$$) {
    my ($name, $length, $hash) = @_;
    if (exists $key_sizes{$length}) {
	    $key_sizes{$length}++;
    } else {
	    $key_sizes{$length}=1;
    }
    $checked_keys++;
    if (exists $fpr_hash{$hash}) {
	$weak_keys++;
	$text .= "$name weak ($hash)\n";
    }
}


sub from_ssh_key_file ($) {
    my $name = shift;
    if (open (my $FH, '<', $name)) {
	my $key = <$FH>; 
	close($FH);
	if (! defined $key) {
		$weird_keyfiles++;
		$text .= "cannot read $name properly - empty?\n";
	} elsif ($key =~ m/ssh-dss/) {
		$dsa_keys++;
		$text .= "$name is a DSA key\n";
	}
    } else {
    	$text .= "Could not open $name: $!";
    }
    my ($length, $hash) = ssh_fprint_file $name;
    if ($length && $hash) {
	ssh_fprint_check "$name:1", $length, $hash;
    } else {
	$text .= "$name:1: warning: failed to parse SSH key file\n";
    }
}

sub clear_tmp ($) {
    my $tmp = shift;
    seek $tmp, 0, 0 or die "seek: $!";
    truncate $tmp, 0 or die "truncate: $!";
}

sub from_ssh_auth_file ($) {
    my $name = shift;
    my $auth;
    unless (open $auth, '<', $name) {
	warn "$name:0: error: open failed: $!\n";
	return;
    }
    my $tmp = new File::Temp;
    while (my $line = <$auth>) {
	chomp $line;
	my $lineno = $.;
	clear_tmp $tmp;
	next if $line =~ m/^$/; # ignore empty lines
	next if $line =~ m/^#/; # ignore comments
	if ($line =~ m/ssh-dss/) {
		$dsa_keys++;
		$text .= "$name:$lineno is a DSA key\n";
	}
	print $tmp "$line\n" or die "print: $!";
	$tmp->flush;
	my ($length, $hash) = ssh_fprint_file "$tmp";
	if ($length && $hash) {
	    ssh_fprint_check "$name:$lineno", $length, $hash;
	} else {
	    $text .= "$name:$lineno: warning: unparsable line\n";
	}
    }
}

sub from_ssh_host (@) {
    my @names = @_;
    my @lines;
    push @lines, safe_backtick qw|ssh-keyscan -t rsa|, @names;
    push @lines, safe_backtick qw|ssh-keyscan -t dsa|, @names;

    my $tmp = new File::Temp;
    for my $line (@lines) {
	next if $line =~ /^#/;
	next if $line =~ /^no hostkey alg/;
	my ($host, $data) = $line =~ /^(\S+) (.*)$/;
	clear_tmp $tmp;
	print $tmp "$data\n" or die "print: $!";
	$tmp->flush;
	my ($length, $hash) = ssh_fprint_file "$tmp";
	if ($length && $hash) {
	    ssh_fprint_check "$host", $length, $hash;
	} else {
	    $text .= "$host: warning: unparsable line\n";
	}
    }
}

sub from_user ($) {
    my $user = shift;
    my ($name,$passwd,$uid,$gid,
	$quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
    my $file = "$dir/.ssh/authorized_keys";
    from_ssh_auth_file $file if -r $file;
    $file = "$dir/.ssh/authorized_keys2";
    from_ssh_auth_file $file if -r $file;
    $file = "$dir/.ssh/id_rsa.pub";
    from_ssh_key_file $file if -r $file;
    $file = "$dir/.ssh/id_dsa.pub";
    from_ssh_key_file $file if -r $file;
}

sub from_user_all () {
    setpwent;
    while (my $name = getpwent) {
	from_user $name;
    }
    endpwent;
}


sub from_debianorg_places () {
    open(F, "/etc/ssh/sshd_config") or die ("Cannot open /etc/ssh/sshd_config: $!\n");
    my @lines = <F>;
    close(F);

    my @ak = grep { /^AuthorizedKeysFile\s/i } @lines;
    my @ak2 = grep { /^AuthorizedKeysFile2\s/i } @lines;

    if (scalar @ak != 1) {
	print $fh "UNKNOWN\n";
	print $fh "There is more than one AuthorizedKeysFile definition in sshd_config\n";
	exit
    }
    if (scalar @ak2 != 1) {
	print $fh "UNKNOWN\n";
	print $fh "There is more than one AuthorizedKeysFile2 definition in sshd_config\n";
	exit
    }
    unless ($ak[0] =~ m#^((?i)AuthorizedKeysFile)\s+/etc/ssh/userkeys/%u$# ) {
	print $fh "UNKNOWN\n";
	print $fh "The AuthorizedKeysFile definition has an unexpected value.  Should be /etc/ssh/userkeys/%u\n";
	exit
    }
    unless ($ak2[0] =~ m#^((?i)AuthorizedKeysFile2)\s+/var/lib/misc/userkeys/%u$# ) {
	print $fh "UNKNOWN\n";
	print $fh "The AuthorizedKeysFile2 definition has an unexpected value.  Should be /var/lib/misc/userkeys/%u\n";
	exit
    }

    for my $d (qw{/etc/ssh/userkeys /var/lib/misc/userkeys}) {
	next unless (-d $d);
	opendir(D, $d) or die "Cannot opendir $d: $!\n";
	for my $file (grep { ! -d $d.'/'.$_ } readdir(D)) {
	    next if ($file eq 'README-DSA-BUILDD');
	    my $f = $d.'/'.$file;
	    from_ssh_auth_file $f if -r $f;
	};
    };
}