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