lustre/tests/acl/run

   1 #!/usr/bin/perl -w -U
   2
   3 #
   4 # Possible improvements:
   5 #
   6 # - distinguish stdout and stderr output
   7 # - add environment variable like assignments
   8 # - run up to a specific line
   9 # - resume at a specific line
  10 #
  11
  12 use strict;
  13 use FileHandle;
  14 use Getopt::Std;
  15 use POSIX qw(isatty setuid);
  16 use vars qw($opt_v);
  17
  18 no warnings qw(taint);
  19
  20 getopts('v');
  21
  22 my ($OK, $FAILED) = ("ok", "failed");
  23 if (isatty(fileno(STDOUT))) {
  24         $OK = "\033[32m" . $OK . "\033[m";
  25         $FAILED = "\033[31m\033[1m" . $FAILED . "\033[m";
  26 }
  27
  28 sub exec_test($$);
  29 sub process_test($$$$);
  30
  31 my ($prog, $in, $out) = ([], [], []);
  32 my $line_number = 0;
  33 my $prog_line;
  34 my ($tests, $failed) = (0,0);
  35 my $testfile;
  36
  37 if (!defined($ARGV[0])) {
  38         print "No test file specified\n";
  39         exit 1;
  40 }
  41
  42 open($testfile, $ARGV[0]) or die "Can't open file $ARGV[0]: $!";
  43 for (;;) {
  44   my $line = <$testfile>; $line_number++;
  45   if (defined $line && $line !~ /\%s/) {
  46     # Substitute %VAR and %{VAR} with environment variables.
  47     $line =~ s[%(?:(\w+)|\{(\w+)\})][$ENV{"$1$2"}]eg;
  48   }
  49   if (defined $line) {
  50     if ($line =~ s/^\s*< ?//) {
  51       push @$in, $line;
  52     } elsif ($line =~ s/^\s*> ?//) {
  53       push @$out, $line;
  54     } else {
  55       process_test($prog, $prog_line, $in, $out);
  56
  57       $prog = [];
  58       $prog_line = 0;
  59     }
  60     if ($line =~ s/^\s*\$ ?//) {
  61       $line =~ s/\s+#.*//;  # remove comments here...
  62       $prog = [ map { s/\\(.)/$1/g; $_ } split /(?<!\\)\s+/, $line ];
  63       $prog_line = $line_number;
  64       $in = [];
  65       $out = [];
  66     }
  67   } else {
  68     process_test($prog, $prog_line, $in, $out);
  69     last;
  70   }
  71 }
  72 close($testfile);
  73
  74 my $status = sprintf("%d commands (%d passed, %d failed)",
  75         $tests, $tests-$failed, $failed);
  76 if (isatty(fileno(STDOUT))) {
  77         if ($failed) {
  78                 $status = "\033[31m\033[1m" . $status . "\033[m";
  79         } else {
  80                 $status = "\033[32m" . $status . "\033[m";
  81         }
  82 }
  83 print $status, "\n";
  84 exit $failed ? 1 : 0;
  85
  86
  87 sub process_test($$$$) {
  88   my ($prog, $prog_line, $in, $out) = @_;
  89
  90   return unless @$prog;
  91
  92        my $p = [ @$prog ];
  93        print "[$prog_line] \$ ", join(' ',
  94              map { s/\s/\\$&/g; $_ } @$p), " -- ";
  95        my $result = exec_test($prog, $in);
  96        my $good = 1;
  97        my $nmax = (@$out > @$result) ? @$out : @$result;
  98        for (my $n=0; $n < $nmax; $n++) {
  99          if (!defined($out->[$n]) || !defined($result->[$n]) ||
 100              ($result->[$n] !~ m/\Q$out->[$n]\E/)) {
 101                  $good = 0;
 102          }
 103        }
 104        $tests++;
 105        $failed++ unless $good;
 106        print $good ? $OK : $FAILED, "\n";
 107        if (!$good) {
 108          for (my $n=0; $n < $nmax; $n++) {
 109            my $l = defined($out->[$n]) ? $out->[$n] : "~";
 110            chomp $l;
 111            my $r = defined($result->[$n]) ? $result->[$n] : "~";
 112            chomp $r;
 113            print sprintf("%-37s %s %-39s\n", $l, $l eq $r ? "|" : "?", $r);
 114          }
 115        } elsif ($opt_v) {
 116          print join('', @$result);
 117        }
 118 }
 119
 120
 121 sub su($) {
 122   my ($user) = @_;
 123
 124   $user ||= "root";
 125
 126   my ($login, $pass, $uid, $gid) = getpwnam($user)
 127     or return [ "su: user $user does not exist\n" ];
 128   my @groups = ();
 129   my $fh = new FileHandle("/etc/group")
 130     or return [ "opening /etc/group: $!\n" ];
 131   while (<$fh>) {
 132     chomp;
 133     my ($group, $passwd, $gid, $users) = split /:/;
 134     foreach my $u (split /,/, $users) {
 135       push @groups, $gid
 136         if ($user eq $u);
 137     }
 138   }
 139   $fh->close;
 140
 141   my $groups = join(" ", ($gid, $gid, @groups));
 142   #print STDERR "[[$groups]]\n";
 143   $! = 0;  # reset errno
 144   $> = 0;
 145   $( = $gid;
 146   $) = $groups;
 147   if ($!) {
 148     return [ "su: $!\n" ];
 149   }
 150   if ($uid != 0) {
 151     $> = $uid;
 152     #$< = $uid;
 153     if ($!) {
 154       return [ "su: $prog->[1]: $!\n" ];
 155     }
 156   }
 157   #print STDERR "[($>,$<)($(,$))]";
 158   return [];
 159 }
 160
 161
 162 sub sg($) {
 163   my ($group) = @_;
 164
 165   my $gid = getgrnam($group)
 166     or return [ "sg: group $group does not exist\n" ];
 167   my %groups = map { $_ eq $gid ? () : ($_ => 1) } (split /\s/, $));
 168
 169   #print STDERR "<<", join("/", keys %groups), ">>\n";
 170   my $groups = join(" ", ($gid, $gid, keys %groups));
 171   #print STDERR "[[$groups]]\n";
 172   $! = 0;  # reset errno
 173   if ($> != 0) {
 174           my $uid = $>;
 175           $> = 0;
 176           $( = $gid;
 177           $) = $groups;
 178           $> = $uid;
 179   } else {
 180           $( = $gid;
 181           $) = $groups;
 182   }
 183   if ($!) {
 184     return [ "sg: $!\n" ];
 185   }
 186   print STDERR "[($>,$<)($(,$))]";
 187   return [];
 188 }
 189
 190
 191 sub exec_test($$) {
 192   my ($prog, $in) = @_;
 193   local (*IN, *IN_DUP, *IN2, *OUT_DUP, *OUT, *OUT2);
 194   my $needs_shell = (join('', @$prog) =~ /[][|<>"'`\$\*\?]/);
 195
 196   if ($prog->[0] eq "umask") {
 197     umask oct $prog->[1];
 198     return [];
 199   } elsif ($prog->[0] eq "cd") {
 200     if (!chdir $prog->[1]) {
 201       return [ "chdir: $prog->[1]: $!\n" ];
 202     }
 203     return [];
 204   } elsif ($prog->[0] eq "su") {
 205     return su($prog->[1]);
 206   } elsif ($prog->[0] eq "sg") {
 207     return sg($prog->[1]);
 208   }
 209
 210   pipe *IN2, *OUT
 211     or die "Can't create pipe for reading: $!";
 212   open *IN_DUP, "<&STDIN"
 213     or *IN_DUP = undef;
 214   open *STDIN, "<&IN2"
 215     or die "Can't duplicate pipe for reading: $!";
 216   close *IN2;
 217
 218   open *OUT_DUP, ">&STDOUT"
 219     or die "Can't duplicate STDOUT: $!";
 220   pipe *IN, *OUT2
 221     or die "Can't create pipe for writing: $!";
 222   open *STDOUT, ">&OUT2"
 223     or die "Can't duplicate pipe for writing: $!";
 224   close *OUT2;
 225
 226   *STDOUT->autoflush();
 227   *OUT->autoflush();
 228
 229   if (fork()) {
 230     # Server
 231     if (*IN_DUP) {
 232       open *STDIN, "<&IN_DUP"
 233         or die "Can't duplicate STDIN: $!";
 234       close *IN_DUP
 235         or die "Can't close STDIN duplicate: $!";
 236     }
 237     open *STDOUT, ">&OUT_DUP"
 238       or die "Can't duplicate STDOUT: $!";
 239     close *OUT_DUP
 240       or die "Can't close STDOUT duplicate: $!";
 241
 242     foreach my $line (@$in) {
 243       #print "> $line";
 244       print OUT $line;
 245     }
 246     close *OUT
 247       or die "Can't close pipe for writing: $!";
 248
 249     my $result = [];
 250     while (<IN>) {
 251       #print "< $_";
 252       if ($needs_shell) {
 253         s#^/bin/sh: line \d+: ##;
 254         s#^/bin/sh: ##; # temporarily added by ericm
 255       }
 256       push @$result, $_;
 257     }
 258     return $result;
 259   } else {
 260     # Client
 261     $< = $>;
 262     close IN
 263       or die "Can't close read end for input pipe: $!";
 264     close OUT
 265       or die "Can't close write end for output pipe: $!";
 266     close OUT_DUP
 267       or die "Can't close STDOUT duplicate: $!";
 268     local *ERR_DUP;
 269     open ERR_DUP, ">&STDERR"
 270       or die "Can't duplicate STDERR: $!";
 271     open STDERR, ">&STDOUT"
 272       or die "Can't join STDOUT and STDERR: $!";
 273
 274     if ($needs_shell) {
 275       exec ('/bin/sh', '-c', join(" ", @$prog));
 276     } else {
 277       exec @$prog;
 278     }
 279     print STDERR $prog->[0], ": $!\n";
 280     exit;
 281   }
 282 }
 283