[RFC] scripts: add leaking_addresses.pl

[RFC] scripts: add leaking_addresses.pl

[Tobin C. Harding]

Currently we are leaking addresses from the kernel to user space. This
script as an attempt to find those leakages. Script parses `dmesg`
output and /proc and /sys files for suspicious entries.

Signed-off-by: Tobin C. Harding <me@tobin.cc>
---

My usual disclaimer; I am a long way from being a Perl monger, any tips,
however trivial, most welcome.

Parses dmesg output first then;

Algorithm walks the directory tree of /proc and /sys, opens each file
for reading and parses file line by line. We therefore need to skip
certain files;

 - binary files.
 - relay large files of fixed format that _definitely_ won't leak.
 - non-readable files.

Since I do not know procfs or sysfs extensively I set `DEBUG = 1` within
the script (causes output of file name before parsing) and checked each
file it choked on. Obviously this means there are going to be a bunch of
other files not present on my system. Either more files to skip or a
suggestion of a better way to do this most appreciated.

Like I said, happy to take suggestions, abuse, tweaks etc

Thanks in advance for taking the time to look at this. Oh, I didn't
comment on my regex skills, no further comment required ;)

thanks,
Tobin.

 scripts/leaking_addresses.pl | 139 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 139 insertions(+)
 create mode 100755 scripts/leaking_addresses.pl

diff --git a/scripts/leaking_addresses.pl b/scripts/leaking_addresses.pl
new file mode 100755
index 000000000000..940547b716e3
--- /dev/null
+++ b/scripts/leaking_addresses.pl
@@ -0,0 +1,139 @@
+#!/usr/bin/env perl
+#
+# leaking_addresses.pl scan kernel for potential leaking addresses.
+
+use warnings;
+use strict;
+use File::Basename;
+use feature 'say';
+
+my $DEBUG = 0;
+my @dirs = ('/proc', '/sys');
+
+parse_dmesg();
+
+foreach(@dirs)
+{
+    walk($_);
+}
+
+exit 0;
+
+#
+# TODO
+#
+# - Add support for 32 bit architectures.
+#
+sub may_leak_address
+{
+    my $line = $_[0];
+    my $regex = 'ffff[a-fA-F0-9]{12}';
+    my $mask = 'ffffffffffffffff';
+
+    if ($line =~ /$mask/) {
+        return
+    }
+
+    if ($line =~ /$regex/) {
+        return 1;
+    }
+    return;
+}
+
+sub parse_dmesg
+{
+    my $line;
+    open my $cmd, '-|', 'dmesg';
+    while ($line = <$cmd>) {
+        if (may_leak_address($line)) {
+            print 'dmesg: ' . $line;
+        }
+    }
+    close $cmd;
+}
+
+# We should skip these files
+sub skip_file
+{
+    my $path = $_[0];
+
+    my @skip_paths = ('/proc/kmsg', '/proc/kcore', '/proc/kallsyms',
+                      '/proc/fs/ext4/sdb1/mb_groups', '/sys/kernel/debug/tracing/trace_pipe',
+                      '/sys/kernel/security/apparmor/revision');
+    my @skip_files = ('pagemap', 'events', 'access','registers', 'snapshot_raw',
+                      'trace_pipe_raw', 'trace_pipe');
+
+    foreach(@skip_paths) {
+        if ($_ eq $_[0]) {
+            return 1;
+        }
+    }
+
+    my($filename, $dirs, $suffix) = fileparse($path);
+
+    foreach(@skip_files) {
+        if ($_ eq $filename) {
+            return 1;
+        }
+    }
+
+    return;
+}
+
+sub parse_file
+{
+    my $file = $_[0];
+
+    if (! -R $file) {
+        return;
+    }
+
+    if (skip_file($file)) {
+        if ($DEBUG == 1) {
+            print "skipping file: $file\n";
+        }
+        return;
+    }
+    if ($DEBUG == 1) {
+        print "parsing $file\n";
+    }
+
+    open my $fh, $file or return;
+
+    while( my $line = <$fh>)  {
+        if (may_leak_address($line)) {
+            print $file . ': ' . $line;
+        }
+    }
+
+    close $fh;
+}
+
+# Recursively walk directory tree
+sub walk
+{
+    my @dirs = ($_[0]);
+    my %seen;
+
+    while (my $pwd = shift @dirs) {
+        if (!opendir(DIR,"$pwd")) {
+            print STDERR "Cannot open $pwd\n";          
+            next;
+        } 
+        my @files = readdir(DIR);
+        closedir(DIR);
+        foreach my $file (@files) {
+            next if ($file eq '.' or $file eq '..');
+
+            my $path = "$pwd/$file";
+            next if (-l $path);
+
+            if (-d $path and !$seen{$path}) {
+                $seen{$path} = 1;
+                push @dirs, "$path";
+            } else {
+                parse_file("$path");
+            }
+        }
+    }
+}
-- 
2.7.4

