Add check-aclperms.pl
missing from the dist tarball
Guido Günther
10 years ago
| 0 | From: =?UTF-8?q?Guido=20G=C3=BCnther?= <agx@sigxcpu.org> | |
| 1 | Date: Thu, 26 Sep 2013 13:29:54 +0200 | |
| 2 | Subject: Add check-aclperms.pl | |
| 3 | ||
| 4 | missing from the dist tarball | |
| 5 | --- | |
| 6 | src/check-aclperms.pl | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 7 | 1 file changed, 73 insertions(+) | |
| 8 | create mode 100755 src/check-aclperms.pl | |
| 9 | ||
| 10 | diff --git a/src/check-aclperms.pl b/src/check-aclperms.pl | |
| 11 | new file mode 100755 | |
| 12 | index 0000000..5b1b4db | |
| 13 | --- /dev/null | |
| 14 | +++ b/src/check-aclperms.pl | |
| 15 | @@ -0,0 +1,73 @@ | |
| 16 | +#!/usr/bin/perl | |
| 17 | +# | |
| 18 | +# Copyright (C) 2013 Red Hat, Inc. | |
| 19 | +# | |
| 20 | +# This library is free software; you can redistribute it and/or | |
| 21 | +# modify it under the terms of the GNU Lesser General Public | |
| 22 | +# License as published by the Free Software Foundation; either | |
| 23 | +# version 2.1 of the License, or (at your option) any later version. | |
| 24 | +# | |
| 25 | +# This library is distributed in the hope that it will be useful, | |
| 26 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 27 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 28 | +# Lesser General Public License for more details. | |
| 29 | +# | |
| 30 | +# You should have received a copy of the GNU Lesser General Public | |
| 31 | +# License along with this library. If not, see | |
| 32 | +# <http://www.gnu.org/licenses/>. | |
| 33 | +# | |
| 34 | +# This script just validates that the stringified version of | |
| 35 | +# a virAccessPerm enum matches the enum constant name. We do | |
| 36 | +# a lot of auto-generation of code, so when these don't match | |
| 37 | +# problems occur, preventing auth from succeeding at all. | |
| 38 | + | |
| 39 | +my $hdr = shift; | |
| 40 | +my $impl = shift; | |
| 41 | + | |
| 42 | +my %perms; | |
| 43 | + | |
| 44 | +my @perms; | |
| 45 | + | |
| 46 | +open HDR, $hdr or die "cannot read $hdr: $!"; | |
| 47 | + | |
| 48 | +while (<HDR>) { | |
| 49 | + if (/^\s+VIR_ACCESS_PERM_([_A-Z]+)(,?|\s|$)/) { | |
| 50 | + my $perm = $1; | |
| 51 | + | |
| 52 | + $perms{$perm} = 1 unless ($perm =~ /_LAST$/); | |
| 53 | + } | |
| 54 | +} | |
| 55 | + | |
| 56 | +close HDR; | |
| 57 | + | |
| 58 | + | |
| 59 | +open IMPL, $impl or die "cannot read $impl: $!"; | |
| 60 | + | |
| 61 | +my $group; | |
| 62 | +my $warned = 0; | |
| 63 | + | |
| 64 | +while (defined (my $line = <IMPL>)) { | |
| 65 | + if ($line =~ /VIR_ACCESS_PERM_([_A-Z]+)_LAST/) { | |
| 66 | + $group = $1; | |
| 67 | + } elsif ($line =~ /"[_a-z]+"/) { | |
| 68 | + my @bits = split /,/, $line; | |
| 69 | + foreach my $bit (@bits) { | |
| 70 | + if ($bit =~ /"([_a-z]+)"/) { | |
| 71 | + my $perm = uc($group . "_" . $1); | |
| 72 | + if (!exists $perms{$perm}) { | |
| 73 | + print STDERR "Unknown perm string $1 for group $group\n"; | |
| 74 | + $warned = 1; | |
| 75 | + } | |
| 76 | + delete $perms{$perm}; | |
| 77 | + } | |
| 78 | + } | |
| 79 | + } | |
| 80 | +} | |
| 81 | +close IMPL; | |
| 82 | + | |
| 83 | +foreach my $perm (keys %perms) { | |
| 84 | + print STDERR "Perm $perm had not string form\n"; | |
| 85 | + $warned = 1; | |
| 86 | +} | |
| 87 | + | |
| 88 | +exit $warned; |