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