Whamcloud - gitweb
Branch: HEAD
[fs/lustre-release.git] / 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