kernel/fiasco/tool/autocheck

   1 #! /usr/bin/perl -W
   2 #
   3 # Automatically check some L4 applications using Fiasco-UX
   4 #
   5 #
   6 #  Adam Lackorzynski <adam@os.inf.tu-dresden.de>
   7 #
   8
   9 use strict;
  10 use Getopt::Long;
  11
  12 my $FIASCOUX;
  13 my $L4DIR;
  14 my $OBJDIR = 'OBJ-x86_586-l4v2';
  15
  16 my $ALARM_TIMEOUT = 60; # in seconds
  17
  18 my %templs = (
  19   rmgr     => '%s/pkg/rmgr/server/fiasco_ux_src/%s/rmgr-ux',
  20   roottask => '%s/pkg/roottask/server/src/%s/roottask',
  21   sigma0   => '%s/pkg/sigma0/server/fiasco_ux_src/%s/sigma0-ux',
  22   ktest    => '%s/pkg/ktest/server/src/%s/ktest',
  23   pingpong => '%s/pkg/pingpong/server/src/%s/pingpong',
  24 );
  25
  26 my $Verbose = 0;
  27 my $Quiet   = 0;
  28
  29 my %progs;
  30 my %results;
  31 my %output;
  32
  33 my $exit_code = 0;
  34
  35 sub usage() {
  36   print <<EOU;
  37 $0 [options]
  38
  39  --l4dir, -l path         Path to an L4 directory
  40  --fiascoux, -f file      Path to the Fiasco-UX binary
  41  --objdir, -O objdir      Object dir, currently: $OBJDIR
  42  --verbose, -v            Be verbose (e.g. show output of L4 apps)
  43  --quiet, -q              Tell nothing, just set the exit code
  44
  45  Environment variables:
  46   L4DIR                   Path to an L4 directory
  47   FIASCOUX                Path to the Fiasco-UX binary
  48 EOU
  49 }
  50
  51 ##
  52 # Check if L4DIR looks like an L4 directory
  53 sub check_for_l4dir() {
  54   unless (-d "$L4DIR/pkg/l4sys/include" ||
  55           -d "$L4DIR/kernel/fiasco/src/kern/ux") {
  56     die "$L4DIR doesn't look like an L4 directory!";
  57   }
  58 }
  59
  60 ##
  61 # Just check if the supplied binary in $FIASCOUX is really
  62 # a Fiasco UX version. Native versions will just segfault.
  63 sub check_for_fiasco_ux() {
  64
  65   unless ((-x $FIASCOUX && -f $FIASCOUX) ||
  66           (-l $FIASCOUX && -x readlink $FIASCOUX && -f readlink $FIASCOUX)) {
  67     die "$FIASCOUX: Does not exist or isn't an executable file";
  68   }
  69
  70   system("$FIASCOUX -h >/dev/null 2>&1");
  71   die "$FIASCOUX doesn't seem to be a UX version." if $?;
  72
  73
  74 }
  75
  76 ##
  77 # Check for userland (rmgr-ux, sigma0-ux, ...)
  78 sub check_for_userland() {
  79   foreach my $t (keys %templs) {
  80     my $p = sprintf $templs{$t}, $L4DIR, $OBJDIR;
  81     die "There's no $p!" unless -x $p;
  82     $progs{$t} = $p;
  83   }
  84 }
  85
  86 ##
  87 # Called if alarm signal received
  88 sub got_sig_alarm {
  89   print "Fiasco-UX timed out after $ALARM_TIMEOUT seconds!\n";
  90   exit 1;
  91 }
  92
  93 ##
  94 # Set alarm so that we abort if something hangs
  95 sub set_alarm() {
  96   $SIG{ALRM} = \&got_sig_alarm;
  97   alarm $ALARM_TIMEOUT;
  98 }
  99
 100 sub fiascoux_cmdline() {
 101   (my $p = $FIASCOUX) =~ s/\/[^\/]+$//;
 102   "cd $p && $FIASCOUX -R $progs{rmgr} -S $progs{sigma0}";
 103 }
 104
 105
 106 ##
 107 # call_text
 108 sub call_test($) {
 109   my ($name) = @_;
 110
 111   # default
 112   $results{$name} = '';
 113
 114   my $cmdline = fiascoux_cmdline()." -l $progs{$name}";
 115   print "Calling: $cmdline" if $Verbose;
 116
 117   open(F, "$cmdline 2>&1|")
 118     || die "Can't start Fiasco with $progs{$name}: $!";
 119   while (<F>) {
 120     $output{$name} .= $_;
 121     print if $Verbose;
 122   }
 123   close F;
 124
 125   eval "test_$name()";
 126   if ($@) {
 127     print "Internal error: $@\n";
 128     $results{$name} = 'Internal error';
 129   } else {
 130     print_result($name);
 131   }
 132 }
 133
 134 ##
 135 # ktest - gives nice output so it's easy to scan
 136 sub test_ktest() {
 137   $_ = $output{ktest};
 138   $results{ktest} = 'Failed results' if /failed/ || /\(TIMEOUT\)/;
 139 }
 140
 141 ##
 142 # pingpong - is a benchmark, so a bit hard to scan
 143 # for now, we'll just see that all 9 tests are run and that there are
 144 # a certain number of lines
 145 sub test_pingpong() {
 146   $_ = $output{pingpong};
 147   unless (/Kernel\sversion\s\d.*/sm) {
 148     $results{pingpong} = 'Unknown output';
 149     return;
 150   }
 151   $_ = $&;
 152   my @lines = split /\n/;
 153   my $linecount = scalar @lines;
 154   for my $n (0 .. 9) {
 155     unless (/>>\s+$n:\s/m) {
 156       $results{pingpong} = 'Not all tests did run';
 157       return;
 158     }
 159   }
 160   if ($linecount != 88) {
 161     $results{pingpong} = 'Wrong line count of output';
 162     return;
 163   }
 164 }
 165
 166 ##
 167 # print test results
 168 sub print_result($) {
 169   my $p = shift;
 170   if (!$Quiet) {
 171     printf "%-15s: %s\n", $p,
 172          ($results{$p} eq '') ? "Passed" : "failed ($results{$p})";
 173   }
 174 }
 175
 176 ##
 177 # Get the exit code of our little program
 178 sub get_exit_code() {
 179   for my $t (keys %results) {
 180     return 1 if $results{$t} ne '';
 181   }
 182   0;
 183 }
 184
 185
 186 # -------------------------------------------------------------
 187
 188 unless (GetOptions("help|h", sub { usage(); exit(0); },
 189                    "l4dir|l=s", \$L4DIR,
 190                    "fiascoux|f=s", \$FIASCOUX,
 191                    "objdir|O=s", \$OBJDIR,
 192                    "verbose|v!", \$Verbose,
 193                    "quiet|q!", \$Quiet,
 194                    "roottask!", sub { $templs{rmgr} = $templs{roottask}; },
 195                    )) {
 196   usage();
 197   exit(1);
 198 }
 199
 200 $L4DIR = $ENV{L4DIR}       || die "Need an L4DIR set!" unless $L4DIR;
 201 $FIASCOUX = $ENV{FIASCOUX} || die "Need a Fiasco-UX path!" unless $FIASCOUX;
 202
 203 check_for_l4dir();
 204 check_for_fiasco_ux();
 205 check_for_userland();
 206
 207 set_alarm();
 208
 209 call_test("ktest");
 210 call_test("pingpong");
 211
 212 exit get_exit_code();