1#!/usr/bin/env perl
2# SPDX-License-Identifier: GPL-2.0-only
3#
4# (c) 2017 Tobin C. Harding <me@tobin.cc>
5#
6# leaking_addresses.pl: Scan the kernel for potential leaking addresses.
7#  - Scans dmesg output.
8#  - Walks directory tree and parses each file (for each directory in @DIRS).
9#
10# Use --debug to output path before parsing, this is useful to find files that
11# cause the script to choke.
12
13#
14# When the system is idle it is likely that most files under /proc/PID will be
15# identical for various processes.  Scanning _all_ the PIDs under /proc is
16# unnecessary and implies that we are thoroughly scanning /proc.  This is _not_
17# the case because there may be ways userspace can trigger creation of /proc
18# files that leak addresses but were not present during a scan.  For these two
19# reasons we exclude all PID directories under /proc except '1/'
20
21use warnings;
22use strict;
23use POSIX;
24use File::Basename;
25use File::Spec;
26use Cwd 'abs_path';
27use Term::ANSIColor qw(:constants);
28use Getopt::Long qw(:config no_auto_abbrev);
29use Config;
30use bigint qw/hex/;
31use feature 'state';
32
33my $P = $0;
34
35# Directories to scan.
36my @DIRS = ('/proc', '/sys');
37
38# Timer for parsing each file, in seconds.
39my $TIMEOUT = 10;
40
41# Kernel addresses vary by architecture.  We can only auto-detect the following
42# architectures (using `uname -m`).  (flag --32-bit overrides auto-detection.)
43my @SUPPORTED_ARCHITECTURES = ('x86_64', 'ppc64', 'x86');
44
45# Command line options.
46my $help = 0;
47my $debug = 0;
48my $raw = 0;
49my $output_raw = "";	# Write raw results to file.
50my $input_raw = "";	# Read raw results from file instead of scanning.
51my $suppress_dmesg = 0;		# Don't show dmesg in output.
52my $squash_by_path = 0;		# Summary report grouped by absolute path.
53my $squash_by_filename = 0;	# Summary report grouped by filename.
54my $kernel_config_file = "";	# Kernel configuration file.
55my $opt_32bit = 0;		# Scan 32-bit kernel.
56my $page_offset_32bit = 0;	# Page offset for 32-bit kernel.
57
58# Skip these absolute paths.
59my @skip_abs = (
60	'/proc/kmsg',
61	'/proc/device-tree',
62	'/proc/1/syscall',
63	'/sys/firmware/devicetree',
64	'/sys/kernel/debug/tracing/trace_pipe',
65	'/sys/kernel/security/apparmor/revision');
66
67# Skip these under any subdirectory.
68my @skip_any = (
69	'pagemap',
70	'events',
71	'access',
72	'registers',
73	'snapshot_raw',
74	'trace_pipe_raw',
75	'ptmx',
76	'trace_pipe',
77	'fd',
78	'usbmon');
79
80sub help
81{
82	my ($exitcode) = @_;
83
84	print << "EOM";
85
86Usage: $P [OPTIONS]
87
88Options:
89
90	-o, --output-raw=<file>		Save results for future processing.
91	-i, --input-raw=<file>		Read results from file instead of scanning.
92	      --raw			Show raw results (default).
93	      --suppress-dmesg		Do not show dmesg results.
94	      --squash-by-path		Show one result per unique path.
95	      --squash-by-filename	Show one result per unique filename.
96	--kernel-config-file=<file>     Kernel configuration file (e.g /boot/config)
97	--32-bit			Scan 32-bit kernel.
98	--page-offset-32-bit=o		Page offset (for 32-bit kernel 0xABCD1234).
99	-d, --debug			Display debugging output.
100	-h, --help			Display this help and exit.
101
102Scans the running kernel for potential leaking addresses.
103
104EOM
105	exit($exitcode);
106}
107
108GetOptions(
109	'd|debug'		=> \$debug,
110	'h|help'		=> \$help,
111	'o|output-raw=s'        => \$output_raw,
112	'i|input-raw=s'         => \$input_raw,
113	'suppress-dmesg'        => \$suppress_dmesg,
114	'squash-by-path'        => \$squash_by_path,
115	'squash-by-filename'    => \$squash_by_filename,
116	'raw'                   => \$raw,
117	'kernel-config-file=s'	=> \$kernel_config_file,
118	'32-bit'		=> \$opt_32bit,
119	'page-offset-32-bit=o'	=> \$page_offset_32bit,
120) or help(1);
121
122help(0) if ($help);
123
124if ($input_raw) {
125	format_output($input_raw);
126	exit(0);
127}
128
129if (!$input_raw and ($squash_by_path or $squash_by_filename)) {
130	printf "\nSummary reporting only available with --input-raw=<file>\n";
131	printf "(First run scan with --output-raw=<file>.)\n";
132	exit(128);
133}
134
135if (!(is_supported_architecture() or $opt_32bit or $page_offset_32bit)) {
136	printf "\nScript does not support your architecture, sorry.\n";
137	printf "\nCurrently we support: \n\n";
138	foreach(@SUPPORTED_ARCHITECTURES) {
139		printf "\t%s\n", $_;
140	}
141	printf("\n");
142
143	printf("If you are running a 32-bit architecture you may use:\n");
144	printf("\n\t--32-bit or --page-offset-32-bit=<page offset>\n\n");
145
146	my $archname = `uname -m`;
147	printf("Machine hardware name (`uname -m`): %s\n", $archname);
148
149	exit(129);
150}
151
152if ($output_raw) {
153	open my $fh, '>', $output_raw or die "$0: $output_raw: $!\n";
154	select $fh;
155}
156
157parse_dmesg();
158walk(@DIRS);
159
160exit 0;
161
162sub dprint
163{
164	printf(STDERR @_) if $debug;
165}
166
167sub is_supported_architecture
168{
169	return (is_x86_64() or is_ppc64() or is_ix86_32());
170}
171
172sub is_32bit
173{
174	# Allow --32-bit or --page-offset-32-bit to override
175	if ($opt_32bit or $page_offset_32bit) {
176		return 1;
177	}
178
179	return is_ix86_32();
180}
181
182sub is_ix86_32
183{
184       state $arch = `uname -m`;
185
186       chomp $arch;
187       if ($arch =~ m/i[3456]86/) {
188               return 1;
189       }
190       return 0;
191}
192
193sub is_arch
194{
195       my ($desc) = @_;
196       my $arch = `uname -m`;
197
198       chomp $arch;
199       if ($arch eq $desc) {
200               return 1;
201       }
202       return 0;
203}
204
205sub is_x86_64
206{
207	state $is = is_arch('x86_64');
208	return $is;
209}
210
211sub is_ppc64
212{
213	state $is = is_arch('ppc64');
214	return $is;
215}
216
217# Gets config option value from kernel config file.
218# Returns "" on error or if config option not found.
219sub get_kernel_config_option
220{
221	my ($option) = @_;
222	my $value = "";
223	my $tmp_file = "";
224	my @config_files;
225
226	# Allow --kernel-config-file to override.
227	if ($kernel_config_file ne "") {
228		@config_files = ($kernel_config_file);
229	} elsif (-R "/proc/config.gz") {
230		my $tmp_file = "/tmp/tmpkconf";
231
232		if (system("gunzip < /proc/config.gz > $tmp_file")) {
233			dprint("system(gunzip < /proc/config.gz) failed\n");
234			return "";
235		} else {
236			@config_files = ($tmp_file);
237		}
238	} else {
239		my $file = '/boot/config-' . `uname -r`;
240		chomp $file;
241		@config_files = ($file, '/boot/config');
242	}
243
244	foreach my $file (@config_files) {
245		dprint("parsing config file: $file\n");
246		$value = option_from_file($option, $file);
247		if ($value ne "") {
248			last;
249		}
250	}
251
252	if ($tmp_file ne "") {
253		system("rm -f $tmp_file");
254	}
255
256	return $value;
257}
258
259# Parses $file and returns kernel configuration option value.
260sub option_from_file
261{
262	my ($option, $file) = @_;
263	my $str = "";
264	my $val = "";
265
266	open(my $fh, "<", $file) or return "";
267	while (my $line = <$fh> ) {
268		if ($line =~ /^$option/) {
269			($str, $val) = split /=/, $line;
270			chomp $val;
271			last;
272		}
273	}
274
275	close $fh;
276	return $val;
277}
278
279sub is_false_positive
280{
281	my ($match) = @_;
282
283	if (is_32bit()) {
284		return is_false_positive_32bit($match);
285	}
286
287	# 64 bit false positives.
288
289	if ($match =~ '\b(0x)?(f|F){16}\b' or
290	    $match =~ '\b(0x)?0{16}\b') {
291		return 1;
292	}
293
294	if (is_x86_64() and is_in_vsyscall_memory_region($match)) {
295		return 1;
296	}
297
298	return 0;
299}
300
301sub is_false_positive_32bit
302{
303       my ($match) = @_;
304       state $page_offset = get_page_offset();
305
306       if ($match =~ '\b(0x)?(f|F){8}\b') {
307               return 1;
308       }
309
310       if (hex($match) < $page_offset) {
311               return 1;
312       }
313
314       return 0;
315}
316
317# returns integer value
318sub get_page_offset
319{
320       my $page_offset;
321       my $default_offset = 0xc0000000;
322
323       # Allow --page-offset-32bit to override.
324       if ($page_offset_32bit != 0) {
325               return $page_offset_32bit;
326       }
327
328       $page_offset = get_kernel_config_option('CONFIG_PAGE_OFFSET');
329       if (!$page_offset) {
330	       return $default_offset;
331       }
332       return $page_offset;
333}
334
335sub is_in_vsyscall_memory_region
336{
337	my ($match) = @_;
338
339	my $hex = hex($match);
340	my $region_min = hex("0xffffffffff600000");
341	my $region_max = hex("0xffffffffff601000");
342
343	return ($hex >= $region_min and $hex <= $region_max);
344}
345
346# True if argument potentially contains a kernel address.
347sub may_leak_address
348{
349	my ($line) = @_;
350	my $address_re;
351
352	# Signal masks.
353	if ($line =~ '^SigBlk:' or
354	    $line =~ '^SigIgn:' or
355	    $line =~ '^SigCgt:') {
356		return 0;
357	}
358
359	if ($line =~ '\bKEY=[[:xdigit:]]{14} [[:xdigit:]]{16} [[:xdigit:]]{16}\b' or
360	    $line =~ '\b[[:xdigit:]]{14} [[:xdigit:]]{16} [[:xdigit:]]{16}\b') {
361		return 0;
362	}
363
364	$address_re = get_address_re();
365	while ($line =~ /($address_re)/g) {
366		if (!is_false_positive($1)) {
367			return 1;
368		}
369	}
370
371	return 0;
372}
373
374sub get_address_re
375{
376	if (is_ppc64()) {
377		return '\b(0x)?[89abcdef]00[[:xdigit:]]{13}\b';
378	} elsif (is_32bit()) {
379		return '\b(0x)?[[:xdigit:]]{8}\b';
380	}
381
382	return get_x86_64_re();
383}
384
385sub get_x86_64_re
386{
387	# We handle page table levels but only if explicitly configured using
388	# CONFIG_PGTABLE_LEVELS.  If config file parsing fails or config option
389	# is not found we default to using address regular expression suitable
390	# for 4 page table levels.
391	state $ptl = get_kernel_config_option('CONFIG_PGTABLE_LEVELS');
392
393	if ($ptl == 5) {
394		return '\b(0x)?ff[[:xdigit:]]{14}\b';
395	}
396	return '\b(0x)?ffff[[:xdigit:]]{12}\b';
397}
398
399sub parse_dmesg
400{
401	open my $cmd, '-|', 'dmesg';
402	while (<$cmd>) {
403		if (may_leak_address($_)) {
404			print 'dmesg: ' . $_;
405		}
406	}
407	close $cmd;
408}
409
410# True if we should skip this path.
411sub skip
412{
413	my ($path) = @_;
414
415	foreach (@skip_abs) {
416		return 1 if (/^$path$/);
417	}
418
419	my($filename, $dirs, $suffix) = fileparse($path);
420	foreach (@skip_any) {
421		return 1 if (/^$filename$/);
422	}
423
424	return 0;
425}
426
427sub timed_parse_file
428{
429	my ($file) = @_;
430
431	eval {
432		local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required.
433		alarm $TIMEOUT;
434		parse_file($file);
435		alarm 0;
436	};
437
438	if ($@) {
439		die unless $@ eq "alarm\n";	# Propagate unexpected errors.
440		printf STDERR "timed out parsing: %s\n", $file;
441	}
442}
443
444sub parse_file
445{
446	my ($file) = @_;
447
448	if (! -R $file) {
449		return;
450	}
451
452	if (! -T $file) {
453		return;
454	}
455
456	open my $fh, "<", $file or return;
457	while ( <$fh> ) {
458		chomp;
459		if (may_leak_address($_)) {
460			printf("$file: $_\n");
461		}
462	}
463	close $fh;
464}
465
466# Checks if the actual path name is leaking a kernel address.
467sub check_path_for_leaks
468{
469	my ($path) = @_;
470
471	if (may_leak_address($path)) {
472		printf("Path name may contain address: $path\n");
473	}
474}
475
476# Recursively walk directory tree.
477sub walk
478{
479	my @dirs = @_;
480
481	while (my $pwd = shift @dirs) {
482		next if (!opendir(DIR, $pwd));
483		my @files = readdir(DIR);
484		closedir(DIR);
485
486		foreach my $file (@files) {
487			next if ($file eq '.' or $file eq '..');
488
489			my $path = "$pwd/$file";
490			next if (-l $path);
491
492			# skip /proc/PID except /proc/1
493			next if (($path =~ /^\/proc\/[0-9]+$/) &&
494				 ($path !~ /^\/proc\/1$/));
495
496			next if (skip($path));
497
498			check_path_for_leaks($path);
499
500			if (-d $path) {
501				push @dirs, $path;
502				next;
503			}
504
505			dprint("parsing: $path\n");
506			timed_parse_file($path);
507		}
508	}
509}
510
511sub format_output
512{
513	my ($file) = @_;
514
515	# Default is to show raw results.
516	if ($raw or (!$squash_by_path and !$squash_by_filename)) {
517		dump_raw_output($file);
518		return;
519	}
520
521	my ($total, $dmesg, $paths, $files) = parse_raw_file($file);
522
523	printf "\nTotal number of results from scan (incl dmesg): %d\n", $total;
524
525	if (!$suppress_dmesg) {
526		print_dmesg($dmesg);
527	}
528
529	if ($squash_by_filename) {
530		squash_by($files, 'filename');
531	}
532
533	if ($squash_by_path) {
534		squash_by($paths, 'path');
535	}
536}
537
538sub dump_raw_output
539{
540	my ($file) = @_;
541
542	open (my $fh, '<', $file) or die "$0: $file: $!\n";
543	while (<$fh>) {
544		if ($suppress_dmesg) {
545			if ("dmesg:" eq substr($_, 0, 6)) {
546				next;
547			}
548		}
549		print $_;
550	}
551	close $fh;
552}
553
554sub parse_raw_file
555{
556	my ($file) = @_;
557
558	my $total = 0;          # Total number of lines parsed.
559	my @dmesg;              # dmesg output.
560	my %files;              # Unique filenames containing leaks.
561	my %paths;              # Unique paths containing leaks.
562
563	open (my $fh, '<', $file) or die "$0: $file: $!\n";
564	while (my $line = <$fh>) {
565		$total++;
566
567		if ("dmesg:" eq substr($line, 0, 6)) {
568			push @dmesg, $line;
569			next;
570		}
571
572		cache_path(\%paths, $line);
573		cache_filename(\%files, $line);
574	}
575
576	return $total, \@dmesg, \%paths, \%files;
577}
578
579sub print_dmesg
580{
581	my ($dmesg) = @_;
582
583	print "\ndmesg output:\n";
584
585	if (@$dmesg == 0) {
586		print "<no results>\n";
587		return;
588	}
589
590	foreach(@$dmesg) {
591		my $index = index($_, ': ');
592		$index += 2;    # skid ': '
593		print substr($_, $index);
594	}
595}
596
597sub squash_by
598{
599	my ($ref, $desc) = @_;
600
601	print "\nResults squashed by $desc (excl dmesg). ";
602	print "Displaying [<number of results> <$desc>], <example result>\n";
603
604	if (keys %$ref == 0) {
605		print "<no results>\n";
606		return;
607	}
608
609	foreach(keys %$ref) {
610		my $lines = $ref->{$_};
611		my $length = @$lines;
612		printf "[%d %s] %s", $length, $_, @$lines[0];
613	}
614}
615
616sub cache_path
617{
618	my ($paths, $line) = @_;
619
620	my $index = index($line, ': ');
621	my $path = substr($line, 0, $index);
622
623	$index += 2;            # skip ': '
624	add_to_cache($paths, $path, substr($line, $index));
625}
626
627sub cache_filename
628{
629	my ($files, $line) = @_;
630
631	my $index = index($line, ': ');
632	my $path = substr($line, 0, $index);
633	my $filename = basename($path);
634
635	$index += 2;            # skip ': '
636	add_to_cache($files, $filename, substr($line, $index));
637}
638
639sub add_to_cache
640{
641	my ($cache, $key, $value) = @_;
642
643	if (!$cache->{$key}) {
644		$cache->{$key} = ();
645	}
646	push @{$cache->{$key}}, $value;
647}
648