Re: [RFC] scripts: add leaking_addresses.pl

[Steven Rostedt]

On Thu, 19 Oct 2017 17:34:44 +1100
"Tobin C. Harding" <me@tobin.cc> wrote:

> 
> My usual disclaimer; I am a long way from being a Perl monger, any tips,

I'm a semi Perl monger.

> however trivial, most welcome.
> 
> Parses dmesg output first then;
> 
> Algorithm walks the directory tree of /proc and /sys, opens each file
> for reading and parses file line by line. We therefore need to skip
> certain files;
> 
>  - binary files.
>  - relay large files of fixed format that _definitely_ won't leak.

"relay large files"? What do the files relay with? ;-)

>  - non-readable files.
> 
> Since I do not know procfs or sysfs extensively I set `DEBUG = 1` within
> the script (causes output of file name before parsing) and checked each
> file it choked on. Obviously this means there are going to be a bunch of
> other files not present on my system. Either more files to skip or a
> suggestion of a better way to do this most appreciated.
> 
> Like I said, happy to take suggestions, abuse, tweaks etc

abuse accepted.

> 
> Thanks in advance for taking the time to look at this. Oh, I didn't
> comment on my regex skills, no further comment required ;)
> 
> thanks,
> Tobin.
> 
>  scripts/leaking_addresses.pl | 139 +++++++++++++++++++++++++++++++++++++++++++
>  1 file changed, 139 insertions(+)
>  create mode 100755 scripts/leaking_addresses.pl
> 
> diff --git a/scripts/leaking_addresses.pl b/scripts/leaking_addresses.pl
> new file mode 100755
> index 000000000000..940547b716e3
> --- /dev/null
> +++ b/scripts/leaking_addresses.pl
> @@ -0,0 +1,139 @@
> +#!/usr/bin/env perl
> +#
> +# leaking_addresses.pl scan kernel for potential leaking addresses.
> +
> +use warnings;
> +use strict;
> +use File::Basename;
> +use feature 'say';
> +
> +my $DEBUG = 0;
> +my @dirs = ('/proc', '/sys');
> +
> +parse_dmesg();
> +
> +foreach(@dirs)
> +{
> +    walk($_);
> +}
> +
> +exit 0;
> +
> +#
> +# TODO
> +#
> +# - Add support for 32 bit architectures.

I wonder if it is OK to add to the banner or just afterward what the
word size of the computer is. You could also search for strings like
amd64 in the banner.

