1136fc5c4STobin C. Harding#!/usr/bin/env perl 2136fc5c4STobin C. Harding# 3136fc5c4STobin C. Harding# (c) 2017 Tobin C. Harding <me@tobin.cc> 4136fc5c4STobin C. Harding# Licensed under the terms of the GNU GPL License version 2 5136fc5c4STobin C. Harding# 61410fe4eSTobin C. Harding# leaking_addresses.pl: Scan the kernel for potential leaking addresses. 7136fc5c4STobin C. Harding# - Scans dmesg output. 8136fc5c4STobin C. Harding# - Walks directory tree and parses each file (for each directory in @DIRS). 9136fc5c4STobin C. Harding# 10136fc5c4STobin C. Harding# Use --debug to output path before parsing, this is useful to find files that 11136fc5c4STobin C. Harding# cause the script to choke. 12136fc5c4STobin C. Harding 13472c9e10STobin C. Harding# 14472c9e10STobin C. Harding# When the system is idle it is likely that most files under /proc/PID will be 15472c9e10STobin C. Harding# identical for various processes. Scanning _all_ the PIDs under /proc is 16472c9e10STobin C. Harding# unnecessary and implies that we are thoroughly scanning /proc. This is _not_ 17472c9e10STobin C. Harding# the case because there may be ways userspace can trigger creation of /proc 18472c9e10STobin C. Harding# files that leak addresses but were not present during a scan. For these two 19472c9e10STobin C. Harding# reasons we exclude all PID directories under /proc except '1/' 20472c9e10STobin C. Harding 21136fc5c4STobin C. Hardinguse warnings; 22136fc5c4STobin C. Hardinguse strict; 23136fc5c4STobin C. Hardinguse POSIX; 24136fc5c4STobin C. Hardinguse File::Basename; 25136fc5c4STobin C. Hardinguse File::Spec; 26136fc5c4STobin C. Hardinguse Cwd 'abs_path'; 27136fc5c4STobin C. Hardinguse Term::ANSIColor qw(:constants); 28136fc5c4STobin C. Hardinguse Getopt::Long qw(:config no_auto_abbrev); 2962139c12STobin C. Hardinguse Config; 3087e37588STobin C. Hardinguse bigint qw/hex/; 312f042c93STobin C. Hardinguse feature 'state'; 32136fc5c4STobin C. Harding 33136fc5c4STobin C. Hardingmy $P = $0; 34136fc5c4STobin C. Harding 35136fc5c4STobin C. Harding# Directories to scan. 36136fc5c4STobin C. Hardingmy @DIRS = ('/proc', '/sys'); 37136fc5c4STobin C. Harding 38dd98c252STobin C. Harding# Timer for parsing each file, in seconds. 39dd98c252STobin C. Hardingmy $TIMEOUT = 10; 40dd98c252STobin C. Harding 411410fe4eSTobin C. Harding# Kernel addresses vary by architecture. We can only auto-detect the following 421410fe4eSTobin C. Harding# architectures (using `uname -m`). (flag --32-bit overrides auto-detection.) 431410fe4eSTobin C. Hardingmy @SUPPORTED_ARCHITECTURES = ('x86_64', 'ppc64', 'x86'); 4462139c12STobin C. Harding 45136fc5c4STobin C. Harding# Command line options. 46136fc5c4STobin C. Hardingmy $help = 0; 47136fc5c4STobin C. Hardingmy $debug = 0; 48d09bd8daSTobin C. Hardingmy $raw = 0; 49d09bd8daSTobin C. Hardingmy $output_raw = ""; # Write raw results to file. 50d09bd8daSTobin C. Hardingmy $input_raw = ""; # Read raw results from file instead of scanning. 51d09bd8daSTobin C. Hardingmy $suppress_dmesg = 0; # Don't show dmesg in output. 52d09bd8daSTobin C. Hardingmy $squash_by_path = 0; # Summary report grouped by absolute path. 53d09bd8daSTobin C. Hardingmy $squash_by_filename = 0; # Summary report grouped by filename. 54f9d2a42dSTobin C. Hardingmy $kernel_config_file = ""; # Kernel configuration file. 551410fe4eSTobin C. Hardingmy $opt_32bit = 0; # Scan 32-bit kernel. 561410fe4eSTobin C. Hardingmy $page_offset_32bit = 0; # Page offset for 32-bit kernel. 57136fc5c4STobin C. Harding 58b401f56fSTobin C. Harding# Skip these absolute paths. 59b401f56fSTobin C. Hardingmy @skip_abs = ( 60b401f56fSTobin C. Harding '/proc/kmsg', 611c1e3be0STobin C. Harding '/proc/device-tree', 622ad74293STobin C. Harding '/proc/1/syscall', 63b401f56fSTobin C. Harding '/sys/firmware/devicetree', 64136fc5c4STobin C. Harding '/sys/kernel/debug/tracing/trace_pipe', 65136fc5c4STobin C. Harding '/sys/kernel/security/apparmor/revision'); 66136fc5c4STobin C. Harding 67b401f56fSTobin C. Harding# Skip these under any subdirectory. 68b401f56fSTobin C. Hardingmy @skip_any = ( 69136fc5c4STobin C. Harding 'pagemap', 70136fc5c4STobin C. Harding 'events', 71136fc5c4STobin C. Harding 'access', 72136fc5c4STobin C. Harding 'registers', 73136fc5c4STobin C. Harding 'snapshot_raw', 74136fc5c4STobin C. Harding 'trace_pipe_raw', 75136fc5c4STobin C. Harding 'ptmx', 76b401f56fSTobin C. Harding 'trace_pipe', 77136fc5c4STobin C. Harding 'fd', 78b401f56fSTobin C. Harding 'usbmon'); 79136fc5c4STobin C. Harding 80136fc5c4STobin C. Hardingsub help 81136fc5c4STobin C. Harding{ 82136fc5c4STobin C. Harding my ($exitcode) = @_; 83136fc5c4STobin C. Harding 84136fc5c4STobin C. Harding print << "EOM"; 85d09bd8daSTobin C. Harding 86136fc5c4STobin C. HardingUsage: $P [OPTIONS] 87136fc5c4STobin C. Harding 88136fc5c4STobin C. HardingOptions: 89136fc5c4STobin C. Harding 90d09bd8daSTobin C. Harding -o, --output-raw=<file> Save results for future processing. 91d09bd8daSTobin C. Harding -i, --input-raw=<file> Read results from file instead of scanning. 92d09bd8daSTobin C. Harding --raw Show raw results (default). 93d09bd8daSTobin C. Harding --suppress-dmesg Do not show dmesg results. 94d09bd8daSTobin C. Harding --squash-by-path Show one result per unique path. 95d09bd8daSTobin C. Harding --squash-by-filename Show one result per unique filename. 96f9d2a42dSTobin C. Harding --kernel-config-file=<file> Kernel configuration file (e.g /boot/config) 971410fe4eSTobin C. Harding --32-bit Scan 32-bit kernel. 981410fe4eSTobin C. Harding --page-offset-32-bit=o Page offset (for 32-bit kernel 0xABCD1234). 99136fc5c4STobin C. Harding -d, --debug Display debugging output. 100136fc5c4STobin C. Harding -h, --help, --version Display this help and exit. 101136fc5c4STobin C. Harding 1021410fe4eSTobin C. HardingScans the running kernel for potential leaking addresses. 103136fc5c4STobin C. Harding 104136fc5c4STobin C. HardingEOM 105136fc5c4STobin C. Harding exit($exitcode); 106136fc5c4STobin C. Harding} 107136fc5c4STobin C. Harding 108136fc5c4STobin C. HardingGetOptions( 109136fc5c4STobin C. Harding 'd|debug' => \$debug, 110136fc5c4STobin C. Harding 'h|help' => \$help, 111d09bd8daSTobin C. Harding 'version' => \$help, 112d09bd8daSTobin C. Harding 'o|output-raw=s' => \$output_raw, 113d09bd8daSTobin C. Harding 'i|input-raw=s' => \$input_raw, 114d09bd8daSTobin C. Harding 'suppress-dmesg' => \$suppress_dmesg, 115d09bd8daSTobin C. Harding 'squash-by-path' => \$squash_by_path, 116d09bd8daSTobin C. Harding 'squash-by-filename' => \$squash_by_filename, 117d09bd8daSTobin C. Harding 'raw' => \$raw, 118f9d2a42dSTobin C. Harding 'kernel-config-file=s' => \$kernel_config_file, 1191410fe4eSTobin C. Harding '32-bit' => \$opt_32bit, 1201410fe4eSTobin C. Harding 'page-offset-32-bit=o' => \$page_offset_32bit, 121136fc5c4STobin C. Harding) or help(1); 122136fc5c4STobin C. Harding 123136fc5c4STobin C. Hardinghelp(0) if ($help); 124136fc5c4STobin C. Harding 125d09bd8daSTobin C. Hardingif ($input_raw) { 126d09bd8daSTobin C. Harding format_output($input_raw); 127d09bd8daSTobin C. Harding exit(0); 128d09bd8daSTobin C. Harding} 129d09bd8daSTobin C. Harding 130d09bd8daSTobin C. Hardingif (!$input_raw and ($squash_by_path or $squash_by_filename)) { 131d09bd8daSTobin C. Harding printf "\nSummary reporting only available with --input-raw=<file>\n"; 132d09bd8daSTobin C. Harding printf "(First run scan with --output-raw=<file>.)\n"; 133d09bd8daSTobin C. Harding exit(128); 134d09bd8daSTobin C. Harding} 135d09bd8daSTobin C. Harding 1361410fe4eSTobin C. Hardingif (!(is_supported_architecture() or $opt_32bit or $page_offset_32bit)) { 13762139c12STobin C. Harding printf "\nScript does not support your architecture, sorry.\n"; 13862139c12STobin C. Harding printf "\nCurrently we support: \n\n"; 13962139c12STobin C. Harding foreach(@SUPPORTED_ARCHITECTURES) { 14062139c12STobin C. Harding printf "\t%s\n", $_; 14162139c12STobin C. Harding } 1426efb7458STobin C. Harding printf("\n"); 14362139c12STobin C. Harding 1441410fe4eSTobin C. Harding printf("If you are running a 32-bit architecture you may use:\n"); 1451410fe4eSTobin C. Harding printf("\n\t--32-bit or --page-offset-32-bit=<page offset>\n\n"); 1461410fe4eSTobin C. Harding 1476efb7458STobin C. Harding my $archname = `uname -m`; 1486efb7458STobin C. Harding printf("Machine hardware name (`uname -m`): %s\n", $archname); 14962139c12STobin C. Harding 15062139c12STobin C. Harding exit(129); 15162139c12STobin C. Harding} 15262139c12STobin C. Harding 153d09bd8daSTobin C. Hardingif ($output_raw) { 154d09bd8daSTobin C. Harding open my $fh, '>', $output_raw or die "$0: $output_raw: $!\n"; 155d09bd8daSTobin C. Harding select $fh; 156d09bd8daSTobin C. Harding} 157d09bd8daSTobin C. Harding 158136fc5c4STobin C. Hardingparse_dmesg(); 159136fc5c4STobin C. Hardingwalk(@DIRS); 160136fc5c4STobin C. Harding 161136fc5c4STobin C. Hardingexit 0; 162136fc5c4STobin C. Harding 163136fc5c4STobin C. Hardingsub dprint 164136fc5c4STobin C. Harding{ 165136fc5c4STobin C. Harding printf(STDERR @_) if $debug; 166136fc5c4STobin C. Harding} 167136fc5c4STobin C. Harding 16862139c12STobin C. Hardingsub is_supported_architecture 16962139c12STobin C. Harding{ 1701410fe4eSTobin C. Harding return (is_x86_64() or is_ppc64() or is_ix86_32()); 1711410fe4eSTobin C. Harding} 1721410fe4eSTobin C. Harding 1731410fe4eSTobin C. Hardingsub is_32bit 1741410fe4eSTobin C. Harding{ 1751410fe4eSTobin C. Harding # Allow --32-bit or --page-offset-32-bit to override 1761410fe4eSTobin C. Harding if ($opt_32bit or $page_offset_32bit) { 1771410fe4eSTobin C. Harding return 1; 1781410fe4eSTobin C. Harding } 1791410fe4eSTobin C. Harding 1801410fe4eSTobin C. Harding return is_ix86_32(); 1811410fe4eSTobin C. Harding} 1821410fe4eSTobin C. Harding 1831410fe4eSTobin C. Hardingsub is_ix86_32 1841410fe4eSTobin C. Harding{ 1855e4bac34STobin C. Harding state $arch = `uname -m`; 1861410fe4eSTobin C. Harding 1871410fe4eSTobin C. Harding chomp $arch; 1881410fe4eSTobin C. Harding if ($arch =~ m/i[3456]86/) { 1891410fe4eSTobin C. Harding return 1; 1901410fe4eSTobin C. Harding } 1911410fe4eSTobin C. Harding return 0; 19262139c12STobin C. Harding} 19362139c12STobin C. Harding 1945eb0da05STobin C. Hardingsub is_arch 19562139c12STobin C. Harding{ 1965eb0da05STobin C. Harding my ($desc) = @_; 1975eb0da05STobin C. Harding my $arch = `uname -m`; 19862139c12STobin C. Harding 1995eb0da05STobin C. Harding chomp $arch; 2005eb0da05STobin C. Harding if ($arch eq $desc) { 20162139c12STobin C. Harding return 1; 20262139c12STobin C. Harding } 20362139c12STobin C. Harding return 0; 20462139c12STobin C. Harding} 20562139c12STobin C. Harding 2065eb0da05STobin C. Hardingsub is_x86_64 2075eb0da05STobin C. Harding{ 2085e4bac34STobin C. Harding state $is = is_arch('x86_64'); 2095e4bac34STobin C. Harding return $is; 2105eb0da05STobin C. Harding} 2115eb0da05STobin C. Harding 21262139c12STobin C. Hardingsub is_ppc64 21362139c12STobin C. Harding{ 2145e4bac34STobin C. Harding state $is = is_arch('ppc64'); 2155e4bac34STobin C. Harding return $is; 21662139c12STobin C. Harding} 21762139c12STobin C. Harding 218f9d2a42dSTobin C. Harding# Gets config option value from kernel config file. 219f9d2a42dSTobin C. Harding# Returns "" on error or if config option not found. 220f9d2a42dSTobin C. Hardingsub get_kernel_config_option 221f9d2a42dSTobin C. Harding{ 222f9d2a42dSTobin C. Harding my ($option) = @_; 223f9d2a42dSTobin C. Harding my $value = ""; 224f9d2a42dSTobin C. Harding my $tmp_file = ""; 225f9d2a42dSTobin C. Harding my @config_files; 226f9d2a42dSTobin C. Harding 227f9d2a42dSTobin C. Harding # Allow --kernel-config-file to override. 228f9d2a42dSTobin C. Harding if ($kernel_config_file ne "") { 229f9d2a42dSTobin C. Harding @config_files = ($kernel_config_file); 230f9d2a42dSTobin C. Harding } elsif (-R "/proc/config.gz") { 231f9d2a42dSTobin C. Harding my $tmp_file = "/tmp/tmpkconf"; 232f9d2a42dSTobin C. Harding 233f9d2a42dSTobin C. Harding if (system("gunzip < /proc/config.gz > $tmp_file")) { 234f9d2a42dSTobin C. Harding dprint "$0: system(gunzip < /proc/config.gz) failed\n"; 235f9d2a42dSTobin C. Harding return ""; 236f9d2a42dSTobin C. Harding } else { 237f9d2a42dSTobin C. Harding @config_files = ($tmp_file); 238f9d2a42dSTobin C. Harding } 239f9d2a42dSTobin C. Harding } else { 240f9d2a42dSTobin C. Harding my $file = '/boot/config-' . `uname -r`; 241f9d2a42dSTobin C. Harding chomp $file; 242f9d2a42dSTobin C. Harding @config_files = ($file, '/boot/config'); 243f9d2a42dSTobin C. Harding } 244f9d2a42dSTobin C. Harding 245f9d2a42dSTobin C. Harding foreach my $file (@config_files) { 246f9d2a42dSTobin C. Harding dprint("parsing config file: %s\n", $file); 247f9d2a42dSTobin C. Harding $value = option_from_file($option, $file); 248f9d2a42dSTobin C. Harding if ($value ne "") { 249f9d2a42dSTobin C. Harding last; 250f9d2a42dSTobin C. Harding } 251f9d2a42dSTobin C. Harding } 252f9d2a42dSTobin C. Harding 253f9d2a42dSTobin C. Harding if ($tmp_file ne "") { 254f9d2a42dSTobin C. Harding system("rm -f $tmp_file"); 255f9d2a42dSTobin C. Harding } 256f9d2a42dSTobin C. Harding 257f9d2a42dSTobin C. Harding return $value; 258f9d2a42dSTobin C. Harding} 259f9d2a42dSTobin C. Harding 260f9d2a42dSTobin C. Harding# Parses $file and returns kernel configuration option value. 261f9d2a42dSTobin C. Hardingsub option_from_file 262f9d2a42dSTobin C. Harding{ 263f9d2a42dSTobin C. Harding my ($option, $file) = @_; 264f9d2a42dSTobin C. Harding my $str = ""; 265f9d2a42dSTobin C. Harding my $val = ""; 266f9d2a42dSTobin C. Harding 267f9d2a42dSTobin C. Harding open(my $fh, "<", $file) or return ""; 268f9d2a42dSTobin C. Harding while (my $line = <$fh> ) { 269f9d2a42dSTobin C. Harding if ($line =~ /^$option/) { 270f9d2a42dSTobin C. Harding ($str, $val) = split /=/, $line; 271f9d2a42dSTobin C. Harding chomp $val; 272f9d2a42dSTobin C. Harding last; 273f9d2a42dSTobin C. Harding } 274f9d2a42dSTobin C. Harding } 275f9d2a42dSTobin C. Harding 276f9d2a42dSTobin C. Harding close $fh; 277f9d2a42dSTobin C. Harding return $val; 278f9d2a42dSTobin C. Harding} 279f9d2a42dSTobin C. Harding 280136fc5c4STobin C. Hardingsub is_false_positive 281136fc5c4STobin C. Harding{ 282136fc5c4STobin C. Harding my ($match) = @_; 283136fc5c4STobin C. Harding 2841410fe4eSTobin C. Harding if (is_32bit()) { 2851410fe4eSTobin C. Harding return is_false_positive_32bit($match); 2861410fe4eSTobin C. Harding } 2871410fe4eSTobin C. Harding 2881410fe4eSTobin C. Harding # 64 bit false positives. 2891410fe4eSTobin C. Harding 290136fc5c4STobin C. Harding if ($match =~ '\b(0x)?(f|F){16}\b' or 291136fc5c4STobin C. Harding $match =~ '\b(0x)?0{16}\b') { 292136fc5c4STobin C. Harding return 1; 293136fc5c4STobin C. Harding } 294136fc5c4STobin C. Harding 29587e37588STobin C. Harding if (is_x86_64() and is_in_vsyscall_memory_region($match)) { 296136fc5c4STobin C. Harding return 1; 297136fc5c4STobin C. Harding } 298136fc5c4STobin C. Harding 299136fc5c4STobin C. Harding return 0; 300136fc5c4STobin C. Harding} 301136fc5c4STobin C. Harding 3021410fe4eSTobin C. Hardingsub is_false_positive_32bit 3031410fe4eSTobin C. Harding{ 3041410fe4eSTobin C. Harding my ($match) = @_; 3051410fe4eSTobin C. Harding state $page_offset = get_page_offset(); 3061410fe4eSTobin C. Harding 3071410fe4eSTobin C. Harding if ($match =~ '\b(0x)?(f|F){8}\b') { 3081410fe4eSTobin C. Harding return 1; 3091410fe4eSTobin C. Harding } 3101410fe4eSTobin C. Harding 3111410fe4eSTobin C. Harding if (hex($match) < $page_offset) { 3121410fe4eSTobin C. Harding return 1; 3131410fe4eSTobin C. Harding } 3141410fe4eSTobin C. Harding 3151410fe4eSTobin C. Harding return 0; 3161410fe4eSTobin C. Harding} 3171410fe4eSTobin C. Harding 3181410fe4eSTobin C. Harding# returns integer value 3191410fe4eSTobin C. Hardingsub get_page_offset 3201410fe4eSTobin C. Harding{ 3211410fe4eSTobin C. Harding my $page_offset; 3221410fe4eSTobin C. Harding my $default_offset = 0xc0000000; 3231410fe4eSTobin C. Harding 3241410fe4eSTobin C. Harding # Allow --page-offset-32bit to override. 3251410fe4eSTobin C. Harding if ($page_offset_32bit != 0) { 3261410fe4eSTobin C. Harding return $page_offset_32bit; 3271410fe4eSTobin C. Harding } 3281410fe4eSTobin C. Harding 3291410fe4eSTobin C. Harding $page_offset = get_kernel_config_option('CONFIG_PAGE_OFFSET'); 3301410fe4eSTobin C. Harding if (!$page_offset) { 3311410fe4eSTobin C. Harding return $default_offset; 3321410fe4eSTobin C. Harding } 3331410fe4eSTobin C. Harding return $page_offset; 3341410fe4eSTobin C. Harding} 3351410fe4eSTobin C. Harding 33687e37588STobin C. Hardingsub is_in_vsyscall_memory_region 33787e37588STobin C. Harding{ 33887e37588STobin C. Harding my ($match) = @_; 33987e37588STobin C. Harding 34087e37588STobin C. Harding my $hex = hex($match); 34187e37588STobin C. Harding my $region_min = hex("0xffffffffff600000"); 34287e37588STobin C. Harding my $region_max = hex("0xffffffffff601000"); 34387e37588STobin C. Harding 34487e37588STobin C. Harding return ($hex >= $region_min and $hex <= $region_max); 34587e37588STobin C. Harding} 34687e37588STobin C. Harding 347136fc5c4STobin C. Harding# True if argument potentially contains a kernel address. 348136fc5c4STobin C. Hardingsub may_leak_address 349136fc5c4STobin C. Harding{ 350136fc5c4STobin C. Harding my ($line) = @_; 35162139c12STobin C. Harding my $address_re; 352136fc5c4STobin C. Harding 353136fc5c4STobin C. Harding # Signal masks. 354136fc5c4STobin C. Harding if ($line =~ '^SigBlk:' or 355a11949ecSTobin C. Harding $line =~ '^SigIgn:' or 356136fc5c4STobin C. Harding $line =~ '^SigCgt:') { 357136fc5c4STobin C. Harding return 0; 358136fc5c4STobin C. Harding } 359136fc5c4STobin C. Harding 360136fc5c4STobin C. Harding if ($line =~ '\bKEY=[[:xdigit:]]{14} [[:xdigit:]]{16} [[:xdigit:]]{16}\b' or 361136fc5c4STobin C. Harding $line =~ '\b[[:xdigit:]]{14} [[:xdigit:]]{16} [[:xdigit:]]{16}\b') { 362136fc5c4STobin C. Harding return 0; 363136fc5c4STobin C. Harding } 364136fc5c4STobin C. Harding 3652f042c93STobin C. Harding $address_re = get_address_re(); 3662306a677STobin C. Harding while ($line =~ /($address_re)/g) { 367136fc5c4STobin C. Harding if (!is_false_positive($1)) { 368136fc5c4STobin C. Harding return 1; 369136fc5c4STobin C. Harding } 370136fc5c4STobin C. Harding } 371136fc5c4STobin C. Harding 372136fc5c4STobin C. Harding return 0; 373136fc5c4STobin C. Harding} 374136fc5c4STobin C. Harding 3752f042c93STobin C. Hardingsub get_address_re 3762f042c93STobin C. Harding{ 3771410fe4eSTobin C. Harding if (is_ppc64()) { 3782f042c93STobin C. Harding return '\b(0x)?[89abcdef]00[[:xdigit:]]{13}\b'; 3791410fe4eSTobin C. Harding } elsif (is_32bit()) { 3801410fe4eSTobin C. Harding return '\b(0x)?[[:xdigit:]]{8}\b'; 3812f042c93STobin C. Harding } 3821410fe4eSTobin C. Harding 3831410fe4eSTobin C. Harding return get_x86_64_re(); 3842f042c93STobin C. Harding} 3852f042c93STobin C. Harding 3862f042c93STobin C. Hardingsub get_x86_64_re 3872f042c93STobin C. Harding{ 3882f042c93STobin C. Harding # We handle page table levels but only if explicitly configured using 3892f042c93STobin C. Harding # CONFIG_PGTABLE_LEVELS. If config file parsing fails or config option 3902f042c93STobin C. Harding # is not found we default to using address regular expression suitable 3912f042c93STobin C. Harding # for 4 page table levels. 3922f042c93STobin C. Harding state $ptl = get_kernel_config_option('CONFIG_PGTABLE_LEVELS'); 3932f042c93STobin C. Harding 3942f042c93STobin C. Harding if ($ptl == 5) { 3952f042c93STobin C. Harding return '\b(0x)?ff[[:xdigit:]]{14}\b'; 3962f042c93STobin C. Harding } 3972f042c93STobin C. Harding return '\b(0x)?ffff[[:xdigit:]]{12}\b'; 3982f042c93STobin C. Harding} 3992f042c93STobin C. Harding 400136fc5c4STobin C. Hardingsub parse_dmesg 401136fc5c4STobin C. Harding{ 402136fc5c4STobin C. Harding open my $cmd, '-|', 'dmesg'; 403136fc5c4STobin C. Harding while (<$cmd>) { 404136fc5c4STobin C. Harding if (may_leak_address($_)) { 405136fc5c4STobin C. Harding print 'dmesg: ' . $_; 406136fc5c4STobin C. Harding } 407136fc5c4STobin C. Harding } 408136fc5c4STobin C. Harding close $cmd; 409136fc5c4STobin C. Harding} 410136fc5c4STobin C. Harding 411136fc5c4STobin C. Harding# True if we should skip this path. 412136fc5c4STobin C. Hardingsub skip 413136fc5c4STobin C. Harding{ 414b401f56fSTobin C. Harding my ($path) = @_; 415136fc5c4STobin C. Harding 416b401f56fSTobin C. Harding foreach (@skip_abs) { 417136fc5c4STobin C. Harding return 1 if (/^$path$/); 418136fc5c4STobin C. Harding } 419136fc5c4STobin C. Harding 420136fc5c4STobin C. Harding my($filename, $dirs, $suffix) = fileparse($path); 421b401f56fSTobin C. Harding foreach (@skip_any) { 422136fc5c4STobin C. Harding return 1 if (/^$filename$/); 423136fc5c4STobin C. Harding } 424136fc5c4STobin C. Harding 425136fc5c4STobin C. Harding return 0; 426136fc5c4STobin C. Harding} 427136fc5c4STobin C. Harding 428dd98c252STobin C. Hardingsub timed_parse_file 429dd98c252STobin C. Harding{ 430dd98c252STobin C. Harding my ($file) = @_; 431dd98c252STobin C. Harding 432dd98c252STobin C. Harding eval { 433dd98c252STobin C. Harding local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required. 434dd98c252STobin C. Harding alarm $TIMEOUT; 435dd98c252STobin C. Harding parse_file($file); 436dd98c252STobin C. Harding alarm 0; 437dd98c252STobin C. Harding }; 438dd98c252STobin C. Harding 439dd98c252STobin C. Harding if ($@) { 440dd98c252STobin C. Harding die unless $@ eq "alarm\n"; # Propagate unexpected errors. 441dd98c252STobin C. Harding printf STDERR "timed out parsing: %s\n", $file; 442dd98c252STobin C. Harding } 443dd98c252STobin C. Harding} 444dd98c252STobin C. Harding 445136fc5c4STobin C. Hardingsub parse_file 446136fc5c4STobin C. Harding{ 447136fc5c4STobin C. Harding my ($file) = @_; 448136fc5c4STobin C. Harding 449136fc5c4STobin C. Harding if (! -R $file) { 450136fc5c4STobin C. Harding return; 451136fc5c4STobin C. Harding } 452136fc5c4STobin C. Harding 453e2858cadSTobin C. Harding if (! -T $file) { 454e2858cadSTobin C. Harding return; 455e2858cadSTobin C. Harding } 456e2858cadSTobin C. Harding 457136fc5c4STobin C. Harding open my $fh, "<", $file or return; 458136fc5c4STobin C. Harding while ( <$fh> ) { 459136fc5c4STobin C. Harding if (may_leak_address($_)) { 460136fc5c4STobin C. Harding print $file . ': ' . $_; 461136fc5c4STobin C. Harding } 462136fc5c4STobin C. Harding } 463136fc5c4STobin C. Harding close $fh; 464136fc5c4STobin C. Harding} 465136fc5c4STobin C. Harding 466136fc5c4STobin C. Harding# Recursively walk directory tree. 467136fc5c4STobin C. Hardingsub walk 468136fc5c4STobin C. Harding{ 469136fc5c4STobin C. Harding my @dirs = @_; 470136fc5c4STobin C. Harding 471136fc5c4STobin C. Harding while (my $pwd = shift @dirs) { 472136fc5c4STobin C. Harding next if (!opendir(DIR, $pwd)); 473136fc5c4STobin C. Harding my @files = readdir(DIR); 474136fc5c4STobin C. Harding closedir(DIR); 475136fc5c4STobin C. Harding 476136fc5c4STobin C. Harding foreach my $file (@files) { 477136fc5c4STobin C. Harding next if ($file eq '.' or $file eq '..'); 478136fc5c4STobin C. Harding 479136fc5c4STobin C. Harding my $path = "$pwd/$file"; 480136fc5c4STobin C. Harding next if (-l $path); 481136fc5c4STobin C. Harding 482472c9e10STobin C. Harding # skip /proc/PID except /proc/1 483472c9e10STobin C. Harding next if (($path =~ /^\/proc\/[0-9]+$/) && 484472c9e10STobin C. Harding ($path !~ /^\/proc\/1$/)); 485472c9e10STobin C. Harding 486b401f56fSTobin C. Harding next if (skip($path)); 487b401f56fSTobin C. Harding 488136fc5c4STobin C. Harding if (-d $path) { 489136fc5c4STobin C. Harding push @dirs, $path; 490b401f56fSTobin C. Harding next; 491136fc5c4STobin C. Harding } 492b401f56fSTobin C. Harding 493b401f56fSTobin C. Harding dprint "parsing: $path\n"; 494b401f56fSTobin C. Harding timed_parse_file($path); 495136fc5c4STobin C. Harding } 496136fc5c4STobin C. Harding } 497136fc5c4STobin C. Harding} 498d09bd8daSTobin C. Harding 499d09bd8daSTobin C. Hardingsub format_output 500d09bd8daSTobin C. Harding{ 501d09bd8daSTobin C. Harding my ($file) = @_; 502d09bd8daSTobin C. Harding 503d09bd8daSTobin C. Harding # Default is to show raw results. 504d09bd8daSTobin C. Harding if ($raw or (!$squash_by_path and !$squash_by_filename)) { 505d09bd8daSTobin C. Harding dump_raw_output($file); 506d09bd8daSTobin C. Harding return; 507d09bd8daSTobin C. Harding } 508d09bd8daSTobin C. Harding 509d09bd8daSTobin C. Harding my ($total, $dmesg, $paths, $files) = parse_raw_file($file); 510d09bd8daSTobin C. Harding 511d09bd8daSTobin C. Harding printf "\nTotal number of results from scan (incl dmesg): %d\n", $total; 512d09bd8daSTobin C. Harding 513d09bd8daSTobin C. Harding if (!$suppress_dmesg) { 514d09bd8daSTobin C. Harding print_dmesg($dmesg); 515d09bd8daSTobin C. Harding } 516d09bd8daSTobin C. Harding 517d09bd8daSTobin C. Harding if ($squash_by_filename) { 518d09bd8daSTobin C. Harding squash_by($files, 'filename'); 519d09bd8daSTobin C. Harding } 520d09bd8daSTobin C. Harding 521d09bd8daSTobin C. Harding if ($squash_by_path) { 522d09bd8daSTobin C. Harding squash_by($paths, 'path'); 523d09bd8daSTobin C. Harding } 524d09bd8daSTobin C. Harding} 525d09bd8daSTobin C. Harding 526d09bd8daSTobin C. Hardingsub dump_raw_output 527d09bd8daSTobin C. Harding{ 528d09bd8daSTobin C. Harding my ($file) = @_; 529d09bd8daSTobin C. Harding 530d09bd8daSTobin C. Harding open (my $fh, '<', $file) or die "$0: $file: $!\n"; 531d09bd8daSTobin C. Harding while (<$fh>) { 532d09bd8daSTobin C. Harding if ($suppress_dmesg) { 533d09bd8daSTobin C. Harding if ("dmesg:" eq substr($_, 0, 6)) { 534d09bd8daSTobin C. Harding next; 535d09bd8daSTobin C. Harding } 536d09bd8daSTobin C. Harding } 537d09bd8daSTobin C. Harding print $_; 538d09bd8daSTobin C. Harding } 539d09bd8daSTobin C. Harding close $fh; 540d09bd8daSTobin C. Harding} 541d09bd8daSTobin C. Harding 542d09bd8daSTobin C. Hardingsub parse_raw_file 543d09bd8daSTobin C. Harding{ 544d09bd8daSTobin C. Harding my ($file) = @_; 545d09bd8daSTobin C. Harding 546d09bd8daSTobin C. Harding my $total = 0; # Total number of lines parsed. 547d09bd8daSTobin C. Harding my @dmesg; # dmesg output. 548d09bd8daSTobin C. Harding my %files; # Unique filenames containing leaks. 549d09bd8daSTobin C. Harding my %paths; # Unique paths containing leaks. 550d09bd8daSTobin C. Harding 551d09bd8daSTobin C. Harding open (my $fh, '<', $file) or die "$0: $file: $!\n"; 552d09bd8daSTobin C. Harding while (my $line = <$fh>) { 553d09bd8daSTobin C. Harding $total++; 554d09bd8daSTobin C. Harding 555d09bd8daSTobin C. Harding if ("dmesg:" eq substr($line, 0, 6)) { 556d09bd8daSTobin C. Harding push @dmesg, $line; 557d09bd8daSTobin C. Harding next; 558d09bd8daSTobin C. Harding } 559d09bd8daSTobin C. Harding 560d09bd8daSTobin C. Harding cache_path(\%paths, $line); 561d09bd8daSTobin C. Harding cache_filename(\%files, $line); 562d09bd8daSTobin C. Harding } 563d09bd8daSTobin C. Harding 564d09bd8daSTobin C. Harding return $total, \@dmesg, \%paths, \%files; 565d09bd8daSTobin C. Harding} 566d09bd8daSTobin C. Harding 567d09bd8daSTobin C. Hardingsub print_dmesg 568d09bd8daSTobin C. Harding{ 569d09bd8daSTobin C. Harding my ($dmesg) = @_; 570d09bd8daSTobin C. Harding 571d09bd8daSTobin C. Harding print "\ndmesg output:\n"; 572d09bd8daSTobin C. Harding 573d09bd8daSTobin C. Harding if (@$dmesg == 0) { 574d09bd8daSTobin C. Harding print "<no results>\n"; 575d09bd8daSTobin C. Harding return; 576d09bd8daSTobin C. Harding } 577d09bd8daSTobin C. Harding 578d09bd8daSTobin C. Harding foreach(@$dmesg) { 579d09bd8daSTobin C. Harding my $index = index($_, ': '); 580d09bd8daSTobin C. Harding $index += 2; # skid ': ' 581d09bd8daSTobin C. Harding print substr($_, $index); 582d09bd8daSTobin C. Harding } 583d09bd8daSTobin C. Harding} 584d09bd8daSTobin C. Harding 585d09bd8daSTobin C. Hardingsub squash_by 586d09bd8daSTobin C. Harding{ 587d09bd8daSTobin C. Harding my ($ref, $desc) = @_; 588d09bd8daSTobin C. Harding 589d09bd8daSTobin C. Harding print "\nResults squashed by $desc (excl dmesg). "; 590d09bd8daSTobin C. Harding print "Displaying [<number of results> <$desc>], <example result>\n"; 591d09bd8daSTobin C. Harding 592d09bd8daSTobin C. Harding if (keys %$ref == 0) { 593d09bd8daSTobin C. Harding print "<no results>\n"; 594d09bd8daSTobin C. Harding return; 595d09bd8daSTobin C. Harding } 596d09bd8daSTobin C. Harding 597d09bd8daSTobin C. Harding foreach(keys %$ref) { 598d09bd8daSTobin C. Harding my $lines = $ref->{$_}; 599d09bd8daSTobin C. Harding my $length = @$lines; 600d09bd8daSTobin C. Harding printf "[%d %s] %s", $length, $_, @$lines[0]; 601d09bd8daSTobin C. Harding } 602d09bd8daSTobin C. Harding} 603d09bd8daSTobin C. Harding 604d09bd8daSTobin C. Hardingsub cache_path 605d09bd8daSTobin C. Harding{ 606d09bd8daSTobin C. Harding my ($paths, $line) = @_; 607d09bd8daSTobin C. Harding 608d09bd8daSTobin C. Harding my $index = index($line, ': '); 609d09bd8daSTobin C. Harding my $path = substr($line, 0, $index); 610d09bd8daSTobin C. Harding 611d09bd8daSTobin C. Harding $index += 2; # skip ': ' 612d09bd8daSTobin C. Harding add_to_cache($paths, $path, substr($line, $index)); 613d09bd8daSTobin C. Harding} 614d09bd8daSTobin C. Harding 615d09bd8daSTobin C. Hardingsub cache_filename 616d09bd8daSTobin C. Harding{ 617d09bd8daSTobin C. Harding my ($files, $line) = @_; 618d09bd8daSTobin C. Harding 619d09bd8daSTobin C. Harding my $index = index($line, ': '); 620d09bd8daSTobin C. Harding my $path = substr($line, 0, $index); 621d09bd8daSTobin C. Harding my $filename = basename($path); 622d09bd8daSTobin C. Harding 623d09bd8daSTobin C. Harding $index += 2; # skip ': ' 624d09bd8daSTobin C. Harding add_to_cache($files, $filename, substr($line, $index)); 625d09bd8daSTobin C. Harding} 626d09bd8daSTobin C. Harding 627d09bd8daSTobin C. Hardingsub add_to_cache 628d09bd8daSTobin C. Harding{ 629d09bd8daSTobin C. Harding my ($cache, $key, $value) = @_; 630d09bd8daSTobin C. Harding 631d09bd8daSTobin C. Harding if (!$cache->{$key}) { 632d09bd8daSTobin C. Harding $cache->{$key} = (); 633d09bd8daSTobin C. Harding } 634d09bd8daSTobin C. Harding push @{$cache->{$key}}, $value; 635d09bd8daSTobin C. Harding} 636