Warn about OpenSSL exponents which are not 65537
[dowkd.git] / dowkd.in
blob761f16731c72766ebfd29194b5f6464189a6f065
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_output_check ($$) {
348 my ($name, $output) = @_;
349 my ($length) =
350 $output =~ /^(?:\s+RSA Public |Private-)Key: \((\d+) bit\)/m;
351 $length or die "internal error: could not parse OpenSSL output\n";
352 my ($modulus) =
353 $output =~ /(?:modulus|\s+Modulus\ \(\d+\ bit\)):$ \s+
354 ( (?:^\s+ (?:[0-9a-f]{2}:)+$ \s+)+
355 ^\s+ (?:[0-9a-f]{2}:)*(?:[0-9a-f]{2})$ )/xm;
356 $modulus or die "internal error: could not parse modulus\n";
357 $modulus =~ y/0-9a-f//cd;
358 my ($exponent) = $output =~ /^(?:\s+|public)Exponent: (\d+) \(0x/m;
359 $exponent or die "internal error: could not parse exponent\n";
361 if ($length == 1024 || $length == 2048) {
362 my $mod = substr $modulus, length($modulus) - 32;
363 $mod =~ y/A-F/a-f/;
364 my @mod = $mod =~ /(..)/g;
365 $mod = join('', map { chr(hex($_)) } reverse @mod);
366 length($mod) == 16 or die;
367 return if check_hash $name, $mod, "OpenSSL/RSA/$length";
368 warn "$name: warning: no blacklist for OpenSSL/RSA/$length key (e=$exponent)\n"
369 if $exponent != 65537;
370 } else {
371 warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
375 sub from_pem ($) {
376 my $name = shift;
377 my $tmp;
378 my $found = 0;
380 my $src;
381 unless (open $src, '<', $name) {
382 warn "$name:0: open failed: $!\n";
383 return 1;
386 while (my $line = <$src>) {
387 if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
388 my $lineno = $.;
389 $tmp or $tmp = new File::Temp;
390 clear_tmp $tmp;
391 do {
392 print $tmp $line or die "print: $!";
393 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
394 } while ($line = <$src>);
395 LAST:
396 $tmp->flush or die "flush: $!";
397 my $out = safe_backtick qw/openssl x509 -noout -text -in/, $tmp;
398 if ($out) {
399 openssl_output_check "$name:$lineno", $out;
400 $found = 1;
401 } else {
402 warn "$name:$lineno: failed to parse certificate\n";
403 return 1;
405 } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
406 my $lineno = $.;
407 $tmp or $tmp = new File::Temp;
408 clear_tmp $tmp;
409 do {
410 print $tmp $line or die "print: $!";
411 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
412 } while ($line = <$src>);
413 LAST_RSA:
414 $tmp->flush or die "flush: $!";
415 my $out = safe_backtick qw/openssl rsa -noout -text -in/, $tmp;
416 if ($out) {
417 openssl_output_check "$name:$lineno", $out;
418 $found = 1;
419 } else {
420 warn "$name:$lineno: failed to parse RSA private key\n";
421 return 1;
426 return $found;
429 sub from_ssh_host ($@) {
430 my ($port, @names) = @_;
432 @names = grep {
433 my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
434 @addrs or warn "warning: host not found: $_\n";
435 @addrs > 0;
436 } @names;
438 my @lines= safe_backtick_stderr qw/ssh-keyscan -t/, 'rsa1,rsa,dsa',
439 '-p', $port, @names;
441 my $tmp = new File::Temp;
442 for my $line (@lines) {
443 next if $line =~ /^(?:#|no hostkey alg)/;
444 my ($host, $data) = $line =~ /^(\S+) (.*)$/;
445 $host && from_ssh_auth_line $tmp, $host, $data
446 or die "$host: warning: unparsable line: $line";
450 sub from_user ($) {
451 my $user = shift;
452 my ($name,$passwd,$uid,$gid,
453 $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
454 unless ($name) {
455 warn "warning: user $user does not exist\n";
456 return;
458 for my $name (qw/authorized_keys authorized_keys2
459 known_hosts known_hosts2
460 id_rsa.pub id_dsa.pub identity.pub/) {
461 my $file = "$dir/.ssh/$name";
462 from_ssh_auth_file $file if -r $file;
466 sub from_user_all () {
467 # This was one loop initially, but does not work with some Perl
468 # versions.
469 setpwent;
470 my @names;
471 while (my $name = getpwent) {
472 push @names, $name;
474 endpwent;
475 from_user $_ for @names;
478 sub from_any_file ($) {
479 my $name = shift;
480 from_openvpn_key $name and return;
481 from_pem $name and return;
482 from_ssh_auth_file $name;
485 sub from_etc () {
486 my $find;
487 open $find, '-|', qw!find /etc -type f (
488 -name *.key -o -name *.pem -o -name *.crt
489 ) -print0! or die "error: could not spawn find: $!";
490 my @files;
492 local $/ = "\0";
493 @files = <$find>;
495 close $find;
496 $? == 0 or die "error: find failed with exit status $?\n";
497 for my $file (@files) {
498 -e $file and from_any_file $file;
502 if (@ARGV && $ARGV[0] eq '-c') {
503 shift @ARGV;
504 $db_file = shift @ARGV if @ARGV;
506 if (@ARGV) {
507 open_db;
508 my $cmd = shift @ARGV;
509 if ($cmd eq 'file') {
510 for my $name (@ARGV) {
511 from_any_file $name;
513 } elsif ($cmd eq 'host') {
514 unless (@ARGV) {
515 help;
516 exit 1;
518 my $port = 22;
519 if ($ARGV[0] eq '-p') {
520 shift @ARGV;
521 if (@ARGV) {
522 $port = shift @ARGV;
524 } elsif ($ARGV[0] =~ /-p(\d+)/) {
525 $port = $1;
526 shift @ARGV;
528 unless (@ARGV) {
529 help;
530 exit 1;
532 from_ssh_host $port, @ARGV;
533 } elsif ($cmd eq 'user') {
534 if (@ARGV) {
535 from_user $_ for @ARGV;
536 } else {
537 from_user_all;
539 } elsif ($cmd eq 'quick') {
540 from_user_all;
541 for my $file (qw/ssh_host_rsa_key.pub ssh_host_dsa_key.pub
542 ssh_host_key ssh_known_hosts ssh_known_hosts2/) {
543 -e $file and from_ssh_auth_file $file;
545 from_etc;
546 } elsif ($cmd eq 'help') {
547 help;
548 exit 0;
549 } elsif ($cmd eq 'version') {
550 print "dowkd $program_version (database $db_version)\n\n";
551 print <<'EOF';
552 ChangeLog:
553 @CHANGELOG@
555 exit 0;
556 } else {
557 die "error: invalid command, use \"help\" to get help\n";
559 print_stats;
560 } else {
561 help;
562 exit 1;
565 __DATA__