> +#
> +sub may_leak_address
> +{
> +    my $line = $_[0];

I usually do:

	my ($line) = $@;

But either is fine.

> +    my $regex = 'ffff[a-fA-F0-9]{12}';

try

 my $regex = '\b(0x)?ffff[[:xdigit:]]{12}\b';

The \b is to match non word characters.

  =ffffdeadbeef1234
  0xffffdeadbeef1234
  =0xffffdeadBEEF1234

all match

  aoeuffffdeeadbeef1234

does not match.

> +    my $mask = 'ffffffffffffffff';

 my $mask = '\b(0[xX])?(fF){16}\b'


> +
> +    if ($line =~ /$mask/) {
> +        return
> +    }
> +
> +    if ($line =~ /$regex/) {
> +        return 1;
> +    }
> +    return;
> +}
> +
> +sub parse_dmesg
> +{
> +    my $line;
> +    open my $cmd, '-|', 'dmesg';
> +    while ($line = <$cmd>) {
> +        if (may_leak_address($line)) {
> +            print 'dmesg: ' . $line;
> +        }
> +    }

Remove $line:

	while (<$cmd>) {
		if (may_leak_address($_)) {
			print 'dmesg: '. $_;
		}
	}

> +    close $cmd;
> +}
> +
> +# We should skip these files
> +sub skip_file
> +{
> +    my $path = $_[0];
> +
> +    my @skip_paths = ('/proc/kmsg', '/proc/kcore', '/proc/kallsyms',
> +                      '/proc/fs/ext4/sdb1/mb_groups', '/sys/kernel/debug/tracing/trace_pipe',
> +                      '/sys/kernel/security/apparmor/revision');
> +    my @skip_files = ('pagemap', 'events', 'access','registers', 'snapshot_raw',
> +                      'trace_pipe_raw', 'trace_pipe');
> +
> +    foreach(@skip_paths) {
> +        if ($_ eq $_[0]) {

does the above work? Shouldn't that be $path?

> +            return 1;

you could also do:

		return 1 if (/^$path$/);

> +        }
> +    }
> +
> +    my($filename, $dirs, $suffix) = fileparse($path);
> +
> +    foreach(@skip_files) {
> +        if ($_ eq $filename) {

	if (/^$filename$/) {

also works. You could also do:

	return 1 if (/^$filename$/);

> +            return 1;
> +        }
> +    }
> +
> +    return;
> +}
> +
> +sub parse_file
> +{
> +    my $file = $_[0];
> +
> +    if (! -R $file) {
> +        return;
> +    }
> +
> +    if (skip_file($file)) {
> +        if ($DEBUG == 1) {
> +            print "skipping file: $file\n";
> +        }
> +        return;
> +    }
> +    if ($DEBUG == 1) {
> +        print "parsing $file\n";
> +    }

To keep from having to do the above, I usually have:

sub dprint {
	return if ($DEBUG != 1);

	print $@;
}

May not even need the $@ part. But then you can just use dprint instead
of the test case and print.

> +
> +    open my $fh, $file or return;
> +
> +    while( my $line = <$fh>)  {

Again, you don't need the $line.

> +        if (may_leak_address($line)) {
> +            print $file . ': ' . $line;
> +        }
> +    }
> +
> +    close $fh;
> +}
> +
> +# Recursively walk directory tree
> +sub walk
> +{
> +    my @dirs = ($_[0]);

Does the above work? What about:

	my @dirs = @_;
?

Oh, you have a foreach(@dirs) calling the walk.
That's probably why it didn't work. Or is it because of the stack usage
below?

-- Steve

> +    my %seen;
> +
> +    while (my $pwd = shift @dirs) {
> +        if (!opendir(DIR,"$pwd")) {
> +            print STDERR "Cannot open $pwd\n";          
> +            next;
> +        } 
> +        my @files = readdir(DIR);
> +        closedir(DIR);
> +        foreach my $file (@files) {
> +            next if ($file eq '.' or $file eq '..');
> +
> +            my $path = "$pwd/$file";
> +            next if (-l $path);
> +
> +            if (-d $path and !$seen{$path}) {
> +                $seen{$path} = 1;
> +                push @dirs, "$path";
> +            } else {
> +                parse_file("$path");
> +            }
> +        }
> +    }
> +}

Re: [RFC] scripts: add leaking_addresses.pl

[Tobin C. Harding]

On Thu, Oct 19, 2017 at 08:44:31AM -0400, Steven Rostedt wrote:
> On Thu, 19 Oct 2017 17:34:44 +1100
> "Tobin C. Harding" <me@tobin.cc> wrote:
> 
> > 
> > My usual disclaimer; I am a long way from being a Perl monger, any tips,
> 
> I'm a semi Perl monger.
> 
> > however trivial, most welcome.
> > 
> > Parses dmesg output first then;
> > 
> > Algorithm walks the directory tree of /proc and /sys, opens each file
> > for reading and parses file line by line. We therefore need to skip
> > certain files;
> > 
> >  - binary files.
> >  - relay large files of fixed format that _definitely_ won't leak.
> 
> "relay large files"? What do the files relay with? ;-)

:) All bugs are shallow to enough eyes eh.

Good tips, thank you. V2 to come.

thanks,
Tobin.

Re: [RFC] scripts: add leaking_addresses.pl

[Petr Mladek]

On Thu 2017-10-19 17:34:44, Tobin C. Harding wrote:
> diff --git a/scripts/leaking_addresses.pl b/scripts/leaking_addresses.pl
> new file mode 100755
> index 000000000000..940547b716e3
> --- /dev/null
> +++ b/scripts/leaking_addresses.pl
> @@ -0,0 +1,139 @@
> +#!/usr/bin/env perl
> +#
> +# leaking_addresses.pl scan kernel for potential leaking addresses.
> +
> +use warnings;
> +use strict;
> +use File::Basename;
> +use feature 'say';

It seems that the 'say' feature is not used at the end.

