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# 6136fc5c4STobin C. Harding# leaking_addresses.pl: Scan 64 bit 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 13136fc5c4STobin C. Hardinguse warnings; 14136fc5c4STobin C. Hardinguse strict; 15136fc5c4STobin C. Hardinguse POSIX; 16136fc5c4STobin C. Hardinguse File::Basename; 17136fc5c4STobin C. Hardinguse File::Spec; 18136fc5c4STobin C. Hardinguse Cwd 'abs_path'; 19136fc5c4STobin C. Hardinguse Term::ANSIColor qw(:constants); 20136fc5c4STobin C. Hardinguse Getopt::Long qw(:config no_auto_abbrev); 2162139c12STobin C. Hardinguse Config; 2287e37588STobin C. Hardinguse bigint qw/hex/; 232f042c93STobin C. Hardinguse feature 'state'; 24136fc5c4STobin C. Harding 25136fc5c4STobin C. Hardingmy $P = $0; 26136fc5c4STobin C. Hardingmy $V = '0.01'; 27136fc5c4STobin C. Harding 28136fc5c4STobin C. Harding# Directories to scan. 29136fc5c4STobin C. Hardingmy @DIRS = ('/proc', '/sys'); 30136fc5c4STobin C. Harding 31dd98c252STobin C. Harding# Timer for parsing each file, in seconds. 32dd98c252STobin C. Hardingmy $TIMEOUT = 10; 33dd98c252STobin C. Harding 3462139c12STobin C. Harding# Script can only grep for kernel addresses on the following architectures. If 3562139c12STobin C. Harding# your architecture is not listed here and has a grep'able kernel address please 3662139c12STobin C. Harding# consider submitting a patch. 3762139c12STobin C. Hardingmy @SUPPORTED_ARCHITECTURES = ('x86_64', 'ppc64'); 3862139c12STobin C. Harding 39136fc5c4STobin C. Harding# Command line options. 40136fc5c4STobin C. Hardingmy $help = 0; 41136fc5c4STobin C. Hardingmy $debug = 0; 42d09bd8daSTobin C. Hardingmy $raw = 0; 43d09bd8daSTobin C. Hardingmy $output_raw = ""; # Write raw results to file. 44d09bd8daSTobin C. Hardingmy $input_raw = ""; # Read raw results from file instead of scanning. 45d09bd8daSTobin C. Hardingmy $suppress_dmesg = 0; # Don't show dmesg in output. 46d09bd8daSTobin C. Hardingmy $squash_by_path = 0; # Summary report grouped by absolute path. 47d09bd8daSTobin C. Hardingmy $squash_by_filename = 0; # Summary report grouped by filename. 48f9d2a42dSTobin C. Hardingmy $kernel_config_file = ""; # Kernel configuration file. 49136fc5c4STobin C. Harding 50136fc5c4STobin C. Harding# Do not parse these files (absolute path). 51136fc5c4STobin C. Hardingmy @skip_parse_files_abs = ('/proc/kmsg', 52136fc5c4STobin C. Harding '/proc/kcore', 53136fc5c4STobin C. Harding '/proc/fs/ext4/sdb1/mb_groups', 54136fc5c4STobin C. Harding '/proc/1/fd/3', 551c1e3be0STobin C. Harding '/sys/firmware/devicetree', 561c1e3be0STobin C. Harding '/proc/device-tree', 57136fc5c4STobin C. Harding '/sys/kernel/debug/tracing/trace_pipe', 58136fc5c4STobin C. Harding '/sys/kernel/security/apparmor/revision'); 59136fc5c4STobin C. Harding 60a284733eSTobin C. Harding# Do not parse these files under any subdirectory. 61136fc5c4STobin C. Hardingmy @skip_parse_files_any = ('0', 62136fc5c4STobin C. Harding '1', 63136fc5c4STobin C. Harding '2', 64136fc5c4STobin C. Harding 'pagemap', 65136fc5c4STobin C. Harding 'events', 66136fc5c4STobin C. Harding 'access', 67136fc5c4STobin C. Harding 'registers', 68136fc5c4STobin C. Harding 'snapshot_raw', 69136fc5c4STobin C. Harding 'trace_pipe_raw', 70136fc5c4STobin C. Harding 'ptmx', 71136fc5c4STobin C. Harding 'trace_pipe'); 72136fc5c4STobin C. Harding 73136fc5c4STobin C. Harding# Do not walk these directories (absolute path). 74136fc5c4STobin C. Hardingmy @skip_walk_dirs_abs = (); 75136fc5c4STobin C. Harding 76136fc5c4STobin C. Harding# Do not walk these directories under any subdirectory. 77136fc5c4STobin C. Hardingmy @skip_walk_dirs_any = ('self', 78136fc5c4STobin C. Harding 'thread-self', 79136fc5c4STobin C. Harding 'cwd', 80136fc5c4STobin C. Harding 'fd', 811c1e3be0STobin C. Harding 'usbmon', 82136fc5c4STobin C. Harding 'stderr', 83136fc5c4STobin C. Harding 'stdin', 84136fc5c4STobin C. Harding 'stdout'); 85136fc5c4STobin C. Harding 86136fc5c4STobin C. Hardingsub help 87136fc5c4STobin C. Harding{ 88136fc5c4STobin C. Harding my ($exitcode) = @_; 89136fc5c4STobin C. Harding 90136fc5c4STobin C. Harding print << "EOM"; 91d09bd8daSTobin C. Harding 92136fc5c4STobin C. HardingUsage: $P [OPTIONS] 93136fc5c4STobin C. HardingVersion: $V 94136fc5c4STobin C. Harding 95136fc5c4STobin C. HardingOptions: 96136fc5c4STobin C. Harding 97d09bd8daSTobin C. Harding -o, --output-raw=<file> Save results for future processing. 98d09bd8daSTobin C. Harding -i, --input-raw=<file> Read results from file instead of scanning. 99d09bd8daSTobin C. Harding --raw Show raw results (default). 100d09bd8daSTobin C. Harding --suppress-dmesg Do not show dmesg results. 101d09bd8daSTobin C. Harding --squash-by-path Show one result per unique path. 102d09bd8daSTobin C. Harding --squash-by-filename Show one result per unique filename. 103f9d2a42dSTobin C. Harding --kernel-config-file=<file> Kernel configuration file (e.g /boot/config) 104136fc5c4STobin C. Harding -d, --debug Display debugging output. 105136fc5c4STobin C. Harding -h, --help, --version Display this help and exit. 106136fc5c4STobin C. Harding 107136fc5c4STobin C. HardingScans the running (64 bit) kernel for potential leaking addresses. 108136fc5c4STobin C. Harding 109136fc5c4STobin C. HardingEOM 110136fc5c4STobin C. Harding exit($exitcode); 111136fc5c4STobin C. Harding} 112136fc5c4STobin C. Harding 113136fc5c4STobin C. HardingGetOptions( 114136fc5c4STobin C. Harding 'd|debug' => \$debug, 115136fc5c4STobin C. Harding 'h|help' => \$help, 116d09bd8daSTobin C. Harding 'version' => \$help, 117d09bd8daSTobin C. Harding 'o|output-raw=s' => \$output_raw, 118d09bd8daSTobin C. Harding 'i|input-raw=s' => \$input_raw, 119d09bd8daSTobin C. Harding 'suppress-dmesg' => \$suppress_dmesg, 120d09bd8daSTobin C. Harding 'squash-by-path' => \$squash_by_path, 121d09bd8daSTobin C. Harding 'squash-by-filename' => \$squash_by_filename, 122d09bd8daSTobin C. Harding 'raw' => \$raw, 123f9d2a42dSTobin C. Harding 'kernel-config-file=s' => \$kernel_config_file, 124136fc5c4STobin C. Harding) or help(1); 125136fc5c4STobin C. Harding 126136fc5c4STobin C. Hardinghelp(0) if ($help); 127136fc5c4STobin C. Harding 128d09bd8daSTobin C. Hardingif ($input_raw) { 129d09bd8daSTobin C. Harding format_output($input_raw); 130d09bd8daSTobin C. Harding exit(0); 131d09bd8daSTobin C. Harding} 132d09bd8daSTobin C. Harding 133d09bd8daSTobin C. Hardingif (!$input_raw and ($squash_by_path or $squash_by_filename)) { 134d09bd8daSTobin C. Harding printf "\nSummary reporting only available with --input-raw=<file>\n"; 135d09bd8daSTobin C. Harding printf "(First run scan with --output-raw=<file>.)\n"; 136d09bd8daSTobin C. Harding exit(128); 137d09bd8daSTobin C. Harding} 138d09bd8daSTobin C. Harding 13962139c12STobin C. Hardingif (!is_supported_architecture()) { 14062139c12STobin C. Harding printf "\nScript does not support your architecture, sorry.\n"; 14162139c12STobin C. Harding printf "\nCurrently we support: \n\n"; 14262139c12STobin C. Harding foreach(@SUPPORTED_ARCHITECTURES) { 14362139c12STobin C. Harding printf "\t%s\n", $_; 14462139c12STobin C. Harding } 1456efb7458STobin C. Harding printf("\n"); 14662139c12STobin 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{ 17062139c12STobin C. Harding return (is_x86_64() or is_ppc64()); 17162139c12STobin C. Harding} 17262139c12STobin C. Harding 17362139c12STobin C. Hardingsub is_x86_64 17462139c12STobin C. Harding{ 1756efb7458STobin C. Harding my $archname = `uname -m`; 17662139c12STobin C. Harding 17762139c12STobin C. Harding if ($archname =~ m/x86_64/) { 17862139c12STobin C. Harding return 1; 17962139c12STobin C. Harding } 18062139c12STobin C. Harding return 0; 18162139c12STobin C. Harding} 18262139c12STobin C. Harding 18362139c12STobin C. Hardingsub is_ppc64 18462139c12STobin C. Harding{ 1856efb7458STobin C. Harding my $archname = `uname -m`; 18662139c12STobin C. Harding 1876efb7458STobin C. Harding if ($archname =~ m/ppc64/) { 18862139c12STobin C. Harding return 1; 18962139c12STobin C. Harding } 19062139c12STobin C. Harding return 0; 19162139c12STobin C. Harding} 19262139c12STobin C. Harding 193f9d2a42dSTobin C. Harding# Gets config option value from kernel config file. 194f9d2a42dSTobin C. Harding# Returns "" on error or if config option not found. 195f9d2a42dSTobin C. Hardingsub get_kernel_config_option 196f9d2a42dSTobin C. Harding{ 197f9d2a42dSTobin C. Harding my ($option) = @_; 198f9d2a42dSTobin C. Harding my $value = ""; 199f9d2a42dSTobin C. Harding my $tmp_file = ""; 200f9d2a42dSTobin C. Harding my @config_files; 201f9d2a42dSTobin C. Harding 202f9d2a42dSTobin C. Harding # Allow --kernel-config-file to override. 203f9d2a42dSTobin C. Harding if ($kernel_config_file ne "") { 204f9d2a42dSTobin C. Harding @config_files = ($kernel_config_file); 205f9d2a42dSTobin C. Harding } elsif (-R "/proc/config.gz") { 206f9d2a42dSTobin C. Harding my $tmp_file = "/tmp/tmpkconf"; 207f9d2a42dSTobin C. Harding 208f9d2a42dSTobin C. Harding if (system("gunzip < /proc/config.gz > $tmp_file")) { 209f9d2a42dSTobin C. Harding dprint "$0: system(gunzip < /proc/config.gz) failed\n"; 210f9d2a42dSTobin C. Harding return ""; 211f9d2a42dSTobin C. Harding } else { 212f9d2a42dSTobin C. Harding @config_files = ($tmp_file); 213f9d2a42dSTobin C. Harding } 214f9d2a42dSTobin C. Harding } else { 215f9d2a42dSTobin C. Harding my $file = '/boot/config-' . `uname -r`; 216f9d2a42dSTobin C. Harding chomp $file; 217f9d2a42dSTobin C. Harding @config_files = ($file, '/boot/config'); 218f9d2a42dSTobin C. Harding } 219f9d2a42dSTobin C. Harding 220f9d2a42dSTobin C. Harding foreach my $file (@config_files) { 221f9d2a42dSTobin C. Harding dprint("parsing config file: %s\n", $file); 222f9d2a42dSTobin C. Harding $value = option_from_file($option, $file); 223f9d2a42dSTobin C. Harding if ($value ne "") { 224f9d2a42dSTobin C. Harding last; 225f9d2a42dSTobin C. Harding } 226f9d2a42dSTobin C. Harding } 227f9d2a42dSTobin C. Harding 228f9d2a42dSTobin C. Harding if ($tmp_file ne "") { 229f9d2a42dSTobin C. Harding system("rm -f $tmp_file"); 230f9d2a42dSTobin C. Harding } 231f9d2a42dSTobin C. Harding 232f9d2a42dSTobin C. Harding return $value; 233f9d2a42dSTobin C. Harding} 234f9d2a42dSTobin C. Harding 235f9d2a42dSTobin C. Harding# Parses $file and returns kernel configuration option value. 236f9d2a42dSTobin C. Hardingsub option_from_file 237f9d2a42dSTobin C. Harding{ 238f9d2a42dSTobin C. Harding my ($option, $file) = @_; 239f9d2a42dSTobin C. Harding my $str = ""; 240f9d2a42dSTobin C. Harding my $val = ""; 241f9d2a42dSTobin C. Harding 242f9d2a42dSTobin C. Harding open(my $fh, "<", $file) or return ""; 243f9d2a42dSTobin C. Harding while (my $line = <$fh> ) { 244f9d2a42dSTobin C. Harding if ($line =~ /^$option/) { 245f9d2a42dSTobin C. Harding ($str, $val) = split /=/, $line; 246f9d2a42dSTobin C. Harding chomp $val; 247f9d2a42dSTobin C. Harding last; 248f9d2a42dSTobin C. Harding } 249f9d2a42dSTobin C. Harding } 250f9d2a42dSTobin C. Harding 251f9d2a42dSTobin C. Harding close $fh; 252f9d2a42dSTobin C. Harding return $val; 253f9d2a42dSTobin C. Harding} 254f9d2a42dSTobin C. Harding 255136fc5c4STobin C. Hardingsub is_false_positive 256136fc5c4STobin C. Harding{ 257136fc5c4STobin C. Harding my ($match) = @_; 258136fc5c4STobin C. Harding 259136fc5c4STobin C. Harding if ($match =~ '\b(0x)?(f|F){16}\b' or 260136fc5c4STobin C. Harding $match =~ '\b(0x)?0{16}\b') { 261136fc5c4STobin C. Harding return 1; 262136fc5c4STobin C. Harding } 263136fc5c4STobin C. Harding 26487e37588STobin C. Harding if (is_x86_64() and is_in_vsyscall_memory_region($match)) { 265136fc5c4STobin C. Harding return 1; 266136fc5c4STobin C. Harding } 267136fc5c4STobin C. Harding 268136fc5c4STobin C. Harding return 0; 269136fc5c4STobin C. Harding} 270136fc5c4STobin C. Harding 27187e37588STobin C. Hardingsub is_in_vsyscall_memory_region 27287e37588STobin C. Harding{ 27387e37588STobin C. Harding my ($match) = @_; 27487e37588STobin C. Harding 27587e37588STobin C. Harding my $hex = hex($match); 27687e37588STobin C. Harding my $region_min = hex("0xffffffffff600000"); 27787e37588STobin C. Harding my $region_max = hex("0xffffffffff601000"); 27887e37588STobin C. Harding 27987e37588STobin C. Harding return ($hex >= $region_min and $hex <= $region_max); 28087e37588STobin C. Harding} 28187e37588STobin C. Harding 282136fc5c4STobin C. Harding# True if argument potentially contains a kernel address. 283136fc5c4STobin C. Hardingsub may_leak_address 284136fc5c4STobin C. Harding{ 285136fc5c4STobin C. Harding my ($line) = @_; 28662139c12STobin C. Harding my $address_re; 287136fc5c4STobin C. Harding 288136fc5c4STobin C. Harding # Signal masks. 289136fc5c4STobin C. Harding if ($line =~ '^SigBlk:' or 290a11949ecSTobin C. Harding $line =~ '^SigIgn:' or 291136fc5c4STobin C. Harding $line =~ '^SigCgt:') { 292136fc5c4STobin C. Harding return 0; 293136fc5c4STobin C. Harding } 294136fc5c4STobin C. Harding 295136fc5c4STobin C. Harding if ($line =~ '\bKEY=[[:xdigit:]]{14} [[:xdigit:]]{16} [[:xdigit:]]{16}\b' or 296136fc5c4STobin C. Harding $line =~ '\b[[:xdigit:]]{14} [[:xdigit:]]{16} [[:xdigit:]]{16}\b') { 297136fc5c4STobin C. Harding return 0; 298136fc5c4STobin C. Harding } 299136fc5c4STobin C. Harding 3002f042c93STobin C. Harding $address_re = get_address_re(); 30162139c12STobin C. Harding while (/($address_re)/g) { 302136fc5c4STobin C. Harding if (!is_false_positive($1)) { 303136fc5c4STobin C. Harding return 1; 304136fc5c4STobin C. Harding } 305136fc5c4STobin C. Harding } 306136fc5c4STobin C. Harding 307136fc5c4STobin C. Harding return 0; 308136fc5c4STobin C. Harding} 309136fc5c4STobin C. Harding 3102f042c93STobin C. Hardingsub get_address_re 3112f042c93STobin C. Harding{ 3122f042c93STobin C. Harding if (is_x86_64()) { 3132f042c93STobin C. Harding return get_x86_64_re(); 3142f042c93STobin C. Harding } elsif (is_ppc64()) { 3152f042c93STobin C. Harding return '\b(0x)?[89abcdef]00[[:xdigit:]]{13}\b'; 3162f042c93STobin C. Harding } 3172f042c93STobin C. Harding} 3182f042c93STobin C. Harding 3192f042c93STobin C. Hardingsub get_x86_64_re 3202f042c93STobin C. Harding{ 3212f042c93STobin C. Harding # We handle page table levels but only if explicitly configured using 3222f042c93STobin C. Harding # CONFIG_PGTABLE_LEVELS. If config file parsing fails or config option 3232f042c93STobin C. Harding # is not found we default to using address regular expression suitable 3242f042c93STobin C. Harding # for 4 page table levels. 3252f042c93STobin C. Harding state $ptl = get_kernel_config_option('CONFIG_PGTABLE_LEVELS'); 3262f042c93STobin C. Harding 3272f042c93STobin C. Harding if ($ptl == 5) { 3282f042c93STobin C. Harding return '\b(0x)?ff[[:xdigit:]]{14}\b'; 3292f042c93STobin C. Harding } 3302f042c93STobin C. Harding return '\b(0x)?ffff[[:xdigit:]]{12}\b'; 3312f042c93STobin C. Harding} 3322f042c93STobin C. Harding 333136fc5c4STobin C. Hardingsub parse_dmesg 334136fc5c4STobin C. Harding{ 335136fc5c4STobin C. Harding open my $cmd, '-|', 'dmesg'; 336136fc5c4STobin C. Harding while (<$cmd>) { 337136fc5c4STobin C. Harding if (may_leak_address($_)) { 338136fc5c4STobin C. Harding print 'dmesg: ' . $_; 339136fc5c4STobin C. Harding } 340136fc5c4STobin C. Harding } 341136fc5c4STobin C. Harding close $cmd; 342136fc5c4STobin C. Harding} 343136fc5c4STobin C. Harding 344136fc5c4STobin C. Harding# True if we should skip this path. 345136fc5c4STobin C. Hardingsub skip 346136fc5c4STobin C. Harding{ 347136fc5c4STobin C. Harding my ($path, $paths_abs, $paths_any) = @_; 348136fc5c4STobin C. Harding 349136fc5c4STobin C. Harding foreach (@$paths_abs) { 350136fc5c4STobin C. Harding return 1 if (/^$path$/); 351136fc5c4STobin C. Harding } 352136fc5c4STobin C. Harding 353136fc5c4STobin C. Harding my($filename, $dirs, $suffix) = fileparse($path); 354136fc5c4STobin C. Harding foreach (@$paths_any) { 355136fc5c4STobin C. Harding return 1 if (/^$filename$/); 356136fc5c4STobin C. Harding } 357136fc5c4STobin C. Harding 358136fc5c4STobin C. Harding return 0; 359136fc5c4STobin C. Harding} 360136fc5c4STobin C. Harding 361136fc5c4STobin C. Hardingsub skip_parse 362136fc5c4STobin C. Harding{ 363136fc5c4STobin C. Harding my ($path) = @_; 364136fc5c4STobin C. Harding return skip($path, \@skip_parse_files_abs, \@skip_parse_files_any); 365136fc5c4STobin C. Harding} 366136fc5c4STobin C. Harding 367dd98c252STobin C. Hardingsub timed_parse_file 368dd98c252STobin C. Harding{ 369dd98c252STobin C. Harding my ($file) = @_; 370dd98c252STobin C. Harding 371dd98c252STobin C. Harding eval { 372dd98c252STobin C. Harding local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required. 373dd98c252STobin C. Harding alarm $TIMEOUT; 374dd98c252STobin C. Harding parse_file($file); 375dd98c252STobin C. Harding alarm 0; 376dd98c252STobin C. Harding }; 377dd98c252STobin C. Harding 378dd98c252STobin C. Harding if ($@) { 379dd98c252STobin C. Harding die unless $@ eq "alarm\n"; # Propagate unexpected errors. 380dd98c252STobin C. Harding printf STDERR "timed out parsing: %s\n", $file; 381dd98c252STobin C. Harding } 382dd98c252STobin C. Harding} 383dd98c252STobin C. Harding 384136fc5c4STobin C. Hardingsub parse_file 385136fc5c4STobin C. Harding{ 386136fc5c4STobin C. Harding my ($file) = @_; 387136fc5c4STobin C. Harding 388136fc5c4STobin C. Harding if (! -R $file) { 389136fc5c4STobin C. Harding return; 390136fc5c4STobin C. Harding } 391136fc5c4STobin C. Harding 392136fc5c4STobin C. Harding if (skip_parse($file)) { 393136fc5c4STobin C. Harding dprint "skipping file: $file\n"; 394136fc5c4STobin C. Harding return; 395136fc5c4STobin C. Harding } 396136fc5c4STobin C. Harding dprint "parsing: $file\n"; 397136fc5c4STobin C. Harding 398136fc5c4STobin C. Harding open my $fh, "<", $file or return; 399136fc5c4STobin C. Harding while ( <$fh> ) { 400136fc5c4STobin C. Harding if (may_leak_address($_)) { 401136fc5c4STobin C. Harding print $file . ': ' . $_; 402136fc5c4STobin C. Harding } 403136fc5c4STobin C. Harding } 404136fc5c4STobin C. Harding close $fh; 405136fc5c4STobin C. Harding} 406136fc5c4STobin C. Harding 407136fc5c4STobin C. Harding 408136fc5c4STobin C. Harding# True if we should skip walking this directory. 409136fc5c4STobin C. Hardingsub skip_walk 410136fc5c4STobin C. Harding{ 411136fc5c4STobin C. Harding my ($path) = @_; 412136fc5c4STobin C. Harding return skip($path, \@skip_walk_dirs_abs, \@skip_walk_dirs_any) 413136fc5c4STobin C. Harding} 414136fc5c4STobin C. Harding 415136fc5c4STobin C. Harding# Recursively walk directory tree. 416136fc5c4STobin C. Hardingsub walk 417136fc5c4STobin C. Harding{ 418136fc5c4STobin C. Harding my @dirs = @_; 419136fc5c4STobin C. Harding 420136fc5c4STobin C. Harding while (my $pwd = shift @dirs) { 421136fc5c4STobin C. Harding next if (skip_walk($pwd)); 422136fc5c4STobin C. Harding next if (!opendir(DIR, $pwd)); 423136fc5c4STobin C. Harding my @files = readdir(DIR); 424136fc5c4STobin C. Harding closedir(DIR); 425136fc5c4STobin C. Harding 426136fc5c4STobin C. Harding foreach my $file (@files) { 427136fc5c4STobin C. Harding next if ($file eq '.' or $file eq '..'); 428136fc5c4STobin C. Harding 429136fc5c4STobin C. Harding my $path = "$pwd/$file"; 430136fc5c4STobin C. Harding next if (-l $path); 431136fc5c4STobin C. Harding 432136fc5c4STobin C. Harding if (-d $path) { 433136fc5c4STobin C. Harding push @dirs, $path; 434136fc5c4STobin C. Harding } else { 435dd98c252STobin C. Harding timed_parse_file($path); 436136fc5c4STobin C. Harding } 437136fc5c4STobin C. Harding } 438136fc5c4STobin C. Harding } 439136fc5c4STobin C. Harding} 440d09bd8daSTobin C. Harding 441d09bd8daSTobin C. Hardingsub format_output 442d09bd8daSTobin C. Harding{ 443d09bd8daSTobin C. Harding my ($file) = @_; 444d09bd8daSTobin C. Harding 445d09bd8daSTobin C. Harding # Default is to show raw results. 446d09bd8daSTobin C. Harding if ($raw or (!$squash_by_path and !$squash_by_filename)) { 447d09bd8daSTobin C. Harding dump_raw_output($file); 448d09bd8daSTobin C. Harding return; 449d09bd8daSTobin C. Harding } 450d09bd8daSTobin C. Harding 451d09bd8daSTobin C. Harding my ($total, $dmesg, $paths, $files) = parse_raw_file($file); 452d09bd8daSTobin C. Harding 453d09bd8daSTobin C. Harding printf "\nTotal number of results from scan (incl dmesg): %d\n", $total; 454d09bd8daSTobin C. Harding 455d09bd8daSTobin C. Harding if (!$suppress_dmesg) { 456d09bd8daSTobin C. Harding print_dmesg($dmesg); 457d09bd8daSTobin C. Harding } 458d09bd8daSTobin C. Harding 459d09bd8daSTobin C. Harding if ($squash_by_filename) { 460d09bd8daSTobin C. Harding squash_by($files, 'filename'); 461d09bd8daSTobin C. Harding } 462d09bd8daSTobin C. Harding 463d09bd8daSTobin C. Harding if ($squash_by_path) { 464d09bd8daSTobin C. Harding squash_by($paths, 'path'); 465d09bd8daSTobin C. Harding } 466d09bd8daSTobin C. Harding} 467d09bd8daSTobin C. Harding 468d09bd8daSTobin C. Hardingsub dump_raw_output 469d09bd8daSTobin C. Harding{ 470d09bd8daSTobin C. Harding my ($file) = @_; 471d09bd8daSTobin C. Harding 472d09bd8daSTobin C. Harding open (my $fh, '<', $file) or die "$0: $file: $!\n"; 473d09bd8daSTobin C. Harding while (<$fh>) { 474d09bd8daSTobin C. Harding if ($suppress_dmesg) { 475d09bd8daSTobin C. Harding if ("dmesg:" eq substr($_, 0, 6)) { 476d09bd8daSTobin C. Harding next; 477d09bd8daSTobin C. Harding } 478d09bd8daSTobin C. Harding } 479d09bd8daSTobin C. Harding print $_; 480d09bd8daSTobin C. Harding } 481d09bd8daSTobin C. Harding close $fh; 482d09bd8daSTobin C. Harding} 483d09bd8daSTobin C. Harding 484d09bd8daSTobin C. Hardingsub parse_raw_file 485d09bd8daSTobin C. Harding{ 486d09bd8daSTobin C. Harding my ($file) = @_; 487d09bd8daSTobin C. Harding 488d09bd8daSTobin C. Harding my $total = 0; # Total number of lines parsed. 489d09bd8daSTobin C. Harding my @dmesg; # dmesg output. 490d09bd8daSTobin C. Harding my %files; # Unique filenames containing leaks. 491d09bd8daSTobin C. Harding my %paths; # Unique paths containing leaks. 492d09bd8daSTobin C. Harding 493d09bd8daSTobin C. Harding open (my $fh, '<', $file) or die "$0: $file: $!\n"; 494d09bd8daSTobin C. Harding while (my $line = <$fh>) { 495d09bd8daSTobin C. Harding $total++; 496d09bd8daSTobin C. Harding 497d09bd8daSTobin C. Harding if ("dmesg:" eq substr($line, 0, 6)) { 498d09bd8daSTobin C. Harding push @dmesg, $line; 499d09bd8daSTobin C. Harding next; 500d09bd8daSTobin C. Harding } 501d09bd8daSTobin C. Harding 502d09bd8daSTobin C. Harding cache_path(\%paths, $line); 503d09bd8daSTobin C. Harding cache_filename(\%files, $line); 504d09bd8daSTobin C. Harding } 505d09bd8daSTobin C. Harding 506d09bd8daSTobin C. Harding return $total, \@dmesg, \%paths, \%files; 507d09bd8daSTobin C. Harding} 508d09bd8daSTobin C. Harding 509d09bd8daSTobin C. Hardingsub print_dmesg 510d09bd8daSTobin C. Harding{ 511d09bd8daSTobin C. Harding my ($dmesg) = @_; 512d09bd8daSTobin C. Harding 513d09bd8daSTobin C. Harding print "\ndmesg output:\n"; 514d09bd8daSTobin C. Harding 515d09bd8daSTobin C. Harding if (@$dmesg == 0) { 516d09bd8daSTobin C. Harding print "<no results>\n"; 517d09bd8daSTobin C. Harding return; 518d09bd8daSTobin C. Harding } 519d09bd8daSTobin C. Harding 520d09bd8daSTobin C. Harding foreach(@$dmesg) { 521d09bd8daSTobin C. Harding my $index = index($_, ': '); 522d09bd8daSTobin C. Harding $index += 2; # skid ': ' 523d09bd8daSTobin C. Harding print substr($_, $index); 524d09bd8daSTobin C. Harding } 525d09bd8daSTobin C. Harding} 526d09bd8daSTobin C. Harding 527d09bd8daSTobin C. Hardingsub squash_by 528d09bd8daSTobin C. Harding{ 529d09bd8daSTobin C. Harding my ($ref, $desc) = @_; 530d09bd8daSTobin C. Harding 531d09bd8daSTobin C. Harding print "\nResults squashed by $desc (excl dmesg). "; 532d09bd8daSTobin C. Harding print "Displaying [<number of results> <$desc>], <example result>\n"; 533d09bd8daSTobin C. Harding 534d09bd8daSTobin C. Harding if (keys %$ref == 0) { 535d09bd8daSTobin C. Harding print "<no results>\n"; 536d09bd8daSTobin C. Harding return; 537d09bd8daSTobin C. Harding } 538d09bd8daSTobin C. Harding 539d09bd8daSTobin C. Harding foreach(keys %$ref) { 540d09bd8daSTobin C. Harding my $lines = $ref->{$_}; 541d09bd8daSTobin C. Harding my $length = @$lines; 542d09bd8daSTobin C. Harding printf "[%d %s] %s", $length, $_, @$lines[0]; 543d09bd8daSTobin C. Harding } 544d09bd8daSTobin C. Harding} 545d09bd8daSTobin C. Harding 546d09bd8daSTobin C. Hardingsub cache_path 547d09bd8daSTobin C. Harding{ 548d09bd8daSTobin C. Harding my ($paths, $line) = @_; 549d09bd8daSTobin C. Harding 550d09bd8daSTobin C. Harding my $index = index($line, ': '); 551d09bd8daSTobin C. Harding my $path = substr($line, 0, $index); 552d09bd8daSTobin C. Harding 553d09bd8daSTobin C. Harding $index += 2; # skip ': ' 554d09bd8daSTobin C. Harding add_to_cache($paths, $path, substr($line, $index)); 555d09bd8daSTobin C. Harding} 556d09bd8daSTobin C. Harding 557d09bd8daSTobin C. Hardingsub cache_filename 558d09bd8daSTobin C. Harding{ 559d09bd8daSTobin C. Harding my ($files, $line) = @_; 560d09bd8daSTobin C. Harding 561d09bd8daSTobin C. Harding my $index = index($line, ': '); 562d09bd8daSTobin C. Harding my $path = substr($line, 0, $index); 563d09bd8daSTobin C. Harding my $filename = basename($path); 564d09bd8daSTobin C. Harding 565d09bd8daSTobin C. Harding $index += 2; # skip ': ' 566d09bd8daSTobin C. Harding add_to_cache($files, $filename, substr($line, $index)); 567d09bd8daSTobin C. Harding} 568d09bd8daSTobin C. Harding 569d09bd8daSTobin C. Hardingsub add_to_cache 570d09bd8daSTobin C. Harding{ 571d09bd8daSTobin C. Harding my ($cache, $key, $value) = @_; 572d09bd8daSTobin C. Harding 573d09bd8daSTobin C. Harding if (!$cache->{$key}) { 574d09bd8daSTobin C. Harding $cache->{$key} = (); 575d09bd8daSTobin C. Harding } 576d09bd8daSTobin C. Harding push @{$cache->{$key}}, $value; 577d09bd8daSTobin C. Harding} 578