tests/check-file-access.pl

   1 #!/usr/bin/env perl
   2 #
   3 # Copyright (C) 2016 Red Hat, Inc.
   4 #
   5 # This library is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU Lesser General Public
   7 # License as published by the Free Software Foundation; either
   8 # version 2.1 of the License, or (at your option) any later version.
   9 #
  10 # This library is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # Lesser General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU Lesser General Public
  16 # License along with this library.  If not, see
  17 # <http://www.gnu.org/licenses/>.
  18 #
  19 # This script is supposed to check test_file_access.txt file and
  20 # warn about file accesses outside our working tree.
  21 #
  22 #
  23
  24 use strict;
  25 use warnings;
  26
  27 my $access_file = "test_file_access.txt";
  28 my $whitelist_file = "file_access_whitelist.txt";
  29
  30 my @known_actions = ("open", "fopen", "access", "stat", "lstat", "connect");
  31
  32 my @files;
  33 my @whitelist;
  34
  35 open FILE, "<", $access_file or die "Unable to open $access_file: $!";
  36 while (<FILE>) {
  37     chomp;
  38     if (/^(\S*):\s*(\S*):\s*(\S*)(\s*:\s*(.*))?$/) {
  39         my %rec;
  40         ${rec}{path} = $1;
  41         ${rec}{action} = $2;
  42         ${rec}{progname} = $3;
  43         if (defined $5) {
  44             ${rec}{testname} = $5;
  45         }
  46         push (@files, \%rec);
  47     } else {
  48         die "Malformed line $_";
  49     }
  50 }
  51 close FILE;
  52
  53 open FILE, "<", $whitelist_file or die "Unable to open $whitelist_file: $!";
  54 while (<FILE>) {
  55     chomp;
  56     if (/^\s*#.*$/) {
  57         # comment
  58     } elsif (/^(\S*):\s*(\S*)(:\s*(\S*)(\s*:\s*(.*))?)?$/ and
  59             grep /^$2$/, @known_actions) {
  60         # $path: $action: $progname: $testname
  61         my %rec;
  62         ${rec}{path} = $1;
  63         ${rec}{action} = $3;
  64         if (defined $4) {
  65             ${rec}{progname} = $4;
  66         }
  67         if (defined $6) {
  68             ${rec}{testname} = $6;
  69         }
  70         push (@whitelist, \%rec);
  71     } elsif (/^(\S*)(:\s*(\S*)(\s*:\s*(.*))?)?$/) {
  72         # $path: $progname: $testname
  73         my %rec;
  74         ${rec}{path} = $1;
  75         if (defined $3) {
  76             ${rec}{progname} = $3;
  77         }
  78         if (defined $5) {
  79             ${rec}{testname} = $5;
  80         }
  81         push (@whitelist, \%rec);
  82     } else {
  83         die "Malformed line $_";
  84     }
  85 }
  86 close FILE;
  87
  88 # Now we should check if %traces is included in $whitelist. For
  89 # now checking just keys is sufficient
  90 my $error = 0;
  91 for my $file (@files) {
  92     my $match = 0;
  93
  94     for my $rule (@whitelist) {
  95         if (not %${file}{path} =~ m/^$rule->{path}$/) {
  96             next;
  97         }
  98
  99         if (defined %${rule}{action} and
 100             not %${file}{action} =~ m/^$rule->{action}$/) {
 101             next;
 102         }
 103
 104         if (defined %${rule}{progname} and
 105             not %${file}{progname} =~ m/^$rule->{progname}$/) {
 106             next;
 107         }
 108
 109         if (defined %${rule}{testname} and
 110             defined %${file}{testname} and
 111             not %${file}{testname} =~ m/^$rule->{testname}$/) {
 112             next;
 113         }
 114
 115         $match = 1;
 116     }
 117
 118     if (not $match) {
 119         $error = 1;
 120         print "$file->{path}: $file->{action}: $file->{progname}";
 121         print ": $file->{testname}" if defined %${file}{testname};
 122         print "\n";
 123     }
 124 }
 125
 126 exit $error;