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