Move changelog near the end of the file
[dowkd.git] / dowkd.in
blob0ca0f74d6525452e2d7dc58136b249b8ffaa3bea
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";
182 sub ssh_fprint_file ($) {
183 my $name = shift;
184 my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
185 defined $data or return ();
186 my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
187 return @data if @data == 2;
188 return ();
191 sub ssh_fprint_check ($$$$) {
192 my ($name, $type, $length, $hash) = @_;
193 $type =~ /^(?:rsa1?|dsa)\z/ or die;
194 if (($type eq 'rsa'
195 && ($length == 1024 || $length == 2048 || $length == 4096))
196 || ($type eq 'dsa' && $length == 1024)
197 || ($type eq 'rsa1' && ($length == 1024 || $length == 2048))) {
198 $hash =~ y/://d;
199 $hash =~ s/(..)/chr(hex($1))/ge;
200 check_hash $name, $hash, "OpenSSH/$type/$length";
201 } elsif ($type eq 'dsa') {
202 print "$name: $length bits DSA key not recommended\n";
203 } else {
204 warn "$name: warning: no blacklist for $type/$length key\n";
208 sub clear_tmp ($) {
209 my $tmp = shift;
210 seek $tmp, 0, 0 or die "seek: $!";
211 truncate $tmp, 0 or die "truncate: $!";
214 sub cleanup_ssh_auth_line ($) {
215 my $line = shift;
217 $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
219 OUTSIDE_STRING:
220 if ($line =~ /^\s+(.*)/) {
221 $line = $1;
222 goto SPACE_SEEN;
224 if ($line =~ /^"(.*)/) {
225 $line = $1;
226 goto INSIDE_STRING;
228 if ($line =~ /^\\.(.*)/) {
229 # It doesn't matter if we don't deal with \000 properly, we
230 # just need to defuse the backslash character.
231 $line = $1;
232 goto OUTSIDE_STRING;
234 if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
235 # Skip multiple harmless characters in one go.
236 $line = $1;
237 goto OUTSIDE_STRING;
239 if ($line =~ /^.(.*)/) {
240 # Other characters are stripped one by one.
241 $line = $1;
242 goto OUTSIDE_STRING;
244 return undef; # empty string, no key found
246 INSIDE_STRING:
247 if ($line =~ /^"(.*)/) {
248 $line = $1;
249 goto OUTSIDE_STRING;
251 if ($line =~ /^\\.(.*)/) {
252 # See above, defuse the backslash.
253 $line = $1;
254 goto INSIDE_STRING;
256 if ($line =~ /^[^\\"]+(.*)/) {
257 $line = $1;
258 goto INSIDE_STRING;
260 return undef; # missing closing double quote
262 SPACE_SEEN:
263 $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
264 return undef;
267 sub derive_ssh_auth_type ($) {
268 my $line = shift;
269 $line =~ /^ssh-rsa\s/ and return 'rsa';
270 $line =~ /^ssh-dss\s/ and return 'dsa';
271 $line =~ /^\d+\s/ and return 'rsa1';
272 return undef;
275 sub from_ssh_auth_line ($$$) {
276 my ($tmp, $name, $line) = @_;
277 chomp $line;
280 my $l = cleanup_ssh_auth_line $line;
281 $l or return 0;
282 $line = $l;
284 my $type = derive_ssh_auth_type $line;
286 clear_tmp $tmp;
287 print $tmp "$line\n" or die "print: $!";
288 $tmp->flush or die "flush: $!";
289 my ($length, $hash) = ssh_fprint_file "$tmp";
290 if ($length && $hash) {
291 ssh_fprint_check "$name", $type, $length, $hash;
292 return 1;
295 return 0;
298 sub from_ssh_auth_file ($) {
299 my $name = shift;
300 my $auth;
301 unless (open $auth, '<', $name) {
302 warn "$name:0: error: open failed: $!\n";
303 return;
306 my $tmp = new File::Temp;
307 my $last_status = 1;
308 while (my $line = <$auth>) {
309 next if $line =~ m/^\s*(#|$)/;
310 my $status = from_ssh_auth_line $tmp, "$name:$.", $line;
311 unless ($status) {
312 $last_status and warn "$name:$.: warning: unparsable line\n";
314 $last_status = $status;
318 sub from_openvpn_key ($) {
319 my $name = shift;
320 my $key;
321 unless (open $key, '<', $name) {
322 warn "$name:0: open failed: $!\n";
323 return 1;
326 my $marker;
327 while (my $line = <$key>) {
328 return 0 if $. > 10;
329 if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
330 $marker = 1;
331 } elsif ($marker) {
332 if ($line =~ /^([0-9a-f]{32})/) {
333 $line = $1;
334 $line =~ s/(..)/chr(hex($1))/ge;
335 check_hash "$name:$.", $line, "OpenVPN";
336 return 1;
337 } else {
338 warn "$name:$.: warning: illegal OpenVPN file format\n";
339 return 1;
345 sub openssl_modulus_check ($$) {
346 my ($name, $modulus) = @_;
347 chomp $modulus;
348 if ($modulus =~ /^Modulus=([A-F0-9]+)$/) {
349 $modulus = $1;
350 my $length = length($modulus) * 4;
351 if ($length == 1024 || $length == 2048) {
352 my $mod = substr $modulus, length($modulus) - 32;
353 $mod =~ y/A-F/a-f/;
354 my @mod = $mod =~ /(..)/g;
355 $mod = join('', map { chr(hex($_)) } reverse @mod);
356 check_hash $name, $mod, "OpenSSL/RSA/$length";
357 } else {
358 warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
360 } else {
361 die "internal error: $modulus\n";
365 sub from_pem ($) {
366 my $name = shift;
367 my $tmp;
368 my $found = 0;
370 my $src;
371 unless (open $src, '<', $name) {
372 warn "$name:0: open failed: $!\n";
373 return 1;
376 while (my $line = <$src>) {
377 if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
378 my $lineno = $.;
379 $tmp or $tmp = new File::Temp;
380 clear_tmp $tmp;
381 do {
382 print $tmp $line or die "print: $!";
383 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
384 } while ($line = <$src>);
385 LAST:
386 $tmp->flush or die "flush: $!";
387 my $mod = safe_backtick qw/openssl x509 -noout -modulus -in/, $tmp;
388 if ($mod) {
389 openssl_modulus_check "$name:$lineno", $mod;
390 $found = 1;
391 } else {
392 warn "$name:$lineno: failed to parse certificate\n";
393 return 1;
395 } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
396 my $lineno = $.;
397 $tmp or $tmp = new File::Temp;
398 clear_tmp $tmp;
399 do {
400 print $tmp $line or die "print: $!";
401 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
402 } while ($line = <$src>);
403 LAST_RSA:
404 $tmp->flush or die "flush: $!";
405 my $mod = safe_backtick qw/openssl rsa -noout -modulus -in/, $tmp;
406 if ($mod) {
407 openssl_modulus_check "$name:$lineno", $mod;
408 $found = 1;
409 } else {
410 warn "$name:$lineno: failed to parse RSA private key\n";
411 return 1;
416 return $found;
419 sub from_ssh_host ($@) {
420 my ($port, @names) = @_;
422 @names = grep {
423 my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
424 @addrs or warn "warning: host not found: $_\n";
425 @addrs > 0;
426 } @names;
428 my @lines= safe_backtick_stderr qw/ssh-keyscan -t/, 'rsa1,rsa,dsa',
429 '-p', $port, @names;
431 my $tmp = new File::Temp;
432 for my $line (@lines) {
433 next if $line =~ /^(?:#|no hostkey alg)/;
434 my ($host, $data) = $line =~ /^(\S+) (.*)$/;
435 $host && from_ssh_auth_line $tmp, $host, $data
436 or die "$host: warning: unparsable line: $line";
440 sub from_user ($) {
441 my $user = shift;
442 my ($name,$passwd,$uid,$gid,
443 $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
444 unless ($name) {
445 warn "warning: user $user does not exist\n";
446 return;
448 for my $name (qw/authorized_keys authorized_keys2
449 known_hosts known_hosts2
450 id_rsa.pub id_dsa.pub identity.pub/) {
451 my $file = "$dir/.ssh/$name";
452 from_ssh_auth_file $file if -r $file;
456 sub from_user_all () {
457 # This was one loop initially, but does not work with some Perl
458 # versions.
459 setpwent;
460 my @names;
461 while (my $name = getpwent) {
462 push @names, $name;
464 endpwent;
465 from_user $_ for @names;
468 sub from_any_file ($) {
469 my $name = shift;
470 from_openvpn_key $name and return;
471 from_pem $name and return;
472 from_ssh_auth_file $name;
475 sub from_etc () {
476 my $find;
477 open $find, '-|', qw!find /etc -type f (
478 -name *.key -o -name *.pem -o -name *.crt
479 ) -print0! or die "error: could not spawn find: $!";
480 my @files;
482 local $/ = "\0";
483 @files = <$find>;
485 close $find;
486 $? == 0 or die "error: find failed with exit status $?\n";
487 for my $file (@files) {
488 -e $file and from_any_file $file;
492 if (@ARGV && $ARGV[0] eq '-c') {
493 shift @ARGV;
494 $db_file = shift @ARGV if @ARGV;
496 if (@ARGV) {
497 open_db;
498 my $cmd = shift @ARGV;
499 if ($cmd eq 'file') {
500 for my $name (@ARGV) {
501 from_any_file $name;
503 } elsif ($cmd eq 'host') {
504 unless (@ARGV) {
505 help;
506 exit 1;
508 my $port = 22;
509 if ($ARGV[0] eq '-p') {
510 shift @ARGV;
511 if (@ARGV) {
512 $port = shift @ARGV;
514 } elsif ($ARGV[0] =~ /-p(\d+)/) {
515 $port = $1;
516 shift @ARGV;
518 unless (@ARGV) {
519 help;
520 exit 1;
522 from_ssh_host $port, @ARGV;
523 } elsif ($cmd eq 'user') {
524 if (@ARGV) {
525 from_user $_ for @ARGV;
526 } else {
527 from_user_all;
529 } elsif ($cmd eq 'quick') {
530 from_user_all;
531 for my $file (qw/ssh_host_rsa_key.pub ssh_host_dsa_key.pub
532 ssh_host_key ssh_known_hosts ssh_known_hosts2/) {
533 -e $file and from_ssh_auth_file $file;
535 from_etc;
536 } elsif ($cmd eq 'help') {
537 help;
538 exit 0;
539 } elsif ($cmd eq 'version') {
540 print "dowkd $program_version (database $db_version)\n\n";
541 print <<'EOF';
542 ChangeLog:
543 @CHANGELOG@
545 exit 0;
546 } else {
547 die "error: invalid command, use \"help\" to get help\n";
549 print_stats;
550 } else {
551 help;
552 exit 1;
555 my %hash;
557 __DATA__