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