Change check_hash to return a result indicator
[dowkd.git] / dowkd.in
blob9b5f79bd746558e6923ebc78747801e9b13d9541
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 or 2048
70 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 ++$keys_found;
175 if (exists $db{$hash}) {
176 ++$keys_vulnerable;
177 $descr = $descr ? " ($descr)" : '';
178 print "$name: weak key$descr\n";
179 return 1;
181 return 0;
184 sub ssh_fprint_file ($) {
185 my $name = shift;
186 my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
187 defined $data or return ();
188 my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
189 return @data if @data == 2;
190 return ();
193 sub ssh_fprint_check ($$$$) {
194 my ($name, $type, $length, $hash) = @_;
195 $type =~ /^(?:rsa1?|dsa)\z/ or die;
196 if (($type eq 'rsa'
197 && ($length == 1024 || $length == 2048 || $length == 4096))
198 || ($type eq 'dsa' && $length == 1024)
199 || ($type eq 'rsa1' && ($length == 1024 || $length == 2048))) {
200 $hash =~ y/://d;
201 $hash =~ s/(..)/chr(hex($1))/ge;
202 check_hash $name, $hash, "OpenSSH/$type/$length";
203 } elsif ($type eq 'dsa') {
204 print "$name: $length bits DSA key not recommended\n";
205 } else {
206 warn "$name: warning: no blacklist for $type/$length key\n";
210 sub clear_tmp ($) {
211 my $tmp = shift;
212 seek $tmp, 0, 0 or die "seek: $!";
213 truncate $tmp, 0 or die "truncate: $!";
216 sub cleanup_ssh_auth_line ($) {
217 my $line = shift;
219 $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
221 OUTSIDE_STRING:
222 if ($line =~ /^\s+(.*)/) {
223 $line = $1;
224 goto SPACE_SEEN;
226 if ($line =~ /^"(.*)/) {
227 $line = $1;
228 goto INSIDE_STRING;
230 if ($line =~ /^\\.(.*)/) {
231 # It doesn't matter if we don't deal with \000 properly, we
232 # just need to defuse the backslash character.
233 $line = $1;
234 goto OUTSIDE_STRING;
236 if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
237 # Skip multiple harmless characters in one go.
238 $line = $1;
239 goto OUTSIDE_STRING;
241 if ($line =~ /^.(.*)/) {
242 # Other characters are stripped one by one.
243 $line = $1;
244 goto OUTSIDE_STRING;
246 return undef; # empty string, no key found
248 INSIDE_STRING:
249 if ($line =~ /^"(.*)/) {
250 $line = $1;
251 goto OUTSIDE_STRING;
253 if ($line =~ /^\\.(.*)/) {
254 # See above, defuse the backslash.
255 $line = $1;
256 goto INSIDE_STRING;
258 if ($line =~ /^[^\\"]+(.*)/) {
259 $line = $1;
260 goto INSIDE_STRING;
262 return undef; # missing closing double quote
264 SPACE_SEEN:
265 $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
266 return undef;
269 sub derive_ssh_auth_type ($) {
270 my $line = shift;
271 $line =~ /^ssh-rsa\s/ and return 'rsa';
272 $line =~ /^ssh-dss\s/ and return 'dsa';
273 $line =~ /^\d+\s/ and return 'rsa1';
274 return undef;
277 sub from_ssh_auth_line ($$$) {
278 my ($tmp, $name, $line) = @_;
279 chomp $line;
282 my $l = cleanup_ssh_auth_line $line;
283 $l or return 0;
284 $line = $l;
286 my $type = derive_ssh_auth_type $line;
288 clear_tmp $tmp;
289 print $tmp "$line\n" or die "print: $!";
290 $tmp->flush or die "flush: $!";
291 my ($length, $hash) = ssh_fprint_file "$tmp";
292 if ($length && $hash) {
293 ssh_fprint_check "$name", $type, $length, $hash;
294 return 1;
297 return 0;
300 sub from_ssh_auth_file ($) {
301 my $name = shift;
302 my $auth;
303 unless (open $auth, '<', $name) {
304 warn "$name:0: error: open failed: $!\n";
305 return;
308 my $tmp = new File::Temp;
309 my $last_status = 1;
310 while (my $line = <$auth>) {
311 next if $line =~ m/^\s*(#|$)/;
312 my $status = from_ssh_auth_line $tmp, "$name:$.", $line;
313 unless ($status) {
314 $last_status and warn "$name:$.: warning: unparsable line\n";
316 $last_status = $status;
320 sub from_openvpn_key ($) {
321 my $name = shift;
322 my $key;
323 unless (open $key, '<', $name) {
324 warn "$name:0: open failed: $!\n";
325 return 1;
328 my $marker;
329 while (my $line = <$key>) {
330 return 0 if $. > 10;
331 if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
332 $marker = 1;
333 } elsif ($marker) {
334 if ($line =~ /^([0-9a-f]{32})/) {
335 $line = $1;
336 $line =~ s/(..)/chr(hex($1))/ge;
337 check_hash "$name:$.", $line, "OpenVPN";
338 return 1;
339 } else {
340 warn "$name:$.: warning: illegal OpenVPN file format\n";
341 return 1;
347 sub openssl_modulus_check ($$) {
348 my ($name, $modulus) = @_;
349 chomp $modulus;
350 if ($modulus =~ /^Modulus=([A-F0-9]+)$/) {
351 $modulus = $1;
352 my $length = length($modulus) * 4;
353 if ($length == 1024 || $length == 2048) {
354 my $mod = substr $modulus, length($modulus) - 32;
355 $mod =~ y/A-F/a-f/;
356 my @mod = $mod =~ /(..)/g;
357 $mod = join('', map { chr(hex($_)) } reverse @mod);
358 check_hash $name, $mod, "OpenSSL/RSA/$length";
359 } else {
360 warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
362 } else {
363 die "internal error: $modulus\n";
367 sub from_pem ($) {
368 my $name = shift;
369 my $tmp;
370 my $found = 0;
372 my $src;
373 unless (open $src, '<', $name) {
374 warn "$name:0: open failed: $!\n";
375 return 1;
378 while (my $line = <$src>) {
379 if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
380 my $lineno = $.;
381 $tmp or $tmp = new File::Temp;
382 clear_tmp $tmp;
383 do {
384 print $tmp $line or die "print: $!";
385 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
386 } while ($line = <$src>);
387 LAST:
388 $tmp->flush or die "flush: $!";
389 my $mod = safe_backtick qw/openssl x509 -noout -modulus -in/, $tmp;
390 if ($mod) {
391 openssl_modulus_check "$name:$lineno", $mod;
392 $found = 1;
393 } else {
394 warn "$name:$lineno: failed to parse certificate\n";
395 return 1;
397 } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
398 my $lineno = $.;
399 $tmp or $tmp = new File::Temp;
400 clear_tmp $tmp;
401 do {
402 print $tmp $line or die "print: $!";
403 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
404 } while ($line = <$src>);
405 LAST_RSA:
406 $tmp->flush or die "flush: $!";
407 my $mod = safe_backtick qw/openssl rsa -noout -modulus -in/, $tmp;
408 if ($mod) {
409 openssl_modulus_check "$name:$lineno", $mod;
410 $found = 1;
411 } else {
412 warn "$name:$lineno: failed to parse RSA private key\n";
413 return 1;
418 return $found;
421 sub from_ssh_host ($@) {
422 my ($port, @names) = @_;
424 @names = grep {
425 my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
426 @addrs or warn "warning: host not found: $_\n";
427 @addrs > 0;
428 } @names;
430 my @lines= safe_backtick_stderr qw/ssh-keyscan -t/, 'rsa1,rsa,dsa',
431 '-p', $port, @names;
433 my $tmp = new File::Temp;
434 for my $line (@lines) {
435 next if $line =~ /^(?:#|no hostkey alg)/;
436 my ($host, $data) = $line =~ /^(\S+) (.*)$/;
437 $host && from_ssh_auth_line $tmp, $host, $data
438 or die "$host: warning: unparsable line: $line";
442 sub from_user ($) {
443 my $user = shift;
444 my ($name,$passwd,$uid,$gid,
445 $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
446 unless ($name) {
447 warn "warning: user $user does not exist\n";
448 return;
450 for my $name (qw/authorized_keys authorized_keys2
451 known_hosts known_hosts2
452 id_rsa.pub id_dsa.pub identity.pub/) {
453 my $file = "$dir/.ssh/$name";
454 from_ssh_auth_file $file if -r $file;
458 sub from_user_all () {
459 # This was one loop initially, but does not work with some Perl
460 # versions.
461 setpwent;
462 my @names;
463 while (my $name = getpwent) {
464 push @names, $name;
466 endpwent;
467 from_user $_ for @names;
470 sub from_any_file ($) {
471 my $name = shift;
472 from_openvpn_key $name and return;
473 from_pem $name and return;
474 from_ssh_auth_file $name;
477 sub from_etc () {
478 my $find;
479 open $find, '-|', qw!find /etc -type f (
480 -name *.key -o -name *.pem -o -name *.crt
481 ) -print0! or die "error: could not spawn find: $!";
482 my @files;
484 local $/ = "\0";
485 @files = <$find>;
487 close $find;
488 $? == 0 or die "error: find failed with exit status $?\n";
489 for my $file (@files) {
490 -e $file and from_any_file $file;
494 if (@ARGV && $ARGV[0] eq '-c') {
495 shift @ARGV;
496 $db_file = shift @ARGV if @ARGV;
498 if (@ARGV) {
499 open_db;
500 my $cmd = shift @ARGV;
501 if ($cmd eq 'file') {
502 for my $name (@ARGV) {
503 from_any_file $name;
505 } elsif ($cmd eq 'host') {
506 unless (@ARGV) {
507 help;
508 exit 1;
510 my $port = 22;
511 if ($ARGV[0] eq '-p') {
512 shift @ARGV;
513 if (@ARGV) {
514 $port = shift @ARGV;
516 } elsif ($ARGV[0] =~ /-p(\d+)/) {
517 $port = $1;
518 shift @ARGV;
520 unless (@ARGV) {
521 help;
522 exit 1;
524 from_ssh_host $port, @ARGV;
525 } elsif ($cmd eq 'user') {
526 if (@ARGV) {
527 from_user $_ for @ARGV;
528 } else {
529 from_user_all;
531 } elsif ($cmd eq 'quick') {
532 from_user_all;
533 for my $file (qw/ssh_host_rsa_key.pub ssh_host_dsa_key.pub
534 ssh_host_key ssh_known_hosts ssh_known_hosts2/) {
535 -e $file and from_ssh_auth_file $file;
537 from_etc;
538 } elsif ($cmd eq 'help') {
539 help;
540 exit 0;
541 } elsif ($cmd eq 'version') {
542 print "dowkd $program_version (database $db_version)\n\n";
543 print <<'EOF';
544 ChangeLog:
545 @CHANGELOG@
547 exit 0;
548 } else {
549 die "error: invalid command, use \"help\" to get help\n";
551 print_stats;
552 } else {
553 help;
554 exit 1;
557 __DATA__