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