#!/usr/bin/env perl
#
# Copyright (C) 2013-2014 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
# .
#
# This script validates that the driver implementation of any
# public APIs contain ACL checks.
#
# As the script reads each source file, it attempts to identify
# top level function names.
#
# When reading the body of the functions, it looks for anything
# that looks like an API called named XXXEnsureACL. It will
# validate that the XXX prefix matches the name of the function
# it occurs in.
#
# When it later finds the virDriverPtr table, for each entry
# point listed, it will validate if there was a previously
# detected EnsureACL call recorded.
#
use strict;
use warnings;
my $status = 0;
my $brace = 0;
my $maybefunc;
my $intable = 0;
my $table;
my %acls;
my %aclfilters;
my %whitelist = (
"connectClose" => 1,
"connectIsEncrypted" => 1,
"connectIsSecure" => 1,
"connectIsAlive" => 1,
"networkOpen" => 1,
"networkClose" => 1,
"nwfilterOpen" => 1,
"nwfilterClose" => 1,
"secretOpen" => 1,
"secretClose" => 1,
"storageOpen" => 1,
"storageClose" => 1,
"interfaceOpen" => 1,
"interfaceClose" => 1,
"connectURIProbe" => 1,
"localOnly" => 1,
"domainQemuAttach" => 1,
);
# XXX this vzDomainMigrateConfirm3Params looks
# bogus - determine why it doesn't have a valid
# ACL check.
my %implwhitelist = (
"vzDomainMigrateConfirm3Params" => 1,
);
my $lastfile;
sub fixup_name {
my $name = shift;
$name =~ s/Nwfilter/NWFilter/;
$name =~ s/Xml$/XML/;
$name =~ s/Uri$/URI/;
$name =~ s/Uuid$/UUID/;
$name =~ s/Id$/ID/;
$name =~ s/Mac$/MAC/;
$name =~ s/Cpu$/CPU/;
$name =~ s/Os$/OS/;
$name =~ s/Nmi$/NMI/;
$name =~ s/Pm/PM/;
$name =~ s/Fstrim$/FSTrim/;
$name =~ s/Scsi/SCSI/;
$name =~ s/Wwn$/WWN/;
return $name;
}
sub name_to_ProcName {
my $name = shift;
my @elems;
if ($name =~ /_/ || (lc $name) eq "open" || (lc $name) eq "close") {
@elems = split /_/, $name;
@elems = map lc, @elems;
@elems = map ucfirst, @elems;
} else {
@elems = $name;
}
@elems = map { fixup_name($_) } @elems;
my $procname = join "", @elems;
$procname =~ s/^([A-Z])/lc $1/e;
return $procname;
}
my $proto = shift @ARGV;
open PROTO, "<$proto" or die "cannot read $proto";
my %filtered;
my $incomment = 0;
my $filtered = 0;
while () {
if (m,/\*\*,) {
$incomment = 1;
$filtered = 0;
} elsif ($incomment) {
if (m,\*\s\@aclfilter,) {
$filtered = 1;
} elsif ($filtered &&
m,REMOTE_PROC_(.*)\s+=\s*\d+,) {
my $api = name_to_ProcName($1);
# Event filtering is handled in daemon/remote.c instead of drivers
if (! m,_EVENT_REGISTER,) {
$filtered{$api} = 1;
}
$incomment = 0;
}
}
}
close PROTO;
while (<>) {
if (!defined $lastfile ||
$lastfile ne $ARGV) {
%acls = ();
$brace = 0;
$maybefunc = undef;
$lastfile = $ARGV;
}
if ($brace == 0) {
# Looks for anything which appears to be a function
# body name. Doesn't matter if we pick up bogus stuff
# here, as long as we don't miss valid stuff
if (m,\b(\w+)\(,) {
$maybefunc = $1;
}
} elsif ($brace > 0) {
if (m,(\w+)EnsureACL,) {
# Record the fact that maybefunc contains an
# ACL call, and make sure it is the right call!
my $func = $1;
$func =~ s/^vir//;
if (!defined $maybefunc) {
print "$ARGV:$. Unexpected check '$func' outside function\n";
$status = 1;
} else {
unless ($maybefunc =~ /$func$/i) {
print "$ARGV:$. Mismatch check 'vir${func}EnsureACL' for function '$maybefunc'\n";
$status = 1;
}
}
$acls{$maybefunc} = 1;
} elsif (m,(\w+)CheckACL,) {
# Record the fact that maybefunc contains an
# ACL filter call, and make sure it is the right call!
my $func = $1;
$func =~ s/^vir//;
if (!defined $maybefunc) {
print "$ARGV:$. Unexpected check '$func' outside function\n";
$status = 1;
} else {
unless ($maybefunc =~ /$func$/i) {
print "$ARGV:$. Mismatch check 'vir${func}CheckACL' for function '$maybefunc'\n";
$status = 1;
}
}
$aclfilters{$maybefunc} = 1;
} elsif (m,\b(\w+)\(,) {
# Handles case where we replaced an API with a new
# one which adds new parameters, and we're left with
# a simple stub calling the new API.
my $callfunc = $1;
if (exists $acls{$callfunc}) {
$acls{$maybefunc} = 1;
}
if (exists $aclfilters{$callfunc}) {
$aclfilters{$maybefunc} = 1;
}
}
}
# Pass the vir*DriverPtr tables and make sure that
# every func listed there, has an impl which calls
# an ACL function
if ($intable) {
if (/\}/) {
$intable = 0;
$table = undef;
} elsif (/\.(\w+)\s*=\s*(\w+),?/) {
my $api = $1;
my $impl = $2;
next if $impl eq "NULL";
if ($api ne "no" &&
$api ne "name" &&
$table ne "virStateDriver" &&
!exists $acls{$impl} &&
!exists $whitelist{$api} &&
!exists $implwhitelist{$impl}) {
print "$ARGV:$. Missing ACL check in function '$impl' for '$api'\n";
$status = 1;
}
if (exists $filtered{$api} &&
!exists $aclfilters{$impl}) {
print "$ARGV:$. Missing ACL filter in function '$impl' for '$api'\n";
$status = 1;
}
}
} elsif (/^(?:static\s+)?(vir(?:\w+)?Driver)\s+/) {
if ($1 ne "virNWFilterCallbackDriver" &&
$1 ne "virNWFilterTechDriver" &&
$1 ne "virDomainConfNWFilterDriver") {
$intable = 1;
$table = $1;
}
}
my $count;
$count = s/{//g;
$brace += $count;
$count = s/}//g;
$brace -= $count;
} continue {
close ARGV if eof;
}
exit $status;