Add "quick" host check command
[dowkd.git] / dowkd.in
blob605080fa6d92be5c954937cadeb83d3ac6e71af8
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 use strict;
29 use warnings;
31 sub help () {
32 print <<EOF;
33 usage: $0 [OPTIONS...] COMMAND [ARGUMENTS...]
35 COMMAND is one of:
37 file: examine files on the command line for weak keys
38 host: examine the specified hosts for weak SSH keys
39 (change destination port with "host -p PORT HOST...")
40 user: examine user SSH keys for weakness; examine all users if no
41 users are given
42 quick: check this host for weak keys (encompasses "user" plus
43 heuristics to find keys in /etc)
44 help: show this help screen
45 version: show version information
47 OPTIONS is one of:
49 -c FILE: set the database cache file name (default: dowkd.db)
51 dowkd currently handles the following OpenSSH host and user keys,
52 provided they have been generated on a little-endian architecture
53 (such as i386 or amd64):
55 RSA/1024, RSA/2048 (both rsa1 and rsa format)
56 DSA/1024
58 (The relevant OpenSSH versions in Debian do not support DSA key
59 generation with other sizes.)
61 OpenVPN shared also detected if they have been created on
62 little-endian architectures.
64 Unencrypted RSA private keys and PEM certificate files generated by
65 OpenSSL are detected, provided they use key lengths of 1024 or 2048
66 bits (again, only for little-endian architectures).
68 Note that the blacklist by dowkd may be incomplete; it is only
69 intended as a quick check.
71 EOF
74 use DB_File;
75 use File::Temp;
76 use Fcntl;
77 use IO::Handle;
79 my $db_version = '@DB_VERSION@';
80 my $program_version = '@PROGRAM_VERSION@';
81 my $changelog = <<'EOF';
82 ChangeLog:
83 @CHANGELOG@
84 EOF
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 my $keys_found = 0;
147 my $keys_vulnerable = 0;
149 sub print_stats () {
150 print STDERR "summary: keys found: $keys_found, weak keys: $keys_vulnerable\n";
153 sub check_hash ($$;$) {
154 my ($name, $hash, $descr) = @_;
155 ++$keys_found;
156 if (exists $db{$hash}) {
157 ++$keys_vulnerable;
158 $descr = $descr ? " ($descr)" : '';
159 print "$name: weak key$descr\n";
163 sub ssh_fprint_file ($) {
164 my $name = shift;
165 my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
166 defined $data or return ();
167 my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
168 return @data if @data == 2;
169 return ();
172 sub ssh_fprint_check ($$$$) {
173 my ($name, $type, $length, $hash) = @_;
174 $type =~ /^(?:rsa1?|dsa)\z/ or die;
175 if (($type eq 'rsa'
176 && ($length == 1024 || $length == 2048 || $length == 4096))
177 || ($type eq 'dsa' && $length == 1024)
178 || ($type eq 'rsa1' && $length == 1024)) {
179 $hash =~ y/://d;
180 $hash =~ s/(..)/chr(hex($1))/ge;
181 check_hash $name, $hash, "OpenSSH/$type/$length";
182 } elsif ($type eq 'dsa') {
183 print "$name: $length bits DSA key not recommended\n";
184 } else {
185 warn "$name: warning: no blacklist for $type/$length key\n";
189 sub clear_tmp ($) {
190 my $tmp = shift;
191 seek $tmp, 0, 0 or die "seek: $!";
192 truncate $tmp, 0 or die "truncate: $!";
195 sub cleanup_ssh_auth_line ($) {
196 my $line = shift;
198 $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
200 OUTSIDE_STRING:
201 if ($line =~ /^\s+(.*)/) {
202 $line = $1;
203 goto SPACE_SEEN;
205 if ($line =~ /^"(.*)/) {
206 $line = $1;
207 goto INSIDE_STRING;
209 if ($line =~ /^\\.(.*)/) {
210 # It doesn't matter if we don't deal with \000 properly, we
211 # just need to defuse the backslash character.
212 $line = $1;
213 goto OUTSIDE_STRING;
215 if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
216 # Skip multiple harmless characters in one go.
217 $line = $1;
218 goto OUTSIDE_STRING;
220 if ($line =~ /^.(.*)/) {
221 # Other characters are stripped one by one.
222 $line = $1;
223 goto OUTSIDE_STRING;
225 return undef; # empty string, no key found
227 INSIDE_STRING:
228 if ($line =~ /^"(.*)/) {
229 $line = $1;
230 goto OUTSIDE_STRING;
232 if ($line =~ /^\\.(.*)/) {
233 # See above, defuse the backslash.
234 $line = $1;
235 goto INSIDE_STRING;
237 if ($line =~ /^[^\\"]+(.*)/) {
238 $line = $1;
239 goto INSIDE_STRING;
241 return undef; # missing closing double quote
243 SPACE_SEEN:
244 $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
245 return undef;
248 sub derive_ssh_auth_type ($) {
249 my $line = shift;
250 $line =~ /^ssh-rsa\s/ and return 'rsa';
251 $line =~ /^ssh-dss\s/ and return 'dsa';
252 $line =~ /^\d+\s/ and return 'rsa1';
253 return undef;
256 sub from_ssh_auth_line ($$$) {
257 my ($tmp, $name, $line) = @_;
258 chomp $line;
261 my $l = cleanup_ssh_auth_line $line;
262 $l or return 0;
263 $line = $l;
265 my $type = derive_ssh_auth_type $line;
267 clear_tmp $tmp;
268 print $tmp "$line\n" or die "print: $!";
269 $tmp->flush or die "flush: $!";
270 my ($length, $hash) = ssh_fprint_file "$tmp";
271 if ($length && $hash) {
272 ssh_fprint_check "$name", $type, $length, $hash;
273 return 1;
276 return 0;
279 sub from_ssh_auth_file ($) {
280 my $name = shift;
281 my $auth;
282 unless (open $auth, '<', $name) {
283 warn "$name:0: error: open failed: $!\n";
284 return;
287 my $tmp = new File::Temp;
288 my $last_status = 1;
289 while (my $line = <$auth>) {
290 next if $line =~ m/^\s*(#|$)/;
291 my $status = from_ssh_auth_line $tmp, "$name:$.", $line;
292 unless ($status) {
293 $last_status and warn "$name:$.: warning: unparsable line\n";
295 $last_status = $status;
299 sub from_openvpn_key ($) {
300 my $name = shift;
301 my $key;
302 unless (open $key, '<', $name) {
303 warn "$name:0: open failed: $!\n";
304 return 1;
307 my $marker;
308 while (my $line = <$key>) {
309 return 0 if $. > 10;
310 if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
311 $marker = 1;
312 } elsif ($marker) {
313 if ($line =~ /^([0-9a-f]{32})/) {
314 $line = $1;
315 $line =~ s/(..)/chr(hex($1))/ge;
316 check_hash "$name:$.", $line, "OpenVPN";
317 return 1;
318 } else {
319 warn "$name:$.: warning: illegal OpenVPN file format\n";
320 return 1;
326 sub openssl_modulus_check ($$) {
327 my ($name, $modulus) = @_;
328 chomp $modulus;
329 if ($modulus =~ /^Modulus=([A-F0-9]+)$/) {
330 $modulus = $1;
331 my $length = length($modulus) * 4;
332 if ($length == 1024 || $length == 2048) {
333 my $mod = substr $modulus, length($modulus) - 32;
334 $mod =~ y/A-F/a-f/;
335 my @mod = $mod =~ /(..)/g;
336 $mod = join('', map { chr(hex($_)) } reverse @mod);
337 check_hash $name, $mod, "OpenSSL/RSA/$length";
338 } else {
339 warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
341 } else {
342 die "internal error: $modulus\n";
346 sub from_pem ($) {
347 my $name = shift;
348 my $tmp;
349 my $found = 0;
351 my $src;
352 unless (open $src, '<', $name) {
353 warn "$name:0: open failed: $!\n";
354 return 1;
357 while (my $line = <$src>) {
358 if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
359 my $lineno = $.;
360 $tmp or $tmp = new File::Temp;
361 clear_tmp $tmp;
362 do {
363 print $tmp $line or die "print: $!";
364 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
365 } while ($line = <$src>);
366 LAST:
367 $tmp->flush or die "flush: $!";
368 my $mod = safe_backtick qw/openssl x509 -noout -modulus -in/, $tmp;
369 if ($mod) {
370 openssl_modulus_check "$name:$lineno", $mod;
371 $found = 1;
372 } else {
373 warn "$name:$lineno: failed to parse certificate\n";
374 return 1;
376 } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
377 my $lineno = $.;
378 $tmp or $tmp = new File::Temp;
379 clear_tmp $tmp;
380 do {
381 print $tmp $line or die "print: $!";
382 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
383 } while ($line = <$src>);
384 LAST_RSA:
385 $tmp->flush or die "flush: $!";
386 my $mod = safe_backtick qw/openssl rsa -noout -modulus -in/, $tmp;
387 if ($mod) {
388 openssl_modulus_check "$name:$lineno", $mod;
389 $found = 1;
390 } else {
391 warn "$name:$lineno: failed to parse RSA private key\n";
392 return 1;
397 return $found;
400 sub from_ssh_host ($@) {
401 my ($port, @names) = @_;
403 @names = grep {
404 my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
405 @addrs or warn "warning: host not found: $_\n";
406 @addrs > 0;
407 } @names;
409 my @lines;
410 push @lines, safe_backtick qw/ssh-keyscan -t rsa -p/, $port, @names;
411 push @lines, safe_backtick qw/ssh-keyscan -t dsa -p/, $port, @names;
413 my $tmp = new File::Temp;
414 for my $line (@lines) {
415 next if $line =~ /^#/;
416 my ($host, $data) = $line =~ /^(\S+) (.*)$/;
417 from_ssh_auth_line $tmp, $host, $data
418 or die "$host: warning: unparsable line\n";
422 sub from_user ($) {
423 my $user = shift;
424 my ($name,$passwd,$uid,$gid,
425 $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
426 unless ($name) {
427 warn "warning: user $user does not exist\n";
428 return;
430 for my $name (qw/authorized_keys authorized_keys2
431 known_hosts known_hosts2
432 id_rsa.pub id_dsa.pub identity.pub/) {
433 my $file = "$dir/.ssh/$name";
434 from_ssh_auth_file $file if -r $file;
438 sub from_user_all () {
439 # This was one loop initially, but does not work with some Perl
440 # versions.
441 setpwent;
442 my @names;
443 while (my $name = getpwent) {
444 push @names, $name;
446 endpwent;
447 from_user $_ for @names;
450 sub from_any_file ($) {
451 my $name = shift;
452 from_openvpn_key $name and return;
453 from_pem $name and return;
454 from_ssh_auth_file $name;
457 sub from_etc () {
458 my $find;
459 open $find, '-|', qw!find /etc -type f (
460 -name *.key -o -name *.pem -o -name *.crt
461 ) -print0! or die "error: could not spawn find: $!";
462 my @files;
464 local $/ = "\0";
465 @files = <$find>;
467 close $find;
468 $? == 0 or die "error: find failed with exit status $?\n";
469 for my $file (@files) {
470 -e $file and from_any_file $file;
474 if (@ARGV && $ARGV[0] eq '-c') {
475 shift @ARGV;
476 $db_file = shift @ARGV if @ARGV;
478 if (@ARGV) {
479 open_db;
480 my $cmd = shift @ARGV;
481 if ($cmd eq 'file') {
482 for my $name (@ARGV) {
483 from_any_file $name;
485 } elsif ($cmd eq 'host') {
486 unless (@ARGV) {
487 help;
488 exit 1;
490 my $port = 22;
491 if ($ARGV[0] eq '-p') {
492 shift @ARGV;
493 if (@ARGV) {
494 $port = shift @ARGV;
496 } elsif ($ARGV[0] =~ /-p(\d+)/) {
497 $port = $1;
498 shift @ARGV;
500 unless (@ARGV) {
501 help;
502 exit 1;
504 from_ssh_host $port, @ARGV;
505 } elsif ($cmd eq 'user') {
506 if (@ARGV) {
507 from_user $_ for @ARGV;
508 } else {
509 from_user_all;
511 } elsif ($cmd eq 'quick') {
512 from_user_all;
513 for my $file (qw/ssh_host_rsa_key.pub ssh_host_dsa_key.pub
514 ssh_host_key known_hosts known_hosts2/) {
515 -e $file and from_ssh_auth_file $file;
517 from_etc;
518 } elsif ($cmd eq 'help') {
519 help;
520 exit 0;
521 } elsif ($cmd eq 'version') {
522 print "dowkd $program_version (database $db_version)\n\n$changelog";
523 exit 0;
524 } else {
525 die "error: invalid command, use \"help\" to get help\n";
527 print_stats;
528 } else {
529 help;
530 exit 1;
533 my %hash;
535 __DATA__