> +my $DEBUG = 0;
> +my @dirs = ('/proc', '/sys');
> +
> +parse_dmesg();
> +
> +foreach(@dirs)
> +{
> +    walk($_);
> +}
> +
> +exit 0;
> +
> +#
> +# TODO
> +#
> +# - Add support for 32 bit architectures.
> +#
> +sub may_leak_address
> +{
> +    my $line = $_[0];
> +    my $regex = 'ffff[a-fA-F0-9]{12}';
> +    my $mask = 'ffffffffffffffff';
> +
> +    if ($line =~ /$mask/) {
> +        return

I would personally return 0; instead of nothing.
Well, I am used to reading C and not perl ;-)

Also I wonder if we really need to define the pattern
as a variable. It might be better to use it directly
in the regex and put a comment above, e.g.

	# Ignore addresses that say nothing
	if ($line =~ /ffffffffffffffff/ or
	    $line =~ /0000000000000000/) {
		return 0;


> +    }
> +
> +    if ($line =~ /$regex/) {
> +        return 1;
> +    }
> +    return;
> +}
> +
> +sub parse_dmesg
> +{
> +    my $line;
> +    open my $cmd, '-|', 'dmesg';
> +    while ($line = <$cmd>) {
> +        if (may_leak_address($line)) {
> +            print 'dmesg: ' . $line;
> +        }
> +    }
> +    close $cmd;
> +}
> +
> +# We should skip these files
> +sub skip_file
> +{
> +    my $path = $_[0];
> +
> +    my @skip_paths = ('/proc/kmsg', '/proc/kcore', '/proc/kallsyms',
> +                      '/proc/fs/ext4/sdb1/mb_groups', '/sys/kernel/debug/tracing/trace_pipe',
> +                      '/sys/kernel/security/apparmor/revision');

I would suggest to put each directory on a separate line.
It is easier to review and patch.

> +    my @skip_files = ('pagemap', 'events', 'access','registers', 'snapshot_raw',
> +                      'trace_pipe_raw', 'trace_pipe');

Same here.

> +
> +    foreach(@skip_paths) {
> +        if ($_ eq $_[0]) {
> +            return 1;
> +        }
> +    }
> +
> +    my($filename, $dirs, $suffix) = fileparse($path);
> +
> +    foreach(@skip_files) {
> +        if ($_ eq $filename) {
> +            return 1;
> +        }
> +    }
> +
> +    return;
> +}
> +
> +sub parse_file
> +{
> +    my $file = $_[0];
> +
> +    if (! -R $file) {
> +        return;
> +    }
> +
> +    if (skip_file($file)) {
> +        if ($DEBUG == 1) {
> +            print "skipping file: $file\n";
> +        }
> +        return;
> +    }
> +    if ($DEBUG == 1) {
> +        print "parsing $file\n";
> +    }
> +
> +    open my $fh, $file or return;
> +
> +    while( my $line = <$fh>)  {
> +        if (may_leak_address($line)) {
> +            print $file . ': ' . $line;
> +        }
> +    }
> +
> +    close $fh;
> +}
> +
> +# Recursively walk directory tree
> +sub walk
> +{
> +    my @dirs = ($_[0]);
> +    my %seen;
> +
> +    while (my $pwd = shift @dirs) {
> +        if (!opendir(DIR,"$pwd")) {
> +            print STDERR "Cannot open $pwd\n";          

I would print the error only when $DEBUG = 1.
If a directory cannot be opened, it does not leak anything.
Same for opened files.

IMHO, it would make sense to show only real problems.
Otherwise people would have troubles to interpret it.

> +            next;
> +        } 
> +        my @files = readdir(DIR);
> +        closedir(DIR);
> +        foreach my $file (@files) {
> +            next if ($file eq '.' or $file eq '..');
> +
> +            my $path = "$pwd/$file";
> +            next if (-l $path);
> +
> +            if (-d $path and !$seen{$path}) {
> +                $seen{$path} = 1;

How is it possible to see a path twice, please?

> +                push @dirs, "$path";
> +            } else {
> +                parse_file("$path");
> +            }
> +        }
> +    }
> +}

Best Regards,
Petr

Re: [RFC] scripts: add leaking_addresses.pl

[Tobin C. Harding]

On Thu, Oct 19, 2017 at 05:19:49PM +0200, Petr Mladek wrote:
> On Thu 2017-10-19 17:34:44, Tobin C. Harding wrote:
[snip]

Good tips, thank you. Will merge every ones suggestions. V2 to come.

thanks,
Tobin.