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 clear_tmp ($) {
 159     my $tmp = shift;
 160     seek $tmp, 0, 0 or die "seek: $!";
 161     truncate $tmp, 0 or die "truncate: $!";
 162 }
 163
 164 sub cleanup_ssh_auth_line ($) {
 165     my $line = shift;
 166
 167     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 168
 169   OUTSIDE_STRING:
 170     if ($line =~ /^\s+(.*)/) {
 171         $line = $1;
 172         goto SPACE_SEEN;
 173     }
 174     if ($line =~ /^"(.*)/) {
 175         $line = $1;
 176         goto INSIDE_STRING;
 177     }
 178     if ($line =~ /^\\.(.*)/) {
 179         # It doesn't matter if we don't deal with \000 properly, we
 180         # just need to defuse the backslash character.
 181         $line = $1;
 182         goto OUTSIDE_STRING;
 183     }
 184     if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
 185         # Skip multiple harmless characters in one go.
 186         $line = $1;
 187         goto OUTSIDE_STRING;
 188     }
 189     if ($line =~ /^.(.*)/) {
 190         # Other characters are stripped one by one.
 191         $line = $1;
 192         goto OUTSIDE_STRING;
 193     }
 194     return undef;               # empty string, no key found
 195
 196   INSIDE_STRING:
 197     if ($line =~ /^"(.*)/) {
 198         $line = $1;
 199         goto OUTSIDE_STRING;
 200     }
 201     if ($line =~ /^\\.(.*)/) {
 202         # See above, defuse the backslash.
 203         $line = $1;
 204         goto INSIDE_STRING;
 205     }
 206     if ($line =~ /^[^\\"]+(.*)/) {
 207         $line = $1;
 208         goto INSIDE_STRING;
 209     }
 210     return undef;               # missing closing double quote
 211
 212   SPACE_SEEN:
 213     $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
 214     return undef;
 215 }
 216
 217 sub from_ssh_auth_fd ($$) {
 218     my ($name, $auth) = @_;
 219     my $tmp = new File::Temp;
 220     while (my $line = <$auth>) {
 221         chomp $line;
 222         next if $line =~ m/^\s*(#|$)/;
 223         my $lineno = $.;
 224
 225         {
 226             my $l = cleanup_ssh_auth_line $line;
 227             $l or goto ERROR;
 228             $line = $l;
 229         }
 230
 231         clear_tmp $tmp;
 232         print $tmp "$line\n" or die "print: $!";
 233         $tmp->flush;
 234         my ($length, $hash) = ssh_fprint_file "$tmp";
 235         if ($length && $hash) {
 236             ssh_fprint_check "$name:$lineno", $length, $hash;
 237             next;
 238         }
 239
 240       ERROR:
 241         warn "$name:$lineno: warning: unparsable line\n";
 242     }
 243 }
 244
 245 sub from_ssh_auth_file ($) {
 246     my $name = shift;
 247     my $auth;
 248     unless (open $auth, '<', $name) {
 249         warn "$name:0: error: open failed: $!\n";
 250         return;
 251     }
 252     return from_ssh_auth_fd $name, $auth;
 253 }
 254
 255 sub from_openvpn_key ($) {
 256     my $name = shift;
 257     my $key;
 258     unless (open $key, '<', $name) {
 259         warn "$name:0: open failed: $!\n";
 260         return 1;
 261     }
 262
 263     my $marker;
 264     while (my $line = <$key>) {
 265         return 0 if $. > 10;
 266         if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
 267             $marker = 1;
 268         } elsif ($marker) {
 269             if ($line =~ /^([0-9a-f]{32})/) {
 270                 $line = $1;
 271                 $line =~ s/(..)/chr(hex($1))/ge;
 272                 check_hash "$name:$.", $line;
 273                 return 1;
 274             } else {
 275                 warn "$name:$.: warning: illegal OpenVPN file format\n";
 276                 return 1;
 277             }
 278         }
 279     }
 280 }
 281
 282 sub from_ssh_host (@) {
 283     my @names = @_;
 284     my @lines;
 285     push @lines, safe_backtick qw/ssh-keyscan -t rsa/, @names;
 286     push @lines, safe_backtick qw/ssh-keyscan -t dsa/, @names;
 287
 288     my $tmp = new File::Temp;
 289     for my $line (@lines) {
 290         next if $line =~ /^#/;
 291         my ($host, $data) = $line =~ /^(\S+) (.*)$/;
 292         clear_tmp $tmp;
 293         print $tmp "$data\n" or die "print: $!";
 294         $tmp->flush;
 295         my ($length, $hash) = ssh_fprint_file "$tmp";
 296         if ($length && $hash) {
 297             ssh_fprint_check "$host", $length, $hash;
 298         } else {
 299             warn "$host: warning: unparsable line\n";
 300         }
 301     }
 302 }
 303
 304 sub from_user ($) {
 305     my $user = shift;
 306     my ($name,$passwd,$uid,$gid,
 307         $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
 308     unless ($name) {
 309         warn "warning: user $user does not exist\n";
 310         return;
 311     }
 312     for my $name (qw/authorized_keys authorized_keys2
 313                      known_hosts known_hosts2
 314                      id_rsa.pub id_dsa.pub identity.pub/) {
 315         my $file = "$dir/.ssh/$name";
 316         from_ssh_auth_file $file if -r $file;
 317     }
 318 }
 319
 320 sub from_user_all () {
 321     # This was one loop initially, but does not work with some Perl
 322     # versions.
 323     setpwent;
 324     my @names;
 325     while (my $name = getpwent) {
 326         push @names, $name;
 327     }
 328     endpwent;
 329     from_user $_ for @names;
 330 }
 331
 332 if (@ARGV && $ARGV[0] eq '-c') {
 333     shift @ARGV;
 334     $db_file = shift @ARGV if @ARGV;
 335 }
 336 if (@ARGV) {
 337     open_db;
 338     my $cmd = shift @ARGV;
 339     if ($cmd eq 'file') {
 340         for my $name (@ARGV) {
 341             next if from_openvpn_key $name;
 342             from_ssh_auth_file $name;
 343         }
 344     } elsif ($cmd eq 'host') {
 345         from_ssh_host @ARGV;
 346     } elsif ($cmd eq 'user') {
 347         if (@ARGV) {
 348             from_user $_ for @ARGV;
 349         } else {
 350             from_user_all;
 351         }
 352     } elsif ($cmd eq 'help') {
 353         help;
 354         exit 0;
 355     } else {
 356         die "error: invalid command, use \"help\" to get help\n";
 357     }
 358     print_stats;
 359 } else {
 360     help;
 361     exit 1;
 362 }
 363
 364 my %hash;
 365
 366 __DATA__