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 use strict;
  29 use warnings;
  30
  31 sub help () {
  32     print <<EOF;
  33 usage: $0 [OPTIONS...] COMMAND [ARGUMENTS...]
  34
  35 COMMAND is one of:
  36
  37   file: examine files on the command line for weak keys
  38   host: examine the specified hosts for weak SSH keys
  39   user: examine user SSH keys for weakness; examine all users if no
  40         users are given
  41   help: show this help screen
  42   version: show version information
  43
  44 OPTIONS is one pf:
  45
  46   -c FILE: set the database cache file name (default: dowkd.db)
  47
  48 dowkd currently handles the following OpenSSH host and user keys,
  49 provided they have been generated on a little-endian architecture
  50 (such as i386 or amd64): RSA/1024 (both rsa1 and rsa format), RSA/2048
  51 and DSA/1024.  (The relevant OpenSSH versions in Debian do not support
  52 DSA key generation with other sizes.)
  53
  54 OpenVPN shared also detected on little-endian architecture.
  55
  56 Unencrypted RSA private keys and PEM certificate files generated by
  57 OpenSSL are detected, provided they use key lengths of 1024 or 2048
  58 bits.
  59
  60 Note that the blacklist by dowkd may be incomplete; it is only
  61 intended as a quick check.
  62
  63 EOF
  64 }
  65
  66 use DB_File;
  67 use File::Temp;
  68 use Fcntl;
  69 use IO::Handle;
  70
  71 my $db_version = '@DB_VERSION@';
  72 my $program_version = '@PROGRAM_VERSION@';
  73
  74 my $db_file = 'dowkd.db';
  75
  76 my $db;
  77 my %db;
  78
  79 sub create_db () {
  80     warn "notice: creating database, please wait\n";
  81     $db = tie %db, 'DB_File', $db_file, O_RDWR | O_CREAT, 0777, $DB_BTREE
  82         or die "error: could not open database: $!\n";
  83
  84     $db{''} = $db_version;
  85     while (my $line = <DATA>) {
  86         next if $line =~ /^\**$/;
  87         chomp $line;
  88         $line =~ /^[0-9a-f]{32}$/ or die "error: invalid data line";
  89         $line =~ s/(..)/chr(hex($1))/ge;
  90         $db{$line} = '';
  91     }
  92
  93     $db->sync;
  94 }
  95
  96 sub open_db () {
  97     if (-r $db_file) {
  98         $db = tie %db, 'DB_File', $db_file, O_RDONLY, 0777, $DB_BTREE
  99             or die "error: could not open database: $!\n";
 100         my $stored_version = $db{''};
 101         $stored_version && $stored_version eq $db_version or create_db;
 102     } else {
 103         unlink $db_file;
 104         create_db;
 105     }
 106 }
 107
 108 sub safe_backtick (@) {
 109     my @args = @_;
 110     my $fh;
 111     open $fh, '-|', @args
 112         or die "error: failed to spawn $args[0]: $!\n";
 113     my @result;
 114     if (wantarray) {
 115         @result = <$fh>;
 116     } else {
 117         local $/;
 118         @result = scalar(<$fh>);
 119     }
 120     close $fh;
 121     $? == 0 or return undef;
 122     if (wantarray) {
 123         return @result;
 124     } else {
 125         return $result[0];
 126     }
 127 }
 128
 129 my $keys_found = 0;
 130 my $keys_vulnerable = 0;
 131
 132 sub print_stats () {
 133     print STDERR "summary: keys found: $keys_found, weak keys: $keys_vulnerable\n";
 134 }
 135
 136 sub check_hash ($$;$) {
 137     my ($name, $hash, $descr) = @_;
 138     ++$keys_found;
 139     if (exists $db{$hash}) {
 140         ++$keys_vulnerable;
 141         $descr = $descr ? " ($descr)" : '';
 142         print "$name: weak key$descr\n";
 143     }
 144 }
 145
 146 sub ssh_fprint_file ($) {
 147     my $name = shift;
 148     my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
 149     defined $data or return ();
 150     my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
 151     return @data if @data == 2;
 152     return ();
 153 }
 154
 155 sub ssh_fprint_check ($$$$) {
 156     my ($name, $type, $length, $hash) = @_;
 157     $type =~ /^(?:rsa1?|dsa)\z/ or die;
 158     if (($type eq 'rsa' && ($length == 1024 || $length == 2048))
 159         || ($type eq 'dsa' && $length == 1024)
 160         || ($type eq 'rsa1' && $length == 1024)) {
 161         $hash =~ y/://d;
 162         $hash =~ s/(..)/chr(hex($1))/ge;
 163         check_hash $name, $hash, "OpenSSH/$type/$length";
 164     } elsif ($type eq 'dsa') {
 165         print "$name: $length bits DSA key not recommended\n";
 166     } else {
 167         warn "$name: warning: no blacklist for $type/$length key\n";
 168     }
 169 }
 170
 171 sub clear_tmp ($) {
 172     my $tmp = shift;
 173     seek $tmp, 0, 0 or die "seek: $!";
 174     truncate $tmp, 0 or die "truncate: $!";
 175 }
 176
 177 sub cleanup_ssh_auth_line ($) {
 178     my $line = shift;
 179
 180     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 181
 182   OUTSIDE_STRING:
 183     if ($line =~ /^\s+(.*)/) {
 184         $line = $1;
 185         goto SPACE_SEEN;
 186     }
 187     if ($line =~ /^"(.*)/) {
 188         $line = $1;
 189         goto INSIDE_STRING;
 190     }
 191     if ($line =~ /^\\.(.*)/) {
 192         # It doesn't matter if we don't deal with \000 properly, we
 193         # just need to defuse the backslash character.
 194         $line = $1;
 195         goto OUTSIDE_STRING;
 196     }
 197     if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
 198         # Skip multiple harmless characters in one go.
 199         $line = $1;
 200         goto OUTSIDE_STRING;
 201     }
 202     if ($line =~ /^.(.*)/) {
 203         # Other characters are stripped one by one.
 204         $line = $1;
 205         goto OUTSIDE_STRING;
 206     }
 207     return undef;               # empty string, no key found
 208
 209   INSIDE_STRING:
 210     if ($line =~ /^"(.*)/) {
 211         $line = $1;
 212         goto OUTSIDE_STRING;
 213     }
 214     if ($line =~ /^\\.(.*)/) {
 215         # See above, defuse the backslash.
 216         $line = $1;
 217         goto INSIDE_STRING;
 218     }
 219     if ($line =~ /^[^\\"]+(.*)/) {
 220         $line = $1;
 221         goto INSIDE_STRING;
 222     }
 223     return undef;               # missing closing double quote
 224
 225   SPACE_SEEN:
 226     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 227     return undef;
 228 }
 229
 230 sub derive_ssh_auth_type ($) {
 231     my $line = shift;
 232     $line =~ /^ssh-rsa\s/ and return 'rsa';
 233     $line =~ /^ssh-dss\s/ and return 'dsa';
 234     $line =~ /^\d+\s/ and return 'rsa1';
 235     return undef;
 236 }
 237
 238 sub from_ssh_auth_line ($$$) {
 239     my ($tmp, $name, $line) = @_;
 240     chomp $line;
 241     return if $line =~ m/^\s*(#|$)/;
 242
 243     {
 244         my $l = cleanup_ssh_auth_line $line;
 245         $l or goto ERROR;
 246         $line = $l;
 247     }
 248     my $type = derive_ssh_auth_type $line;
 249
 250     clear_tmp $tmp;
 251     print $tmp "$line\n" or die "print: $!";
 252     $tmp->flush or die "flush: $!";
 253     my ($length, $hash) = ssh_fprint_file "$tmp";
 254     if ($length && $hash) {
 255         ssh_fprint_check "$name", $type, $length, $hash;
 256         return;
 257     }
 258
 259   ERROR:
 260     warn "$name: warning: unparsable line\n";
 261 }
 262
 263 sub from_ssh_auth_file ($) {
 264     my $name = shift;
 265     my $auth;
 266     unless (open $auth, '<', $name) {
 267         warn "$name:0: error: open failed: $!\n";
 268         return;
 269     }
 270
 271     my $tmp = new File::Temp;
 272     while (my $line = <$auth>) {
 273         from_ssh_auth_line $tmp, "$name:$.", $line;
 274     }
 275 }
 276
 277 sub from_openvpn_key ($) {
 278     my $name = shift;
 279     my $key;
 280     unless (open $key, '<', $name) {
 281         warn "$name:0: open failed: $!\n";
 282         return 1;
 283     }
 284
 285     my $marker;
 286     while (my $line = <$key>) {
 287         return 0 if $. > 10;
 288         if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
 289             $marker = 1;
 290         } elsif ($marker) {
 291             if ($line =~ /^([0-9a-f]{32})/) {
 292                 $line = $1;
 293                 $line =~ s/(..)/chr(hex($1))/ge;
 294                 check_hash "$name:$.", $line, "OpenVPN";
 295                 return 1;
 296             } else {
 297                 warn "$name:$.: warning: illegal OpenVPN file format\n";
 298                 return 1;
 299             }
 300         }
 301     }
 302 }
 303
 304 sub openssl_modulus_check ($$) {
 305     my ($name, $modulus) = @_;
 306     chomp $modulus;
 307     if ($modulus =~ /^Modulus=([A-F0-9]+)$/) {
 308         $modulus = $1;
 309         my $length = length($modulus) * 4;
 310         if ($length == 1024 || $length == 2048) {
 311             my $mod = substr $modulus, length($modulus) - 32;
 312             $mod =~ y/A-F/a-f/;
 313             my @mod = $mod =~ /(..)/g;
 314             $mod = join('', map { chr(hex($_)) } reverse @mod);
 315             check_hash $name, $mod, "OpenSSL/RSA/$length";
 316         } else {
 317             warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
 318         }
 319     } else {
 320         die "internal error: $modulus\n";
 321     }
 322 }
 323
 324 sub from_pem ($) {
 325     my $name = shift;
 326     my $tmp;
 327     my $found = 0;
 328
 329     my $src;
 330     unless (open $src, '<', $name) {
 331         warn "$name:0: open failed: $!\n";
 332         return 1;
 333     }
 334
 335     while (my $line = <$src>) {
 336         if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
 337             my $lineno = $.;
 338             $tmp or $tmp = new File::Temp;
 339             clear_tmp $tmp;
 340             do {
 341                 print $tmp $line or die "print: $!";
 342                 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
 343             } while ($line = <$src>);
 344           LAST:
 345             $tmp->flush or die "flush: $!";
 346             my $mod = safe_backtick qw/openssl x509 -noout -modulus -in/, $tmp;
 347             if ($mod) {
 348                 openssl_modulus_check "$name:$lineno", $mod;
 349                 $found = 1;
 350             } else {
 351                 warn "$name:$lineno: failed to parse certificate\n";
 352                 return 1;
 353             }
 354         } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
 355             my $lineno = $.;
 356             $tmp or $tmp = new File::Temp;
 357             clear_tmp $tmp;
 358             do {
 359                 print $tmp $line or die "print: $!";
 360                 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
 361             } while ($line = <$src>);
 362           LAST_RSA:
 363             $tmp->flush or die "flush: $!";
 364             my $mod = safe_backtick qw/openssl rsa -noout -modulus -in/, $tmp;
 365             if ($mod) {
 366                 openssl_modulus_check "$name:$lineno", $mod;
 367                 $found = 1;
 368             } else {
 369                 warn "$name:$lineno: failed to parse RSA private key\n";
 370                 return 1;
 371             }
 372         }
 373     }
 374
 375     return $found;
 376 }
 377
 378 sub from_ssh_host (@) {
 379     my @names = @_;
 380
 381     @names = grep {
 382         my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
 383         @addrs or warn "warning: host not found: $_\n";
 384         @addrs > 0;
 385     } @names;
 386
 387     my @lines;
 388     push @lines, safe_backtick qw/ssh-keyscan -t rsa/, @names;
 389     push @lines, safe_backtick qw/ssh-keyscan -t dsa/, @names;
 390
 391     my $tmp = new File::Temp;
 392     for my $line (@lines) {
 393         next if $line =~ /^#/;
 394         my ($host, $data) = $line =~ /^(\S+) (.*)$/;
 395         from_ssh_auth_line $tmp, $host, $data;
 396     }
 397 }
 398
 399 sub from_user ($) {
 400     my $user = shift;
 401     my ($name,$passwd,$uid,$gid,
 402         $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
 403     unless ($name) {
 404         warn "warning: user $user does not exist\n";
 405         return;
 406     }
 407     for my $name (qw/authorized_keys authorized_keys2
 408                      known_hosts known_hosts2
 409                      id_rsa.pub id_dsa.pub identity.pub/) {
 410         my $file = "$dir/.ssh/$name";
 411         from_ssh_auth_file $file if -r $file;
 412     }
 413 }
 414
 415 sub from_user_all () {
 416     # This was one loop initially, but does not work with some Perl
 417     # versions.
 418     setpwent;
 419     my @names;
 420     while (my $name = getpwent) {
 421         push @names, $name;
 422     }
 423     endpwent;
 424     from_user $_ for @names;
 425 }
 426
 427 if (@ARGV && $ARGV[0] eq '-c') {
 428     shift @ARGV;
 429     $db_file = shift @ARGV if @ARGV;
 430 }
 431 if (@ARGV) {
 432     open_db;
 433     my $cmd = shift @ARGV;
 434     if ($cmd eq 'file') {
 435         for my $name (@ARGV) {
 436             next if from_openvpn_key $name;
 437             next if from_pem $name;
 438             from_ssh_auth_file $name;
 439         }
 440     } elsif ($cmd eq 'host') {
 441         from_ssh_host @ARGV;
 442     } elsif ($cmd eq 'user') {
 443         if (@ARGV) {
 444             from_user $_ for @ARGV;
 445         } else {
 446             from_user_all;
 447         }
 448     } elsif ($cmd eq 'help') {
 449         help;
 450         exit 0;
 451     } elsif ($cmd eq 'version') {
 452         print "dowkd $program_version (database $db_version)\n";
 453         exit 0;
 454     } else {
 455         die "error: invalid command, use \"help\" to get help\n";
 456     }
 457     print_stats;
 458 } else {
 459     help;
 460     exit 1;
 461 }
 462
 463 my %hash;
 464
 465 __DATA__