Factor out cli_get_port function
[dowkd.git] / dowkd.in
blob8212b8408a0fe376df48a294eb0359223eb3ec1f
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, 2048 or
70 4096 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 STDIN, '/dev/null' or die "error: could not redirect stdin: $!";
161 open STDERR, '>&STDOUT' or die "error: could not redirect stderr: $!";
162 exec @args or die "exec: failed: $!";
166 my $keys_found = 0;
167 my $keys_vulnerable = 0;
169 sub print_stats () {
170 print STDERR "summary: keys found: $keys_found, weak keys: $keys_vulnerable\n";
173 sub check_hash ($$;$) {
174 my ($name, $hash, $descr) = @_;
175 $hash && length($hash) == 16 or die "wrong hash size " . length($hash);
176 ++$keys_found;
177 if (exists $db{$hash}) {
178 ++$keys_vulnerable;
179 $descr = $descr ? " ($descr)" : '';
180 print "$name: weak key$descr\n";
181 return 1;
183 return 0;
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_output_check ($$) {
350 my ($name, $output) = @_;
351 my ($length) =
352 $output =~ /^(?:\s+RSA Public |Private-)Key: \((\d+) bit\)/m;
353 $length or die "internal error: could not parse OpenSSL output\n";
354 my ($modulus) =
355 $output =~ /(?:modulus|\s+Modulus\ \(\d+\ bit\)):$ \s+
356 ( (?:^\s+ (?:[0-9a-f]{2}:)+$ \s+)+
357 ^\s+ (?:[0-9a-f]{2}:)*(?:[0-9a-f]{2})$ )/xm;
358 $modulus or die "internal error: could not parse modulus\n";
359 $modulus =~ y/0-9a-f//cd;
360 my ($exponent) = $output =~ /^(?:\s+|public)Exponent: (\d+) \(0x/m;
361 $exponent or die "internal error: could not parse exponent\n";
363 if ($length == 1024 || $length == 2048 || $length == 4096) {
364 my $mod = substr $modulus, length($modulus) - 32;
365 $mod =~ y/A-F/a-f/;
366 my @mod = $mod =~ /(..)/g;
367 $mod = join('', map { chr(hex($_)) } reverse @mod);
368 length($mod) == 16 or die;
369 return if check_hash $name, $mod, "OpenSSL/RSA/$length";
370 warn "$name: warning: no blacklist for OpenSSL/RSA/$length key (e=$exponent)\n"
371 if $exponent != 65537;
372 } else {
373 warn "$name: warning: no blacklist for OpenSSL/RSA/$length key\n";
377 sub from_pem ($) {
378 my $name = shift;
379 my $tmp;
380 my $found = 0;
382 my $src;
383 unless (open $src, '<', $name) {
384 warn "$name:0: open failed: $!\n";
385 return 1;
388 while (my $line = <$src>) {
389 if ($line =~ /^-----BEGIN CERTIFICATE-----/) {
390 my $lineno = $.;
391 $tmp or $tmp = new File::Temp;
392 clear_tmp $tmp;
393 do {
394 print $tmp $line or die "print: $!";
395 goto LAST if $line =~ /^-----END CERTIFICATE-----/;
396 } while ($line = <$src>);
397 LAST:
398 $tmp->flush or die "flush: $!";
399 my $out = safe_backtick qw/openssl x509 -noout -text -in/, $tmp;
400 if ($out) {
401 openssl_output_check "$name:$lineno", $out;
402 $found = 1;
403 } else {
404 warn "$name:$lineno: failed to parse certificate\n";
405 return 1;
407 } elsif ($line =~ /^-----BEGIN RSA PRIVATE KEY-----/) {
408 my $lineno = $.;
409 $tmp or $tmp = new File::Temp;
410 clear_tmp $tmp;
411 do {
412 print $tmp $line or die "print: $!";
413 goto LAST_RSA if $line =~ /^-----END RSA PRIVATE KEY-----/;
414 } while ($line = <$src>);
415 LAST_RSA:
416 $tmp->flush or die "flush: $!";
417 my $out = safe_backtick qw/openssl rsa -noout -text -in/, $tmp;
418 if ($out) {
419 openssl_output_check "$name:$lineno", $out;
420 $found = 1;
421 } else {
422 warn "$name:$lineno: failed to parse RSA private key\n";
423 return 1;
428 return $found;
431 sub from_ssh_host ($@) {
432 my ($port, @names) = @_;
434 @names = grep {
435 my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname $_;
436 @addrs or warn "warning: host not found: $_\n";
437 @addrs > 0;
438 } @names;
440 my @lines= safe_backtick_stderr qw/ssh-keyscan -t/, 'rsa1,rsa,dsa',
441 '-p', $port, @names;
443 my $tmp = new File::Temp;
444 for my $line (@lines) {
445 next if $line =~ /^(?:#|no hostkey alg)/;
446 my ($host, $data) = $line =~ /^(\S+) (.*)$/;
447 $host && from_ssh_auth_line $tmp, $host, $data
448 or die "$host: warning: unparsable line: $line";
452 sub from_user ($) {
453 my $user = shift;
454 my ($name,$passwd,$uid,$gid,
455 $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
456 unless ($name) {
457 warn "warning: user $user does not exist\n";
458 return;
460 for my $name (qw/authorized_keys authorized_keys2
461 known_hosts known_hosts2
462 id_rsa.pub id_dsa.pub identity.pub/) {
463 my $file = "$dir/.ssh/$name";
464 from_ssh_auth_file $file if -r $file;
468 sub from_user_all () {
469 # This was one loop initially, but does not work with some Perl
470 # versions.
471 setpwent;
472 my @names;
473 while (my $name = getpwent) {
474 push @names, $name;
476 endpwent;
477 from_user $_ for @names;
480 sub from_any_file ($) {
481 my $name = shift;
482 from_openvpn_key $name and return;
483 from_pem $name and return;
484 from_ssh_auth_file $name;
487 sub from_etc () {
488 my $find;
489 open $find, '-|', qw!find /etc -type f (
490 -name *.key -o -name *.pem -o -name *.crt
491 ) -print0! or die "error: could not spawn find: $!";
492 my @files;
494 local $/ = "\0";
495 @files = <$find>;
497 close $find;
498 $? == 0 or die "error: find failed with exit status $?\n";
499 for my $file (@files) {
500 -e $file and from_any_file $file;
504 sub cli_get_port (\@$) {
505 my ($args, $port) = @_;
506 if ($args && @$args) {
507 if ($args->[0] eq '-p') {
508 shift @$args;
509 if (@$args) {
510 $port = shift @$args;
512 } elsif ($args->[0] =~ /-p(\d+)/) {
513 $port = $1;
514 shift @$args;
517 return $port;
520 if (@ARGV && $ARGV[0] eq '-c') {
521 shift @ARGV;
522 $db_file = shift @ARGV if @ARGV;
524 if (@ARGV) {
525 open_db;
526 my $cmd = shift @ARGV;
527 if ($cmd eq 'file') {
528 for my $name (@ARGV) {
529 from_any_file $name;
531 } elsif ($cmd eq 'host') {
532 my $port = cli_get_port @ARGV, 22;
533 unless (@ARGV) {
534 help;
535 exit 1;
537 from_ssh_host $port, @ARGV;
538 } elsif ($cmd eq 'user') {
539 if (@ARGV) {
540 from_user $_ for @ARGV;
541 } else {
542 from_user_all;
544 } elsif ($cmd eq 'quick') {
545 from_user_all;
546 for my $file (qw/ssh_host_rsa_key.pub ssh_host_dsa_key.pub
547 ssh_host_key ssh_known_hosts ssh_known_hosts2/) {
548 -e $file and from_ssh_auth_file $file;
550 from_etc;
551 } elsif ($cmd eq 'help') {
552 help;
553 exit 0;
554 } elsif ($cmd eq 'version') {
555 print "dowkd $program_version (database $db_version)\n\n";
556 print <<'EOF';
557 ChangeLog:
558 @CHANGELOG@
560 exit 0;
561 } else {
562 die "error: invalid command, use \"help\" to get help\n";
564 print_stats;
565 } else {
566 help;
567 exit 1;
570 __DATA__