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) }