lustre/tests/runacltest

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use FileHandle;
   5 use POSIX qw(geteuid getegid isatty);
   6
   7 my $owner = getpwuid(geteuid());
   8 my $group = getgrgid(getegid());
   9
  10 my ($OK, $FAILED) = ("ok", "failed");
  11 if (isatty(fileno(STDOUT))) {
  12         $OK = "\033[32m" . $OK . "\033[m";
  13         $FAILED = "\033[31m\033[1m" . $FAILED . "\033[m";
  14 }
  15
  16 my ($prog, $in, $out) = ([], [], []);
  17 my $line = 0;
  18 my $prog_line;
  19 my ($tests, $failed);
  20
  21 for (;;) {
  22   my $script = <>; $line++;
  23   $script =~ s/\@OWNER\@/$owner/g;
  24   $script =~ s/\@GROUP\@/$group/g;
  25   next if (defined($script) && $script =~ /^!/);
  26   if (!defined($script) || $script =~ s/^\$ ?//) {
  27     if (@$prog) {
  28        #print "[$prog_line] \$ ", join(' ', @$prog), " -- ";
  29        my $p = [ @$prog ];
  30        print "[$prog_line] \$ ", join(' ',
  31              map { s/\s/\\$&/g; $_ } @$p), " -- ";
  32        my $result = exec_test($prog, $in);
  33        my $good = 1;
  34        my $nmax = (@$out > @$result) ? @$out : @$result;
  35        for (my $n=0; $n < $nmax; $n++) {
  36          if (!defined($out->[$n]) || !defined($result->[$n]) ||
  37              $out->[$n] ne $result->[$n]) {
  38                  $good = 0;
  39                  #chomp $out->[$n];
  40                  #chomp $result->[$n];
  41                  #print "$out->[$n] != $result->[$n]";
  42          }
  43        }
  44        $tests++;
  45        $failed++ unless $good;
  46        print $good ? $OK : $FAILED, "\n";
  47        if (!$good) {
  48          for (my $n=0; $n < $nmax; $n++) {
  49            my $l = defined($out->[$n]) ? $out->[$n] : "~";
  50            chomp $l;
  51            my $r = defined($result->[$n]) ? $result->[$n] : "~";
  52            chomp $r;
  53            print sprintf("%-37s | %-39s\n", $l, $r);
  54          }
  55        }
  56     }
  57     #$prog = [ split /\s+/, $script ] if $script;
  58     $prog = [ map { s/\\(.)/$1/g; $_ } split /(?<!\\)\s+/, $script ] if $script;
  59     $prog_line = $line;
  60     $in = [];
  61     $out = [];
  62   } elsif ($script =~ s/^> ?//) {
  63     push @$in, $script;
  64   } else {
  65     push @$out, $script;
  66   }
  67   last unless defined($script);
  68 }
  69 my $status = sprintf("%d commands (%d passed, %d failed)",
  70         $tests, $tests-$failed, $failed);
  71 if (isatty(fileno(STDOUT))) {
  72         if ($failed) {
  73                 $status = "\033[31m\033[1m" . $status . "\033[m";
  74         } else {
  75                 $status = "\033[32m" . $status . "\033[m";
  76         }
  77 }
  78 print $status, "\n";
  79 exit $failed ? 1 : 0;
  80
  81 sub exec_test($$) {
  82   my ($prog, $in) = @_;
  83   local (*IN, *IN_DUP, *IN2, *OUT_DUP, *OUT, *OUT2);
  84
  85   if ($prog->[0] eq "umask") {
  86     umask oct $prog->[1];
  87     return [];
  88   } elsif ($prog->[0] eq "cd") {
  89     if (!chdir $prog->[1]) {
  90       return [ "chdir: $prog->[1]: $!\n" ];
  91     }
  92     return [];
  93   }
  94
  95   pipe *IN2, *OUT
  96     or die "Can't create pipe for reading: $!";
  97   open *IN_DUP, "<&STDIN"
  98     or *IN_DUP = undef;
  99   open *STDIN, "<&IN2"
 100     or die "Can't duplicate pipe for reading: $!";
 101   close *IN2;
 102
 103   open *OUT_DUP, ">&STDOUT"
 104     or die "Can't duplicate STDOUT: $!";
 105   pipe *IN, *OUT2
 106     or die "Can't create pipe for writing: $!";
 107   open *STDOUT, ">&OUT2"
 108     or die "Can't duplicate pipe for writing: $!";
 109   close *OUT2;
 110
 111   *STDOUT->autoflush();
 112   *OUT->autoflush();
 113
 114   if (fork()) {
 115     # Server
 116     if (*IN_DUP) {
 117       open *STDIN, "<&IN_DUP"
 118         or die "Can't duplicate STDIN: $!";
 119       close *IN_DUP
 120         or die "Can't close STDIN duplicate: $!";
 121     }
 122     open *STDOUT, ">&OUT_DUP"
 123       or die "Can't duplicate STDOUT: $!";
 124     close *OUT_DUP
 125       or die "Can't close STDOUT duplicate: $!";
 126
 127     foreach my $line (@$in) {
 128       #print "> $line";
 129       print OUT $line;
 130     }
 131     close *OUT
 132       or die "Can't close pipe for writing: $!";
 133
 134     my $result = [];
 135     while (<IN>) {
 136       #print "< $_";
 137       push @$result, $_;
 138     }
 139     return $result;
 140   } else {
 141     # Client
 142     close IN
 143       or die "Can't close read end for input pipe: $!";
 144     close OUT
 145       or die "Can't close write end for output pipe: $!";
 146     close OUT_DUP
 147       or die "Can't close STDOUT duplicate: $!";
 148     local *ERR_DUP;
 149     open ERR_DUP, ">&STDERR"
 150       or die "Can't duplicate STDERR: $!";
 151     open STDERR, ">&STDOUT"
 152       or die "Can't join STDOUT and STDERR: $!";
 153
 154     #print ERR_DUP "<", join(' ', @$prog), ">\n";
 155     exec @$prog;
 156     print ERR_DUP $prog->[0], ": $!\n";
 157     exit;
 158   }
 159 }
 160