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