dowkd.in

   1 #!/usr/bin/perl
   2
   3 # Debian/OpenSSL Weak Key Detector
   4 #
   5 # Copyright (C) 2008, Florian Weimer <fw@deneb.enyo.de>
   6 #
   7 # Permission to use, copy, modify, and distribute this software for
   8 # any purpose with or without fee is hereby granted, provided that the
   9 # above copyright notice and this permission notice appear in all
  10 # copies.
  11 #
  12 # THE SOFTWARE IS PROVIDED "AS IS" AND FLORIAN WEIMER AND HIS
  13 # CONTRIBUTORS DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE
  14 # INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.  IN
  15 # NO EVENT SHALL FLORIAN WEIMER OR HIS CONTRIBUTORS BE LIABLE FOR ANY
  16 # SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  17 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
  18 # AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING
  19 # OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
  20 # SOFTWARE.
  21 #
  22 # Blacklist data has been provided by Kees Cook, Peter Palfrader and
  23 # James Strandboge.
  24 #
  25 # Patches and comments are welcome.  Please send them to
  26 # <fw@deneb.enyo.de>, and use "dowkd" in the subject line.
  27
  28 use strict;
  29 use warnings;
  30
  31 sub help () {
  32     print <<EOF;
  33 usage: $0 [OPTIONS...] COMMAND [ARGUMENTS...]
  34
  35 COMMAND is one of:
  36
  37   file: examine files on the command line for weak keys
  38   host: examine the specified hosts for weak SSH keys
  39   user: examine user SSH keys for weakness; examine all users if no
  40         users are given
  41   help: show this help screen
  42   version: show version information
  43
  44 OPTIONS is one pf:
  45
  46   -c FILE: set the database cache file name (default: dowkd.db)
  47
  48 dowkd currently handles the following OpenSSH host and user keys,
  49 provided they have been generated on a little-endian architecture
  50 (such as i386 or amd64): RSA/1024 (both rsa1 and rsa format), RSA/2048
  51 and DSA/1024.  (The relevant OpenSSH versions in Debian do not support
  52 DSA key generation with other sizes.)
  53
  54 OpenVPN shared also detected on little-endian architecture.
  55
  56 Unencrypted RSA private keys and PEM certificate files generated by
  57 OpenSSL are detected, provided they use key lengths of 1024 or 2048
  58 bits.
  59
  60 Note that the blacklist by dowkd may be incomplete; it is only
  61 intended as a quick check.
  62
  63 EOF
  64 }
  65
  66 use DB_File;
  67 use File::Temp;
  68 use Fcntl;
  69 use IO::Handle;
  70
  71 my $db_version = '@DB_VERSION@';
  72 my $program_version = '@PROGRAM_VERSION@';
  73 my $changelog = <<'EOF';
  74 ChangeLog:
  75 @CHANGELOG@
  76 EOF
  77
  78 my $db_file = 'dowkd.db';
  79
  80 my $db;
  81 my %db;
  82
  83 sub create_db () {
  84     warn "notice: creating database, please wait\n";
  85     $db = tie %db, 'DB_File', $db_file, O_RDWR | O_CREAT, 0777, $DB_BTREE
  86         or die "error: could not open database: $!\n";
  87
  88     $db{''} = $db_version;
  89     while (my $line = <DATA>) {
  90         next if $line =~ /^\**$/;
  91         chomp $line;
  92         $line =~ /^[0-9a-f]{32}$/ or die "error: invalid data line";
  93         $line =~ s/(..)/chr(hex($1))/ge;
  94         $db{$line} = '';
  95     }
  96
  97     $db->sync;
  98 }
  99
 100 sub open_db () {
 101     if (-r $db_file) {
 102         $db = tie %db, 'DB_File', $db_file, O_RDONLY, 0777, $DB_BTREE
 103             or die "error: could not open database: $!\n";
 104         my $stored_version = $db{''};
 105         $stored_version && $stored_version eq $db_version or create_db;
 106     } else {
 107         unlink $db_file;
 108         create_db;
 109     }
 110 }
 111
 112 sub safe_backtick (@) {
 113     my @args = @_;
 114     my $fh;
 115     open $fh, '-|', @args
 116         or die "error: failed to spawn $args[0]: $!\n";
 117     my @result;
 118     if (wantarray) {
 119         @result = <$fh>;
 120     } else {
 121         local $/;
 122         @result = scalar(<$fh>);
 123     }
 124     close $fh;
 125     $? == 0 or return undef;
 126     if (wantarray) {
 127         return @result;
 128     } else {
 129         return $result[0];
 130     }
 131 }
 132
 133 my $keys_found = 0;
 134 my $keys_vulnerable = 0;
 135
 136 sub print_stats () {
 137     print STDERR "summary: keys found: $keys_found, weak keys: $keys_vulnerable\n";
 138 }
 139
 140 sub check_hash ($$;$) {
 141     my ($name, $hash, $descr) = @_;
 142     ++$keys_found;
 143     if (exists $db{$hash}) {
 144         ++$keys_vulnerable;
 145         $descr = $descr ? " ($descr)" : '';
 146         print "$name: weak key$descr\n";
 147     }
 148 }
 149
 150 sub ssh_fprint_file ($) {
 151     my $name = shift;
 152     my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
 153     defined $data or return ();
 154     my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
 155     return @data if @data == 2;
 156     return ();
 157 }
 158
 159 sub ssh_fprint_check ($$$$) {
 160     my ($name, $type, $length, $hash) = @_;
 161     $type =~ /^(?:rsa1?|dsa)\z/ or die;
 162     if (($type eq 'rsa'
 163          && ($length == 1024 || $length == 2048 || $length == 4096))
 164         || ($type eq 'dsa' && $length == 1024)
 165         || ($type eq 'rsa1' && $length == 1024)) {
 166         $hash =~ y/://d;
 167         $hash =~ s/(..)/chr(hex($1))/ge;
 168         check_hash $name, $hash, "OpenSSH/$type/$length";
 169     } elsif ($type eq 'dsa') {
 170         print "$name: $length bits DSA key not recommended\n";
 171     } else {
 172         warn "$name: warning: no blacklist for $type/$length key\n";
 173     }
 174 }
 175
 176 sub clear_tmp ($) {
 177     my $tmp = shift;
 178     seek $tmp, 0, 0 or die "seek: $!";
 179     truncate $tmp, 0 or die "truncate: $!";
 180 }
 181
 182 sub cleanup_ssh_auth_line ($) {
 183     my $line = shift;
 184
 185     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 186
 187   OUTSIDE_STRING:
 188     if ($line =~ /^\s+(.*)/) {
 189         $line = $1;
 190         goto SPACE_SEEN;
 191     }
 192     if ($line =~ /^"(.*)/) {
 193         $line = $1;
 194         goto INSIDE_STRING;
 195     }
 196     if ($line =~ /^\\.(.*)/) {
 197         # It doesn't matter if we don't deal with \000 properly, we
 198         # just need to defuse the backslash character.
 199         $line = $1;
 200         goto OUTSIDE_STRING;
 201     }
 202     if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
 203         # Skip multiple harmless characters in one go.
 204         $line = $1;
 205         goto OUTSIDE_STRING;
 206     }
 207     if ($line =~ /^.(.*)/) {
 208         # Other characters are stripped one by one.
 209         $line = $1;
 210         goto OUTSIDE_STRING;
 211     }
 212     return undef;               # empty string, no key found
 213
 214   INSIDE_STRING:
 215     if ($line =~ /^"(.*)/) {
 216         $line = $1;
 217         goto OUTSIDE_STRING;
 218     }
 219     if ($line =~ /^\\.(.*)/) {
 220         # See above, defuse the backslash.
 221         $line = $1;
 222         goto INSIDE_STRING;
 223     }
 224     if ($line =~ /^[^\\"]+(.*)/) {
 225         $line = $1;
 226         goto INSIDE_STRING;
 227     }
 228     return undef;               # missing closing double quote
 229
 230   SPACE_SEEN:
 231     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 232     return undef;
 233 }
 234
 235 sub derive_ssh_auth_type ($) {
 236     my $line = shift;
 237     $line =~ /^ssh-rsa\s/ and return 'rsa';
 238     $line =~ /^ssh-dss\s/ and return 'dsa';
 239     $line =~ /^\d+\s/ and return 'rsa1';
 240     return undef;
 241 }
 242
 243 sub from_ssh_auth_line ($$$) {
 244     my ($tmp, $name, $line) = @_;
 245     chomp $line;
 246     return if $line =~ m/^\s*(#|$)/;
 247
 248     {
 249         my $l = cleanup_ssh_auth_line $line;
 250         $l or goto ERROR;
 251         $line = $l;
 252     }
 253     my $type = derive_ssh_auth_type $line;
 254
 255     clear_tmp $tmp;
 256     print $tmp "$line\n" or die "print: $!";
 257     $tmp->flush or die "flush: $!";
 258     my ($length, $hash) = ssh_fprint_file "$tmp";
 259     if ($length && $hash) {
 260         ssh_fprint_check "$name", $type, $length, $hash;
 261         return;
 262     }
 263
 264   ERROR:
 265     warn "$name: warning: unparsable line\n";
 266 }
 267
 268 sub from_ssh_auth_file ($) {
 269     my $name = shift;
 270     my $auth;
 271     unless (open $auth, '<', $name) {
 272         warn "$name:0: error: open failed: $!\n";
 273         return;
 274     }
 275
 276     my $tmp = new File::Temp;
 277     while (my $line = <$auth>) {
 278         from_ssh_auth_line $tmp, "$name:$.", $line;
 279     }
 280 }
 281
 282 sub from_openvpn_key ($) {
 283     my $name = shift;
 284     my $key;
 285     unless (open $key, '<', $name) {
 286         warn "$name:0: open failed: $!\n";
 287         return 1;
 288     }
 289
 290     my $marker;
 291     while (my $line = <$key>) {
 292         return 0 if $. > 10;
 293         if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
 294             $marker = 1;
 295         } elsif ($marker) {
 296             if ($line =~ /^([0-9a-f]{32})/) {
 297                 $line = $1;
 298                 $line =~ s/(..)/chr(hex($1))/ge;
 299                 check_hash "$name:$.", $line, "OpenVPN";
 300                 return 1;
 301             } else {
 302                 warn "$name:$.: warning: illegal OpenVPN file format\n";
 303                 return 1;
 304             }
 305         }
 306     }
 307 }
 308
 309 sub openssl_modulus_check ($$) {
 310     my ($name, $modulus) = @_;
 311     chomp $modulus;
 312     if ($modulus =~ /^Modulus=([A-F0-9]+)$/) {
 313         $modulus = $1;
 314         my $length = length($modulus) * 4;
 315         if ($length == 1024 || $length == 2048) {
 316             my $mod = substr $modulus, length($modulus) - 32;
 317             $mod =~ y/A-F/a-f/;
 318             my @mod = $mod =~ /(..)/g;
 319             $mod = join('', map { chr(hex($_)) } reverse @mod);
 320             check_hash $name, $mod, "OpenSSL/RSA/$length";
 321         } else {
 322             warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
 323         }
 324     } else {
 325         die "internal error: $modulus\n";
 326     }
 327 }
 328
 329 sub from_pem ($) {
 330     my $name = shift;
 331     my $tmp;
 332     my $found = 0;
 333
 334     my $src;
 335     unless (open $src, '<', $name) {
 336         warn "$name:0: open failed: $!\n";
 337         return 1;
 338     }
 339
 340     while (my $line = <$src>) {
 341         if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
 342             my $lineno = $.;
 343             $tmp or $tmp = new File::Temp;
 344             clear_tmp $tmp;
 345             do {
 346                 print $tmp $line or die "print: $!";
 347                 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
 348             } while ($line = <$src>);
 349           LAST:
 350             $tmp->flush or die "flush: $!";
 351             my $mod = safe_backtick qw/openssl x509 -noout -modulus -in/, $tmp;
 352             if ($mod) {
 353                 openssl_modulus_check "$name:$lineno", $mod;
 354                 $found = 1;
 355             } else {
 356                 warn "$name:$lineno: failed to parse certificate\n";
 357                 return 1;
 358             }
 359         } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
 360             my $lineno = $.;
 361             $tmp or $tmp = new File::Temp;
 362             clear_tmp $tmp;
 363             do {
 364                 print $tmp $line or die "print: $!";
 365                 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
 366             } while ($line = <$src>);
 367           LAST_RSA:
 368             $tmp->flush or die "flush: $!";
 369             my $mod = safe_backtick qw/openssl rsa -noout -modulus -in/, $tmp;
 370             if ($mod) {
 371                 openssl_modulus_check "$name:$lineno", $mod;
 372                 $found = 1;
 373             } else {
 374                 warn "$name:$lineno: failed to parse RSA private key\n";
 375                 return 1;
 376             }
 377         }
 378     }
 379
 380     return $found;
 381 }
 382
 383 sub from_ssh_host (@) {
 384     my @names = @_;
 385
 386     @names = grep {
 387         my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
 388         @addrs or warn "warning: host not found: $_\n";
 389         @addrs > 0;
 390     } @names;
 391
 392     my @lines;
 393     push @lines, safe_backtick qw/ssh-keyscan -t rsa/, @names;
 394     push @lines, safe_backtick qw/ssh-keyscan -t dsa/, @names;
 395
 396     my $tmp = new File::Temp;
 397     for my $line (@lines) {
 398         next if $line =~ /^#/;
 399         my ($host, $data) = $line =~ /^(\S+) (.*)$/;
 400         from_ssh_auth_line $tmp, $host, $data;
 401     }
 402 }
 403
 404 sub from_user ($) {
 405     my $user = shift;
 406     my ($name,$passwd,$uid,$gid,
 407         $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
 408     unless ($name) {
 409         warn "warning: user $user does not exist\n";
 410         return;
 411     }
 412     for my $name (qw/authorized_keys authorized_keys2
 413                      known_hosts known_hosts2
 414                      id_rsa.pub id_dsa.pub identity.pub/) {
 415         my $file = "$dir/.ssh/$name";
 416         from_ssh_auth_file $file if -r $file;
 417     }
 418 }
 419
 420 sub from_user_all () {
 421     # This was one loop initially, but does not work with some Perl
 422     # versions.
 423     setpwent;
 424     my @names;
 425     while (my $name = getpwent) {
 426         push @names, $name;
 427     }
 428     endpwent;
 429     from_user $_ for @names;
 430 }
 431
 432 if (@ARGV && $ARGV[0] eq '-c') {
 433     shift @ARGV;
 434     $db_file = shift @ARGV if @ARGV;
 435 }
 436 if (@ARGV) {
 437     open_db;
 438     my $cmd = shift @ARGV;
 439     if ($cmd eq 'file') {
 440         for my $name (@ARGV) {
 441             next if from_openvpn_key $name;
 442             next if from_pem $name;
 443             from_ssh_auth_file $name;
 444         }
 445     } elsif ($cmd eq 'host') {
 446         from_ssh_host @ARGV;
 447     } elsif ($cmd eq 'user') {
 448         if (@ARGV) {
 449             from_user $_ for @ARGV;
 450         } else {
 451             from_user_all;
 452         }
 453     } elsif ($cmd eq 'help') {
 454         help;
 455         exit 0;
 456     } elsif ($cmd eq 'version') {
 457         print "dowkd $program_version (database $db_version)\n\n$changelog";
 458         exit 0;
 459     } else {
 460         die "error: invalid command, use \"help\" to get help\n";
 461     }
 462     print_stats;
 463 } else {
 464     help;
 465     exit 1;
 466 }
 467
 468 my %hash;
 469
 470 __DATA__