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 use feature 'state';
  24
  25 my $P = $0;
  26 my $V = '0.01';
  27
  28 # Directories to scan.
  29 my @DIRS = ('/proc', '/sys');
  30
  31 # Timer for parsing each file, in seconds.
  32 my $TIMEOUT = 10;
  33
  34 # Script can only grep for kernel addresses on the following architectures. If
  35 # your architecture is not listed here and has a grep'able kernel address please
  36 # consider submitting a patch.
  37 my @SUPPORTED_ARCHITECTURES = ('x86_64', 'ppc64');
  38
  39 # Command line options.
  40 my $help = 0;
  41 my $debug = 0;
  42 my $raw = 0;
  43 my $output_raw = "";    # Write raw results to file.
  44 my $input_raw = "";     # Read raw results from file instead of scanning.
  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 my $kernel_config_file = "";    # Kernel configuration file.
  49
  50 # Do not parse these files (absolute path).
  51 my @skip_parse_files_abs = ('/proc/kmsg',
  52                             '/proc/kcore',
  53                             '/proc/fs/ext4/sdb1/mb_groups',
  54                             '/proc/1/fd/3',
  55                             '/sys/firmware/devicetree',
  56                             '/proc/device-tree',
  57                             '/sys/kernel/debug/tracing/trace_pipe',
  58                             '/sys/kernel/security/apparmor/revision');
  59
  60 # Do not parse these files under any subdirectory.
  61 my @skip_parse_files_any = ('0',
  62                             '1',
  63                             '2',
  64                             'pagemap',
  65                             'events',
  66                             'access',
  67                             'registers',
  68                             'snapshot_raw',
  69                             'trace_pipe_raw',
  70                             'ptmx',
  71                             'trace_pipe');
  72
  73 # Do not walk these directories (absolute path).
  74 my @skip_walk_dirs_abs = ();
  75
  76 # Do not walk these directories under any subdirectory.
  77 my @skip_walk_dirs_any = ('self',
  78                           'thread-self',
  79                           'cwd',
  80                           'fd',
  81                           'usbmon',
  82                           'stderr',
  83                           'stdin',
  84                           'stdout');
  85
  86 sub help
  87 {
  88         my ($exitcode) = @_;
  89
  90         print << "EOM";
  91
  92 Usage: $P [OPTIONS]
  93 Version: $V
  94
  95 Options:
  96
  97         -o, --output-raw=<file>         Save results for future processing.
  98         -i, --input-raw=<file>          Read results from file instead of scanning.
  99               --raw                     Show raw results (default).
 100               --suppress-dmesg          Do not show dmesg results.
 101               --squash-by-path          Show one result per unique path.
 102               --squash-by-filename      Show one result per unique filename.
 103         --kernel-config-file=<file>     Kernel configuration file (e.g /boot/config)
 104         -d, --debug                     Display debugging output.
 105         -h, --help, --version           Display this help and exit.
 106
 107 Scans the running (64 bit) kernel for potential leaking addresses.
 108
 109 EOM
 110         exit($exitcode);
 111 }
 112
 113 GetOptions(
 114         'd|debug'               => \$debug,
 115         'h|help'                => \$help,
 116         'version'               => \$help,
 117         'o|output-raw=s'        => \$output_raw,
 118         'i|input-raw=s'         => \$input_raw,
 119         'suppress-dmesg'        => \$suppress_dmesg,
 120         'squash-by-path'        => \$squash_by_path,
 121         'squash-by-filename'    => \$squash_by_filename,
 122         'raw'                   => \$raw,
 123         'kernel-config-file=s'  => \$kernel_config_file,
 124 ) or help(1);
 125
 126 help(0) if ($help);
 127
 128 if ($input_raw) {
 129         format_output($input_raw);
 130         exit(0);
 131 }
 132
 133 if (!$input_raw and ($squash_by_path or $squash_by_filename)) {
 134         printf "\nSummary reporting only available with --input-raw=<file>\n";
 135         printf "(First run scan with --output-raw=<file>.)\n";
 136         exit(128);
 137 }
 138
 139 if (!is_supported_architecture()) {
 140         printf "\nScript does not support your architecture, sorry.\n";
 141         printf "\nCurrently we support: \n\n";
 142         foreach(@SUPPORTED_ARCHITECTURES) {
 143                 printf "\t%s\n", $_;
 144         }
 145         printf("\n");
 146
 147         my $archname = `uname -m`;
 148         printf("Machine hardware name (`uname -m`): %s\n", $archname);
 149
 150         exit(129);
 151 }
 152
 153 if ($output_raw) {
 154         open my $fh, '>', $output_raw or die "$0: $output_raw: $!\n";
 155         select $fh;
 156 }
 157
 158 parse_dmesg();
 159 walk(@DIRS);
 160
 161 exit 0;
 162
 163 sub dprint
 164 {
 165         printf(STDERR @_) if $debug;
 166 }
 167
 168 sub is_supported_architecture
 169 {
 170         return (is_x86_64() or is_ppc64());
 171 }
 172
 173 sub is_arch
 174 {
 175        my ($desc) = @_;
 176        my $arch = `uname -m`;
 177
 178        chomp $arch;
 179        if ($arch eq $desc) {
 180                return 1;
 181        }
 182        return 0;
 183 }
 184
 185 sub is_x86_64
 186 {
 187         return is_arch('x86_64');
 188 }
 189
 190 sub is_ppc64
 191 {
 192         return is_arch('ppc64');
 193 }
 194
 195 # Gets config option value from kernel config file.
 196 # Returns "" on error or if config option not found.
 197 sub get_kernel_config_option
 198 {
 199         my ($option) = @_;
 200         my $value = "";
 201         my $tmp_file = "";
 202         my @config_files;
 203
 204         # Allow --kernel-config-file to override.
 205         if ($kernel_config_file ne "") {
 206                 @config_files = ($kernel_config_file);
 207         } elsif (-R "/proc/config.gz") {
 208                 my $tmp_file = "/tmp/tmpkconf";
 209
 210                 if (system("gunzip < /proc/config.gz > $tmp_file")) {
 211                         dprint "$0: system(gunzip < /proc/config.gz) failed\n";
 212                         return "";
 213                 } else {
 214                         @config_files = ($tmp_file);
 215                 }
 216         } else {
 217                 my $file = '/boot/config-' . `uname -r`;
 218                 chomp $file;
 219                 @config_files = ($file, '/boot/config');
 220         }
 221
 222         foreach my $file (@config_files) {
 223                 dprint("parsing config file: %s\n", $file);
 224                 $value = option_from_file($option, $file);
 225                 if ($value ne "") {
 226                         last;
 227                 }
 228         }
 229
 230         if ($tmp_file ne "") {
 231                 system("rm -f $tmp_file");
 232         }
 233
 234         return $value;
 235 }
 236
 237 # Parses $file and returns kernel configuration option value.
 238 sub option_from_file
 239 {
 240         my ($option, $file) = @_;
 241         my $str = "";
 242         my $val = "";
 243
 244         open(my $fh, "<", $file) or return "";
 245         while (my $line = <$fh> ) {
 246                 if ($line =~ /^$option/) {
 247                         ($str, $val) = split /=/, $line;
 248                         chomp $val;
 249                         last;
 250                 }
 251         }
 252
 253         close $fh;
 254         return $val;
 255 }
 256
 257 sub is_false_positive
 258 {
 259         my ($match) = @_;
 260
 261         if ($match =~ '\b(0x)?(f|F){16}\b' or
 262             $match =~ '\b(0x)?0{16}\b') {
 263                 return 1;
 264         }
 265
 266         if (is_x86_64() and is_in_vsyscall_memory_region($match)) {
 267                 return 1;
 268         }
 269
 270         return 0;
 271 }
 272
 273 sub is_in_vsyscall_memory_region
 274 {
 275         my ($match) = @_;
 276
 277         my $hex = hex($match);
 278         my $region_min = hex("0xffffffffff600000");
 279         my $region_max = hex("0xffffffffff601000");
 280
 281         return ($hex >= $region_min and $hex <= $region_max);
 282 }
 283
 284 # True if argument potentially contains a kernel address.
 285 sub may_leak_address
 286 {
 287         my ($line) = @_;
 288         my $address_re;
 289
 290         # Signal masks.
 291         if ($line =~ '^SigBlk:' or
 292             $line =~ '^SigIgn:' or
 293             $line =~ '^SigCgt:') {
 294                 return 0;
 295         }
 296
 297         if ($line =~ '\bKEY=[[:xdigit:]]{14} [[:xdigit:]]{16} [[:xdigit:]]{16}\b' or
 298             $line =~ '\b[[:xdigit:]]{14} [[:xdigit:]]{16} [[:xdigit:]]{16}\b') {
 299                 return 0;
 300         }
 301
 302         $address_re = get_address_re();
 303         while (/($address_re)/g) {
 304                 if (!is_false_positive($1)) {
 305                         return 1;
 306                 }
 307         }
 308
 309         return 0;
 310 }
 311
 312 sub get_address_re
 313 {
 314         if (is_x86_64()) {
 315                 return get_x86_64_re();
 316         } elsif (is_ppc64()) {
 317                 return '\b(0x)?[89abcdef]00[[:xdigit:]]{13}\b';
 318         }
 319 }
 320
 321 sub get_x86_64_re
 322 {
 323         # We handle page table levels but only if explicitly configured using
 324         # CONFIG_PGTABLE_LEVELS.  If config file parsing fails or config option
 325         # is not found we default to using address regular expression suitable
 326         # for 4 page table levels.
 327         state $ptl = get_kernel_config_option('CONFIG_PGTABLE_LEVELS');
 328
 329         if ($ptl == 5) {
 330                 return '\b(0x)?ff[[:xdigit:]]{14}\b';
 331         }
 332         return '\b(0x)?ffff[[:xdigit:]]{12}\b';
 333 }
 334
 335 sub parse_dmesg
 336 {
 337         open my $cmd, '-|', 'dmesg';
 338         while (<$cmd>) {
 339                 if (may_leak_address($_)) {
 340                         print 'dmesg: ' . $_;
 341                 }
 342         }
 343         close $cmd;
 344 }
 345
 346 # True if we should skip this path.
 347 sub skip
 348 {
 349         my ($path, $paths_abs, $paths_any) = @_;
 350
 351         foreach (@$paths_abs) {
 352                 return 1 if (/^$path$/);
 353         }
 354
 355         my($filename, $dirs, $suffix) = fileparse($path);
 356         foreach (@$paths_any) {
 357                 return 1 if (/^$filename$/);
 358         }
 359
 360         return 0;
 361 }
 362
 363 sub skip_parse
 364 {
 365         my ($path) = @_;
 366         return skip($path, \@skip_parse_files_abs, \@skip_parse_files_any);
 367 }
 368
 369 sub timed_parse_file
 370 {
 371         my ($file) = @_;
 372
 373         eval {
 374                 local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required.
 375                 alarm $TIMEOUT;
 376                 parse_file($file);
 377                 alarm 0;
 378         };
 379
 380         if ($@) {
 381                 die unless $@ eq "alarm\n";     # Propagate unexpected errors.
 382                 printf STDERR "timed out parsing: %s\n", $file;
 383         }
 384 }
 385
 386 sub parse_file
 387 {
 388         my ($file) = @_;
 389
 390         if (! -R $file) {
 391                 return;
 392         }
 393
 394         if (skip_parse($file)) {
 395                 dprint "skipping file: $file\n";
 396                 return;
 397         }
 398         dprint "parsing: $file\n";
 399
 400         open my $fh, "<", $file or return;
 401         while ( <$fh> ) {
 402                 if (may_leak_address($_)) {
 403                         print $file . ': ' . $_;
 404                 }
 405         }
 406         close $fh;
 407 }
 408
 409
 410 # True if we should skip walking this directory.
 411 sub skip_walk
 412 {
 413         my ($path) = @_;
 414         return skip($path, \@skip_walk_dirs_abs, \@skip_walk_dirs_any)
 415 }
 416
 417 # Recursively walk directory tree.
 418 sub walk
 419 {
 420         my @dirs = @_;
 421
 422         while (my $pwd = shift @dirs) {
 423                 next if (skip_walk($pwd));
 424                 next if (!opendir(DIR, $pwd));
 425                 my @files = readdir(DIR);
 426                 closedir(DIR);
 427
 428                 foreach my $file (@files) {
 429                         next if ($file eq '.' or $file eq '..');
 430
 431                         my $path = "$pwd/$file";
 432                         next if (-l $path);
 433
 434                         if (-d $path) {
 435                                 push @dirs, $path;
 436                         } else {
 437                                 timed_parse_file($path);
 438                         }
 439                 }
 440         }
 441 }
 442
 443 sub format_output
 444 {
 445         my ($file) = @_;
 446
 447         # Default is to show raw results.
 448         if ($raw or (!$squash_by_path and !$squash_by_filename)) {
 449                 dump_raw_output($file);
 450                 return;
 451         }
 452
 453         my ($total, $dmesg, $paths, $files) = parse_raw_file($file);
 454
 455         printf "\nTotal number of results from scan (incl dmesg): %d\n", $total;
 456
 457         if (!$suppress_dmesg) {
 458                 print_dmesg($dmesg);
 459         }
 460
 461         if ($squash_by_filename) {
 462                 squash_by($files, 'filename');
 463         }
 464
 465         if ($squash_by_path) {
 466                 squash_by($paths, 'path');
 467         }
 468 }
 469
 470 sub dump_raw_output
 471 {
 472         my ($file) = @_;
 473
 474         open (my $fh, '<', $file) or die "$0: $file: $!\n";
 475         while (<$fh>) {
 476                 if ($suppress_dmesg) {
 477                         if ("dmesg:" eq substr($_, 0, 6)) {
 478                                 next;
 479                         }
 480                 }
 481                 print $_;
 482         }
 483         close $fh;
 484 }
 485
 486 sub parse_raw_file
 487 {
 488         my ($file) = @_;
 489
 490         my $total = 0;          # Total number of lines parsed.
 491         my @dmesg;              # dmesg output.
 492         my %files;              # Unique filenames containing leaks.
 493         my %paths;              # Unique paths containing leaks.
 494
 495         open (my $fh, '<', $file) or die "$0: $file: $!\n";
 496         while (my $line = <$fh>) {
 497                 $total++;
 498
 499                 if ("dmesg:" eq substr($line, 0, 6)) {
 500                         push @dmesg, $line;
 501                         next;
 502                 }
 503
 504                 cache_path(\%paths, $line);
 505                 cache_filename(\%files, $line);
 506         }
 507
 508         return $total, \@dmesg, \%paths, \%files;
 509 }
 510
 511 sub print_dmesg
 512 {
 513         my ($dmesg) = @_;
 514
 515         print "\ndmesg output:\n";
 516
 517         if (@$dmesg == 0) {
 518                 print "<no results>\n";
 519                 return;
 520         }
 521
 522         foreach(@$dmesg) {
 523                 my $index = index($_, ': ');
 524                 $index += 2;    # skid ': '
 525                 print substr($_, $index);
 526         }
 527 }
 528
 529 sub squash_by
 530 {
 531         my ($ref, $desc) = @_;
 532
 533         print "\nResults squashed by $desc (excl dmesg). ";
 534         print "Displaying [<number of results> <$desc>], <example result>\n";
 535
 536         if (keys %$ref == 0) {
 537                 print "<no results>\n";
 538                 return;
 539         }
 540
 541         foreach(keys %$ref) {
 542                 my $lines = $ref->{$_};
 543                 my $length = @$lines;
 544                 printf "[%d %s] %s", $length, $_, @$lines[0];
 545         }
 546 }
 547
 548 sub cache_path
 549 {
 550         my ($paths, $line) = @_;
 551
 552         my $index = index($line, ': ');
 553         my $path = substr($line, 0, $index);
 554
 555         $index += 2;            # skip ': '
 556         add_to_cache($paths, $path, substr($line, $index));
 557 }
 558
 559 sub cache_filename
 560 {
 561         my ($files, $line) = @_;
 562
 563         my $index = index($line, ': ');
 564         my $path = substr($line, 0, $index);
 565         my $filename = basename($path);
 566
 567         $index += 2;            # skip ': '
 568         add_to_cache($files, $filename, substr($line, $index));
 569 }
 570
 571 sub add_to_cache
 572 {
 573         my ($cache, $key, $value) = @_;
 574
 575         if (!$cache->{$key}) {
 576                 $cache->{$key} = ();
 577         }
 578         push @{$cache->{$key}}, $value;
 579 }