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