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