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