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