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
  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 sub safe_backtick_stderr {
 147     my @args = @_;
 148     my $fh;
 149     my $pid = open $fh, '-|';
 150     if ($pid) {
 151         my @result = <$fh>;
 152         close $fh;
 153         $? == 0 or return undef;
 154         if (wantarray) {
 155             return @result;
 156         } else {
 157             return join('', @result);
 158         }
 159     } else {
 160         open STDERR, '>&STDOUT' or die "error: could not redirect stderr: $!";
 161         exec @args or die "exec: failed: $!";
 162     }
 163 }
 164
 165 my $keys_found = 0;
 166 my $keys_vulnerable = 0;
 167
 168 sub print_stats () {
 169     print STDERR "summary: keys found: $keys_found, weak keys: $keys_vulnerable\n";
 170 }
 171
 172 sub check_hash ($$;$) {
 173     my ($name, $hash, $descr) = @_;
 174     ++$keys_found;
 175     if (exists $db{$hash}) {
 176         ++$keys_vulnerable;
 177         $descr = $descr ? " ($descr)" : '';
 178         print "$name: weak key$descr\n";
 179     }
 180 }
 181
 182 sub ssh_fprint_file ($) {
 183     my $name = shift;
 184     my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
 185     defined $data or return ();
 186     my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
 187     return @data if @data == 2;
 188     return ();
 189 }
 190
 191 sub ssh_fprint_check ($$$$) {
 192     my ($name, $type, $length, $hash) = @_;
 193     $type =~ /^(?:rsa1?|dsa)\z/ or die;
 194     if (($type eq 'rsa'
 195          && ($length == 1024 || $length == 2048 || $length == 4096))
 196         || ($type eq 'dsa' && $length == 1024)
 197         || ($type eq 'rsa1' && ($length == 1024 || $length == 2048))) {
 198         $hash =~ y/://d;
 199         $hash =~ s/(..)/chr(hex($1))/ge;
 200         check_hash $name, $hash, "OpenSSH/$type/$length";
 201     } elsif ($type eq 'dsa') {
 202         print "$name: $length bits DSA key not recommended\n";
 203     } else {
 204         warn "$name: warning: no blacklist for $type/$length key\n";
 205     }
 206 }
 207
 208 sub clear_tmp ($) {
 209     my $tmp = shift;
 210     seek $tmp, 0, 0 or die "seek: $!";
 211     truncate $tmp, 0 or die "truncate: $!";
 212 }
 213
 214 sub cleanup_ssh_auth_line ($) {
 215     my $line = shift;
 216
 217     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 218
 219   OUTSIDE_STRING:
 220     if ($line =~ /^\s+(.*)/) {
 221         $line = $1;
 222         goto SPACE_SEEN;
 223     }
 224     if ($line =~ /^"(.*)/) {
 225         $line = $1;
 226         goto INSIDE_STRING;
 227     }
 228     if ($line =~ /^\\.(.*)/) {
 229         # It doesn't matter if we don't deal with \000 properly, we
 230         # just need to defuse the backslash character.
 231         $line = $1;
 232         goto OUTSIDE_STRING;
 233     }
 234     if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
 235         # Skip multiple harmless characters in one go.
 236         $line = $1;
 237         goto OUTSIDE_STRING;
 238     }
 239     if ($line =~ /^.(.*)/) {
 240         # Other characters are stripped one by one.
 241         $line = $1;
 242         goto OUTSIDE_STRING;
 243     }
 244     return undef;               # empty string, no key found
 245
 246   INSIDE_STRING:
 247     if ($line =~ /^"(.*)/) {
 248         $line = $1;
 249         goto OUTSIDE_STRING;
 250     }
 251     if ($line =~ /^\\.(.*)/) {
 252         # See above, defuse the backslash.
 253         $line = $1;
 254         goto INSIDE_STRING;
 255     }
 256     if ($line =~ /^[^\\"]+(.*)/) {
 257         $line = $1;
 258         goto INSIDE_STRING;
 259     }
 260     return undef;               # missing closing double quote
 261
 262   SPACE_SEEN:
 263     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 264     return undef;
 265 }
 266
 267 sub derive_ssh_auth_type ($) {
 268     my $line = shift;
 269     $line =~ /^ssh-rsa\s/ and return 'rsa';
 270     $line =~ /^ssh-dss\s/ and return 'dsa';
 271     $line =~ /^\d+\s/ and return 'rsa1';
 272     return undef;
 273 }
 274
 275 sub from_ssh_auth_line ($$$) {
 276     my ($tmp, $name, $line) = @_;
 277     chomp $line;
 278
 279     {
 280         my $l = cleanup_ssh_auth_line $line;
 281         $l or return 0;
 282         $line = $l;
 283     }
 284     my $type = derive_ssh_auth_type $line;
 285
 286     clear_tmp $tmp;
 287     print $tmp "$line\n" or die "print: $!";
 288     $tmp->flush or die "flush: $!";
 289     my ($length, $hash) = ssh_fprint_file "$tmp";
 290     if ($length && $hash) {
 291         ssh_fprint_check "$name", $type, $length, $hash;
 292         return 1;
 293     }
 294
 295     return 0;
 296 }
 297
 298 sub from_ssh_auth_file ($) {
 299     my $name = shift;
 300     my $auth;
 301     unless (open $auth, '<', $name) {
 302         warn "$name:0: error: open failed: $!\n";
 303         return;
 304     }
 305
 306     my $tmp = new File::Temp;
 307     my $last_status = 1;
 308     while (my $line = <$auth>) {
 309         next if $line =~ m/^\s*(#|$)/;
 310         my $status = from_ssh_auth_line $tmp, "$name:$.", $line;
 311         unless ($status) {
 312             $last_status and warn "$name:$.: warning: unparsable line\n";
 313         }
 314         $last_status = $status;
 315     }
 316 }
 317
 318 sub from_openvpn_key ($) {
 319     my $name = shift;
 320     my $key;
 321     unless (open $key, '<', $name) {
 322         warn "$name:0: open failed: $!\n";
 323         return 1;
 324     }
 325
 326     my $marker;
 327     while (my $line = <$key>) {
 328         return 0 if $. > 10;
 329         if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
 330             $marker = 1;
 331         } elsif ($marker) {
 332             if ($line =~ /^([0-9a-f]{32})/) {
 333                 $line = $1;
 334                 $line =~ s/(..)/chr(hex($1))/ge;
 335                 check_hash "$name:$.", $line, "OpenVPN";
 336                 return 1;
 337             } else {
 338                 warn "$name:$.: warning: illegal OpenVPN file format\n";
 339                 return 1;
 340             }
 341         }
 342     }
 343 }
 344
 345 sub openssl_modulus_check ($$) {
 346     my ($name, $modulus) = @_;
 347     chomp $modulus;
 348     if ($modulus =~ /^Modulus=([A-F0-9]+)$/) {
 349         $modulus = $1;
 350         my $length = length($modulus) * 4;
 351         if ($length == 1024 || $length == 2048) {
 352             my $mod = substr $modulus, length($modulus) - 32;
 353             $mod =~ y/A-F/a-f/;
 354             my @mod = $mod =~ /(..)/g;
 355             $mod = join('', map { chr(hex($_)) } reverse @mod);
 356             check_hash $name, $mod, "OpenSSL/RSA/$length";
 357         } else {
 358             warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
 359         }
 360     } else {
 361         die "internal error: $modulus\n";
 362     }
 363 }
 364
 365 sub from_pem ($) {
 366     my $name = shift;
 367     my $tmp;
 368     my $found = 0;
 369
 370     my $src;
 371     unless (open $src, '<', $name) {
 372         warn "$name:0: open failed: $!\n";
 373         return 1;
 374     }
 375
 376     while (my $line = <$src>) {
 377         if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
 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 if $line =~ /^-----END CERTIFICATE-----/;
 384             } while ($line = <$src>);
 385           LAST:
 386             $tmp->flush or die "flush: $!";
 387             my $mod = safe_backtick qw/openssl x509 -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 certificate\n";
 393                 return 1;
 394             }
 395         } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
 396             my $lineno = $.;
 397             $tmp or $tmp = new File::Temp;
 398             clear_tmp $tmp;
 399             do {
 400                 print $tmp $line or die "print: $!";
 401                 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
 402             } while ($line = <$src>);
 403           LAST_RSA:
 404             $tmp->flush or die "flush: $!";
 405             my $mod = safe_backtick qw/openssl rsa -noout -modulus -in/, $tmp;
 406             if ($mod) {
 407                 openssl_modulus_check "$name:$lineno", $mod;
 408                 $found = 1;
 409             } else {
 410                 warn "$name:$lineno: failed to parse RSA private key\n";
 411                 return 1;
 412             }
 413         }
 414     }
 415
 416     return $found;
 417 }
 418
 419 sub from_ssh_host ($@) {
 420     my ($port, @names) = @_;
 421
 422     @names = grep {
 423         my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
 424         @addrs or warn "warning: host not found: $_\n";
 425         @addrs > 0;
 426     } @names;
 427
 428     my @lines= safe_backtick_stderr qw/ssh-keyscan -t/, 'rsa1,rsa,dsa',
 429         '-p', $port, @names;
 430
 431     my $tmp = new File::Temp;
 432     for my $line (@lines) {
 433         next if $line =~ /^(?:#|no hostkey alg)/;
 434         my ($host, $data) = $line =~ /^(\S+) (.*)$/;
 435         $host && from_ssh_auth_line $tmp, $host, $data
 436             or die "$host: warning: unparsable line: $line";
 437     }
 438 }
 439
 440 sub from_user ($) {
 441     my $user = shift;
 442     my ($name,$passwd,$uid,$gid,
 443         $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
 444     unless ($name) {
 445         warn "warning: user $user does not exist\n";
 446         return;
 447     }
 448     for my $name (qw/authorized_keys authorized_keys2
 449                      known_hosts known_hosts2
 450                      id_rsa.pub id_dsa.pub identity.pub/) {
 451         my $file = "$dir/.ssh/$name";
 452         from_ssh_auth_file $file if -r $file;
 453     }
 454 }
 455
 456 sub from_user_all () {
 457     # This was one loop initially, but does not work with some Perl
 458     # versions.
 459     setpwent;
 460     my @names;
 461     while (my $name = getpwent) {
 462         push @names, $name;
 463     }
 464     endpwent;
 465     from_user $_ for @names;
 466 }
 467
 468 sub from_any_file ($) {
 469     my $name = shift;
 470     from_openvpn_key $name and return;
 471     from_pem $name and return;
 472     from_ssh_auth_file $name;
 473 }
 474
 475 sub from_etc () {
 476     my $find;
 477     open $find, '-|', qw!find /etc -type f (
 478             -name *.key -o -name *.pem -o -name *.crt
 479         ) -print0! or die "error: could not spawn find: $!";
 480     my @files;
 481     {
 482         local $/ = "\0";
 483         @files = <$find>;
 484     }
 485     close $find;
 486     $? == 0 or die "error: find failed with exit status $?\n";
 487     for my $file (@files) {
 488         -e $file and from_any_file $file;
 489     }
 490 }
 491
 492 if (@ARGV && $ARGV[0] eq '-c') {
 493     shift @ARGV;
 494     $db_file = shift @ARGV if @ARGV;
 495 }
 496 if (@ARGV) {
 497     open_db;
 498     my $cmd = shift @ARGV;
 499     if ($cmd eq 'file') {
 500         for my $name (@ARGV) {
 501             from_any_file $name;
 502         }
 503     } elsif ($cmd eq 'host') {
 504         unless (@ARGV) {
 505             help;
 506             exit 1;
 507         }
 508         my $port = 22;
 509         if ($ARGV[0] eq '-p') {
 510             shift @ARGV;
 511             if (@ARGV) {
 512                 $port = shift @ARGV;
 513             }
 514         } elsif ($ARGV[0] =~ /-p(\d+)/) {
 515             $port = $1;
 516             shift @ARGV;
 517         }
 518         unless (@ARGV) {
 519             help;
 520             exit 1;
 521         }
 522         from_ssh_host $port, @ARGV;
 523     } elsif ($cmd eq 'user') {
 524         if (@ARGV) {
 525             from_user $_ for @ARGV;
 526         } else {
 527             from_user_all;
 528         }
 529     } elsif ($cmd eq 'quick') {
 530         from_user_all;
 531         for my $file (qw/ssh_host_rsa_key.pub ssh_host_dsa_key.pub
 532                         ssh_host_key ssh_known_hosts ssh_known_hosts2/) {
 533             -e $file and from_ssh_auth_file $file;
 534         }
 535         from_etc;
 536     } elsif ($cmd eq 'help') {
 537         help;
 538         exit 0;
 539     } elsif ($cmd eq 'version') {
 540         print "dowkd $program_version (database $db_version)\n\n";
 541         print <<'EOF';
 542 ChangeLog:
 543 @CHANGELOG@
 544 EOF
 545         exit 0;
 546     } else {
 547         die "error: invalid command, use \"help\" to get help\n";
 548     }
 549     print_stats;
 550 } else {
 551     help;
 552     exit 1;
 553 }
 554
 555 __DATA__