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
 258     {
 259         my $l = cleanup_ssh_auth_line $line;
 260         $l or return 0;
 261         $line = $l;
 262     }
 263     my $type = derive_ssh_auth_type $line;
 264
 265     clear_tmp $tmp;
 266     print $tmp "$line\n" or die "print: $!";
 267     $tmp->flush or die "flush: $!";
 268     my ($length, $hash) = ssh_fprint_file "$tmp";
 269     if ($length && $hash) {
 270         ssh_fprint_check "$name", $type, $length, $hash;
 271         return 1;
 272     }
 273
 274     return 0;
 275 }
 276
 277 sub from_ssh_auth_file ($) {
 278     my $name = shift;
 279     my $auth;
 280     unless (open $auth, '<', $name) {
 281         warn "$name:0: error: open failed: $!\n";
 282         return;
 283     }
 284
 285     my $tmp = new File::Temp;
 286     my $last_status = 1;
 287     while (my $line = <$auth>) {
 288         next if $line =~ m/^\s*(#|$)/;
 289         my $status = from_ssh_auth_line $tmp, "$name:$.", $line;
 290         unless ($status) {
 291             $last_status and warn "$name:$.: warning: unparsable line\n";
 292         }
 293         $last_status = $status;
 294     }
 295 }
 296
 297 sub from_openvpn_key ($) {
 298     my $name = shift;
 299     my $key;
 300     unless (open $key, '<', $name) {
 301         warn "$name:0: open failed: $!\n";
 302         return 1;
 303     }
 304
 305     my $marker;
 306     while (my $line = <$key>) {
 307         return 0 if $. > 10;
 308         if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
 309             $marker = 1;
 310         } elsif ($marker) {
 311             if ($line =~ /^([0-9a-f]{32})/) {
 312                 $line = $1;
 313                 $line =~ s/(..)/chr(hex($1))/ge;
 314                 check_hash "$name:$.", $line, "OpenVPN";
 315                 return 1;
 316             } else {
 317                 warn "$name:$.: warning: illegal OpenVPN file format\n";
 318                 return 1;
 319             }
 320         }
 321     }
 322 }
 323
 324 sub openssl_modulus_check ($$) {
 325     my ($name, $modulus) = @_;
 326     chomp $modulus;
 327     if ($modulus =~ /^Modulus=([A-F0-9]+)$/) {
 328         $modulus = $1;
 329         my $length = length($modulus) * 4;
 330         if ($length == 1024 || $length == 2048) {
 331             my $mod = substr $modulus, length($modulus) - 32;
 332             $mod =~ y/A-F/a-f/;
 333             my @mod = $mod =~ /(..)/g;
 334             $mod = join('', map { chr(hex($_)) } reverse @mod);
 335             check_hash $name, $mod, "OpenSSL/RSA/$length";
 336         } else {
 337             warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
 338         }
 339     } else {
 340         die "internal error: $modulus\n";
 341     }
 342 }
 343
 344 sub from_pem ($) {
 345     my $name = shift;
 346     my $tmp;
 347     my $found = 0;
 348
 349     my $src;
 350     unless (open $src, '<', $name) {
 351         warn "$name:0: open failed: $!\n";
 352         return 1;
 353     }
 354
 355     while (my $line = <$src>) {
 356         if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
 357             my $lineno = $.;
 358             $tmp or $tmp = new File::Temp;
 359             clear_tmp $tmp;
 360             do {
 361                 print $tmp $line or die "print: $!";
 362                 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
 363             } while ($line = <$src>);
 364           LAST:
 365             $tmp->flush or die "flush: $!";
 366             my $mod = safe_backtick qw/openssl x509 -noout -modulus -in/, $tmp;
 367             if ($mod) {
 368                 openssl_modulus_check "$name:$lineno", $mod;
 369                 $found = 1;
 370             } else {
 371                 warn "$name:$lineno: failed to parse certificate\n";
 372                 return 1;
 373             }
 374         } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
 375             my $lineno = $.;
 376             $tmp or $tmp = new File::Temp;
 377             clear_tmp $tmp;
 378             do {
 379                 print $tmp $line or die "print: $!";
 380                 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
 381             } while ($line = <$src>);
 382           LAST_RSA:
 383             $tmp->flush or die "flush: $!";
 384             my $mod = safe_backtick qw/openssl rsa -noout -modulus -in/, $tmp;
 385             if ($mod) {
 386                 openssl_modulus_check "$name:$lineno", $mod;
 387                 $found = 1;
 388             } else {
 389                 warn "$name:$lineno: failed to parse RSA private key\n";
 390                 return 1;
 391             }
 392         }
 393     }
 394
 395     return $found;
 396 }
 397
 398 sub from_ssh_host ($@) {
 399     my ($port, @names) = @_;
 400
 401     @names = grep {
 402         my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
 403         @addrs or warn "warning: host not found: $_\n";
 404         @addrs > 0;
 405     } @names;
 406
 407     my @lines;
 408     push @lines, safe_backtick qw/ssh-keyscan -t rsa -p/, $port, @names;
 409     push @lines, safe_backtick qw/ssh-keyscan -t dsa -p/, $port, @names;
 410
 411     my $tmp = new File::Temp;
 412     for my $line (@lines) {
 413         next if $line =~ /^#/;
 414         my ($host, $data) = $line =~ /^(\S+) (.*)$/;
 415         from_ssh_auth_line $tmp, $host, $data
 416             or die "$host: warning: unparsable line\n";
 417     }
 418 }
 419
 420 sub from_user ($) {
 421     my $user = shift;
 422     my ($name,$passwd,$uid,$gid,
 423         $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
 424     unless ($name) {
 425         warn "warning: user $user does not exist\n";
 426         return;
 427     }
 428     for my $name (qw/authorized_keys authorized_keys2
 429                      known_hosts known_hosts2
 430                      id_rsa.pub id_dsa.pub identity.pub/) {
 431         my $file = "$dir/.ssh/$name";
 432         from_ssh_auth_file $file if -r $file;
 433     }
 434 }
 435
 436 sub from_user_all () {
 437     # This was one loop initially, but does not work with some Perl
 438     # versions.
 439     setpwent;
 440     my @names;
 441     while (my $name = getpwent) {
 442         push @names, $name;
 443     }
 444     endpwent;
 445     from_user $_ for @names;
 446 }
 447
 448 if (@ARGV && $ARGV[0] eq '-c') {
 449     shift @ARGV;
 450     $db_file = shift @ARGV if @ARGV;
 451 }
 452 if (@ARGV) {
 453     open_db;
 454     my $cmd = shift @ARGV;
 455     if ($cmd eq 'file') {
 456         for my $name (@ARGV) {
 457             next if from_openvpn_key $name;
 458             next if from_pem $name;
 459             from_ssh_auth_file $name;
 460         }
 461     } elsif ($cmd eq 'host') {
 462         unless (@ARGV) {
 463             help;
 464             exit 1;
 465         }
 466         my $port = 22;
 467         if ($ARGV[0] eq '-p') {
 468             shift @ARGV;
 469             if (@ARGV) {
 470                 $port = shift @ARGV;
 471             }
 472         } elsif ($ARGV[0] =~ /-p(\d+)/) {
 473             $port = $1;
 474             shift @ARGV;
 475         }
 476         unless (@ARGV) {
 477             help;
 478             exit 1;
 479         }
 480         from_ssh_host $port, @ARGV;
 481     } elsif ($cmd eq 'user') {
 482         if (@ARGV) {
 483             from_user $_ for @ARGV;
 484         } else {
 485             from_user_all;
 486         }
 487     } elsif ($cmd eq 'help') {
 488         help;
 489         exit 0;
 490     } elsif ($cmd eq 'version') {
 491         print "dowkd $program_version (database $db_version)\n\n$changelog";
 492         exit 0;
 493     } else {
 494         die "error: invalid command, use \"help\" to get help\n";
 495     }
 496     print_stats;
 497 } else {
 498     help;
 499     exit 1;
 500 }
 501
 502 my %hash;
 503
 504 __DATA__