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/; 23136fc5c4STobin C. Harding 24136fc5c4STobin C. Hardingmy $P = $0; 25136fc5c4STobin C. Hardingmy $V = '0.01'; 26136fc5c4STobin C. Harding 27136fc5c4STobin C. Harding# Directories to scan. 28136fc5c4STobin C. Hardingmy @DIRS = ('/proc', '/sys'); 29136fc5c4STobin C. Harding 30dd98c252STobin C. Harding# Timer for parsing each file, in seconds. 31dd98c252STobin C. Hardingmy $TIMEOUT = 10; 32dd98c252STobin C. Harding 3362139c12STobin C. Harding# Script can only grep for kernel addresses on the following architectures. If 3462139c12STobin C. Harding# your architecture is not listed here and has a grep'able kernel address please 3562139c12STobin C. Harding# consider submitting a patch. 3662139c12STobin C. Hardingmy @SUPPORTED_ARCHITECTURES = ('x86_64', 'ppc64'); 3762139c12STobin C. Harding 38136fc5c4STobin C. Harding# Command line options. 39136fc5c4STobin C. Hardingmy $help = 0; 40136fc5c4STobin C. Hardingmy $debug = 0; 41d09bd8daSTobin C. Hardingmy $raw = 0; 42d09bd8daSTobin C. Hardingmy $output_raw = ""; # Write raw results to file. 43d09bd8daSTobin C. Hardingmy $input_raw = ""; # Read raw results from file instead of scanning. 44d09bd8daSTobin C. Hardingmy $suppress_dmesg = 0; # Don't show dmesg in output. 45d09bd8daSTobin C. Hardingmy $squash_by_path = 0; # Summary report grouped by absolute path. 46d09bd8daSTobin C. Hardingmy $squash_by_filename = 0; # Summary report grouped by filename. 47f9d2a42dSTobin C. Hardingmy $kernel_config_file = ""; # Kernel configuration file. 48136fc5c4STobin C. Harding 49136fc5c4STobin C. Harding# Do not parse these files (absolute path). 50136fc5c4STobin C. Hardingmy @skip_parse_files_abs = ('/proc/kmsg', 51136fc5c4STobin C. Harding '/proc/kcore', 52136fc5c4STobin C. Harding '/proc/fs/ext4/sdb1/mb_groups', 53136fc5c4STobin C. Harding '/proc/1/fd/3', 541c1e3be0STobin C. Harding '/sys/firmware/devicetree', 551c1e3be0STobin C. Harding '/proc/device-tree', 56136fc5c4STobin C. Harding '/sys/kernel/debug/tracing/trace_pipe', 57136fc5c4STobin C. Harding '/sys/kernel/security/apparmor/revision'); 58136fc5c4STobin C. Harding 59a284733eSTobin C. Harding# Do not parse these files under any subdirectory. 60136fc5c4STobin C. Hardingmy @skip_parse_files_any = ('0', 61136fc5c4STobin C. Harding '1', 62136fc5c4STobin C. Harding '2', 63136fc5c4STobin C. Harding 'pagemap', 64136fc5c4STobin C. Harding 'events', 65136fc5c4STobin C. Harding 'access', 66136fc5c4STobin C. Harding 'registers', 67136fc5c4STobin C. Harding 'snapshot_raw', 68136fc5c4STobin C. Harding 'trace_pipe_raw', 69136fc5c4STobin C. Harding 'ptmx', 70136fc5c4STobin C. Harding 'trace_pipe'); 71136fc5c4STobin C. Harding 72136fc5c4STobin C. Harding# Do not walk these directories (absolute path). 73136fc5c4STobin C. Hardingmy @skip_walk_dirs_abs = (); 74136fc5c4STobin C. Harding 75136fc5c4STobin C. Harding# Do not walk these directories under any subdirectory. 76136fc5c4STobin C. Hardingmy @skip_walk_dirs_any = ('self', 77136fc5c4STobin C. Harding 'thread-self', 78136fc5c4STobin C. Harding 'cwd', 79136fc5c4STobin C. Harding 'fd', 801c1e3be0STobin C. Harding 'usbmon', 81136fc5c4STobin C. Harding 'stderr', 82136fc5c4STobin C. Harding 'stdin', 83136fc5c4STobin C. Harding 'stdout'); 84136fc5c4STobin C. Harding 85136fc5c4STobin C. Hardingsub help 86136fc5c4STobin C. Harding{ 87136fc5c4STobin C. Harding my ($exitcode) = @_; 88136fc5c4STobin C. Harding 89136fc5c4STobin C. Harding print << "EOM"; 90d09bd8daSTobin C. Harding 91136fc5c4STobin C. HardingUsage: $P [OPTIONS] 92136fc5c4STobin C. HardingVersion: $V 93136fc5c4STobin C. Harding 94136fc5c4STobin C. HardingOptions: 95136fc5c4STobin C. Harding 96d09bd8daSTobin C. Harding -o, --output-raw=<file> Save results for future processing. 97d09bd8daSTobin C. Harding -i, --input-raw=<file> Read results from file instead of scanning. 98d09bd8daSTobin C. Harding --raw Show raw results (default). 99d09bd8daSTobin C. Harding --suppress-dmesg Do not show dmesg results. 100d09bd8daSTobin C. Harding --squash-by-path Show one result per unique path. 101d09bd8daSTobin C. Harding --squash-by-filename Show one result per unique filename. 102f9d2a42dSTobin C. Harding --kernel-config-file=<file> Kernel configuration file (e.g /boot/config) 103136fc5c4STobin C. Harding -d, --debug Display debugging output. 104136fc5c4STobin C. Harding -h, --help, --version Display this help and exit. 105136fc5c4STobin C. Harding 106136fc5c4STobin C. HardingScans the running (64 bit) kernel for potential leaking addresses. 107136fc5c4STobin C. Harding 108136fc5c4STobin C. HardingEOM 109136fc5c4STobin C. Harding exit($exitcode); 110136fc5c4STobin C. Harding} 111136fc5c4STobin C. Harding 112136fc5c4STobin C. HardingGetOptions( 113136fc5c4STobin C. Harding 'd|debug' => \$debug, 114136fc5c4STobin C. Harding 'h|help' => \$help, 115d09bd8daSTobin C. Harding 'version' => \$help, 116d09bd8daSTobin C. Harding 'o|output-raw=s' => \$output_raw, 117d09bd8daSTobin C. Harding 'i|input-raw=s' => \$input_raw, 118d09bd8daSTobin C. Harding 'suppress-dmesg' => \$suppress_dmesg, 119d09bd8daSTobin C. Harding 'squash-by-path' => \$squash_by_path, 120d09bd8daSTobin C. Harding 'squash-by-filename' => \$squash_by_filename, 121d09bd8daSTobin C. Harding 'raw' => \$raw, 122f9d2a42dSTobin C. Harding 'kernel-config-file=s' => \$kernel_config_file, 123136fc5c4STobin C. Harding) or help(1); 124136fc5c4STobin C. Harding 125136fc5c4STobin C. Hardinghelp(0) if ($help); 126136fc5c4STobin C. Harding 127d09bd8daSTobin C. Hardingif ($input_raw) { 128d09bd8daSTobin C. Harding format_output($input_raw); 129d09bd8daSTobin C. Harding exit(0); 130d09bd8daSTobin C. Harding} 131d09bd8daSTobin C. Harding 132d09bd8daSTobin C. Hardingif (!$input_raw and ($squash_by_path or $squash_by_filename)) { 133d09bd8daSTobin C. Harding printf "\nSummary reporting only available with --input-raw=<file>\n"; 134d09bd8daSTobin C. Harding printf "(First run scan with --output-raw=<file>.)\n"; 135d09bd8daSTobin C. Harding exit(128); 136d09bd8daSTobin C. Harding} 137d09bd8daSTobin C. Harding 13862139c12STobin C. Hardingif (!is_supported_architecture()) { 13962139c12STobin C. Harding printf "\nScript does not support your architecture, sorry.\n"; 14062139c12STobin C. Harding printf "\nCurrently we support: \n\n"; 14162139c12STobin C. Harding foreach(@SUPPORTED_ARCHITECTURES) { 14262139c12STobin C. Harding printf "\t%s\n", $_; 14362139c12STobin C. Harding } 14462139c12STobin C. Harding 14562139c12STobin C. Harding my $archname = $Config{archname}; 14662139c12STobin C. Harding printf "\n\$ perl -MConfig -e \'print \"\$Config{archname}\\n\"\'\n"; 14762139c12STobin C. Harding printf "%s\n", $archname; 14862139c12STobin C. Harding 14962139c12STobin C. Harding exit(129); 15062139c12STobin C. Harding} 15162139c12STobin C. Harding 152d09bd8daSTobin C. Hardingif ($output_raw) { 153d09bd8daSTobin C. Harding open my $fh, '>', $output_raw or die "$0: $output_raw: $!\n"; 154d09bd8daSTobin C. Harding select $fh; 155d09bd8daSTobin C. Harding} 156d09bd8daSTobin C. Harding 157136fc5c4STobin C. Hardingparse_dmesg(); 158136fc5c4STobin C. Hardingwalk(@DIRS); 159136fc5c4STobin C. Harding 160136fc5c4STobin C. Hardingexit 0; 161136fc5c4STobin C. Harding 162136fc5c4STobin C. Hardingsub dprint 163136fc5c4STobin C. Harding{ 164136fc5c4STobin C. Harding printf(STDERR @_) if $debug; 165136fc5c4STobin C. Harding} 166136fc5c4STobin C. Harding 16762139c12STobin C. Hardingsub is_supported_architecture 16862139c12STobin C. Harding{ 16962139c12STobin C. Harding return (is_x86_64() or is_ppc64()); 17062139c12STobin C. Harding} 17162139c12STobin C. Harding 17262139c12STobin C. Hardingsub is_x86_64 17362139c12STobin C. Harding{ 17462139c12STobin C. Harding my $archname = $Config{archname}; 17562139c12STobin C. Harding 17662139c12STobin C. Harding if ($archname =~ m/x86_64/) { 17762139c12STobin C. Harding return 1; 17862139c12STobin C. Harding } 17962139c12STobin C. Harding return 0; 18062139c12STobin C. Harding} 18162139c12STobin C. Harding 18262139c12STobin C. Hardingsub is_ppc64 18362139c12STobin C. Harding{ 18462139c12STobin C. Harding my $archname = $Config{archname}; 18562139c12STobin C. Harding 18662139c12STobin C. Harding if ($archname =~ m/powerpc/ and $archname =~ m/64/) { 18762139c12STobin C. Harding return 1; 18862139c12STobin C. Harding } 18962139c12STobin C. Harding return 0; 19062139c12STobin C. Harding} 19162139c12STobin C. Harding 192f9d2a42dSTobin C. Harding# Gets config option value from kernel config file. 193f9d2a42dSTobin C. Harding# Returns "" on error or if config option not found. 194f9d2a42dSTobin C. Hardingsub get_kernel_config_option 195f9d2a42dSTobin C. Harding{ 196f9d2a42dSTobin C. Harding my ($option) = @_; 197f9d2a42dSTobin C. Harding my $value = ""; 198f9d2a42dSTobin C. Harding my $tmp_file = ""; 199f9d2a42dSTobin C. Harding my @config_files; 200f9d2a42dSTobin C. Harding 201f9d2a42dSTobin C. Harding # Allow --kernel-config-file to override. 202f9d2a42dSTobin C. Harding if ($kernel_config_file ne "") { 203f9d2a42dSTobin C. Harding @config_files = ($kernel_config_file); 204f9d2a42dSTobin C. Harding } elsif (-R "/proc/config.gz") { 205f9d2a42dSTobin C. Harding my $tmp_file = "/tmp/tmpkconf"; 206f9d2a42dSTobin C. Harding 207f9d2a42dSTobin C. Harding if (system("gunzip < /proc/config.gz > $tmp_file")) { 208f9d2a42dSTobin C. Harding dprint "$0: system(gunzip < /proc/config.gz) failed\n"; 209f9d2a42dSTobin C. Harding return ""; 210f9d2a42dSTobin C. Harding } else { 211f9d2a42dSTobin C. Harding @config_files = ($tmp_file); 212f9d2a42dSTobin C. Harding } 213f9d2a42dSTobin C. Harding } else { 214f9d2a42dSTobin C. Harding my $file = '/boot/config-' . `uname -r`; 215f9d2a42dSTobin C. Harding chomp $file; 216f9d2a42dSTobin C. Harding @config_files = ($file, '/boot/config'); 217f9d2a42dSTobin C. Harding } 218f9d2a42dSTobin C. Harding 219f9d2a42dSTobin C. Harding foreach my $file (@config_files) { 220f9d2a42dSTobin C. Harding dprint("parsing config file: %s\n", $file); 221f9d2a42dSTobin C. Harding $value = option_from_file($option, $file); 222f9d2a42dSTobin C. Harding if ($value ne "") { 223f9d2a42dSTobin C. Harding last; 224f9d2a42dSTobin C. Harding } 225f9d2a42dSTobin C. Harding } 226f9d2a42dSTobin C. Harding 227f9d2a42dSTobin C. Harding if ($tmp_file ne "") { 228f9d2a42dSTobin C. Harding system("rm -f $tmp_file"); 229f9d2a42dSTobin C. Harding } 230f9d2a42dSTobin C. Harding 231f9d2a42dSTobin C. Harding return $value; 232f9d2a42dSTobin C. Harding} 233f9d2a42dSTobin C. Harding 234f9d2a42dSTobin C. Harding# Parses $file and returns kernel configuration option value. 235f9d2a42dSTobin C. Hardingsub option_from_file 236f9d2a42dSTobin C. Harding{ 237f9d2a42dSTobin C. Harding my ($option, $file) = @_; 238f9d2a42dSTobin C. Harding my $str = ""; 239f9d2a42dSTobin C. Harding my $val = ""; 240f9d2a42dSTobin C. Harding 241f9d2a42dSTobin C. Harding open(my $fh, "<", $file) or return ""; 242f9d2a42dSTobin C. Harding while (my $line = <$fh> ) { 243f9d2a42dSTobin C. Harding if ($line =~ /^$option/) { 244f9d2a42dSTobin C. Harding ($str, $val) = split /=/, $line; 245f9d2a42dSTobin C. Harding chomp $val; 246f9d2a42dSTobin C. Harding last; 247f9d2a42dSTobin C. Harding } 248f9d2a42dSTobin C. Harding } 249f9d2a42dSTobin C. Harding 250f9d2a42dSTobin C. Harding close $fh; 251f9d2a42dSTobin C. Harding return $val; 252f9d2a42dSTobin C. Harding} 253f9d2a42dSTobin C. Harding 254136fc5c4STobin C. Hardingsub is_false_positive 255136fc5c4STobin C. Harding{ 256136fc5c4STobin C. Harding my ($match) = @_; 257136fc5c4STobin C. Harding 258136fc5c4STobin C. Harding if ($match =~ '\b(0x)?(f|F){16}\b' or 259136fc5c4STobin C. Harding $match =~ '\b(0x)?0{16}\b') { 260136fc5c4STobin C. Harding return 1; 261136fc5c4STobin C. Harding } 262136fc5c4STobin C. Harding 26387e37588STobin C. Harding if (is_x86_64() and is_in_vsyscall_memory_region($match)) { 264136fc5c4STobin C. Harding return 1; 265136fc5c4STobin C. Harding } 266136fc5c4STobin C. Harding 267136fc5c4STobin C. Harding return 0; 268136fc5c4STobin C. Harding} 269136fc5c4STobin C. Harding 27087e37588STobin C. Hardingsub is_in_vsyscall_memory_region 27187e37588STobin C. Harding{ 27287e37588STobin C. Harding my ($match) = @_; 27387e37588STobin C. Harding 27487e37588STobin C. Harding my $hex = hex($match); 27587e37588STobin C. Harding my $region_min = hex("0xffffffffff600000"); 27687e37588STobin C. Harding my $region_max = hex("0xffffffffff601000"); 27787e37588STobin C. Harding 27887e37588STobin C. Harding return ($hex >= $region_min and $hex <= $region_max); 27987e37588STobin C. Harding} 28087e37588STobin C. Harding 281136fc5c4STobin C. Harding# True if argument potentially contains a kernel address. 282136fc5c4STobin C. Hardingsub may_leak_address 283136fc5c4STobin C. Harding{ 284136fc5c4STobin C. Harding my ($line) = @_; 28562139c12STobin C. Harding my $address_re; 286136fc5c4STobin C. Harding 287136fc5c4STobin C. Harding # Signal masks. 288136fc5c4STobin C. Harding if ($line =~ '^SigBlk:' or 289a11949ecSTobin C. Harding $line =~ '^SigIgn:' or 290136fc5c4STobin C. Harding $line =~ '^SigCgt:') { 291136fc5c4STobin C. Harding return 0; 292136fc5c4STobin C. Harding } 293136fc5c4STobin C. Harding 294136fc5c4STobin C. Harding if ($line =~ '\bKEY=[[:xdigit:]]{14} [[:xdigit:]]{16} [[:xdigit:]]{16}\b' or 295136fc5c4STobin C. Harding $line =~ '\b[[:xdigit:]]{14} [[:xdigit:]]{16} [[:xdigit:]]{16}\b') { 296136fc5c4STobin C. Harding return 0; 297136fc5c4STobin C. Harding } 298136fc5c4STobin C. Harding 29962139c12STobin C. Harding # One of these is guaranteed to be true. 30062139c12STobin C. Harding if (is_x86_64()) { 30162139c12STobin C. Harding $address_re = '\b(0x)?ffff[[:xdigit:]]{12}\b'; 30262139c12STobin C. Harding } elsif (is_ppc64()) { 30362139c12STobin C. Harding $address_re = '\b(0x)?[89abcdef]00[[:xdigit:]]{13}\b'; 30462139c12STobin C. Harding } 30562139c12STobin C. Harding 30662139c12STobin C. Harding while (/($address_re)/g) { 307136fc5c4STobin C. Harding if (!is_false_positive($1)) { 308136fc5c4STobin C. Harding return 1; 309136fc5c4STobin C. Harding } 310136fc5c4STobin C. Harding } 311136fc5c4STobin C. Harding 312136fc5c4STobin C. Harding return 0; 313136fc5c4STobin C. Harding} 314136fc5c4STobin C. Harding 315136fc5c4STobin C. Hardingsub parse_dmesg 316136fc5c4STobin C. Harding{ 317136fc5c4STobin C. Harding open my $cmd, '-|', 'dmesg'; 318136fc5c4STobin C. Harding while (<$cmd>) { 319136fc5c4STobin C. Harding if (may_leak_address($_)) { 320136fc5c4STobin C. Harding print 'dmesg: ' . $_; 321136fc5c4STobin C. Harding } 322136fc5c4STobin C. Harding } 323136fc5c4STobin C. Harding close $cmd; 324136fc5c4STobin C. Harding} 325136fc5c4STobin C. Harding 326136fc5c4STobin C. Harding# True if we should skip this path. 327136fc5c4STobin C. Hardingsub skip 328136fc5c4STobin C. Harding{ 329136fc5c4STobin C. Harding my ($path, $paths_abs, $paths_any) = @_; 330136fc5c4STobin C. Harding 331136fc5c4STobin C. Harding foreach (@$paths_abs) { 332136fc5c4STobin C. Harding return 1 if (/^$path$/); 333136fc5c4STobin C. Harding } 334136fc5c4STobin C. Harding 335136fc5c4STobin C. Harding my($filename, $dirs, $suffix) = fileparse($path); 336136fc5c4STobin C. Harding foreach (@$paths_any) { 337136fc5c4STobin C. Harding return 1 if (/^$filename$/); 338136fc5c4STobin C. Harding } 339136fc5c4STobin C. Harding 340136fc5c4STobin C. Harding return 0; 341136fc5c4STobin C. Harding} 342136fc5c4STobin C. Harding 343136fc5c4STobin C. Hardingsub skip_parse 344136fc5c4STobin C. Harding{ 345136fc5c4STobin C. Harding my ($path) = @_; 346136fc5c4STobin C. Harding return skip($path, \@skip_parse_files_abs, \@skip_parse_files_any); 347136fc5c4STobin C. Harding} 348136fc5c4STobin C. Harding 349dd98c252STobin C. Hardingsub timed_parse_file 350dd98c252STobin C. Harding{ 351dd98c252STobin C. Harding my ($file) = @_; 352dd98c252STobin C. Harding 353dd98c252STobin C. Harding eval { 354dd98c252STobin C. Harding local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required. 355dd98c252STobin C. Harding alarm $TIMEOUT; 356dd98c252STobin C. Harding parse_file($file); 357dd98c252STobin C. Harding alarm 0; 358dd98c252STobin C. Harding }; 359dd98c252STobin C. Harding 360dd98c252STobin C. Harding if ($@) { 361dd98c252STobin C. Harding die unless $@ eq "alarm\n"; # Propagate unexpected errors. 362dd98c252STobin C. Harding printf STDERR "timed out parsing: %s\n", $file; 363dd98c252STobin C. Harding } 364dd98c252STobin C. Harding} 365dd98c252STobin C. Harding 366136fc5c4STobin C. Hardingsub parse_file 367136fc5c4STobin C. Harding{ 368136fc5c4STobin C. Harding my ($file) = @_; 369136fc5c4STobin C. Harding 370136fc5c4STobin C. Harding if (! -R $file) { 371136fc5c4STobin C. Harding return; 372136fc5c4STobin C. Harding } 373136fc5c4STobin C. Harding 374136fc5c4STobin C. Harding if (skip_parse($file)) { 375136fc5c4STobin C. Harding dprint "skipping file: $file\n"; 376136fc5c4STobin C. Harding return; 377136fc5c4STobin C. Harding } 378136fc5c4STobin C. Harding dprint "parsing: $file\n"; 379136fc5c4STobin C. Harding 380136fc5c4STobin C. Harding open my $fh, "<", $file or return; 381136fc5c4STobin C. Harding while ( <$fh> ) { 382136fc5c4STobin C. Harding if (may_leak_address($_)) { 383136fc5c4STobin C. Harding print $file . ': ' . $_; 384136fc5c4STobin C. Harding } 385136fc5c4STobin C. Harding } 386136fc5c4STobin C. Harding close $fh; 387136fc5c4STobin C. Harding} 388136fc5c4STobin C. Harding 389136fc5c4STobin C. Harding 390136fc5c4STobin C. Harding# True if we should skip walking this directory. 391136fc5c4STobin C. Hardingsub skip_walk 392136fc5c4STobin C. Harding{ 393136fc5c4STobin C. Harding my ($path) = @_; 394136fc5c4STobin C. Harding return skip($path, \@skip_walk_dirs_abs, \@skip_walk_dirs_any) 395136fc5c4STobin C. Harding} 396136fc5c4STobin C. Harding 397136fc5c4STobin C. Harding# Recursively walk directory tree. 398136fc5c4STobin C. Hardingsub walk 399136fc5c4STobin C. Harding{ 400136fc5c4STobin C. Harding my @dirs = @_; 401136fc5c4STobin C. Harding 402136fc5c4STobin C. Harding while (my $pwd = shift @dirs) { 403136fc5c4STobin C. Harding next if (skip_walk($pwd)); 404136fc5c4STobin C. Harding next if (!opendir(DIR, $pwd)); 405136fc5c4STobin C. Harding my @files = readdir(DIR); 406136fc5c4STobin C. Harding closedir(DIR); 407136fc5c4STobin C. Harding 408136fc5c4STobin C. Harding foreach my $file (@files) { 409136fc5c4STobin C. Harding next if ($file eq '.' or $file eq '..'); 410136fc5c4STobin C. Harding 411136fc5c4STobin C. Harding my $path = "$pwd/$file"; 412136fc5c4STobin C. Harding next if (-l $path); 413136fc5c4STobin C. Harding 414136fc5c4STobin C. Harding if (-d $path) { 415136fc5c4STobin C. Harding push @dirs, $path; 416136fc5c4STobin C. Harding } else { 417dd98c252STobin C. Harding timed_parse_file($path); 418136fc5c4STobin C. Harding } 419136fc5c4STobin C. Harding } 420136fc5c4STobin C. Harding } 421136fc5c4STobin C. Harding} 422d09bd8daSTobin C. Harding 423d09bd8daSTobin C. Hardingsub format_output 424d09bd8daSTobin C. Harding{ 425d09bd8daSTobin C. Harding my ($file) = @_; 426d09bd8daSTobin C. Harding 427d09bd8daSTobin C. Harding # Default is to show raw results. 428d09bd8daSTobin C. Harding if ($raw or (!$squash_by_path and !$squash_by_filename)) { 429d09bd8daSTobin C. Harding dump_raw_output($file); 430d09bd8daSTobin C. Harding return; 431d09bd8daSTobin C. Harding } 432d09bd8daSTobin C. Harding 433d09bd8daSTobin C. Harding my ($total, $dmesg, $paths, $files) = parse_raw_file($file); 434d09bd8daSTobin C. Harding 435d09bd8daSTobin C. Harding printf "\nTotal number of results from scan (incl dmesg): %d\n", $total; 436d09bd8daSTobin C. Harding 437d09bd8daSTobin C. Harding if (!$suppress_dmesg) { 438d09bd8daSTobin C. Harding print_dmesg($dmesg); 439d09bd8daSTobin C. Harding } 440d09bd8daSTobin C. Harding 441d09bd8daSTobin C. Harding if ($squash_by_filename) { 442d09bd8daSTobin C. Harding squash_by($files, 'filename'); 443d09bd8daSTobin C. Harding } 444d09bd8daSTobin C. Harding 445d09bd8daSTobin C. Harding if ($squash_by_path) { 446d09bd8daSTobin C. Harding squash_by($paths, 'path'); 447d09bd8daSTobin C. Harding } 448d09bd8daSTobin C. Harding} 449d09bd8daSTobin C. Harding 450d09bd8daSTobin C. Hardingsub dump_raw_output 451d09bd8daSTobin C. Harding{ 452d09bd8daSTobin C. Harding my ($file) = @_; 453d09bd8daSTobin C. Harding 454d09bd8daSTobin C. Harding open (my $fh, '<', $file) or die "$0: $file: $!\n"; 455d09bd8daSTobin C. Harding while (<$fh>) { 456d09bd8daSTobin C. Harding if ($suppress_dmesg) { 457d09bd8daSTobin C. Harding if ("dmesg:" eq substr($_, 0, 6)) { 458d09bd8daSTobin C. Harding next; 459d09bd8daSTobin C. Harding } 460d09bd8daSTobin C. Harding } 461d09bd8daSTobin C. Harding print $_; 462d09bd8daSTobin C. Harding } 463d09bd8daSTobin C. Harding close $fh; 464d09bd8daSTobin C. Harding} 465d09bd8daSTobin C. Harding 466d09bd8daSTobin C. Hardingsub parse_raw_file 467d09bd8daSTobin C. Harding{ 468d09bd8daSTobin C. Harding my ($file) = @_; 469d09bd8daSTobin C. Harding 470d09bd8daSTobin C. Harding my $total = 0; # Total number of lines parsed. 471d09bd8daSTobin C. Harding my @dmesg; # dmesg output. 472d09bd8daSTobin C. Harding my %files; # Unique filenames containing leaks. 473d09bd8daSTobin C. Harding my %paths; # Unique paths containing leaks. 474d09bd8daSTobin C. Harding 475d09bd8daSTobin C. Harding open (my $fh, '<', $file) or die "$0: $file: $!\n"; 476d09bd8daSTobin C. Harding while (my $line = <$fh>) { 477d09bd8daSTobin C. Harding $total++; 478d09bd8daSTobin C. Harding 479d09bd8daSTobin C. Harding if ("dmesg:" eq substr($line, 0, 6)) { 480d09bd8daSTobin C. Harding push @dmesg, $line; 481d09bd8daSTobin C. Harding next; 482d09bd8daSTobin C. Harding } 483d09bd8daSTobin C. Harding 484d09bd8daSTobin C. Harding cache_path(\%paths, $line); 485d09bd8daSTobin C. Harding cache_filename(\%files, $line); 486d09bd8daSTobin C. Harding } 487d09bd8daSTobin C. Harding 488d09bd8daSTobin C. Harding return $total, \@dmesg, \%paths, \%files; 489d09bd8daSTobin C. Harding} 490d09bd8daSTobin C. Harding 491d09bd8daSTobin C. Hardingsub print_dmesg 492d09bd8daSTobin C. Harding{ 493d09bd8daSTobin C. Harding my ($dmesg) = @_; 494d09bd8daSTobin C. Harding 495d09bd8daSTobin C. Harding print "\ndmesg output:\n"; 496d09bd8daSTobin C. Harding 497d09bd8daSTobin C. Harding if (@$dmesg == 0) { 498d09bd8daSTobin C. Harding print "<no results>\n"; 499d09bd8daSTobin C. Harding return; 500d09bd8daSTobin C. Harding } 501d09bd8daSTobin C. Harding 502d09bd8daSTobin C. Harding foreach(@$dmesg) { 503d09bd8daSTobin C. Harding my $index = index($_, ': '); 504d09bd8daSTobin C. Harding $index += 2; # skid ': ' 505d09bd8daSTobin C. Harding print substr($_, $index); 506d09bd8daSTobin C. Harding } 507d09bd8daSTobin C. Harding} 508d09bd8daSTobin C. Harding 509d09bd8daSTobin C. Hardingsub squash_by 510d09bd8daSTobin C. Harding{ 511d09bd8daSTobin C. Harding my ($ref, $desc) = @_; 512d09bd8daSTobin C. Harding 513d09bd8daSTobin C. Harding print "\nResults squashed by $desc (excl dmesg). "; 514d09bd8daSTobin C. Harding print "Displaying [<number of results> <$desc>], <example result>\n"; 515d09bd8daSTobin C. Harding 516d09bd8daSTobin C. Harding if (keys %$ref == 0) { 517d09bd8daSTobin C. Harding print "<no results>\n"; 518d09bd8daSTobin C. Harding return; 519d09bd8daSTobin C. Harding } 520d09bd8daSTobin C. Harding 521d09bd8daSTobin C. Harding foreach(keys %$ref) { 522d09bd8daSTobin C. Harding my $lines = $ref->{$_}; 523d09bd8daSTobin C. Harding my $length = @$lines; 524d09bd8daSTobin C. Harding printf "[%d %s] %s", $length, $_, @$lines[0]; 525d09bd8daSTobin C. Harding } 526d09bd8daSTobin C. Harding} 527d09bd8daSTobin C. Harding 528d09bd8daSTobin C. Hardingsub cache_path 529d09bd8daSTobin C. Harding{ 530d09bd8daSTobin C. Harding my ($paths, $line) = @_; 531d09bd8daSTobin C. Harding 532d09bd8daSTobin C. Harding my $index = index($line, ': '); 533d09bd8daSTobin C. Harding my $path = substr($line, 0, $index); 534d09bd8daSTobin C. Harding 535d09bd8daSTobin C. Harding $index += 2; # skip ': ' 536d09bd8daSTobin C. Harding add_to_cache($paths, $path, substr($line, $index)); 537d09bd8daSTobin C. Harding} 538d09bd8daSTobin C. Harding 539d09bd8daSTobin C. Hardingsub cache_filename 540d09bd8daSTobin C. Harding{ 541d09bd8daSTobin C. Harding my ($files, $line) = @_; 542d09bd8daSTobin C. Harding 543d09bd8daSTobin C. Harding my $index = index($line, ': '); 544d09bd8daSTobin C. Harding my $path = substr($line, 0, $index); 545d09bd8daSTobin C. Harding my $filename = basename($path); 546d09bd8daSTobin C. Harding 547d09bd8daSTobin C. Harding $index += 2; # skip ': ' 548d09bd8daSTobin C. Harding add_to_cache($files, $filename, substr($line, $index)); 549d09bd8daSTobin C. Harding} 550d09bd8daSTobin C. Harding 551d09bd8daSTobin C. Hardingsub add_to_cache 552d09bd8daSTobin C. Harding{ 553d09bd8daSTobin C. Harding my ($cache, $key, $value) = @_; 554d09bd8daSTobin C. Harding 555d09bd8daSTobin C. Harding if (!$cache->{$key}) { 556d09bd8daSTobin C. Harding $cache->{$key} = (); 557d09bd8daSTobin C. Harding } 558d09bd8daSTobin C. Harding push @{$cache->{$key}}, $value; 559d09bd8daSTobin C. Harding} 560