debian/scripts/config-check

   1 #!/usr/bin/perl
   2 #
   3 # check-config -- check the current config for issues
   4 #
   5 use strict;
   6
   7 my $P = 'check-config';
   8
   9 my $test = -1;
  10 if ($ARGV[0] eq '--test') {
  11         $test = $ARGV[1] + 0;
  12 } elsif ($#ARGV != 4) {
  13         die "Usage: $P <config> <arch> <flavour> <commonconfig> <warn-only>\n";
  14 }
  15
  16 my ($config, $arch, $flavour, $commonconfig, $warn_only) = @ARGV;
  17
  18 my $checks = "$commonconfig/enforce";
  19 my %values = ();
  20
  21 # If we are in overridden then still perform the checks and emit the messages
  22 # but do not return failure.  Those items marked FATAL will alway trigger
  23 # failure.
  24 my $fail_exit = 1;
  25 $fail_exit = 0 if ($warn_only eq 'true' || $warn_only eq '1');
  26 my $exit_val = 0;
  27
  28 # Predicate execution engine.
  29 sub pred_first {
  30         my ($rest) = @_;
  31         my $depth = 0;
  32         my $off;
  33         my $char;
  34         my $pred;
  35
  36         for ($off = 0; $off <= length($rest); $off++) {
  37                 $char = substr($rest, $off, 1);
  38                 if ($char eq '(') {
  39                         $depth++;
  40                 } elsif ($char eq ')') {
  41                         $depth--;
  42                 } elsif ($depth == 0 && $char eq '&') {
  43                         last;
  44                 } elsif ($depth == 0 && $char eq '|') {
  45                         last;
  46                 }
  47         }
  48         if ($depth > 0) {
  49                 die "$P: $rest: missing close parenthesis ')'\n";
  50         } elsif ($depth < 0) {
  51                 die "$P: $rest: missing open parenthesis '('\n";
  52         }
  53
  54         ($pred, $rest) = (substr($rest, 0, $off), substr($rest, $off + 1));
  55
  56         $pred =~ s/^\s*//;
  57         $pred =~ s/\s*$//;
  58
  59         #print "pred<$pred> rest<$rest> char<$char>\n";
  60         ($pred, $rest, $char);
  61 }
  62
  63 sub pred_do {
  64         my ($pred) = @_;
  65         my (@a) = split(' ', $pred);
  66
  67         if ($a[0] eq 'arch') {
  68                 die "$P: $pred: malformed -- $pred <arch>\n" if ($#a != 1);
  69                 #print "    *** ARCH<$arch ?? $a[1]>\n";
  70                 return ($arch eq $a[1])
  71         } elsif ($a[0] eq 'flavour') {
  72                 die "$P: $pred: malformed -- $pred <flavour>\n" if ($#a != 1);
  73                 #print "    *** FLAVOUR<$flavour ?? $a[1]>\n";
  74                 return ($flavour eq $a[1])
  75         } elsif ($a[0] eq 'value') {
  76                 die "$P: $pred: malformed -- $pred <name> <val>\n" if ($#a != 2);
  77                 #print "    *** CHECK<$a[1] $a[2] ?? " . $values{$a[1]} . ">\n";
  78                 return ($values{$a[1]} eq $a[2]);
  79         } elsif ($a[0] eq 'exists') {
  80                 die "$P: $pred: malformed -- $pred <name>\n" if ($#a != 1);
  81                 return (defined $values{$a[1]});
  82         } else {
  83                 die "$P: $pred: unknown predicate\n";
  84         }
  85         return 1;
  86 }
  87 sub pred_exec {
  88         my ($rest) = @_;
  89         my $pred;
  90         my $res;
  91         my $sep;
  92
  93         #print "pred_exec<$rest>\n";
  94
  95         ($pred, $rest, $sep) = pred_first($rest);
  96
  97         # Leading ! implies inversion.
  98         if ($pred =~ /^\s*!\s*(.*)$/) {
  99                 #print " invert<$1>\n";
 100                 $res = !pred_exec($1);
 101
 102         # Recurse left for complex expressions.
 103         } elsif ($pred =~ /^\s*\((.*)\)\s*$/) {
 104                 #print " left<$1>\n";
 105                 $res = pred_exec($1);
 106
 107         # Check for common syntax issues.
 108         } elsif ($pred eq '') {
 109                 if ($sep eq '&' || $sep eq '|') {
 110                         die "$P: $pred$rest: malformed binary operator\n";
 111                 } else {
 112                         die "$P: $pred$rest: syntax error\n";
 113                 }
 114
 115         # A predicate, execute it.
 116         } else {
 117                 #print " DO<$pred> sep<$sep>\n";
 118                 $res = pred_do($pred);
 119         }
 120
 121         #print " pre-return res<$res> sep<$sep>\n";
 122         if ($sep eq '') {
 123                 #
 124
 125         # Recurse right for binary operators -- note these are lazy.
 126         } elsif ($sep eq '&' || $sep eq '|') {
 127                 #print " right<$rest> ? sep<$sep> res<$res>\n";
 128                 if ($rest =~ /^\s*($|\||\&)/) {
 129                         die "$P: $pred$rest: malformed binary operator\n";
 130                 }
 131                 if (($res && $sep eq '&') || (!$res && $sep eq '|')) {
 132                         #print " right<$rest>\n";
 133                         $res = pred_exec($rest);
 134                 }
 135
 136         } else {
 137                 die "$P: $pred$rest: malformed predicate\n";
 138         }
 139         #print " return res<$res> sep<$sep>\n";
 140         return $res;
 141 }
 142
 143 #
 144 # PREDICATE TESTS
 145 #
 146 my $test_total = 1;
 147 my $test_good = 0;
 148 sub pred_test {
 149         my ($pred, $eres, $eerr) = @_;
 150         my ($res, $err, $fail);
 151
 152         $test_total++;
 153         if ($test != 0 && $test != $test_total - 1) {
 154                 return;
 155         }
 156
 157         eval {
 158                 $res = pred_exec($pred);
 159         };
 160         $err = $@;
 161         chomp($err);
 162
 163         $res = !!$res;
 164         $eres = !!$eres;
 165
 166         $fail = '';
 167         if (defined $eres && $res != $eres) {
 168                 $fail = "result missmatch, expected $eres returned $res";
 169         }
 170         if (defined $eerr && $err eq '') {
 171                 $fail = "error missmatch, expected '$eerr' returned success";
 172         } elsif (defined $eerr && $err !~ /$eerr/) {
 173                 $fail = "error missmatch, expected '$eerr' returned '$err'";
 174         } elsif (!defined $eerr && $err ne '') {
 175                 $fail = "error missmatch, expected success returned '$err'";
 176         }
 177
 178         if ($fail eq '') {
 179                 $test_good++;
 180         } else {
 181                 print "$pred: $test_total: FAIL: $fail\n";
 182         }
 183         #print "TEST<$pred> eres<$eres> eerr<$eerr> res<$res> err<$err>\n";
 184 }
 185 if ($test >= 0) {
 186         $arch = 'MYARCH';
 187         $flavour = 'MYFLAVOUR';
 188         %values = ( 'ENABLED' => 'y', 'DISABLED' => 'n' );
 189
 190         # Errors.
 191         my $eunkn = 'unknown predicate';
 192         my $epred = 'malformed';
 193         my $eclose = 'missing close parenthesis';
 194         my $eopen = 'missing open parenthesis';
 195         my $ebinary = 'malformed binary operator';
 196
 197         # Basic predicate tests.
 198         print "TEST: $test_total: basic predicate tests ...\n";
 199
 200         pred_test('nosuchcommand', undef, $eunkn);
 201         pred_test('arch', undef, $epred);
 202         pred_test('arch MYARCH MYARCH', undef, $epred);
 203         pred_test('arch MYARCH', 1, undef);
 204         pred_test('arch NOTMYARCH', 0, undef);
 205
 206         pred_test('flavour', undef, $epred);
 207         pred_test('flavour MYFLAVOUR myflavour', undef, $epred);
 208         pred_test('flavour MYFLAVOUR', 1, undef);
 209         pred_test('flavour NOTMYFLAVOUR', 0, undef);
 210
 211         pred_test('value', undef, $epred);
 212         pred_test('value ENABLED', undef, $epred);
 213         pred_test('value ENABLED ENABLED ENABLED', undef, $epred);
 214         pred_test('value ENABLED y', 1, undef);
 215         pred_test('value ENABLED n', 0, undef);
 216         pred_test('value DISABLED n', 1, undef);
 217         pred_test('value DISABLED y', 0, undef);
 218
 219         pred_test('exists', undef, $epred);
 220         pred_test('exists ENABLED ENABLED', undef, $epred);
 221         pred_test('exists ENABLED', 1, undef);
 222         pred_test('exists DISABLED', 1, undef);
 223         pred_test('exists MISSING', 0, undef);
 224
 225         print "TEST: $test_total: inversion tests ...\n";
 226         pred_test('!exists ENABLED', 0, undef);
 227         pred_test('!exists MISSING', 1, undef);
 228         pred_test('!!exists ENABLED', 1, undef);
 229         pred_test('!!exists MISSING', 0, undef);
 230         pred_test('!!!exists ENABLED', 0, undef);
 231         pred_test('!!!exists MISSING', 1, undef);
 232
 233         print "TEST: $test_total: parentheses tests ...\n";
 234         pred_test('(exists ENABLED)', 1, undef);
 235         pred_test('((exists ENABLED))', 1, undef);
 236         pred_test('(((exists ENABLED)))', 1, undef);
 237         pred_test('(exists MISSING)', 0, undef);
 238         pred_test('((exists MISSING))', 0, undef);
 239         pred_test('(((exists MISSING)))', 0, undef);
 240
 241         pred_test('(!exists ENABLED)', 0, undef);
 242         pred_test('((!exists ENABLED))', 0, undef);
 243         pred_test('(((!exists ENABLED)))', 0, undef);
 244         pred_test('(!exists MISSING)', 1, undef);
 245         pred_test('((!exists MISSING))', 1, undef);
 246         pred_test('(((!exists MISSING)))', 1, undef);
 247
 248         pred_test('((!(exists ENABLED)))', 0, undef);
 249         pred_test('((!(exists MISSING)))', 1, undef);
 250         pred_test('(!((exists ENABLED)))', 0, undef);
 251         pred_test('(!((exists MISSING)))', 1, undef);
 252         pred_test('!(((exists ENABLED)))', 0, undef);
 253         pred_test('!(((exists MISSING)))', 1, undef);
 254         pred_test('!((!(exists ENABLED)))', 1, undef);
 255         pred_test('!((!(exists MISSING)))', 0, undef);
 256         pred_test('!(!(!(exists ENABLED)))', 0, undef);
 257         pred_test('!(!(!(exists MISSING)))', 1, undef);
 258
 259         pred_test('(', undef, $eclose);
 260         pred_test('()(', undef, $eclose);
 261         pred_test('(())(', undef, $eclose);
 262         pred_test('((()))(', undef, $eclose);
 263         pred_test('(()', undef, $eclose);
 264         pred_test('((())', undef, $eclose);
 265         pred_test('(((()))', undef, $eclose);
 266         pred_test('(()()', undef, $eclose);
 267         pred_test('((())()', undef, $eclose);
 268
 269         pred_test(')', undef, $eopen);
 270         pred_test('())', undef, $eopen);
 271         pred_test('(()))', undef, $eopen);
 272         pred_test('((())))', undef, $eopen);
 273
 274         print "TEST: $test_total: binary and tests ...\n";
 275
 276         pred_test('exists ENABLED &', undef, $ebinary);
 277         pred_test('& exists ENABLED', undef, $ebinary);
 278         pred_test('exists ENABLED & & exists ENABLED', undef, $ebinary);
 279
 280         pred_test('exists MISSING & exists MISSING', 0, undef);
 281         pred_test('exists MISSING & exists ENABLED', 0, undef);
 282         pred_test('exists ENABLED & exists MISSING', 0, undef);
 283         pred_test('exists ENABLED & exists ENABLED', 1, undef);
 284
 285         pred_test('exists MISSING & exists MISSING & exists MISSING', 0, undef);
 286         pred_test('exists MISSING & exists MISSING & exists ENABLED', 0, undef);
 287         pred_test('exists MISSING & exists ENABLED & exists MISSING', 0, undef);
 288         pred_test('exists MISSING & exists ENABLED & exists ENABLED', 0, undef);
 289         pred_test('exists ENABLED & exists MISSING & exists MISSING', 0, undef);
 290         pred_test('exists ENABLED & exists MISSING & exists ENABLED', 0, undef);
 291         pred_test('exists ENABLED & exists ENABLED & exists MISSING', 0, undef);
 292         pred_test('exists ENABLED & exists ENABLED & exists ENABLED', 1, undef);
 293
 294         print "TEST: $test_total: binary or tests ...\n";
 295
 296         pred_test('exists ENABLED |', undef, $ebinary);
 297         pred_test('| exists ENABLED', undef, $ebinary);
 298         pred_test('exists ENABLED | | exists ENABLED', undef, $ebinary);
 299
 300         pred_test('exists MISSING | exists MISSING', 0, undef);
 301         pred_test('exists MISSING | exists ENABLED', 1, undef);
 302         pred_test('exists ENABLED | exists MISSING', 1, undef);
 303         pred_test('exists ENABLED | exists ENABLED', 1, undef);
 304
 305         pred_test('exists MISSING | exists MISSING | exists MISSING', 0, undef);
 306         pred_test('exists MISSING | exists MISSING | exists ENABLED', 1, undef);
 307         pred_test('exists MISSING | exists ENABLED | exists MISSING', 1, undef);
 308         pred_test('exists MISSING | exists ENABLED | exists ENABLED', 1, undef);
 309         pred_test('exists ENABLED | exists MISSING | exists MISSING', 1, undef);
 310         pred_test('exists ENABLED | exists MISSING | exists ENABLED', 1, undef);
 311         pred_test('exists ENABLED | exists ENABLED | exists MISSING', 1, undef);
 312         pred_test('exists ENABLED | exists ENABLED | exists ENABLED', 1, undef);
 313
 314         print "TEST: $test_total: binary or/and combination tests ...\n";
 315
 316         pred_test('exists MISSING | exists MISSING & exists MISSING', 0, undef);
 317         pred_test('exists MISSING | exists MISSING & exists ENABLED', 0, undef);
 318         pred_test('exists MISSING | exists ENABLED & exists MISSING', 0, undef);
 319         pred_test('exists MISSING | exists ENABLED & exists ENABLED', 1, undef);
 320         pred_test('exists ENABLED | exists MISSING & exists MISSING', 1, undef);
 321         pred_test('exists ENABLED | exists MISSING & exists ENABLED', 1, undef);
 322         pred_test('exists ENABLED | exists ENABLED & exists MISSING', 1, undef);
 323         pred_test('exists ENABLED | exists ENABLED & exists ENABLED', 1, undef);
 324
 325         print "TEST: $test_total: binary and/or combination tests ...\n";
 326
 327         pred_test('exists MISSING & exists MISSING | exists MISSING', 0, undef);
 328         pred_test('exists MISSING & exists MISSING | exists ENABLED', 0, undef);
 329         pred_test('exists MISSING & exists ENABLED | exists MISSING', 0, undef);
 330         pred_test('exists MISSING & exists ENABLED | exists ENABLED', 0, undef);
 331         pred_test('exists ENABLED & exists MISSING | exists MISSING', 0, undef);
 332         pred_test('exists ENABLED & exists MISSING | exists ENABLED', 1, undef);
 333         pred_test('exists ENABLED & exists ENABLED | exists MISSING', 1, undef);
 334         pred_test('exists ENABLED & exists ENABLED | exists ENABLED', 1, undef);
 335
 336         $test_total--;
 337         print "TEST: $test_good/$test_total succeeded\n";
 338
 339         exit $exit_val;
 340 }
 341
 342 # Load up the current configuration values -- FATAL if this fails
 343 print "$P: $config: loading config\n";
 344 open(CONFIG, "<$config") || die "$P: $config: open failed -- $! -- aborting\n";
 345 while (<CONFIG>) {
 346         # Pull out values.
 347         /^#*\s*(CONFIG_\w+)[\s=](.*)$/ or next;
 348         if ($2 eq 'is not set') {
 349                 $values{$1} = 'n';
 350         } else {
 351                 $values{$1} = $2;
 352         }
 353 }
 354 close(CONFIG);
 355
 356 # FATAL: Check if we have an enforcement list.
 357 my $pass = 0;
 358 my $total = 0;
 359 my $line = '';
 360 print "$P: $checks: loading checks\n";
 361 open(CHECKS, "<$checks") || die "$P: $checks: open failed -- $! -- aborting\n";
 362 while (<CHECKS>) {
 363         /^#/ && next;
 364         chomp;
 365
 366         $line .= $_;
 367         if ($line =~ /\\$/) {
 368                 chop($line);
 369                 $line .= " ";
 370                 next;
 371         }
 372         $line =~ /^\s*$/ && next;
 373
 374         #print "CHECK: <$line>\n";
 375         $total++;
 376         my $result = pred_exec($line);
 377         if (!$result) {
 378                 print "$P: FAIL: $line\n";
 379                 $exit_val = $fail_exit;
 380         } else {
 381                 $pass++;
 382         }
 383
 384         $line = '';
 385 }
 386 close(CHECKS);
 387
 388 print "$P: $pass/$total checks passed -- exit $exit_val\n";
 389 exit $exit_val;