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