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