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