VisionFive2 Linux kernel

StarFive Tech Linux Kernel for VisionFive (JH7110) boards (mirror)

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