The compound classes

Compound classes in cfengine (whose rules cfperl implements) are simple class names separated by the logical operators ".", "|", "!" (dot, pipe, or exclamation). A simple class is, for instance "solaris" or "linux" (defined by cfperl to be true on a Solaris or Linux machine respectively) or "Hr_00" (defined by cfperl to be true between 00:00 and 00:59 in the morning). A compound class combines simple classes; for instance "solaris.Hr_00" would be true if both classes were true, while "solaris|linux" would be true on both Solaris and Linux machines.

The exclamation, "!", negates the simple class that follows it, so "!linux" would only be true on non-Linux machines. Furthermore, parentheses can group logical expressions, and "||" is an alias for "|". As you can see, compound classes are quite complex, and trying to interpret them without Parse::RecDescent would be nearly impossible.

Another point to keep in mind is that classes may be defined or undefined during a cfperl execution, as a consequence of a command. Thus, interpreting compound classes just once at the beginning of cfperl's execution will not work. The interpretation must be done on the fly.

The compound classes parser

The compound classes parser is quite complex, since it implements a full logical language interpreter and returns an evaluation tree of the logical expression. The evaluation tree is interpreted and evaluated in the allowed_cfrun_atom() function in cfperl, through the eval_tree() function.

The parser defines the Parse::RecDescent autoaction (an action appended to all items without a specific action) to be an array of a subroutine and of the item itself. This is an identity function, and is currently unused.

{
 local $::RD_AUTOACTION = q{ [ sub{ $_[1]; }, $item[1] ] };
 $parsers{CLASS_HIERARCHY} = new Parse::RecDescent(q{
  input : disj

  disj : conj /\|+/ disj { [ sub{ $_[1] || $_[2] }, $item{conj}, $item{disj}  ] }
       | conj

  conj : unary /\.+/ conj { [ sub{ $_[1] && $_[2] }, $item{unary}, $item{conj ] }
       | unary

  unary : inversion
        | '!(' input ')' { [ sub{ ! $_[1] }, $item{input} ] }
        | '(' input ')' { [ sub{ $_[1] }, $item{input} ] }
        | atom

  inversion : '!'/\w+/ { [ sub{
                               my $classes = shift;
                               my $atom = shift;
#                               print "not_atom($atom) ";
                               return !exists $classes->{$atom};
                              }, $item[2] ] }

  atom : /\w+/ { [ sub{
                       my $classes = shift;
                       my $atom = shift;
#                       print "atom($atom) ";
                       return exists $classes->{$atom};
                      }, $item[1] ] }

});
}