#!/usr/bin/env perl
# Copyright (c) 2018 Samsung Electronics Co., Ltd All Rights Reserved
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License

# the generated file is included verbatim into security-manager-rules-writer.cpp
# therein lie more comments

use strict; use warnings; use 5.10.1;
sub member { my $m = shift; grep { $_ eq $m } @_ }

# rule groups (roughly correspond to variables used and functions generated)
my @rulesAuthor;
my @rulesPkgLabelAuthor;
my @rulesPkgLabel;
my @rulesSystemPkgLabel;
my @rulesPathRW;
my @rulesPath;
my @rulesSharedRO;

# one rule per line, either on stdin or in file arguments
my @lines;
while (<>) { chomp; push @lines, $_; }

# process lines in sorted order so that similar rules are clustered together
for (sort @lines) {
    # make sure the rule is canonical - it's important for the writer (which makes assumptions about rule width and such)
    die "heading whitespace ($_)" if /^\s/;
    die "trailing whitespace ($_)" if /\s$/;
    die "non-space whitespace ($_)" if grep {/[^ ]/} /(\s)/g;
    die "two or more consecutive spaces ($_)" if /  /;

    # the rule is split into an odd number of segments (3 or 5): verbatim variable verbatim (variable verbatim)?
    # ex. "System ~PROCESS~ rwxat" -> ("System ", "PROCESS", " rwxat")
    # even elements are variables, odd ones verbatim strings
    my @segments = split /~/;

    # segment-based validation
    die "rule without variables ($_)" if @segments < 2;
    die "too many variables ($_)" if @segments > 5;
    die "even number of segments ($_)" if !(@segments % 2);
    die "ending segment empty ($_)" if !length $segments[-1];
    my %varCount;
    for (@segments[grep {$_%2} 0..$#segments]) {
        die "unknown var ($_)" if !member $_, qw(PATH_TRUSTED PROCESS PATH_RO PATH_RW PATH_SHARED_RO);
        die "var used twice ($_)" if exists $varCount{$_};
        $varCount{$_} = 1;
    }
    die "first segment ending with non-space character ($_)" if length $segments[0] && $segments[0] !~ / $/;
    die "last segment starting with non-space character ($_)" if length $segments[-1] && $segments[-1] !~ /^ /;
    die "variables not surrounded with whitespace ($_)" if grep {/^$/ || /^[^ ]/ || /[^ ]$/} @segments[grep {!($_%2)} 2..$#segments-2];

    # make sure the permission string is a valid constant
    my ($prePerm, $permChars) = $segments[-1] =~ /(.* )([^ ]*)$/;
    my %perm;
    for (split //, $permChars) {
        die "unknown permission char ($_) in ($segments[-1])" if !member $_, split //, "rwxatlb";
        die "duplicate permission char ($_) in ($segments[-1])" if exists $perm{$_};
        $perm{$_} = 1;
    }

    # sort permission string characters to improve constant sharing in the writer
    $segments[-1] = $prePerm . join '', grep {exists $perm{$_}} split //, "rwxatlb";

    # partition rules into rough groups
    die "invalid subject variable ($segments[1])" if $segments[0] eq '' && $segments[1] ne 'PROCESS';
    if (1 == keys %varCount) {
        # single variable rules
        if (exists $varCount{PATH_TRUSTED}) {
            push @rulesAuthor, [@segments];
        } elsif (exists $varCount{PATH_SHARED_RO}) {
            push @rulesSharedRO, [@segments];
        } elsif (exists $varCount{PATH_RO}) {
            push @rulesPath, [@segments];
        } elsif (exists $varCount{PATH_RW}) {
            push @rulesPathRW, [@segments];
        } else { # PROCESS
            push @{$segments[0] eq '' ? \@rulesPkgLabel : \@rulesSystemPkgLabel}, [@segments];
        }
    } else {
        # multi variable rules
        if (exists $varCount{PATH_TRUSTED}) {
            push @rulesPkgLabelAuthor, [@segments];
        } elsif (exists $varCount{PATH_RO} || exists $varCount{PATH_RW}) {
            push @rulesPkgLabel, [@segments];
        } else {
            die "unsupported multi-variable rule ($_)";
        }
    }
}

# for non-hybrid packages, ~PATH_RW~ == ~PROCESS~
# this may lead to rule duplication between @rulesPathRW and @rulesSystemPkgLabel
#
# in order to avoid this, @rulesPathRW is split into two groups:
#     rules having an isomorphic ~PROCESS~ rule end up in @rulesPathRWHybridOnly (not to be applied to non-hybrid packages)
#     other rules end up in @rulesPath (applied to all packages)
my @pureProcessRulesAsPathRWRule = map {$_->[0].'~PATH_RW~'.$_->[2]} @rulesSystemPkgLabel;
my @rulesPathRWHybridOnly;
push @rulesPath, grep {
    my $asRule = $_->[0].'~PATH_RW~'.$_->[2];
    my $hasRedudnantProcessRule = member $asRule, @pureProcessRulesAsPathRWRule;
    push @rulesPathRWHybridOnly, $_ if $hasRedudnantProcessRule;
    !$hasRedudnantProcessRule;
} @rulesPathRW;

# generate a function that writes a sequence of rules
sub rules {
    my $functionName = shift;
    my $mustBeNonempty = shift;
    die "($functionName()) has no rules - remove the call and propagate to make sure the loader stays fast" if $mustBeNonempty && !@_;
    say "inl void $functionName() {";
    for (@_) {
        my @segments = @$_;
        print "    rule(";
        for (0..$#segments/2-1) {
            my $verbatim = $segments[2*$_];
            my $wildcard = $segments[2*$_ + 1];
            my $var = 'pkgL';
            if ($wildcard eq 'PROCESS') {
                $segments[2*$_+2] =~ s/^ //;
                $var = 'pl';
            } elsif ($wildcard eq 'PATH_TRUSTED') {
                $verbatim .= 'User::Author::';
                $var = 'pathTrusted';
            } elsif ($wildcard eq 'PATH_RO') {
                $segments[2*$_+2] = '::RO'.$segments[2*$_+2];
            } elsif ($wildcard eq 'PATH_SHARED_RO') {
                $segments[2*$_+2] = '::SharedRO'.$segments[2*$_+2];
            }
            print "\"$verbatim\", " if length $verbatim;
            print "$var, ";
        }
        say "\"$segments[-1]\");";
    }
    say "}";
}

rules 'rulesAuthor', 0, @rulesAuthor;
rules 'rulesPkgLabelAuthor', 1, @rulesPkgLabelAuthor;
rules 'rulesPkgLabel', 0, @rulesPkgLabel;
rules 'rulesSystemPkgLabel', 0, @rulesSystemPkgLabel;
rules 'rulesPathRWHybridOnly', 0, @rulesPathRWHybridOnly;
rules 'rulesPath', 0, @rulesPath;
rules 'rulesSharedRO', 0, @rulesSharedRO;