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     while (my $line = <DATA>) {
  89         next if $line =~ /^\**$/;
  90         chomp $line;
  91         $line =~ /^[0-9a-f]{32}$/ or die "error: invalid data line";
  92         $line =~ s/(..)/chr(hex($1))/ge;
  93         $db{$line} = '';
  94     }
  95
  96     # Set at the end so that no incomplete database is left behind.
  97     $db{''} = $db_version;
  98
  99     $db->sync;
 100 }
 101
 102 sub open_db () {
 103     if (-r $db_file) {
 104         $db = tie %db, 'DB_File', $db_file, O_RDONLY, 0777, $DB_BTREE
 105             or die "error: could not open database: $!\n";
 106         my $stored_version = $db{''};
 107         $stored_version && $stored_version eq $db_version or create_db;
 108     } else {
 109         unlink $db_file;
 110         create_db;
 111     }
 112 }
 113
 114 sub safe_backtick (@) {
 115     my @args = @_;
 116     my $fh;
 117     open $fh, '-|', @args
 118         or die "error: failed to spawn $args[0]: $!\n";
 119     my @result;
 120     if (wantarray) {
 121         @result = <$fh>;
 122     } else {
 123         local $/;
 124         @result = scalar(<$fh>);
 125     }
 126     close $fh;
 127     $? == 0 or return undef;
 128     if (wantarray) {
 129         return @result;
 130     } else {
 131         return $result[0];
 132     }
 133 }
 134
 135 my $keys_found = 0;
 136 my $keys_vulnerable = 0;
 137
 138 sub print_stats () {
 139     print STDERR "summary: keys found: $keys_found, weak keys: $keys_vulnerable\n";
 140 }
 141
 142 sub check_hash ($$;$) {
 143     my ($name, $hash, $descr) = @_;
 144     ++$keys_found;
 145     if (exists $db{$hash}) {
 146         ++$keys_vulnerable;
 147         $descr = $descr ? " ($descr)" : '';
 148         print "$name: weak key$descr\n";
 149     }
 150 }
 151
 152 sub ssh_fprint_file ($) {
 153     my $name = shift;
 154     my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
 155     defined $data or return ();
 156     my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
 157     return @data if @data == 2;
 158     return ();
 159 }
 160
 161 sub ssh_fprint_check ($$$$) {
 162     my ($name, $type, $length, $hash) = @_;
 163     $type =~ /^(?:rsa1?|dsa)\z/ or die;
 164     if (($type eq 'rsa'
 165          && ($length == 1024 || $length == 2048 || $length == 4096))
 166         || ($type eq 'dsa' && $length == 1024)
 167         || ($type eq 'rsa1' && $length == 1024)) {
 168         $hash =~ y/://d;
 169         $hash =~ s/(..)/chr(hex($1))/ge;
 170         check_hash $name, $hash, "OpenSSH/$type/$length";
 171     } elsif ($type eq 'dsa') {
 172         print "$name: $length bits DSA key not recommended\n";
 173     } else {
 174         warn "$name: warning: no blacklist for $type/$length key\n";
 175     }
 176 }
 177
 178 sub clear_tmp ($) {
 179     my $tmp = shift;
 180     seek $tmp, 0, 0 or die "seek: $!";
 181     truncate $tmp, 0 or die "truncate: $!";
 182 }
 183
 184 sub cleanup_ssh_auth_line ($) {
 185     my $line = shift;
 186
 187     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 188
 189   OUTSIDE_STRING:
 190     if ($line =~ /^\s+(.*)/) {
 191         $line = $1;
 192         goto SPACE_SEEN;
 193     }
 194     if ($line =~ /^"(.*)/) {
 195         $line = $1;
 196         goto INSIDE_STRING;
 197     }
 198     if ($line =~ /^\\.(.*)/) {
 199         # It doesn't matter if we don't deal with \000 properly, we
 200         # just need to defuse the backslash character.
 201         $line = $1;
 202         goto OUTSIDE_STRING;
 203     }
 204     if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
 205         # Skip multiple harmless characters in one go.
 206         $line = $1;
 207         goto OUTSIDE_STRING;
 208     }
 209     if ($line =~ /^.(.*)/) {
 210         # Other characters are stripped one by one.
 211         $line = $1;
 212         goto OUTSIDE_STRING;
 213     }
 214     return undef;               # empty string, no key found
 215
 216   INSIDE_STRING:
 217     if ($line =~ /^"(.*)/) {
 218         $line = $1;
 219         goto OUTSIDE_STRING;
 220     }
 221     if ($line =~ /^\\.(.*)/) {
 222         # See above, defuse the backslash.
 223         $line = $1;
 224         goto INSIDE_STRING;
 225     }
 226     if ($line =~ /^[^\\"]+(.*)/) {
 227         $line = $1;
 228         goto INSIDE_STRING;
 229     }
 230     return undef;               # missing closing double quote
 231
 232   SPACE_SEEN:
 233     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 234     return undef;
 235 }
 236
 237 sub derive_ssh_auth_type ($) {
 238     my $line = shift;
 239     $line =~ /^ssh-rsa\s/ and return 'rsa';
 240     $line =~ /^ssh-dss\s/ and return 'dsa';
 241     $line =~ /^\d+\s/ and return 'rsa1';
 242     return undef;
 243 }
 244
 245 sub from_ssh_auth_line ($$$) {
 246     my ($tmp, $name, $line) = @_;
 247     chomp $line;
 248     return if $line =~ m/^\s*(#|$)/;
 249
 250     {
 251         my $l = cleanup_ssh_auth_line $line;
 252         $l or goto ERROR;
 253         $line = $l;
 254     }
 255     my $type = derive_ssh_auth_type $line;
 256
 257     clear_tmp $tmp;
 258     print $tmp "$line\n" or die "print: $!";
 259     $tmp->flush or die "flush: $!";
 260     my ($length, $hash) = ssh_fprint_file "$tmp";
 261     if ($length && $hash) {
 262         ssh_fprint_check "$name", $type, $length, $hash;
 263         return;
 264     }
 265
 266   ERROR:
 267     warn "$name: warning: unparsable line\n";
 268 }
 269
 270 sub from_ssh_auth_file ($) {
 271     my $name = shift;
 272     my $auth;
 273     unless (open $auth, '<', $name) {
 274         warn "$name:0: error: open failed: $!\n";
 275         return;
 276     }
 277
 278     my $tmp = new File::Temp;
 279     while (my $line = <$auth>) {
 280         from_ssh_auth_line $tmp, "$name:$.", $line;
 281     }
 282 }
 283
 284 sub from_openvpn_key ($) {
 285     my $name = shift;
 286     my $key;
 287     unless (open $key, '<', $name) {
 288         warn "$name:0: open failed: $!\n";
 289         return 1;
 290     }
 291
 292     my $marker;
 293     while (my $line = <$key>) {
 294         return 0 if $. > 10;
 295         if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
 296             $marker = 1;
 297         } elsif ($marker) {
 298             if ($line =~ /^([0-9a-f]{32})/) {
 299                 $line = $1;
 300                 $line =~ s/(..)/chr(hex($1))/ge;
 301                 check_hash "$name:$.", $line, "OpenVPN";
 302                 return 1;
 303             } else {
 304                 warn "$name:$.: warning: illegal OpenVPN file format\n";
 305                 return 1;
 306             }
 307         }
 308     }
 309 }
 310
 311 sub openssl_modulus_check ($$) {
 312     my ($name, $modulus) = @_;
 313     chomp $modulus;
 314     if ($modulus =~ /^Modulus=([A-F0-9]+)$/) {
 315         $modulus = $1;
 316         my $length = length($modulus) * 4;
 317         if ($length == 1024 || $length == 2048) {
 318             my $mod = substr $modulus, length($modulus) - 32;
 319             $mod =~ y/A-F/a-f/;
 320             my @mod = $mod =~ /(..)/g;
 321             $mod = join('', map { chr(hex($_)) } reverse @mod);
 322             check_hash $name, $mod, "OpenSSL/RSA/$length";
 323         } else {
 324             warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
 325         }
 326     } else {
 327         die "internal error: $modulus\n";
 328     }
 329 }
 330
 331 sub from_pem ($) {
 332     my $name = shift;
 333     my $tmp;
 334     my $found = 0;
 335
 336     my $src;
 337     unless (open $src, '<', $name) {
 338         warn "$name:0: open failed: $!\n";
 339         return 1;
 340     }
 341
 342     while (my $line = <$src>) {
 343         if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
 344             my $lineno = $.;
 345             $tmp or $tmp = new File::Temp;
 346             clear_tmp $tmp;
 347             do {
 348                 print $tmp $line or die "print: $!";
 349                 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
 350             } while ($line = <$src>);
 351           LAST:
 352             $tmp->flush or die "flush: $!";
 353             my $mod = safe_backtick qw/openssl x509 -noout -modulus -in/, $tmp;
 354             if ($mod) {
 355                 openssl_modulus_check "$name:$lineno", $mod;
 356                 $found = 1;
 357             } else {
 358                 warn "$name:$lineno: failed to parse certificate\n";
 359                 return 1;
 360             }
 361         } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
 362             my $lineno = $.;
 363             $tmp or $tmp = new File::Temp;
 364             clear_tmp $tmp;
 365             do {
 366                 print $tmp $line or die "print: $!";
 367                 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
 368             } while ($line = <$src>);
 369           LAST_RSA:
 370             $tmp->flush or die "flush: $!";
 371             my $mod = safe_backtick qw/openssl rsa -noout -modulus -in/, $tmp;
 372             if ($mod) {
 373                 openssl_modulus_check "$name:$lineno", $mod;
 374                 $found = 1;
 375             } else {
 376                 warn "$name:$lineno: failed to parse RSA private key\n";
 377                 return 1;
 378             }
 379         }
 380     }
 381
 382     return $found;
 383 }
 384
 385 sub from_ssh_host (@) {
 386     my @names = @_;
 387
 388     @names = grep {
 389         my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
 390         @addrs or warn "warning: host not found: $_\n";
 391         @addrs > 0;
 392     } @names;
 393
 394     my @lines;
 395     push @lines, safe_backtick qw/ssh-keyscan -t rsa/, @names;
 396     push @lines, safe_backtick qw/ssh-keyscan -t dsa/, @names;
 397
 398     my $tmp = new File::Temp;
 399     for my $line (@lines) {
 400         next if $line =~ /^#/;
 401         my ($host, $data) = $line =~ /^(\S+) (.*)$/;
 402         from_ssh_auth_line $tmp, $host, $data;
 403     }
 404 }
 405
 406 sub from_user ($) {
 407     my $user = shift;
 408     my ($name,$passwd,$uid,$gid,
 409         $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
 410     unless ($name) {
 411         warn "warning: user $user does not exist\n";
 412         return;
 413     }
 414     for my $name (qw/authorized_keys authorized_keys2
 415                      known_hosts known_hosts2
 416                      id_rsa.pub id_dsa.pub identity.pub/) {
 417         my $file = "$dir/.ssh/$name";
 418         from_ssh_auth_file $file if -r $file;
 419     }
 420 }
 421
 422 sub from_user_all () {
 423     # This was one loop initially, but does not work with some Perl
 424     # versions.
 425     setpwent;
 426     my @names;
 427     while (my $name = getpwent) {
 428         push @names, $name;
 429     }
 430     endpwent;
 431     from_user $_ for @names;
 432 }
 433
 434 if (@ARGV && $ARGV[0] eq '-c') {
 435     shift @ARGV;
 436     $db_file = shift @ARGV if @ARGV;
 437 }
 438 if (@ARGV) {
 439     open_db;
 440     my $cmd = shift @ARGV;
 441     if ($cmd eq 'file') {
 442         for my $name (@ARGV) {
 443             next if from_openvpn_key $name;
 444             next if from_pem $name;
 445             from_ssh_auth_file $name;
 446         }
 447     } elsif ($cmd eq 'host') {
 448         from_ssh_host @ARGV;
 449     } elsif ($cmd eq 'user') {
 450         if (@ARGV) {
 451             from_user $_ for @ARGV;
 452         } else {
 453             from_user_all;
 454         }
 455     } elsif ($cmd eq 'help') {
 456         help;
 457         exit 0;
 458     } elsif ($cmd eq 'version') {
 459         print "dowkd $program_version (database $db_version)\n\n$changelog";
 460         exit 0;
 461     } else {
 462         die "error: invalid command, use \"help\" to get help\n";
 463     }
 464     print_stats;
 465 } else {
 466     help;
 467     exit 1;
 468 }
 469
 470 my %hash;
 471
 472 __DATA__