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          (change destination port with "host -p PORT HOST...")
  40   user:  examine user SSH keys for weakness; examine all users if no
  41          users are given
  42   quick: check this host for weak keys (encompasses "user" plus
  43          heuristics to find keys in /etc)
  44   help:  show this help screen
  45   version: show version information
  46
  47 OPTIONS is one of:
  48
  49   -c FILE: set the database cache file name (default: dowkd.db)
  50
  51 dowkd currently handles the following OpenSSH host and user keys,
  52 provided they have been generated on a little-endian architecture
  53 (such as i386 or amd64):
  54
  55   RSA/1024, RSA/2048 (both rsa1 and rsa format)
  56   DSA/1024
  57
  58 (The relevant OpenSSH versions in Debian do not support DSA key
  59 generation with other sizes.)
  60
  61 OpenVPN shared also detected if they have been created on
  62 little-endian architectures.
  63
  64 Unencrypted RSA private keys and PEM certificate files generated by
  65 OpenSSL are detected, provided they use key lengths of 1024 or 2048
  66 bits (again, only for little-endian architectures).
  67
  68 Note that the blacklist by dowkd may be incomplete; it is only
  69 intended as a quick check.
  70
  71 EOF
  72 }
  73
  74 use DB_File;
  75 use File::Temp;
  76 use Fcntl;
  77 use IO::Handle;
  78
  79 my $db_version = '@DB_VERSION@';
  80 my $program_version = '@PROGRAM_VERSION@';
  81 my $changelog = <<'EOF';
  82 ChangeLog:
  83 @CHANGELOG@
  84 EOF
  85
  86 my $db_file = 'dowkd.db';
  87
  88 my $db;
  89 my %db;
  90
  91 sub create_db () {
  92     warn "notice: creating database, please wait\n";
  93     $db = tie %db, 'DB_File', $db_file, O_RDWR | O_CREAT, 0777, $DB_BTREE
  94         or die "error: could not open database: $!\n";
  95
  96     my $found;
  97     while (my $line = <DATA>) {
  98         next if $line =~ /^\**$/;
  99         chomp $line;
 100         $line =~ /^[0-9a-f]{32}$/ or die "error: invalid data line";
 101         $line =~ s/(..)/chr(hex($1))/ge;
 102         $db{$line} = '';
 103         $found = 1;
 104     }
 105     $found or die "error: no blacklist data found in script\n";
 106
 107     # Set at the end so that no incomplete database is left behind.
 108     $db{''} = $db_version;
 109
 110     $db->sync;
 111 }
 112
 113 sub open_db () {
 114     if (-r $db_file) {
 115         $db = tie %db, 'DB_File', $db_file, O_RDONLY, 0777, $DB_BTREE
 116             or die "error: could not open database: $!\n";
 117         my $stored_version = $db{''};
 118         $stored_version && $stored_version eq $db_version or create_db;
 119     } else {
 120         unlink $db_file;
 121         create_db;
 122     }
 123 }
 124
 125 sub safe_backtick (@) {
 126     my @args = @_;
 127     my $fh;
 128     open $fh, '-|', @args
 129         or die "error: failed to spawn $args[0]: $!\n";
 130     my @result;
 131     if (wantarray) {
 132         @result = <$fh>;
 133     } else {
 134         local $/;
 135         @result = scalar(<$fh>);
 136     }
 137     close $fh;
 138     $? == 0 or return undef;
 139     if (wantarray) {
 140         return @result;
 141     } else {
 142         return $result[0];
 143     }
 144 }
 145
 146 my $keys_found = 0;
 147 my $keys_vulnerable = 0;
 148
 149 sub print_stats () {
 150     print STDERR "summary: keys found: $keys_found, weak keys: $keys_vulnerable\n";
 151 }
 152
 153 sub check_hash ($$;$) {
 154     my ($name, $hash, $descr) = @_;
 155     ++$keys_found;
 156     if (exists $db{$hash}) {
 157         ++$keys_vulnerable;
 158         $descr = $descr ? " ($descr)" : '';
 159         print "$name: weak key$descr\n";
 160     }
 161 }
 162
 163 sub ssh_fprint_file ($) {
 164     my $name = shift;
 165     my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
 166     defined $data or return ();
 167     my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
 168     return @data if @data == 2;
 169     return ();
 170 }
 171
 172 sub ssh_fprint_check ($$$$) {
 173     my ($name, $type, $length, $hash) = @_;
 174     $type =~ /^(?:rsa1?|dsa)\z/ or die;
 175     if (($type eq 'rsa'
 176          && ($length == 1024 || $length == 2048 || $length == 4096))
 177         || ($type eq 'dsa' && $length == 1024)
 178         || ($type eq 'rsa1' && $length == 1024)) {
 179         $hash =~ y/://d;
 180         $hash =~ s/(..)/chr(hex($1))/ge;
 181         check_hash $name, $hash, "OpenSSH/$type/$length";
 182     } elsif ($type eq 'dsa') {
 183         print "$name: $length bits DSA key not recommended\n";
 184     } else {
 185         warn "$name: warning: no blacklist for $type/$length key\n";
 186     }
 187 }
 188
 189 sub clear_tmp ($) {
 190     my $tmp = shift;
 191     seek $tmp, 0, 0 or die "seek: $!";
 192     truncate $tmp, 0 or die "truncate: $!";
 193 }
 194
 195 sub cleanup_ssh_auth_line ($) {
 196     my $line = shift;
 197
 198     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 199
 200   OUTSIDE_STRING:
 201     if ($line =~ /^\s+(.*)/) {
 202         $line = $1;
 203         goto SPACE_SEEN;
 204     }
 205     if ($line =~ /^"(.*)/) {
 206         $line = $1;
 207         goto INSIDE_STRING;
 208     }
 209     if ($line =~ /^\\.(.*)/) {
 210         # It doesn't matter if we don't deal with \000 properly, we
 211         # just need to defuse the backslash character.
 212         $line = $1;
 213         goto OUTSIDE_STRING;
 214     }
 215     if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
 216         # Skip multiple harmless characters in one go.
 217         $line = $1;
 218         goto OUTSIDE_STRING;
 219     }
 220     if ($line =~ /^.(.*)/) {
 221         # Other characters are stripped one by one.
 222         $line = $1;
 223         goto OUTSIDE_STRING;
 224     }
 225     return undef;               # empty string, no key found
 226
 227   INSIDE_STRING:
 228     if ($line =~ /^"(.*)/) {
 229         $line = $1;
 230         goto OUTSIDE_STRING;
 231     }
 232     if ($line =~ /^\\.(.*)/) {
 233         # See above, defuse the backslash.
 234         $line = $1;
 235         goto INSIDE_STRING;
 236     }
 237     if ($line =~ /^[^\\"]+(.*)/) {
 238         $line = $1;
 239         goto INSIDE_STRING;
 240     }
 241     return undef;               # missing closing double quote
 242
 243   SPACE_SEEN:
 244     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 245     return undef;
 246 }
 247
 248 sub derive_ssh_auth_type ($) {
 249     my $line = shift;
 250     $line =~ /^ssh-rsa\s/ and return 'rsa';
 251     $line =~ /^ssh-dss\s/ and return 'dsa';
 252     $line =~ /^\d+\s/ and return 'rsa1';
 253     return undef;
 254 }
 255
 256 sub from_ssh_auth_line ($$$) {
 257     my ($tmp, $name, $line) = @_;
 258     chomp $line;
 259
 260     {
 261         my $l = cleanup_ssh_auth_line $line;
 262         $l or return 0;
 263         $line = $l;
 264     }
 265     my $type = derive_ssh_auth_type $line;
 266
 267     clear_tmp $tmp;
 268     print $tmp "$line\n" or die "print: $!";
 269     $tmp->flush or die "flush: $!";
 270     my ($length, $hash) = ssh_fprint_file "$tmp";
 271     if ($length && $hash) {
 272         ssh_fprint_check "$name", $type, $length, $hash;
 273         return 1;
 274     }
 275
 276     return 0;
 277 }
 278
 279 sub from_ssh_auth_file ($) {
 280     my $name = shift;
 281     my $auth;
 282     unless (open $auth, '<', $name) {
 283         warn "$name:0: error: open failed: $!\n";
 284         return;
 285     }
 286
 287     my $tmp = new File::Temp;
 288     my $last_status = 1;
 289     while (my $line = <$auth>) {
 290         next if $line =~ m/^\s*(#|$)/;
 291         my $status = from_ssh_auth_line $tmp, "$name:$.", $line;
 292         unless ($status) {
 293             $last_status and warn "$name:$.: warning: unparsable line\n";
 294         }
 295         $last_status = $status;
 296     }
 297 }
 298
 299 sub from_openvpn_key ($) {
 300     my $name = shift;
 301     my $key;
 302     unless (open $key, '<', $name) {
 303         warn "$name:0: open failed: $!\n";
 304         return 1;
 305     }
 306
 307     my $marker;
 308     while (my $line = <$key>) {
 309         return 0 if $. > 10;
 310         if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
 311             $marker = 1;
 312         } elsif ($marker) {
 313             if ($line =~ /^([0-9a-f]{32})/) {
 314                 $line = $1;
 315                 $line =~ s/(..)/chr(hex($1))/ge;
 316                 check_hash "$name:$.", $line, "OpenVPN";
 317                 return 1;
 318             } else {
 319                 warn "$name:$.: warning: illegal OpenVPN file format\n";
 320                 return 1;
 321             }
 322         }
 323     }
 324 }
 325
 326 sub openssl_modulus_check ($$) {
 327     my ($name, $modulus) = @_;
 328     chomp $modulus;
 329     if ($modulus =~ /^Modulus=([A-F0-9]+)$/) {
 330         $modulus = $1;
 331         my $length = length($modulus) * 4;
 332         if ($length == 1024 || $length == 2048) {
 333             my $mod = substr $modulus, length($modulus) - 32;
 334             $mod =~ y/A-F/a-f/;
 335             my @mod = $mod =~ /(..)/g;
 336             $mod = join('', map { chr(hex($_)) } reverse @mod);
 337             check_hash $name, $mod, "OpenSSL/RSA/$length";
 338         } else {
 339             warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
 340         }
 341     } else {
 342         die "internal error: $modulus\n";
 343     }
 344 }
 345
 346 sub from_pem ($) {
 347     my $name = shift;
 348     my $tmp;
 349     my $found = 0;
 350
 351     my $src;
 352     unless (open $src, '<', $name) {
 353         warn "$name:0: open failed: $!\n";
 354         return 1;
 355     }
 356
 357     while (my $line = <$src>) {
 358         if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
 359             my $lineno = $.;
 360             $tmp or $tmp = new File::Temp;
 361             clear_tmp $tmp;
 362             do {
 363                 print $tmp $line or die "print: $!";
 364                 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
 365             } while ($line = <$src>);
 366           LAST:
 367             $tmp->flush or die "flush: $!";
 368             my $mod = safe_backtick qw/openssl x509 -noout -modulus -in/, $tmp;
 369             if ($mod) {
 370                 openssl_modulus_check "$name:$lineno", $mod;
 371                 $found = 1;
 372             } else {
 373                 warn "$name:$lineno: failed to parse certificate\n";
 374                 return 1;
 375             }
 376         } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
 377             my $lineno = $.;
 378             $tmp or $tmp = new File::Temp;
 379             clear_tmp $tmp;
 380             do {
 381                 print $tmp $line or die "print: $!";
 382                 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
 383             } while ($line = <$src>);
 384           LAST_RSA:
 385             $tmp->flush or die "flush: $!";
 386             my $mod = safe_backtick qw/openssl rsa -noout -modulus -in/, $tmp;
 387             if ($mod) {
 388                 openssl_modulus_check "$name:$lineno", $mod;
 389                 $found = 1;
 390             } else {
 391                 warn "$name:$lineno: failed to parse RSA private key\n";
 392                 return 1;
 393             }
 394         }
 395     }
 396
 397     return $found;
 398 }
 399
 400 sub from_ssh_host ($@) {
 401     my ($port, @names) = @_;
 402
 403     @names = grep {
 404         my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
 405         @addrs or warn "warning: host not found: $_\n";
 406         @addrs > 0;
 407     } @names;
 408
 409     my @lines;
 410     push @lines, safe_backtick qw/ssh-keyscan -t rsa -p/, $port, @names;
 411     push @lines, safe_backtick qw/ssh-keyscan -t dsa -p/, $port, @names;
 412
 413     my $tmp = new File::Temp;
 414     for my $line (@lines) {
 415         next if $line =~ /^#/;
 416         my ($host, $data) = $line =~ /^(\S+) (.*)$/;
 417         from_ssh_auth_line $tmp, $host, $data
 418             or die "$host: warning: unparsable line\n";
 419     }
 420 }
 421
 422 sub from_user ($) {
 423     my $user = shift;
 424     my ($name,$passwd,$uid,$gid,
 425         $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
 426     unless ($name) {
 427         warn "warning: user $user does not exist\n";
 428         return;
 429     }
 430     for my $name (qw/authorized_keys authorized_keys2
 431                      known_hosts known_hosts2
 432                      id_rsa.pub id_dsa.pub identity.pub/) {
 433         my $file = "$dir/.ssh/$name";
 434         from_ssh_auth_file $file if -r $file;
 435     }
 436 }
 437
 438 sub from_user_all () {
 439     # This was one loop initially, but does not work with some Perl
 440     # versions.
 441     setpwent;
 442     my @names;
 443     while (my $name = getpwent) {
 444         push @names, $name;
 445     }
 446     endpwent;
 447     from_user $_ for @names;
 448 }
 449
 450 sub from_any_file ($) {
 451     my $name = shift;
 452     from_openvpn_key $name and return;
 453     from_pem $name and return;
 454     from_ssh_auth_file $name;
 455 }
 456
 457 sub from_etc () {
 458     my $find;
 459     open $find, '-|', qw!find /etc -type f (
 460             -name *.key -o -name *.pem -o -name *.crt
 461         ) -print0! or die "error: could not spawn find: $!";
 462     my @files;
 463     {
 464         local $/ = "\0";
 465         @files = <$find>;
 466     }
 467     close $find;
 468     $? == 0 or die "error: find failed with exit status $?\n";
 469     for my $file (@files) {
 470         -e $file and from_any_file $file;
 471     }
 472 }
 473
 474 if (@ARGV && $ARGV[0] eq '-c') {
 475     shift @ARGV;
 476     $db_file = shift @ARGV if @ARGV;
 477 }
 478 if (@ARGV) {
 479     open_db;
 480     my $cmd = shift @ARGV;
 481     if ($cmd eq 'file') {
 482         for my $name (@ARGV) {
 483             from_any_file $name;
 484         }
 485     } elsif ($cmd eq 'host') {
 486         unless (@ARGV) {
 487             help;
 488             exit 1;
 489         }
 490         my $port = 22;
 491         if ($ARGV[0] eq '-p') {
 492             shift @ARGV;
 493             if (@ARGV) {
 494                 $port = shift @ARGV;
 495             }
 496         } elsif ($ARGV[0] =~ /-p(\d+)/) {
 497             $port = $1;
 498             shift @ARGV;
 499         }
 500         unless (@ARGV) {
 501             help;
 502             exit 1;
 503         }
 504         from_ssh_host $port, @ARGV;
 505     } elsif ($cmd eq 'user') {
 506         if (@ARGV) {
 507             from_user $_ for @ARGV;
 508         } else {
 509             from_user_all;
 510         }
 511     } elsif ($cmd eq 'quick') {
 512         from_user_all;
 513         for my $file (qw/ssh_host_rsa_key.pub ssh_host_dsa_key.pub
 514                         ssh_host_key known_hosts known_hosts2/) {
 515             -e $file and from_ssh_auth_file $file;
 516         }
 517         from_etc;
 518     } elsif ($cmd eq 'help') {
 519         help;
 520         exit 0;
 521     } elsif ($cmd eq 'version') {
 522         print "dowkd $program_version (database $db_version)\n\n$changelog";
 523         exit 0;
 524     } else {
 525         die "error: invalid command, use \"help\" to get help\n";
 526     }
 527     print_stats;
 528 } else {
 529     help;
 530     exit 1;
 531 }
 532
 533 my %hash;
 534
 535 __DATA__