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 = '1';
  67
  68 my $db_file = 'dowkd.db';
  69
  70 my $db;
  71 my %db;
  72
  73 sub create_db () {
  74     $db = tie %db, 'DB_File', $db_file, O_RDWR | O_CREAT, 0777, $DB_BTREE
  75         or die "error: could not open database: $!\n";
  76
  77     $db{''} = $db_version;
  78     while (my $line = <DATA>) {
  79         next if $line =~ /^\**$/;
  80         chomp $line;
  81         $line =~ /^[0-9a-f]{32}$/ or die "error: invalid data line";
  82         $line =~ s/(..)/chr(hex($1))/ge;
  83         $db{$line} = '';
  84     }
  85
  86     $db->sync;
  87 }
  88
  89 sub open_db () {
  90     if (-r $db_file) {
  91         $db = tie %db, 'DB_File', $db_file, O_RDONLY, 0777, $DB_BTREE
  92             or die "error: could not open database: $!\n";
  93         my $stored_version = $db{''};
  94         $stored_version && $stored_version eq $db_version or create_db;
  95     } else {
  96         unlink $db_file;
  97         create_db;
  98     }
  99 }
 100
 101 sub safe_backtick (@) {
 102     my @args = @_;
 103     my $fh;
 104     open $fh, '-|', @args
 105         or die "error: failed to spawn $args[0]: $!\n";
 106     my @result;
 107     if (wantarray) {
 108         @result = <$fh>;
 109     } else {
 110         local $/;
 111         @result = scalar(<$fh>);
 112     }
 113     close $fh;
 114     $? == 0 or return undef;
 115     if (wantarray) {
 116         return @result;
 117     } else {
 118         return $result[0];
 119     }
 120 }
 121
 122 my $keys_found = 0;
 123 my $keys_vulnerable = 0;
 124
 125 sub print_stats () {
 126     print STDERR "summary: keys found: $keys_found, weak keys: $keys_vulnerable\n";
 127 }
 128
 129 sub check_hash ($$) {
 130     my ($name, $hash) = @_;
 131     ++$keys_found;
 132     if (exists $db{$hash}) {
 133         ++$keys_vulnerable;
 134         print "$name: weak key\n";
 135     }
 136 }
 137
 138 sub ssh_fprint_file ($) {
 139     my $name = shift;
 140     my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
 141     defined $data or return ();
 142     my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
 143     return @data if @data == 2;
 144     return ();
 145 }
 146
 147 sub ssh_fprint_check ($$$) {
 148     my ($name, $length, $hash) = @_;
 149     if ($length == 1024 || $length == 2048) {
 150         $hash =~ y/://d;
 151         $hash =~ s/(..)/chr(hex($1))/ge;
 152         check_hash $name, $hash;
 153     } else {
 154         warn "$name: warning: no suitable blacklist\n";
 155     }
 156                       }
 157
 158 sub from_ssh_key_file ($) {
 159     my $name = shift;
 160     my ($length, $hash) = ssh_fprint_file $name;
 161     if ($length && $hash) {
 162         ssh_fprint_check "$name:1", $length, $hash;
 163     } else {
 164         warn "$name:1: warning: failed to parse SSH key file\n";
 165     }
 166 }
 167
 168 sub clear_tmp ($) {
 169     my $tmp = shift;
 170     seek $tmp, 0, 0 or die "seek: $!";
 171     truncate $tmp, 0 or die "truncate: $!";
 172 }
 173
 174 sub cleanup_ssh_auth_line ($) {
 175     my $line = shift;
 176
 177     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 178
 179   OUTSIDE_STRING:
 180     if ($line =~ /^\s+(.*)/) {
 181         $line = $1;
 182         goto SPACE_SEEN;
 183     }
 184     if ($line =~ /^"(.*)/) {
 185         $line = $1;
 186         goto INSIDE_STRING;
 187     }
 188     if ($line =~ /^\\.(.*)/) {
 189         # It doesn't matter if we don't deal with \000 properly, we
 190         # just need to defuse the backslash character.
 191         $line = $1;
 192         goto OUTSIDE_STRING;
 193     }
 194     if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
 195         # Skip multiple harmless characters in one go.
 196         $line = $1;
 197         goto OUTSIDE_STRING;
 198     }
 199     if ($line =~ /^.(.*)/) {
 200         # Other characters are stripped one by one.
 201         $line = $1;
 202         goto OUTSIDE_STRING;
 203     }
 204     return undef;               # empty string, no key found
 205
 206   INSIDE_STRING:
 207     if ($line =~ /^"(.*)/) {
 208         $line = $1;
 209         goto OUTSIDE_STRING;
 210     }
 211     if ($line =~ /^\\.(.*)/) {
 212         # See above, defuse the backslash.
 213         $line = $1;
 214         goto INSIDE_STRING;
 215     }
 216     if ($line =~ /^[^\\"]+(.*)/) {
 217         $line = $1;
 218         goto INSIDE_STRING;
 219     }
 220     return undef;               # missing closing double quote
 221
 222   SPACE_SEEN:
 223     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 224     return undef;
 225 }
 226
 227 sub from_ssh_auth_file ($) {
 228     my $name = shift;
 229     my $auth;
 230     unless (open $auth, '<', $name) {
 231         warn "$name:0: error: open failed: $!\n";
 232         return;
 233     }
 234     my $tmp = new File::Temp;
 235     while (my $line = <$auth>) {
 236         chomp $line;
 237         next if $line =~ m/^\s*(#|$)/;
 238         my $lineno = $.;
 239
 240         {
 241             my $l = cleanup_ssh_auth_line $line;
 242             $l or goto ERROR;
 243             $line = $l;
 244         }
 245
 246         clear_tmp $tmp;
 247         print $tmp "$line\n" or die "print: $!";
 248         $tmp->flush;
 249         my ($length, $hash) = ssh_fprint_file "$tmp";
 250         if ($length && $hash) {
 251             ssh_fprint_check "$name:$lineno", $length, $hash;
 252             next;
 253         }
 254
 255       ERROR:
 256         warn "$name:$lineno: warning: unparsable line\n";
 257     }
 258 }
 259
 260 sub from_openvpn_key ($) {
 261     my $name = shift;
 262     my $key;
 263     unless (open $key, '<', $name) {
 264         warn "$name:0: open failed: $!\n";
 265         return 1;
 266     }
 267
 268     my $marker;
 269     while (my $line = <$key>) {
 270         return 0 if $. > 10;
 271         if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
 272             $marker = 1;
 273         } elsif ($marker) {
 274             if ($line =~ /^([0-9a-f]{32})/) {
 275                 $line = $1;
 276                 $line =~ s/(..)/chr(hex($1))/ge;
 277                 check_hash "$name:$.", $line;
 278                 return 1;
 279             } else {
 280                 warn "$name:$.: warning: illegal OpenVPN file format\n";
 281                 return 1;
 282             }
 283         }
 284     }
 285 }
 286
 287 sub from_ssh_host (@) {
 288     my @names = @_;
 289     my @lines;
 290     push @lines, safe_backtick qw/ssh-keyscan -t rsa/, @names;
 291     push @lines, safe_backtick qw/ssh-keyscan -t dsa/, @names;
 292
 293     my $tmp = new File::Temp;
 294     for my $line (@lines) {
 295         next if $line =~ /^#/;
 296         my ($host, $data) = $line =~ /^(\S+) (.*)$/;
 297         clear_tmp $tmp;
 298         print $tmp "$data\n" or die "print: $!";
 299         $tmp->flush;
 300         my ($length, $hash) = ssh_fprint_file "$tmp";
 301         if ($length && $hash) {
 302             ssh_fprint_check "$host", $length, $hash;
 303         } else {
 304             warn "$host: warning: unparsable line\n";
 305         }
 306     }
 307 }
 308
 309 sub from_user ($) {
 310     my $user = shift;
 311     my ($name,$passwd,$uid,$gid,
 312         $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
 313     unless ($name) {
 314         warn "warning: user $user does not exist\n";
 315         return;
 316     }
 317     my $file = "$dir/.ssh/authorized_keys";
 318     from_ssh_auth_file $file if -r $file;
 319     $file = "$dir/.ssh/authorized_keys2";
 320     from_ssh_auth_file $file if -r $file;
 321     $file = "$dir/.ssh/known_hosts";
 322     from_ssh_auth_file $file if -r $file;
 323     $file = "$dir/.ssh/known_hosts2";
 324     from_ssh_auth_file $file if -r $file;
 325     $file = "$dir/.ssh/id_rsa.pub";
 326     from_ssh_key_file $file if -r $file;
 327     $file = "$dir/.ssh/id_dsa.pub";
 328     from_ssh_key_file $file if -r $file;
 329 }
 330
 331 sub from_user_all () {
 332     # This was one loop initially, but does not work with some Perl
 333     # versions.
 334     setpwent;
 335     my @names;
 336     while (my $name = getpwent) {
 337         push @names, $name;
 338     }
 339     endpwent;
 340     from_user $_ for @names;
 341 }
 342
 343 if (@ARGV && $ARGV[0] eq '-c') {
 344     shift @ARGV;
 345     $db_file = shift @ARGV if @ARGV;
 346 }
 347 if (@ARGV) {
 348     open_db;
 349     my $cmd = shift @ARGV;
 350     if ($cmd eq 'file') {
 351         for my $name (@ARGV) {
 352             next if from_openvpn_key $name;
 353             from_ssh_auth_file $name;
 354         }
 355     } elsif ($cmd eq 'host') {
 356         from_ssh_host @ARGV;
 357     } elsif ($cmd eq 'user') {
 358         if (@ARGV) {
 359             from_user $_ for @ARGV;
 360         } else {
 361             from_user_all;
 362         }
 363     } elsif ($cmd eq 'help') {
 364         help;
 365         exit 0;
 366     } else {
 367         die "error: invalid command, use \"help\" to get help\n";
 368     }
 369     print_stats;
 370 } else {
 371     help;
 372     exit 1;
 373 }
 374
 375 my %hash;
 376
 377 __DATA__