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