scripts/leaking_addresses.pl

   1 #!/usr/bin/env perl
   2 #
   3 # (c) 2017 Tobin C. Harding <me@tobin.cc>
   4 # Licensed under the terms of the GNU GPL License version 2
   5 #
   6 # leaking_addresses.pl: Scan 64 bit kernel for potential leaking addresses.
   7 #  - Scans dmesg output.
   8 #  - Walks directory tree and parses each file (for each directory in @DIRS).
   9 #
  10 # Use --debug to output path before parsing, this is useful to find files that
  11 # cause the script to choke.
  12
  13 use warnings;
  14 use strict;
  15 use POSIX;
  16 use File::Basename;
  17 use File::Spec;
  18 use Cwd 'abs_path';
  19 use Term::ANSIColor qw(:constants);
  20 use Getopt::Long qw(:config no_auto_abbrev);
  21 use Config;
  22 use bigint qw/hex/;
  23
  24 my $P = $0;
  25 my $V = '0.01';
  26
  27 # Directories to scan.
  28 my @DIRS = ('/proc', '/sys');
  29
  30 # Timer for parsing each file, in seconds.
  31 my $TIMEOUT = 10;
  32
  33 # Script can only grep for kernel addresses on the following architectures. If
  34 # your architecture is not listed here and has a grep'able kernel address please
  35 # consider submitting a patch.
  36 my @SUPPORTED_ARCHITECTURES = ('x86_64', 'ppc64');
  37
  38 # Command line options.
  39 my $help = 0;
  40 my $debug = 0;
  41 my $raw = 0;
  42 my $output_raw = "";    # Write raw results to file.
  43 my $input_raw = "";     # Read raw results from file instead of scanning.
  44
  45 my $suppress_dmesg = 0;         # Don't show dmesg in output.
  46 my $squash_by_path = 0;         # Summary report grouped by absolute path.
  47 my $squash_by_filename = 0;     # Summary report grouped by filename.
  48
  49 # Do not parse these files (absolute path).
  50 my @skip_parse_files_abs = ('/proc/kmsg',
  51                             '/proc/kcore',
  52                             '/proc/fs/ext4/sdb1/mb_groups',
  53                             '/proc/1/fd/3',
  54                             '/sys/firmware/devicetree',
  55                             '/proc/device-tree',
  56                             '/sys/kernel/debug/tracing/trace_pipe',
  57                             '/sys/kernel/security/apparmor/revision');
  58
  59 # Do not parse these files under any subdirectory.
  60 my @skip_parse_files_any = ('0',
  61                             '1',
  62                             '2',
  63                             'pagemap',
  64                             'events',
  65                             'access',
  66                             'registers',
  67                             'snapshot_raw',
  68                             'trace_pipe_raw',
  69                             'ptmx',
  70                             'trace_pipe');
  71
  72 # Do not walk these directories (absolute path).
  73 my @skip_walk_dirs_abs = ();
  74
  75 # Do not walk these directories under any subdirectory.
  76 my @skip_walk_dirs_any = ('self',
  77                           'thread-self',
  78                           'cwd',
  79                           'fd',
  80                           'usbmon',
  81                           'stderr',
  82                           'stdin',
  83                           'stdout');
  84
  85 sub help
  86 {
  87         my ($exitcode) = @_;
  88
  89         print << "EOM";
  90
  91 Usage: $P [OPTIONS]
  92 Version: $V
  93
  94 Options:
  95
  96         -o, --output-raw=<file>         Save results for future processing.
  97         -i, --input-raw=<file>          Read results from file instead of scanning.
  98               --raw                     Show raw results (default).
  99               --suppress-dmesg          Do not show dmesg results.
 100               --squash-by-path          Show one result per unique path.
 101               --squash-by-filename      Show one result per unique filename.
 102         -d, --debug                     Display debugging output.
 103         -h, --help, --version           Display this help and exit.
 104
 105 Scans the running (64 bit) kernel for potential leaking addresses.
 106
 107 EOM
 108         exit($exitcode);
 109 }
 110
 111 GetOptions(
 112         'd|debug'               => \$debug,
 113         'h|help'                => \$help,
 114         'version'               => \$help,
 115         'o|output-raw=s'        => \$output_raw,
 116         'i|input-raw=s'         => \$input_raw,
 117         'suppress-dmesg'        => \$suppress_dmesg,
 118         'squash-by-path'        => \$squash_by_path,
 119         'squash-by-filename'    => \$squash_by_filename,
 120         'raw'                   => \$raw,
 121 ) or help(1);
 122
 123 help(0) if ($help);
 124
 125 if ($input_raw) {
 126         format_output($input_raw);
 127         exit(0);
 128 }
 129
 130 if (!$input_raw and ($squash_by_path or $squash_by_filename)) {
 131         printf "\nSummary reporting only available with --input-raw=<file>\n";
 132         printf "(First run scan with --output-raw=<file>.)\n";
 133         exit(128);
 134 }
 135
 136 if (!is_supported_architecture()) {
 137         printf "\nScript does not support your architecture, sorry.\n";
 138         printf "\nCurrently we support: \n\n";
 139         foreach(@SUPPORTED_ARCHITECTURES) {
 140                 printf "\t%s\n", $_;
 141         }
 142
 143         my $archname = $Config{archname};
 144         printf "\n\$ perl -MConfig -e \'print \"\$Config{archname}\\n\"\'\n";
 145         printf "%s\n", $archname;
 146
 147         exit(129);
 148 }
 149
 150 if ($output_raw) {
 151         open my $fh, '>', $output_raw or die "$0: $output_raw: $!\n";
 152         select $fh;
 153 }
 154
 155 parse_dmesg();
 156 walk(@DIRS);
 157
 158 exit 0;
 159
 160 sub dprint
 161 {
 162         printf(STDERR @_) if $debug;
 163 }
 164
 165 sub is_supported_architecture
 166 {
 167         return (is_x86_64() or is_ppc64());
 168 }
 169
 170 sub is_x86_64
 171 {
 172         my $archname = $Config{archname};
 173
 174         if ($archname =~ m/x86_64/) {
 175                 return 1;
 176         }
 177         return 0;
 178 }
 179
 180 sub is_ppc64
 181 {
 182         my $archname = $Config{archname};
 183
 184         if ($archname =~ m/powerpc/ and $archname =~ m/64/) {
 185                 return 1;
 186         }
 187         return 0;
 188 }
 189
 190 sub is_false_positive
 191 {
 192         my ($match) = @_;
 193
 194         if ($match =~ '\b(0x)?(f|F){16}\b' or
 195             $match =~ '\b(0x)?0{16}\b') {
 196                 return 1;
 197         }
 198
 199         if (is_x86_64() and is_in_vsyscall_memory_region($match)) {
 200                 return 1;
 201         }
 202
 203         return 0;
 204 }
 205
 206 sub is_in_vsyscall_memory_region
 207 {
 208         my ($match) = @_;
 209
 210         my $hex = hex($match);
 211         my $region_min = hex("0xffffffffff600000");
 212         my $region_max = hex("0xffffffffff601000");
 213
 214         return ($hex >= $region_min and $hex <= $region_max);
 215 }
 216
 217 # True if argument potentially contains a kernel address.
 218 sub may_leak_address
 219 {
 220         my ($line) = @_;
 221         my $address_re;
 222
 223         # Signal masks.
 224         if ($line =~ '^SigBlk:' or
 225             $line =~ '^SigIgn:' or
 226             $line =~ '^SigCgt:') {
 227                 return 0;
 228         }
 229
 230         if ($line =~ '\bKEY=[[:xdigit:]]{14} [[:xdigit:]]{16} [[:xdigit:]]{16}\b' or
 231             $line =~ '\b[[:xdigit:]]{14} [[:xdigit:]]{16} [[:xdigit:]]{16}\b') {
 232                 return 0;
 233         }
 234
 235         # One of these is guaranteed to be true.
 236         if (is_x86_64()) {
 237                 $address_re = '\b(0x)?ffff[[:xdigit:]]{12}\b';
 238         } elsif (is_ppc64()) {
 239                 $address_re = '\b(0x)?[89abcdef]00[[:xdigit:]]{13}\b';
 240         }
 241
 242         while (/($address_re)/g) {
 243                 if (!is_false_positive($1)) {
 244                         return 1;
 245                 }
 246         }
 247
 248         return 0;
 249 }
 250
 251 sub parse_dmesg
 252 {
 253         open my $cmd, '-|', 'dmesg';
 254         while (<$cmd>) {
 255                 if (may_leak_address($_)) {
 256                         print 'dmesg: ' . $_;
 257                 }
 258         }
 259         close $cmd;
 260 }
 261
 262 # True if we should skip this path.
 263 sub skip
 264 {
 265         my ($path, $paths_abs, $paths_any) = @_;
 266
 267         foreach (@$paths_abs) {
 268                 return 1 if (/^$path$/);
 269         }
 270
 271         my($filename, $dirs, $suffix) = fileparse($path);
 272         foreach (@$paths_any) {
 273                 return 1 if (/^$filename$/);
 274         }
 275
 276         return 0;
 277 }
 278
 279 sub skip_parse
 280 {
 281         my ($path) = @_;
 282         return skip($path, \@skip_parse_files_abs, \@skip_parse_files_any);
 283 }
 284
 285 sub timed_parse_file
 286 {
 287         my ($file) = @_;
 288
 289         eval {
 290                 local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required.
 291                 alarm $TIMEOUT;
 292                 parse_file($file);
 293                 alarm 0;
 294         };
 295
 296         if ($@) {
 297                 die unless $@ eq "alarm\n";     # Propagate unexpected errors.
 298                 printf STDERR "timed out parsing: %s\n", $file;
 299         }
 300 }
 301
 302 sub parse_file
 303 {
 304         my ($file) = @_;
 305
 306         if (! -R $file) {
 307                 return;
 308         }
 309
 310         if (skip_parse($file)) {
 311                 dprint "skipping file: $file\n";
 312                 return;
 313         }
 314         dprint "parsing: $file\n";
 315
 316         open my $fh, "<", $file or return;
 317         while ( <$fh> ) {
 318                 if (may_leak_address($_)) {
 319                         print $file . ': ' . $_;
 320                 }
 321         }
 322         close $fh;
 323 }
 324
 325
 326 # True if we should skip walking this directory.
 327 sub skip_walk
 328 {
 329         my ($path) = @_;
 330         return skip($path, \@skip_walk_dirs_abs, \@skip_walk_dirs_any)
 331 }
 332
 333 # Recursively walk directory tree.
 334 sub walk
 335 {
 336         my @dirs = @_;
 337
 338         while (my $pwd = shift @dirs) {
 339                 next if (skip_walk($pwd));
 340                 next if (!opendir(DIR, $pwd));
 341                 my @files = readdir(DIR);
 342                 closedir(DIR);
 343
 344                 foreach my $file (@files) {
 345                         next if ($file eq '.' or $file eq '..');
 346
 347                         my $path = "$pwd/$file";
 348                         next if (-l $path);
 349
 350                         if (-d $path) {
 351                                 push @dirs, $path;
 352                         } else {
 353                                 timed_parse_file($path);
 354                         }
 355                 }
 356         }
 357 }
 358
 359 sub format_output
 360 {
 361         my ($file) = @_;
 362
 363         # Default is to show raw results.
 364         if ($raw or (!$squash_by_path and !$squash_by_filename)) {
 365                 dump_raw_output($file);
 366                 return;
 367         }
 368
 369         my ($total, $dmesg, $paths, $files) = parse_raw_file($file);
 370
 371         printf "\nTotal number of results from scan (incl dmesg): %d\n", $total;
 372
 373         if (!$suppress_dmesg) {
 374                 print_dmesg($dmesg);
 375         }
 376
 377         if ($squash_by_filename) {
 378                 squash_by($files, 'filename');
 379         }
 380
 381         if ($squash_by_path) {
 382                 squash_by($paths, 'path');
 383         }
 384 }
 385
 386 sub dump_raw_output
 387 {
 388         my ($file) = @_;
 389
 390         open (my $fh, '<', $file) or die "$0: $file: $!\n";
 391         while (<$fh>) {
 392                 if ($suppress_dmesg) {
 393                         if ("dmesg:" eq substr($_, 0, 6)) {
 394                                 next;
 395                         }
 396                 }
 397                 print $_;
 398         }
 399         close $fh;
 400 }
 401
 402 sub parse_raw_file
 403 {
 404         my ($file) = @_;
 405
 406         my $total = 0;          # Total number of lines parsed.
 407         my @dmesg;              # dmesg output.
 408         my %files;              # Unique filenames containing leaks.
 409         my %paths;              # Unique paths containing leaks.
 410
 411         open (my $fh, '<', $file) or die "$0: $file: $!\n";
 412         while (my $line = <$fh>) {
 413                 $total++;
 414
 415                 if ("dmesg:" eq substr($line, 0, 6)) {
 416                         push @dmesg, $line;
 417                         next;
 418                 }
 419
 420                 cache_path(\%paths, $line);
 421                 cache_filename(\%files, $line);
 422         }
 423
 424         return $total, \@dmesg, \%paths, \%files;
 425 }
 426
 427 sub print_dmesg
 428 {
 429         my ($dmesg) = @_;
 430
 431         print "\ndmesg output:\n";
 432
 433         if (@$dmesg == 0) {
 434                 print "<no results>\n";
 435                 return;
 436         }
 437
 438         foreach(@$dmesg) {
 439                 my $index = index($_, ': ');
 440                 $index += 2;    # skid ': '
 441                 print substr($_, $index);
 442         }
 443 }
 444
 445 sub squash_by
 446 {
 447         my ($ref, $desc) = @_;
 448
 449         print "\nResults squashed by $desc (excl dmesg). ";
 450         print "Displaying [<number of results> <$desc>], <example result>\n";
 451
 452         if (keys %$ref == 0) {
 453                 print "<no results>\n";
 454                 return;
 455         }
 456
 457         foreach(keys %$ref) {
 458                 my $lines = $ref->{$_};
 459                 my $length = @$lines;
 460                 printf "[%d %s] %s", $length, $_, @$lines[0];
 461         }
 462 }
 463
 464 sub cache_path
 465 {
 466         my ($paths, $line) = @_;
 467
 468         my $index = index($line, ': ');
 469         my $path = substr($line, 0, $index);
 470
 471         $index += 2;            # skip ': '
 472         add_to_cache($paths, $path, substr($line, $index));
 473 }
 474
 475 sub cache_filename
 476 {
 477         my ($files, $line) = @_;
 478
 479         my $index = index($line, ': ');
 480         my $path = substr($line, 0, $index);
 481         my $filename = basename($path);
 482
 483         $index += 2;            # skip ': '
 484         add_to_cache($files, $filename, substr($line, $index));
 485 }
 486
 487 sub add_to_cache
 488 {
 489         my ($cache, $key, $value) = @_;
 490
 491         if (!$cache->{$key}) {
 492                 $cache->{$key} = ();
 493         }
 494         push @{$cache->{$key}}, $value;
 495 }