Add safe_backtick_stderr sub
[dowkd.git] / dowkd.in
blobc0bd7bd08ab7c8a7a1149278452dac0fdc476ef0
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@';
85 my $changelog = <<'EOF';
86 ChangeLog:
87 @CHANGELOG@
88 EOF
90 my $db_file = 'dowkd.db';
92 my $db;
93 my %db;
95 sub create_db () {
96 warn "notice: creating database, please wait\n";
97 $db = tie %db, 'DB_File', $db_file, O_RDWR | O_CREAT, 0777, $DB_BTREE
98 or die "error: could not open database: $!\n";
100 my $found;
101 while (my $line = <DATA>) {
102 next if $line =~ /^\**$/;
103 chomp $line;
104 $line =~ /^[0-9a-f]{32}$/ or die "error: invalid data line";
105 $line =~ s/(..)/chr(hex($1))/ge;
106 $db{$line} = '';
107 $found = 1;
109 $found or die "error: no blacklist data found in script\n";
111 # Set at the end so that no incomplete database is left behind.
112 $db{''} = $db_version;
114 $db->sync;
117 sub open_db () {
118 if (-r $db_file) {
119 $db = tie %db, 'DB_File', $db_file, O_RDONLY, 0777, $DB_BTREE
120 or die "error: could not open database: $!\n";
121 my $stored_version = $db{''};
122 $stored_version && $stored_version eq $db_version or create_db;
123 } else {
124 unlink $db_file;
125 create_db;
129 sub safe_backtick (@) {
130 my @args = @_;
131 my $fh;
132 open $fh, '-|', @args
133 or die "error: failed to spawn $args[0]: $!\n";
134 my @result;
135 if (wantarray) {
136 @result = <$fh>;
137 } else {
138 local $/;
139 @result = scalar(<$fh>);
141 close $fh;
142 $? == 0 or return undef;
143 if (wantarray) {
144 return @result;
145 } else {
146 return $result[0];
150 sub safe_backtick_stderr {
151 my @args = @_;
152 my $fh;
153 my $pid = open $fh, '-|';
154 if ($pid) {
155 my @result = <$fh>;
156 close $fh;
157 $? == 0 or return undef;
158 if (wantarray) {
159 return @result;
160 } else {
161 return join('', @result);
163 } else {
164 open STDERR, '>&STDOUT' or die "error: could not redirect stderr: $!";
165 exec @args or die "exec: failed: $!";
169 my $keys_found = 0;
170 my $keys_vulnerable = 0;
172 sub print_stats () {
173 print STDERR "summary: keys found: $keys_found, weak keys: $keys_vulnerable\n";
176 sub check_hash ($$;$) {
177 my ($name, $hash, $descr) = @_;
178 ++$keys_found;
179 if (exists $db{$hash}) {
180 ++$keys_vulnerable;
181 $descr = $descr ? " ($descr)" : '';
182 print "$name: weak key$descr\n";
186 sub ssh_fprint_file ($) {
187 my $name = shift;
188 my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
189 defined $data or return ();
190 my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
191 return @data if @data == 2;
192 return ();
195 sub ssh_fprint_check ($$$$) {
196 my ($name, $type, $length, $hash) = @_;
197 $type =~ /^(?:rsa1?|dsa)\z/ or die;
198 if (($type eq 'rsa'
199 && ($length == 1024 || $length == 2048 || $length == 4096))
200 || ($type eq 'dsa' && $length == 1024)
201 || ($type eq 'rsa1' && ($length == 1024 || $length == 2048))) {
202 $hash =~ y/://d;
203 $hash =~ s/(..)/chr(hex($1))/ge;
204 check_hash $name, $hash, "OpenSSH/$type/$length";
205 } elsif ($type eq 'dsa') {
206 print "$name: $length bits DSA key not recommended\n";
207 } else {
208 warn "$name: warning: no blacklist for $type/$length key\n";
212 sub clear_tmp ($) {
213 my $tmp = shift;
214 seek $tmp, 0, 0 or die "seek: $!";
215 truncate $tmp, 0 or die "truncate: $!";
218 sub cleanup_ssh_auth_line ($) {
219 my $line = shift;
221 $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
223 OUTSIDE_STRING:
224 if ($line =~ /^\s+(.*)/) {
225 $line = $1;
226 goto SPACE_SEEN;
228 if ($line =~ /^"(.*)/) {
229 $line = $1;
230 goto INSIDE_STRING;
232 if ($line =~ /^\\.(.*)/) {
233 # It doesn't matter if we don't deal with \000 properly, we
234 # just need to defuse the backslash character.
235 $line = $1;
236 goto OUTSIDE_STRING;
238 if ($line =~ /^[a-zA-Z0-9_=+-]+(.*)/) {
239 # Skip multiple harmless characters in one go.
240 $line = $1;
241 goto OUTSIDE_STRING;
243 if ($line =~ /^.(.*)/) {
244 # Other characters are stripped one by one.
245 $line = $1;
246 goto OUTSIDE_STRING;
248 return undef; # empty string, no key found
250 INSIDE_STRING:
251 if ($line =~ /^"(.*)/) {
252 $line = $1;
253 goto OUTSIDE_STRING;
255 if ($line =~ /^\\.(.*)/) {
256 # See above, defuse the backslash.
257 $line = $1;
258 goto INSIDE_STRING;
260 if ($line =~ /^[^\\"]+(.*)/) {
261 $line = $1;
262 goto INSIDE_STRING;
264 return undef; # missing closing double quote
266 SPACE_SEEN:
267 $line =~ /^(?:ssh-(?:rsa|dss)\s|\d+\s+\d+\s+\d)/ and return $line;
268 return undef;
271 sub derive_ssh_auth_type ($) {
272 my $line = shift;
273 $line =~ /^ssh-rsa\s/ and return 'rsa';
274 $line =~ /^ssh-dss\s/ and return 'dsa';
275 $line =~ /^\d+\s/ and return 'rsa1';
276 return undef;
279 sub from_ssh_auth_line ($$$) {
280 my ($tmp, $name, $line) = @_;
281 chomp $line;
284 my $l = cleanup_ssh_auth_line $line;
285 $l or return 0;
286 $line = $l;
288 my $type = derive_ssh_auth_type $line;
290 clear_tmp $tmp;
291 print $tmp "$line\n" or die "print: $!";
292 $tmp->flush or die "flush: $!";
293 my ($length, $hash) = ssh_fprint_file "$tmp";
294 if ($length && $hash) {
295 ssh_fprint_check "$name", $type, $length, $hash;
296 return 1;
299 return 0;
302 sub from_ssh_auth_file ($) {
303 my $name = shift;
304 my $auth;
305 unless (open $auth, '<', $name) {
306 warn "$name:0: error: open failed: $!\n";
307 return;
310 my $tmp = new File::Temp;
311 my $last_status = 1;
312 while (my $line = <$auth>) {
313 next if $line =~ m/^\s*(#|$)/;
314 my $status = from_ssh_auth_line $tmp, "$name:$.", $line;
315 unless ($status) {
316 $last_status and warn "$name:$.: warning: unparsable line\n";
318 $last_status = $status;
322 sub from_openvpn_key ($) {
323 my $name = shift;
324 my $key;
325 unless (open $key, '<', $name) {
326 warn "$name:0: open failed: $!\n";
327 return 1;
330 my $marker;
331 while (my $line = <$key>) {
332 return 0 if $. > 10;
333 if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
334 $marker = 1;
335 } elsif ($marker) {
336 if ($line =~ /^([0-9a-f]{32})/) {
337 $line = $1;
338 $line =~ s/(..)/chr(hex($1))/ge;
339 check_hash "$name:$.", $line, "OpenVPN";
340 return 1;
341 } else {
342 warn "$name:$.: warning: illegal OpenVPN file format\n";
343 return 1;
349 sub openssl_modulus_check ($$) {
350 my ($name, $modulus) = @_;
351 chomp $modulus;
352 if ($modulus =~ /^Modulus=([A-F0-9]+)$/) {
353 $modulus = $1;
354 my $length = length($modulus) * 4;
355 if ($length == 1024 || $length == 2048) {
356 my $mod = substr $modulus, length($modulus) - 32;
357 $mod =~ y/A-F/a-f/;
358 my @mod = $mod =~ /(..)/g;
359 $mod = join('', map { chr(hex($_)) } reverse @mod);
360 check_hash $name, $mod, "OpenSSL/RSA/$length";
361 } else {
362 warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
364 } else {
365 die "internal error: $modulus\n";
369 sub from_pem ($) {
370 my $name = shift;
371 my $tmp;
372 my $found = 0;
374 my $src;
375 unless (open $src, '<', $name) {
376 warn "$name:0: open failed: $!\n";
377 return 1;
380 while (my $line = <$src>) {
381 if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
382 my $lineno = $.;
383 $tmp or $tmp = new File::Temp;
384 clear_tmp $tmp;
385 do {
386 print $tmp $line or die "print: $!";
387 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
388 } while ($line = <$src>);
389 LAST:
390 $tmp->flush or die "flush: $!";
391 my $mod = safe_backtick qw/openssl x509 -noout -modulus -in/, $tmp;
392 if ($mod) {
393 openssl_modulus_check "$name:$lineno", $mod;
394 $found = 1;
395 } else {
396 warn "$name:$lineno: failed to parse certificate\n";
397 return 1;
399 } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
400 my $lineno = $.;
401 $tmp or $tmp = new File::Temp;
402 clear_tmp $tmp;
403 do {
404 print $tmp $line or die "print: $!";
405 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
406 } while ($line = <$src>);
407 LAST_RSA:
408 $tmp->flush or die "flush: $!";
409 my $mod = safe_backtick qw/openssl rsa -noout -modulus -in/, $tmp;
410 if ($mod) {
411 openssl_modulus_check "$name:$lineno", $mod;
412 $found = 1;
413 } else {
414 warn "$name:$lineno: failed to parse RSA private key\n";
415 return 1;
420 return $found;
423 sub from_ssh_host ($@) {
424 my ($port, @names) = @_;
426 @names = grep {
427 my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
428 @addrs or warn "warning: host not found: $_\n";
429 @addrs > 0;
430 } @names;
432 my @lines= safe_backtick qw/ssh-keyscan -t/, 'rsa1,rsa,dsa', '-p',
433 $port, @names;
435 my $tmp = new File::Temp;
436 for my $line (@lines) {
437 next if $line =~ /^#/;
438 my ($host, $data) = $line =~ /^(\S+) (.*)$/;
439 from_ssh_auth_line $tmp, $host, $data
440 or die "$host: warning: unparsable line\n";
444 sub from_user ($) {
445 my $user = shift;
446 my ($name,$passwd,$uid,$gid,
447 $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
448 unless ($name) {
449 warn "warning: user $user does not exist\n";
450 return;
452 for my $name (qw/authorized_keys authorized_keys2
453 known_hosts known_hosts2
454 id_rsa.pub id_dsa.pub identity.pub/) {
455 my $file = "$dir/.ssh/$name";
456 from_ssh_auth_file $file if -r $file;
460 sub from_user_all () {
461 # This was one loop initially, but does not work with some Perl
462 # versions.
463 setpwent;
464 my @names;
465 while (my $name = getpwent) {
466 push @names, $name;
468 endpwent;
469 from_user $_ for @names;
472 sub from_any_file ($) {
473 my $name = shift;
474 from_openvpn_key $name and return;
475 from_pem $name and return;
476 from_ssh_auth_file $name;
479 sub from_etc () {
480 my $find;
481 open $find, '-|', qw!find /etc -type f (
482 -name *.key -o -name *.pem -o -name *.crt
483 ) -print0! or die "error: could not spawn find: $!";
484 my @files;
486 local $/ = "\0";
487 @files = <$find>;
489 close $find;
490 $? == 0 or die "error: find failed with exit status $?\n";
491 for my $file (@files) {
492 -e $file and from_any_file $file;
496 if (@ARGV && $ARGV[0] eq '-c') {
497 shift @ARGV;
498 $db_file = shift @ARGV if @ARGV;
500 if (@ARGV) {
501 open_db;
502 my $cmd = shift @ARGV;
503 if ($cmd eq 'file') {
504 for my $name (@ARGV) {
505 from_any_file $name;
507 } elsif ($cmd eq 'host') {
508 unless (@ARGV) {
509 help;
510 exit 1;
512 my $port = 22;
513 if ($ARGV[0] eq '-p') {
514 shift @ARGV;
515 if (@ARGV) {
516 $port = shift @ARGV;
518 } elsif ($ARGV[0] =~ /-p(\d+)/) {
519 $port = $1;
520 shift @ARGV;
522 unless (@ARGV) {
523 help;
524 exit 1;
526 from_ssh_host $port, @ARGV;
527 } elsif ($cmd eq 'user') {
528 if (@ARGV) {
529 from_user $_ for @ARGV;
530 } else {
531 from_user_all;
533 } elsif ($cmd eq 'quick') {
534 from_user_all;
535 for my $file (qw/ssh_host_rsa_key.pub ssh_host_dsa_key.pub
536 ssh_host_key ssh_known_hosts ssh_known_hosts2/) {
537 -e $file and from_ssh_auth_file $file;
539 from_etc;
540 } elsif ($cmd eq 'help') {
541 help;
542 exit 0;
543 } elsif ($cmd eq 'version') {
544 print "dowkd $program_version (database $db_version)\n\n$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__