--- /dev/null
+#!/usr/bin/perl -w
+#
+# Copyright (C) 2016 Red Hat, Inc.
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser General Public
+# License as published by the Free Software Foundation; either
+# version 2.1 of the License, or (at your option) any later version.
+#
+# This library is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library. If not, see
+# <http://www.gnu.org/licenses/>.
+#
+# This script is supposed to check test_file_access.txt file and
+# warn about file accesses outside our working tree.
+#
+#
+
+use strict;
+use warnings;
+
+my $access_file = "test_file_access.txt";
+my $whitelist_file = "file_access_whitelist.txt";
+
+my @files;
+my @whitelist;
+
+open FILE, "<", $access_file or die "Unable to open $access_file: $!";
+while (<FILE>) {
+ chomp;
+ if (/^(\S*):\s*(\S*)(\s*:\s*(.*))?$/) {
+ my %rec;
+ ${rec}{path} = $1;
+ ${rec}{progname} = $2;
+ if (defined $4) {
+ ${rec}{testname} = $4;
+ }
+ push (@files, \%rec);
+ } else {
+ die "Malformed line $_";
+ }
+}
+close FILE;
+
+open FILE, "<", $whitelist_file or die "Unable to open $whitelist_file: $!";
+while (<FILE>) {
+ chomp;
+ if (/^\s*#.*$/) {
+ # comment
+ } elsif (/^(\S*)(:\s*(\S*)(\s*:\s*(.*))?)?$/) {
+ my %rec;
+ ${rec}{path} = $1;
+ if (defined $3) {
+ ${rec}{progname} = $3;
+ }
+ if (defined $5) {
+ ${rec}{testname} = $5;
+ }
+ push (@whitelist, \%rec);
+ } else {
+ die "Malformed line $_";
+ }
+}
+close FILE;
+
+# Now we should check if %traces is included in $whitelist. For
+# now checking just keys is sufficient
+my $error = 0;
+for my $file (@files) {
+ my $match = 0;
+
+ for my $rule (@whitelist) {
+ if (not %${file}{path} =~ m/^$rule->{path}$/) {
+ next;
+ }
+
+ if (defined %${rule}{progname} and
+ not %${file}{progname} =~ m/^$rule->{progname}$/) {
+ next;
+ }
+
+ if (defined %${rule}{testname} and
+ defined %${file}{testname} and
+ not %${file}{testname} =~ m/^$rule->{testname}$/) {
+ next;
+ }
+
+ $match = 1;
+ }
+
+ if (not $match) {
+ $error = 1;
+ print "$file->{path}: $file->{progname}";
+ print ": $file->{testname}" if defined %${file}{testname};
+ print "\n";
+ }
+}
+
+exit $error;
--- /dev/null
+# This is a whitelist that allows accesses to files not in our
+# build directory nor source directory. The records are in the
+# following format:
+#
+# $path: $progname: $testname
+#
+# All these three are evaluated as perl RE. So to allow /dev/sda
+# and /dev/sdb, you can just '/dev/sd[a-b]', or to allow
+# /proc/$pid/status you can '/proc/\d+/status' and so on.
+# Moreover, $progname and $testname can be empty, in which which
+# case $path is allowed for all tests.
+
+/bin/cat: sysinfotest
+/bin/dirname: sysinfotest: x86 sysinfo
+/bin/sleep: commandtest
+/bin/true: commandtest
+/dev/null
+/dev/urandom
+/etc/hosts
+/proc/\d+/status
+
+# This is just a dummy example, DO NOT USE IT LIKE THAT!
+.*: nonexistent-test-touching-everything