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, RSA1/1024, RSA1/2048
  56   RSA/4096
  57   DSA/1024
  58
  59 (The relevant OpenSSH versions in Debian do not support DSA key
  60 generation with other sizes.)
  61
  62 OpenVPN shared also detected if they have been created on
  63 little-endian architectures.
  64
  65 Unencrypted RSA private keys and PEM certificate files generated by
  66 OpenSSL are detected, provided they use key lengths of 1024 or 2048
  67 bits (again, only for little-endian architectures).
  68
  69 Note that the blacklist by dowkd may be incomplete; it is only
  70 intended as a quick check.
  71
  72 EOF
  73 }
  74
  75 use DB_File;
  76 use File::Temp;
  77 use Fcntl;
  78 use IO::Handle;
  79
  80 my $db_version = '@DB_VERSION@';
  81 my $program_version = '@PROGRAM_VERSION@';
  82 my $changelog = <<'EOF';
  83 ChangeLog:
  84 @CHANGELOG@
  85 EOF
  86
  87 my $db_file = 'dowkd.db';
  88
  89 my $db;
  90 my %db;
  91
  92 sub create_db () {
  93     warn "notice: creating database, please wait\n";
  94     $db = tie %db, 'DB_File', $db_file, O_RDWR | O_CREAT, 0777, $DB_BTREE
  95         or die "error: could not open database: $!\n";
  96
  97     my $found;
  98     while (my $line = <DATA>) {
  99         next if $line =~ /^\**$/;
 100         chomp $line;
 101         $line =~ /^[0-9a-f]{32}$/ or die "error: invalid data line";
 102         $line =~ s/(..)/chr(hex($1))/ge;
 103         $db{$line} = '';
 104         $found = 1;
 105     }
 106     $found or die "error: no blacklist data found in script\n";
 107
 108     # Set at the end so that no incomplete database is left behind.
 109     $db{''} = $db_version;
 110
 111     $db->sync;
 112 }
 113
 114 sub open_db () {
 115     if (-r $db_file) {
 116         $db = tie %db, 'DB_File', $db_file, O_RDONLY, 0777, $DB_BTREE
 117             or die "error: could not open database: $!\n";
 118         my $stored_version = $db{''};
 119         $stored_version && $stored_version eq $db_version or create_db;
 120     } else {
 121         unlink $db_file;
 122         create_db;
 123     }
 124 }
 125
 126 sub safe_backtick (@) {
 127     my @args = @_;
 128     my $fh;
 129     open $fh, '-|', @args
 130         or die "error: failed to spawn $args[0]: $!\n";
 131     my @result;
 132     if (wantarray) {
 133         @result = <$fh>;
 134     } else {
 135         local $/;
 136         @result = scalar(<$fh>);
 137     }
 138     close $fh;
 139     $? == 0 or return undef;
 140     if (wantarray) {
 141         return @result;
 142     } else {
 143         return $result[0];
 144     }
 145 }
 146
 147 my $keys_found = 0;
 148 my $keys_vulnerable = 0;
 149
 150 sub print_stats () {
 151     print STDERR "summary: keys found: $keys_found, weak keys: $keys_vulnerable\n";
 152 }
 153
 154 sub check_hash ($$;$) {
 155     my ($name, $hash, $descr) = @_;
 156     ++$keys_found;
 157     if (exists $db{$hash}) {
 158         ++$keys_vulnerable;
 159         $descr = $descr ? " ($descr)" : '';
 160         print "$name: weak key$descr\n";
 161     }
 162 }
 163
 164 sub ssh_fprint_file ($) {
 165     my $name = shift;
 166     my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
 167     defined $data or return ();
 168     my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
 169     return @data if @data == 2;
 170     return ();
 171 }
 172
 173 sub ssh_fprint_check ($$$$) {
 174     my ($name, $type, $length, $hash) = @_;
 175     $type =~ /^(?:rsa1?|dsa)\z/ or die;
 176     if (($type eq 'rsa'
 177          && ($length == 1024 || $length == 2048 || $length == 4096))
 178         || ($type eq 'dsa' && $length == 1024)
 179         || ($type eq 'rsa1' && ($length == 1024 || $length == 2048))) {
 180         $hash =~ y/://d;
 181         $hash =~ s/(..)/chr(hex($1))/ge;
 182         check_hash $name, $hash, "OpenSSH/$type/$length";
 183     } elsif ($type eq 'dsa') {
 184         print "$name: $length bits DSA key not recommended\n";
 185     } else {
 186         warn "$name: warning: no blacklist for $type/$length key\n";
 187     }
 188 }
 189
 190 sub clear_tmp ($) {
 191     my $tmp = shift;
 192     seek $tmp, 0, 0 or die "seek: $!";
 193     truncate $tmp, 0 or die "truncate: $!";
 194 }
 195
 196 sub cleanup_ssh_auth_line ($) {
 197     my $line = shift;
 198
 199     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 200
 201   OUTSIDE_STRING:
 202     if ($line =~ /^\s+(.*)/) {
 203         $line = $1;
 204         goto SPACE_SEEN;
 205     }
 206     if ($line =~ /^"(.*)/) {
 207         $line = $1;
 208         goto INSIDE_STRING;
 209     }
 210     if ($line =~ /^\\.(.*)/) {
 211         # It doesn't matter if we don't deal with \000 properly, we
 212         # just need to defuse the backslash character.
 213         $line = $1;
 214         goto OUTSIDE_STRING;
 215     }
 216     if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
 217         # Skip multiple harmless characters in one go.
 218         $line = $1;
 219         goto OUTSIDE_STRING;
 220     }
 221     if ($line =~ /^.(.*)/) {
 222         # Other characters are stripped one by one.
 223         $line = $1;
 224         goto OUTSIDE_STRING;
 225     }
 226     return undef;               # empty string, no key found
 227
 228   INSIDE_STRING:
 229     if ($line =~ /^"(.*)/) {
 230         $line = $1;
 231         goto OUTSIDE_STRING;
 232     }
 233     if ($line =~ /^\\.(.*)/) {
 234         # See above, defuse the backslash.
 235         $line = $1;
 236         goto INSIDE_STRING;
 237     }
 238     if ($line =~ /^[^\\"]+(.*)/) {
 239         $line = $1;
 240         goto INSIDE_STRING;
 241     }
 242     return undef;               # missing closing double quote
 243
 244   SPACE_SEEN:
 245     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 246     return undef;
 247 }
 248
 249 sub derive_ssh_auth_type ($) {
 250     my $line = shift;
 251     $line =~ /^ssh-rsa\s/ and return 'rsa';
 252     $line =~ /^ssh-dss\s/ and return 'dsa';
 253     $line =~ /^\d+\s/ and return 'rsa1';
 254     return undef;
 255 }
 256
 257 sub from_ssh_auth_line ($$$) {
 258     my ($tmp, $name, $line) = @_;
 259     chomp $line;
 260
 261     {
 262         my $l = cleanup_ssh_auth_line $line;
 263         $l or return 0;
 264         $line = $l;
 265     }
 266     my $type = derive_ssh_auth_type $line;
 267
 268     clear_tmp $tmp;
 269     print $tmp "$line\n" or die "print: $!";
 270     $tmp->flush or die "flush: $!";
 271     my ($length, $hash) = ssh_fprint_file "$tmp";
 272     if ($length && $hash) {
 273         ssh_fprint_check "$name", $type, $length, $hash;
 274         return 1;
 275     }
 276
 277     return 0;
 278 }
 279
 280 sub from_ssh_auth_file ($) {
 281     my $name = shift;
 282     my $auth;
 283     unless (open $auth, '<', $name) {
 284         warn "$name:0: error: open failed: $!\n";
 285         return;
 286     }
 287
 288     my $tmp = new File::Temp;
 289     my $last_status = 1;
 290     while (my $line = <$auth>) {
 291         next if $line =~ m/^\s*(#|$)/;
 292         my $status = from_ssh_auth_line $tmp, "$name:$.", $line;
 293         unless ($status) {
 294             $last_status and warn "$name:$.: warning: unparsable line\n";
 295         }
 296         $last_status = $status;
 297     }
 298 }
 299
 300 sub from_openvpn_key ($) {
 301     my $name = shift;
 302     my $key;
 303     unless (open $key, '<', $name) {
 304         warn "$name:0: open failed: $!\n";
 305         return 1;
 306     }
 307
 308     my $marker;
 309     while (my $line = <$key>) {
 310         return 0 if $. > 10;
 311         if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
 312             $marker = 1;
 313         } elsif ($marker) {
 314             if ($line =~ /^([0-9a-f]{32})/) {
 315                 $line = $1;
 316                 $line =~ s/(..)/chr(hex($1))/ge;
 317                 check_hash "$name:$.", $line, "OpenVPN";
 318                 return 1;
 319             } else {
 320                 warn "$name:$.: warning: illegal OpenVPN file format\n";
 321                 return 1;
 322             }
 323         }
 324     }
 325 }
 326
 327 sub openssl_modulus_check ($$) {
 328     my ($name, $modulus) = @_;
 329     chomp $modulus;
 330     if ($modulus =~ /^Modulus=([A-F0-9]+)$/) {
 331         $modulus = $1;
 332         my $length = length($modulus) * 4;
 333         if ($length == 1024 || $length == 2048) {
 334             my $mod = substr $modulus, length($modulus) - 32;
 335             $mod =~ y/A-F/a-f/;
 336             my @mod = $mod =~ /(..)/g;
 337             $mod = join('', map { chr(hex($_)) } reverse @mod);
 338             check_hash $name, $mod, "OpenSSL/RSA/$length";
 339         } else {
 340             warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
 341         }
 342     } else {
 343         die "internal error: $modulus\n";
 344     }
 345 }
 346
 347 sub from_pem ($) {
 348     my $name = shift;
 349     my $tmp;
 350     my $found = 0;
 351
 352     my $src;
 353     unless (open $src, '<', $name) {
 354         warn "$name:0: open failed: $!\n";
 355         return 1;
 356     }
 357
 358     while (my $line = <$src>) {
 359         if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
 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 if $line =~ /^-----END CERTIFICATE-----/;
 366             } while ($line = <$src>);
 367           LAST:
 368             $tmp->flush or die "flush: $!";
 369             my $mod = safe_backtick qw/openssl x509 -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 certificate\n";
 375                 return 1;
 376             }
 377         } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
 378             my $lineno = $.;
 379             $tmp or $tmp = new File::Temp;
 380             clear_tmp $tmp;
 381             do {
 382                 print $tmp $line or die "print: $!";
 383                 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
 384             } while ($line = <$src>);
 385           LAST_RSA:
 386             $tmp->flush or die "flush: $!";
 387             my $mod = safe_backtick qw/openssl rsa -noout -modulus -in/, $tmp;
 388             if ($mod) {
 389                 openssl_modulus_check "$name:$lineno", $mod;
 390                 $found = 1;
 391             } else {
 392                 warn "$name:$lineno: failed to parse RSA private key\n";
 393                 return 1;
 394             }
 395         }
 396     }
 397
 398     return $found;
 399 }
 400
 401 sub from_ssh_host ($@) {
 402     my ($port, @names) = @_;
 403
 404     @names = grep {
 405         my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
 406         @addrs or warn "warning: host not found: $_\n";
 407         @addrs > 0;
 408     } @names;
 409
 410     my @lines= safe_backtick qw/ssh-keyscan -t/, 'rsa1,rsa,dsa', '-p',
 411         $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 ssh_known_hosts ssh_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__