Add PID-setting preloadable DSO
[dowkd.git] / dowkd.in
blobd7f7056ddd90d6f76f7a5098c4d454d849bf05d2
1 #!/usr/bin/perl
3 # Debian/OpenSSL Weak Key Detector
5 # Written by Florian Weimer <fw@deneb.enyo.de>, with blacklist data
6 # from Kees Cook, Peter Palfrader and James Strandboge.
8 # Patches and comments are welcome.
10 use strict;
11 use warnings;
13 sub help () {
14 print <<EOF;
15 usage: $0 [OPTIONS...] COMMAND [ARGUMENTS...]
17 COMMAND is one of:
19 file: examine files on the command line for weak keys
20 host: examine the specified hosts for weak SSH keys
21 user: examine user SSH keys for weakness; examine all users if no
22 users are given
23 help: show this help screen
25 OPTIONS is one pf:
27 -c FILE: set the database cache file name (default: dowkd.db)
29 dowkd currently handles OpenSSH host and user keys and OpenVPN shared
30 secrets, as long as they use default key lengths and have been created
31 on a little-endian architecture (such as i386 or amd64). Note that
32 the blacklist by dowkd may be incomplete; it is only intended as a
33 quick check.
35 EOF
38 use DB_File;
39 use File::Temp;
40 use Fcntl;
41 use IO::Handle;
43 my $db_version = '1';
45 my $db_file = 'dowkd.db';
47 my $db;
48 my %db;
50 sub create_db () {
51 $db = tie %db, 'DB_File', $db_file, O_RDWR | O_CREAT, 0777, $DB_BTREE
52 or die "error: could not open database: $!\n";
54 $db{''} = $db_version;
55 while (my $line = <DATA>) {
56 next if $line =~ /^\**$/;
57 chomp $line;
58 $line =~ /^[0-9a-f]{32}$/ or die "error: invalid data line";
59 $line =~ s/(..)/chr(hex($1))/ge;
60 $db{$line} = '';
63 $db->sync;
66 sub open_db () {
67 if (-r $db_file) {
68 $db = tie %db, 'DB_File', $db_file, O_RDONLY, 0777, $DB_BTREE
69 or die "error: could not open database: $!\n";
70 my $stored_version = $db{''};
71 $stored_version && $stored_version eq $db_version or create_db;
72 } else {
73 unlink $db_file;
74 create_db;
78 sub safe_backtick (@) {
79 my @args = @_;
80 my $fh;
81 open $fh, '-|', @args
82 or die "error: failed to spawn $args[0]: $!\n";
83 my @result;
84 if (wantarray) {
85 @result = <$fh>;
86 } else {
87 local $/;
88 @result = scalar(<$fh>);
90 close $fh;
91 $? == 0 or return undef;
92 if (wantarray) {
93 return @result;
94 } else {
95 return $result[0];
99 my $keys_found = 0;
100 my $keys_vulnerable = 0;
102 sub print_stats () {
103 print STDERR "summary: keys found: $keys_found, weak keys: $keys_vulnerable\n";
106 sub check_hash ($$) {
107 my ($name, $hash) = @_;
108 ++$keys_found;
109 if (exists $db{$hash}) {
110 ++$keys_vulnerable;
111 print "$name: weak key\n";
115 sub ssh_fprint_file ($) {
116 my $name = shift;
117 my $data = safe_backtick qw/ssh-keygen -l -f/, $name;
118 defined $data or return ();
119 my @data = $data =~ /^(\d+) ([0-9a-f]{2}(?::[0-9a-f]{2}){15})/;
120 return @data if @data == 2;
121 return ();
124 sub ssh_fprint_check ($$$) {
125 my ($name, $length, $hash) = @_;
126 if ($length == 1024 || $length == 2048) {
127 $hash =~ y/://d;
128 $hash =~ s/(..)/chr(hex($1))/ge;
129 check_hash $name, $hash;
130 } else {
131 warn "$name: warning: no suitable blacklist\n";
135 sub from_ssh_key_file ($) {
136 my $name = shift;
137 my ($length, $hash) = ssh_fprint_file $name;
138 if ($length && $hash) {
139 ssh_fprint_check "$name:1", $length, $hash;
140 } else {
141 warn "$name:1: warning: failed to parse SSH key file\n";
145 sub clear_tmp ($) {
146 my $tmp = shift;
147 seek $tmp, 0, 0 or die "seek: $!";
148 truncate $tmp, 0 or die "truncate: $!";
151 sub from_ssh_auth_file ($) {
152 my $name = shift;
153 my $auth;
154 unless (open $auth, '<', $name) {
155 warn "$name:0: error: open failed: $!\n";
156 return;
158 my $tmp = new File::Temp;
159 while (my $line = <$auth>) {
160 chomp $line;
161 next if $line =~ m/^\s*(#|$)/;
162 my $lineno = $.;
163 clear_tmp $tmp;
164 print $tmp "$line\n" or die "print: $!";
165 $tmp->flush;
166 my ($length, $hash) = ssh_fprint_file "$tmp";
167 if ($length && $hash) {
168 ssh_fprint_check "$name:$lineno", $length, $hash;
169 } else {
170 warn "$name:$lineno: warning: unparsable line\n";
175 sub from_openvpn_key ($) {
176 my $name = shift;
177 my $key;
178 unless (open $key, '<', $name) {
179 warn "$name:0: open failed: $!\n";
180 return 1;
183 my $marker;
184 while (my $line = <$key>) {
185 return 0 if $. > 10;
186 if ($line =~ /^-----BEGIN OpenVPN Static key V1-----/) {
187 $marker = 1;
188 } elsif ($marker) {
189 if ($line =~ /^([0-9a-f]{32})/) {
190 $line = $1;
191 $line =~ s/(..)/chr(hex($1))/ge;
192 check_hash "$name:$.", $line;
193 return 1;
194 } else {
195 warn "$name:$.: warning: illegal OpenVPN file format\n";
196 return 1;
202 sub from_ssh_host (@) {
203 my @names = @_;
204 my @lines;
205 push @lines, safe_backtick qw/ssh-keyscan -t rsa/, @names;
206 push @lines, safe_backtick qw/ssh-keyscan -t dsa/, @names;
208 my $tmp = new File::Temp;
209 for my $line (@lines) {
210 next if $line =~ /^#/;
211 my ($host, $data) = $line =~ /^(\S+) (.*)$/;
212 clear_tmp $tmp;
213 print $tmp "$data\n" or die "print: $!";
214 $tmp->flush;
215 my ($length, $hash) = ssh_fprint_file "$tmp";
216 if ($length && $hash) {
217 ssh_fprint_check "$host", $length, $hash;
218 } else {
219 warn "$host: warning: unparsable line\n";
224 sub from_user ($) {
225 my $user = shift;
226 my ($name,$passwd,$uid,$gid,
227 $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
228 my $file = "$dir/.ssh/authorized_keys";
229 from_ssh_auth_file $file if -r $file;
230 $file = "$dir/.ssh/authorized_keys2";
231 from_ssh_auth_file $file if -r $file;
232 $file = "$dir/.ssh/id_rsa.pub";
233 from_ssh_key_file $file if -r $file;
234 $file = "$dir/.ssh/id_dsa.pub";
235 from_ssh_key_file $file if -r $file;
238 sub from_user_all () {
239 # This was one loop initially, but does not work with some Perl
240 # versions.
241 setpwent;
242 my @names;
243 while (my $name = getpwent) {
244 push @names, $name;
246 endpwent;
247 from_user $_ for @names;
250 if (@ARGV && $ARGV[0] eq '-c') {
251 shift @ARGV;
252 $db_file = shift @ARGV if @ARGV;
254 if (@ARGV) {
255 open_db;
256 my $cmd = shift @ARGV;
257 if ($cmd eq 'file') {
258 for my $name (@ARGV) {
259 next if from_openvpn_key $name;
260 from_ssh_auth_file $name;
262 } elsif ($cmd eq 'host') {
263 from_ssh_host @ARGV;
264 } elsif ($cmd eq 'user') {
265 if (@ARGV) {
266 from_user $_ for @ARGV;
267 } else {
268 from_user_all;
270 } elsif ($cmd eq 'help') {
271 help;
272 exit 0;
273 } else {
274 die "error: invalid command, use \"help\" to get help\n";
276 print_stats;
277 } else {
278 help;
279 exit 1;
282 my %hash;
284 __DATA__