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 = '2';
  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         $hash =~ y/://d;
 155         $hash =~ s/(..)/chr(hex($1))/ge;
 156         check_hash $name, $hash, "OpenSSH/$type/$length";
 157     } elsif ($type eq 'dsa') {
 158         print "$name: $length bits DSA key not recommended\n";
 159     } else {
 160         warn "$name: warning: no blacklist for $type/$length key\n";
 161     }
 162 }
 163
 164 sub clear_tmp ($) {
 165     my $tmp = shift;
 166     seek $tmp, 0, 0 or die "seek: $!";
 167     truncate $tmp, 0 or die "truncate: $!";
 168 }
 169
 170 sub cleanup_ssh_auth_line ($) {
 171     my $line = shift;
 172
 173     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 174
 175   OUTSIDE_STRING:
 176     if ($line =~ /^\s+(.*)/) {
 177         $line = $1;
 178         goto SPACE_SEEN;
 179     }
 180     if ($line =~ /^"(.*)/) {
 181         $line = $1;
 182         goto INSIDE_STRING;
 183     }
 184     if ($line =~ /^\\.(.*)/) {
 185         # It doesn't matter if we don't deal with \000 properly, we
 186         # just need to defuse the backslash character.
 187         $line = $1;
 188         goto OUTSIDE_STRING;
 189     }
 190     if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
 191         # Skip multiple harmless characters in one go.
 192         $line = $1;
 193         goto OUTSIDE_STRING;
 194     }
 195     if ($line =~ /^.(.*)/) {
 196         # Other characters are stripped one by one.
 197         $line = $1;
 198         goto OUTSIDE_STRING;
 199     }
 200     return undef;               # empty string, no key found
 201
 202   INSIDE_STRING:
 203     if ($line =~ /^"(.*)/) {
 204         $line = $1;
 205         goto OUTSIDE_STRING;
 206     }
 207     if ($line =~ /^\\.(.*)/) {
 208         # See above, defuse the backslash.
 209         $line = $1;
 210         goto INSIDE_STRING;
 211     }
 212     if ($line =~ /^[^\\"]+(.*)/) {
 213         $line = $1;
 214         goto INSIDE_STRING;
 215     }
 216     return undef;               # missing closing double quote
 217
 218   SPACE_SEEN:
 219     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 220     return undef;
 221 }
 222
 223 sub derive_ssh_auth_type ($) {
 224     my $line = shift;
 225     $line =~ /^ssh-rsa\s/ and return 'rsa';
 226     $line =~ /^ssh-dss\s/ and return 'dsa';
 227     $line =~ /^\d+\s/ and return 'rsa1';
 228     return undef;
 229 }
 230
 231 sub from_ssh_auth_line ($$$) {
 232     my ($tmp, $name, $line) = @_;
 233     chomp $line;
 234     return if $line =~ m/^\s*(#|$)/;
 235
 236     {
 237         my $l = cleanup_ssh_auth_line $line;
 238         $l or goto ERROR;
 239         $line = $l;
 240     }
 241     my $type = derive_ssh_auth_type $line;
 242
 243     clear_tmp $tmp;
 244     print $tmp "$line\n" or die "print: $!";
 245     $tmp->flush or die "flush: $!";
 246     my ($length, $hash) = ssh_fprint_file "$tmp";
 247     if ($length && $hash) {
 248         ssh_fprint_check "$name", $type, $length, $hash;
 249         return;
 250     }
 251
 252   ERROR:
 253     warn "$name: warning: unparsable line\n";
 254 }
 255
 256 sub from_ssh_auth_fd ($$) {
 257     my ($name, $auth) = @_;
 258     my $tmp = new File::Temp;
 259     while (my $line = <$auth>) {
 260         from_ssh_auth_line $tmp, "$name:$.", $line;
 261     }
 262 }
 263
 264 sub from_ssh_auth_file ($) {
 265     my $name = shift;
 266     my $auth;
 267     unless (open $auth, '<', $name) {
 268         warn "$name:0: error: open failed: $!\n";
 269         return;
 270     }
 271     return from_ssh_auth_fd $name, $auth;
 272 }
 273
 274 sub from_openvpn_key ($) {
 275     my $name = shift;
 276     my $key;
 277     unless (open $key, '<', $name) {
 278         warn "$name:0: open failed: $!\n";
 279         return 1;
 280     }
 281
 282     my $marker;
 283     while (my $line = <$key>) {
 284         return 0 if $. > 10;
 285         if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
 286             $marker = 1;
 287         } elsif ($marker) {
 288             if ($line =~ /^([0-9a-f]{32})/) {
 289                 $line = $1;
 290                 $line =~ s/(..)/chr(hex($1))/ge;
 291                 check_hash "$name:$.", $line, "OpenVPN";
 292                 return 1;
 293             } else {
 294                 warn "$name:$.: warning: illegal OpenVPN file format\n";
 295                 return 1;
 296             }
 297         }
 298     }
 299 }
 300
 301 sub openssl_modulus_check ($$) {
 302     my ($name, $modulus) = @_;
 303     chomp $modulus;
 304     if ($modulus =~ /^Modulus=([A-F0-9]+)$/) {
 305         $modulus = $1;
 306         my $length = length($modulus) * 4;
 307         if ($length == 1024 || $length == 2048) {
 308             my $mod = substr $modulus, length($modulus) - 32;
 309             $mod =~ y/A-F/a-f/;
 310             my @mod = $mod =~ /(..)/g;
 311             $mod = join('', map { chr(hex($_)) } reverse @mod);
 312             check_hash $name, $mod, "OpenSSL/RSA/$length";
 313         } else {
 314             warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
 315         }
 316     } else {
 317         die "internal error: $modulus\n";
 318     }
 319 }
 320
 321 sub from_pem ($) {
 322     my $name = shift;
 323     my $tmp;
 324     my $found = 0;
 325
 326     my $src;
 327     unless (open $src, '<', $name) {
 328         warn "$name:0: open failed: $!\n";
 329         return 1;
 330     }
 331
 332     while (my $line = <$src>) {
 333         if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
 334             my $lineno = $.;
 335             $tmp or $tmp = new File::Temp;
 336             clear_tmp $tmp;
 337             do {
 338                 print $tmp $line or die "print: $!";
 339                 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
 340             } while ($line = <$src>);
 341           LAST:
 342             $tmp->flush or die "flush: $!";
 343             my $mod = safe_backtick qw/openssl x509 -noout -modulus -in/, $tmp;
 344             if ($mod) {
 345                 openssl_modulus_check "$name:$lineno", $mod;
 346                 $found = 1;
 347             } else {
 348                 warn "$name:$lineno: failed to parse certificate\n";
 349                 return 1;
 350             }
 351         }
 352     }
 353
 354     return $found;
 355 }
 356
 357 sub from_ssh_host (@) {
 358     my @names = @_;
 359
 360     @names = grep {
 361         my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
 362         @addrs or warn "warning: host not found: $_\n";
 363         @addrs > 0;
 364     } @names;
 365
 366     my @lines;
 367     push @lines, safe_backtick qw/ssh-keyscan -t rsa/, @names;
 368     push @lines, safe_backtick qw/ssh-keyscan -t dsa/, @names;
 369
 370     my $tmp = new File::Temp;
 371     for my $line (@lines) {
 372         next if $line =~ /^#/;
 373         my ($host, $data) = $line =~ /^(\S+) (.*)$/;
 374         from_ssh_auth_line $tmp, $host, $data;
 375     }
 376 }
 377
 378 sub from_user ($) {
 379     my $user = shift;
 380     my ($name,$passwd,$uid,$gid,
 381         $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
 382     unless ($name) {
 383         warn "warning: user $user does not exist\n";
 384         return;
 385     }
 386     for my $name (qw/authorized_keys authorized_keys2
 387                      known_hosts known_hosts2
 388                      id_rsa.pub id_dsa.pub identity.pub/) {
 389         my $file = "$dir/.ssh/$name";
 390         from_ssh_auth_file $file if -r $file;
 391     }
 392 }
 393
 394 sub from_user_all () {
 395     # This was one loop initially, but does not work with some Perl
 396     # versions.
 397     setpwent;
 398     my @names;
 399     while (my $name = getpwent) {
 400         push @names, $name;
 401     }
 402     endpwent;
 403     from_user $_ for @names;
 404 }
 405
 406 if (@ARGV && $ARGV[0] eq '-c') {
 407     shift @ARGV;
 408     $db_file = shift @ARGV if @ARGV;
 409 }
 410 if (@ARGV) {
 411     open_db;
 412     my $cmd = shift @ARGV;
 413     if ($cmd eq 'file') {
 414         for my $name (@ARGV) {
 415             next if from_openvpn_key $name;
 416             next if from_pem $name;
 417             from_ssh_auth_file $name;
 418         }
 419     } elsif ($cmd eq 'host') {
 420         from_ssh_host @ARGV;
 421     } elsif ($cmd eq 'user') {
 422         if (@ARGV) {
 423             from_user $_ for @ARGV;
 424         } else {
 425             from_user_all;
 426         }
 427     } elsif ($cmd eq 'help') {
 428         help;
 429         exit 0;
 430     } else {
 431         die "error: invalid command, use \"help\" to get help\n";
 432     }
 433     print_stats;
 434 } else {
 435     help;
 436     exit 1;
 437 }
 438
 439 my %hash;
 440
 441 __DATA__