Use one ssh-keyscan invocation to gather host keys
[dowkd.git] / dowkd.in
blobe4ba30a9264d0895229f8f51d773311d7dd52375
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= safe_backtick qw/ssh-keyscan -t/, 'rsa1,rsa,dsa', '-p',
410 $port, @names;
412 my $tmp = new File::Temp;
413 for my $line (@lines) {
414 next if $line =~ /^#/;
415 my ($host, $data) = $line =~ /^(\S+) (.*)$/;
416 from_ssh_auth_line $tmp, $host, $data
417 or die "$host: warning: unparsable line\n";
421 sub from_user ($) {
422 my $user = shift;
423 my ($name,$passwd,$uid,$gid,
424 $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
425 unless ($name) {
426 warn "warning: user $user does not exist\n";
427 return;
429 for my $name (qw/authorized_keys authorized_keys2
430 known_hosts known_hosts2
431 id_rsa.pub id_dsa.pub identity.pub/) {
432 my $file = "$dir/.ssh/$name";
433 from_ssh_auth_file $file if -r $file;
437 sub from_user_all () {
438 # This was one loop initially, but does not work with some Perl
439 # versions.
440 setpwent;
441 my @names;
442 while (my $name = getpwent) {
443 push @names, $name;
445 endpwent;
446 from_user $_ for @names;
449 sub from_any_file ($) {
450 my $name = shift;
451 from_openvpn_key $name and return;
452 from_pem $name and return;
453 from_ssh_auth_file $name;
456 sub from_etc () {
457 my $find;
458 open $find, '-|', qw!find /etc -type f (
459 -name *.key -o -name *.pem -o -name *.crt
460 ) -print0! or die "error: could not spawn find: $!";
461 my @files;
463 local $/ = "\0";
464 @files = <$find>;
466 close $find;
467 $? == 0 or die "error: find failed with exit status $?\n";
468 for my $file (@files) {
469 -e $file and from_any_file $file;
473 if (@ARGV && $ARGV[0] eq '-c') {
474 shift @ARGV;
475 $db_file = shift @ARGV if @ARGV;
477 if (@ARGV) {
478 open_db;
479 my $cmd = shift @ARGV;
480 if ($cmd eq 'file') {
481 for my $name (@ARGV) {
482 from_any_file $name;
484 } elsif ($cmd eq 'host') {
485 unless (@ARGV) {
486 help;
487 exit 1;
489 my $port = 22;
490 if ($ARGV[0] eq '-p') {
491 shift @ARGV;
492 if (@ARGV) {
493 $port = shift @ARGV;
495 } elsif ($ARGV[0] =~ /-p(\d+)/) {
496 $port = $1;
497 shift @ARGV;
499 unless (@ARGV) {
500 help;
501 exit 1;
503 from_ssh_host $port, @ARGV;
504 } elsif ($cmd eq 'user') {
505 if (@ARGV) {
506 from_user $_ for @ARGV;
507 } else {
508 from_user_all;
510 } elsif ($cmd eq 'quick') {
511 from_user_all;
512 for my $file (qw/ssh_host_rsa_key.pub ssh_host_dsa_key.pub
513 ssh_host_key known_hosts known_hosts2/) {
514 -e $file and from_ssh_auth_file $file;
516 from_etc;
517 } elsif ($cmd eq 'help') {
518 help;
519 exit 0;
520 } elsif ($cmd eq 'version') {
521 print "dowkd $program_version (database $db_version)\n\n$changelog";
522 exit 0;
523 } else {
524 die "error: invalid command, use \"help\" to get help\n";
526 print_stats;
527 } else {
528 help;
529 exit 1;
532 my %hash;
534 __DATA__