Add sanity check for wrong uses of check_hash
[dowkd.git] / dowkd.in
blobc544af614316dfc851899dd0a2b0827c2f17be34
1 #!/usr/bin/perl
3 # Debian/OpenSSL Weak Key Detector
5 # Copyright (C) 2008, Florian Weimer <fw@deneb.enyo.de>
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.
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.
22 # Blacklist data has been provided by Kees Cook, Peter Palfrader and
23 # James Strandboge.
25 # Patches and comments are welcome. Please send them to
26 # <fw@deneb.enyo.de>, and use "dowkd" in the subject line.
28 # This version is based on commit @PROGRAM_SHA1@
29 # in the GIT repository at <http://repo.or.cz/w/dowkd.git>.
31 use strict;
32 use warnings;
34 sub help () {
35 print <<EOF;
36 usage: $0 [OPTIONS...] COMMAND [ARGUMENTS...]
38 COMMAND is one of:
40 file: examine files on the command line for weak keys
41 host: examine the specified hosts for weak SSH keys
42 (change destination port with "host -p PORT HOST...")
43 user: examine user SSH keys for weakness; examine all users if no
44 users are given
45 quick: check this host for weak keys (encompasses "user" plus
46 heuristics to find keys in /etc)
47 help: show this help screen
48 version: show version information
50 OPTIONS is one of:
52 -c FILE: set the database cache file name (default: dowkd.db)
54 dowkd currently handles the following OpenSSH host and user keys,
55 provided they have been generated on a little-endian architecture
56 (such as i386 or amd64):
58 RSA/1024, RSA/2048, RSA1/1024, RSA1/2048
59 RSA/4096
60 DSA/1024
62 (The relevant OpenSSH versions in Debian do not support DSA key
63 generation with other sizes.)
65 OpenVPN shared also detected if they have been created on
66 little-endian architectures.
68 Unencrypted RSA private keys and PEM certificate files generated by
69 OpenSSL are detected, provided they use key lengths of 1024, 2048 or
70 4096 bits (again, only for little-endian architectures).
72 Note that the blacklist by dowkd may be incomplete; it is only
73 intended as a quick check.
75 EOF
78 use DB_File;
79 use File::Temp;
80 use Fcntl;
81 use IO::Handle;
83 my $db_version = '@DB_VERSION@';
84 my $program_version = '@PROGRAM_VERSION@';
86 my $db_file = 'dowkd.db';
88 my $db;
89 my %db;
91 sub create_db () {
92 warn "notice: creating database, please wait\n";
93 $db = tie %db, 'DB_File', $db_file, O_RDWR | O_CREAT, 0777, $DB_BTREE
94 or die "error: could not open database: $!\n";
96 my $found;
97 while (my $line = <DATA>) {
98 next if $line =~ /^\**$/;
99 chomp $line;
100 $line =~ /^[0-9a-f]{32}$/ or die "error: invalid data line";
101 $line =~ s/(..)/chr(hex($1))/ge;
102 $db{$line} = '';
103 $found = 1;
105 $found or die "error: no blacklist data found in script\n";
107 # Set at the end so that no incomplete database is left behind.
108 $db{''} = $db_version;
110 $db->sync;
113 sub open_db () {
114 if (-r $db_file) {
115 $db = tie %db, 'DB_File', $db_file, O_RDONLY, 0777, $DB_BTREE
116 or die "error: could not open database: $!\n";
117 my $stored_version = $db{''};
118 $stored_version && $stored_version eq $db_version or create_db;
119 } else {
120 unlink $db_file;
121 create_db;
125 sub safe_backtick (@) {
126 my @args = @_;
127 my $fh;
128 open $fh, '-|', @args
129 or die "error: failed to spawn $args[0]: $!\n";
130 my @result;
131 if (wantarray) {
132 @result = <$fh>;
133 } else {
134 local $/;
135 @result = scalar(<$fh>);
137 close $fh;
138 $? == 0 or return undef;
139 if (wantarray) {
140 return @result;
141 } else {
142 return $result[0];
146 sub safe_backtick_stderr {
147 my @args = @_;
148 my $fh;
149 my $pid = open $fh, '-|';
150 if ($pid) {
151 my @result = <$fh>;
152 close $fh;
153 $? == 0 or return undef;
154 if (wantarray) {
155 return @result;
156 } else {
157 return join('', @result);
159 } else {
160 open STDERR, '>&STDOUT' or die "error: could not redirect stderr: $!";
161 exec @args or die "exec: failed: $!";
165 my $keys_found = 0;
166 my $keys_vulnerable = 0;
168 sub print_stats () {
169 print STDERR "summary: keys found: $keys_found, weak keys: $keys_vulnerable\n";
172 sub check_hash ($$;$) {
173 my ($name, $hash, $descr) = @_;
174 $hash && length($hash) == 16 or die "wrong hash size " . length($hash);
175 ++$keys_found;
176 if (exists $db{$hash}) {
177 ++$keys_vulnerable;
178 $descr = $descr ? " ($descr)" : '';
179 print "$name: weak key$descr\n";
180 return 1;
182 return 0;
185 sub ssh_fprint_file ($) {
186 my $name = shift;
187 my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
188 defined $data or return ();
189 my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
190 return @data if @data == 2;
191 return ();
194 sub ssh_fprint_check ($$$$) {
195 my ($name, $type, $length, $hash) = @_;
196 $type =~ /^(?:rsa1?|dsa)\z/ or die;
197 if (($type eq 'rsa'
198 && ($length == 1024 || $length == 2048 || $length == 4096))
199 || ($type eq 'dsa' && $length == 1024)
200 || ($type eq 'rsa1' && ($length == 1024 || $length == 2048))) {
201 $hash =~ y/://d;
202 $hash =~ s/(..)/chr(hex($1))/ge;
203 check_hash $name, $hash, "OpenSSH/$type/$length";
204 } elsif ($type eq 'dsa') {
205 print "$name: $length bits DSA key not recommended\n";
206 } else {
207 warn "$name: warning: no blacklist for $type/$length key\n";
211 sub clear_tmp ($) {
212 my $tmp = shift;
213 seek $tmp, 0, 0 or die "seek: $!";
214 truncate $tmp, 0 or die "truncate: $!";
217 sub cleanup_ssh_auth_line ($) {
218 my $line = shift;
220 $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
222 OUTSIDE_STRING:
223 if ($line =~ /^\s+(.*)/) {
224 $line = $1;
225 goto SPACE_SEEN;
227 if ($line =~ /^"(.*)/) {
228 $line = $1;
229 goto INSIDE_STRING;
231 if ($line =~ /^\\.(.*)/) {
232 # It doesn't matter if we don't deal with \000 properly, we
233 # just need to defuse the backslash character.
234 $line = $1;
235 goto OUTSIDE_STRING;
237 if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
238 # Skip multiple harmless characters in one go.
239 $line = $1;
240 goto OUTSIDE_STRING;
242 if ($line =~ /^.(.*)/) {
243 # Other characters are stripped one by one.
244 $line = $1;
245 goto OUTSIDE_STRING;
247 return undef; # empty string, no key found
249 INSIDE_STRING:
250 if ($line =~ /^"(.*)/) {
251 $line = $1;
252 goto OUTSIDE_STRING;
254 if ($line =~ /^\\.(.*)/) {
255 # See above, defuse the backslash.
256 $line = $1;
257 goto INSIDE_STRING;
259 if ($line =~ /^[^\\"]+(.*)/) {
260 $line = $1;
261 goto INSIDE_STRING;
263 return undef; # missing closing double quote
265 SPACE_SEEN:
266 $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
267 return undef;
270 sub derive_ssh_auth_type ($) {
271 my $line = shift;
272 $line =~ /^ssh-rsa\s/ and return 'rsa';
273 $line =~ /^ssh-dss\s/ and return 'dsa';
274 $line =~ /^\d+\s/ and return 'rsa1';
275 return undef;
278 sub from_ssh_auth_line ($$$) {
279 my ($tmp, $name, $line) = @_;
280 chomp $line;
283 my $l = cleanup_ssh_auth_line $line;
284 $l or return 0;
285 $line = $l;
287 my $type = derive_ssh_auth_type $line;
289 clear_tmp $tmp;
290 print $tmp "$line\n" or die "print: $!";
291 $tmp->flush or die "flush: $!";
292 my ($length, $hash) = ssh_fprint_file "$tmp";
293 if ($length && $hash) {
294 ssh_fprint_check "$name", $type, $length, $hash;
295 return 1;
298 return 0;
301 sub from_ssh_auth_file ($) {
302 my $name = shift;
303 my $auth;
304 unless (open $auth, '<', $name) {
305 warn "$name:0: error: open failed: $!\n";
306 return;
309 my $tmp = new File::Temp;
310 my $last_status = 1;
311 while (my $line = <$auth>) {
312 next if $line =~ m/^\s*(#|$)/;
313 my $status = from_ssh_auth_line $tmp, "$name:$.", $line;
314 unless ($status) {
315 $last_status and warn "$name:$.: warning: unparsable line\n";
317 $last_status = $status;
321 sub from_openvpn_key ($) {
322 my $name = shift;
323 my $key;
324 unless (open $key, '<', $name) {
325 warn "$name:0: open failed: $!\n";
326 return 1;
329 my $marker;
330 while (my $line = <$key>) {
331 return 0 if $. > 10;
332 if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
333 $marker = 1;
334 } elsif ($marker) {
335 if ($line =~ /^([0-9a-f]{32})/) {
336 $line = $1;
337 $line =~ s/(..)/chr(hex($1))/ge;
338 check_hash "$name:$.", $line, "OpenVPN";
339 return 1;
340 } else {
341 warn "$name:$.: warning: illegal OpenVPN file format\n";
342 return 1;
348 sub openssl_output_check ($$) {
349 my ($name, $output) = @_;
350 my ($length) =
351 $output =~ /^(?:\s+RSA Public |Private-)Key: \((\d+) bit\)/m;
352 $length or die "internal error: could not parse OpenSSL output\n";
353 my ($modulus) =
354 $output =~ /(?:modulus|\s+Modulus\ \(\d+\ bit\)):$ \s+
355 ( (?:^\s+ (?:[0-9a-f]{2}:)+$ \s+)+
356 ^\s+ (?:[0-9a-f]{2}:)*(?:[0-9a-f]{2})$ )/xm;
357 $modulus or die "internal error: could not parse modulus\n";
358 $modulus =~ y/0-9a-f//cd;
359 my ($exponent) = $output =~ /^(?:\s+|public)Exponent: (\d+) \(0x/m;
360 $exponent or die "internal error: could not parse exponent\n";
362 if ($length == 1024 || $length == 2048 || $length == 4096) {
363 my $mod = substr $modulus, length($modulus) - 32;
364 $mod =~ y/A-F/a-f/;
365 my @mod = $mod =~ /(..)/g;
366 $mod = join('', map { chr(hex($_)) } reverse @mod);
367 length($mod) == 16 or die;
368 return if check_hash $name, $mod, "OpenSSL/RSA/$length";
369 warn "$name: warning: no blacklist for OpenSSL/RSA/$length key (e=$exponent)\n"
370 if $exponent != 65537;
371 } else {
372 warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
376 sub from_pem ($) {
377 my $name = shift;
378 my $tmp;
379 my $found = 0;
381 my $src;
382 unless (open $src, '<', $name) {
383 warn "$name:0: open failed: $!\n";
384 return 1;
387 while (my $line = <$src>) {
388 if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
389 my $lineno = $.;
390 $tmp or $tmp = new File::Temp;
391 clear_tmp $tmp;
392 do {
393 print $tmp $line or die "print: $!";
394 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
395 } while ($line = <$src>);
396 LAST:
397 $tmp->flush or die "flush: $!";
398 my $out = safe_backtick qw/openssl x509 -noout -text -in/, $tmp;
399 if ($out) {
400 openssl_output_check "$name:$lineno", $out;
401 $found = 1;
402 } else {
403 warn "$name:$lineno: failed to parse certificate\n";
404 return 1;
406 } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
407 my $lineno = $.;
408 $tmp or $tmp = new File::Temp;
409 clear_tmp $tmp;
410 do {
411 print $tmp $line or die "print: $!";
412 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
413 } while ($line = <$src>);
414 LAST_RSA:
415 $tmp->flush or die "flush: $!";
416 my $out = safe_backtick qw/openssl rsa -noout -text -in/, $tmp;
417 if ($out) {
418 openssl_output_check "$name:$lineno", $out;
419 $found = 1;
420 } else {
421 warn "$name:$lineno: failed to parse RSA private key\n";
422 return 1;
427 return $found;
430 sub from_ssh_host ($@) {
431 my ($port, @names) = @_;
433 @names = grep {
434 my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
435 @addrs or warn "warning: host not found: $_\n";
436 @addrs > 0;
437 } @names;
439 my @lines= safe_backtick_stderr qw/ssh-keyscan -t/, 'rsa1,rsa,dsa',
440 '-p', $port, @names;
442 my $tmp = new File::Temp;
443 for my $line (@lines) {
444 next if $line =~ /^(?:#|no hostkey alg)/;
445 my ($host, $data) = $line =~ /^(\S+) (.*)$/;
446 $host && from_ssh_auth_line $tmp, $host, $data
447 or die "$host: warning: unparsable line: $line";
451 sub from_user ($) {
452 my $user = shift;
453 my ($name,$passwd,$uid,$gid,
454 $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
455 unless ($name) {
456 warn "warning: user $user does not exist\n";
457 return;
459 for my $name (qw/authorized_keys authorized_keys2
460 known_hosts known_hosts2
461 id_rsa.pub id_dsa.pub identity.pub/) {
462 my $file = "$dir/.ssh/$name";
463 from_ssh_auth_file $file if -r $file;
467 sub from_user_all () {
468 # This was one loop initially, but does not work with some Perl
469 # versions.
470 setpwent;
471 my @names;
472 while (my $name = getpwent) {
473 push @names, $name;
475 endpwent;
476 from_user $_ for @names;
479 sub from_any_file ($) {
480 my $name = shift;
481 from_openvpn_key $name and return;
482 from_pem $name and return;
483 from_ssh_auth_file $name;
486 sub from_etc () {
487 my $find;
488 open $find, '-|', qw!find /etc -type f (
489 -name *.key -o -name *.pem -o -name *.crt
490 ) -print0! or die "error: could not spawn find: $!";
491 my @files;
493 local $/ = "\0";
494 @files = <$find>;
496 close $find;
497 $? == 0 or die "error: find failed with exit status $?\n";
498 for my $file (@files) {
499 -e $file and from_any_file $file;
503 if (@ARGV && $ARGV[0] eq '-c') {
504 shift @ARGV;
505 $db_file = shift @ARGV if @ARGV;
507 if (@ARGV) {
508 open_db;
509 my $cmd = shift @ARGV;
510 if ($cmd eq 'file') {
511 for my $name (@ARGV) {
512 from_any_file $name;
514 } elsif ($cmd eq 'host') {
515 unless (@ARGV) {
516 help;
517 exit 1;
519 my $port = 22;
520 if ($ARGV[0] eq '-p') {
521 shift @ARGV;
522 if (@ARGV) {
523 $port = shift @ARGV;
525 } elsif ($ARGV[0] =~ /-p(\d+)/) {
526 $port = $1;
527 shift @ARGV;
529 unless (@ARGV) {
530 help;
531 exit 1;
533 from_ssh_host $port, @ARGV;
534 } elsif ($cmd eq 'user') {
535 if (@ARGV) {
536 from_user $_ for @ARGV;
537 } else {
538 from_user_all;
540 } elsif ($cmd eq 'quick') {
541 from_user_all;
542 for my $file (qw/ssh_host_rsa_key.pub ssh_host_dsa_key.pub
543 ssh_host_key ssh_known_hosts ssh_known_hosts2/) {
544 -e $file and from_ssh_auth_file $file;
546 from_etc;
547 } elsif ($cmd eq 'help') {
548 help;
549 exit 0;
550 } elsif ($cmd eq 'version') {
551 print "dowkd $program_version (database $db_version)\n\n";
552 print <<'EOF';
553 ChangeLog:
554 @CHANGELOG@
556 exit 0;
557 } else {
558 die "error: invalid command, use \"help\" to get help\n";
560 print_stats;
561 } else {
562 help;
563 exit 1;
566 __DATA__