xref: /freebsd/tests/sys/acl/run (revision e0c4386e7e71d93b0edc0c8fa156263fc4a8b0b6) 
1#!/usr/bin/perl -w -U
2
3# Copyright (c) 2007, 2008 Andreas Gruenbacher.
4# All rights reserved.
5#
6# Redistribution and use in source and binary forms, with or without
7# modification, are permitted provided that the following conditions
8# are met:
9# 1. Redistributions of source code must retain the above copyright
10#    notice, this list of conditions, and the following disclaimer,
11#    without modification, immediately at the beginning of the file.
12# 2. The name of the author may not be used to endorse or promote products
13#    derived from this software without specific prior written permission.
14#
15# Alternatively, this software may be distributed under the terms of the
16# GNU Public License ("GPL").
17#
18# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
19# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
20# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR
22# ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
24# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
25# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
26# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
27# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
28# SUCH DAMAGE.
29#
30#
31
32#
33# Possible improvements:
34#
35# - distinguish stdout and stderr output
36# - add environment variable like assignments
37# - run up to a specific line
38# - resume at a specific line
39#
40
41use strict;
42use FileHandle;
43use Getopt::Std;
44use POSIX qw(isatty setuid getcwd);
45use vars qw($opt_l $opt_v);
46
47no warnings qw(taint);
48
49$opt_l = ~0;  # a really huge number
50getopts('l:v');
51
52my ($OK, $FAILED) = ("ok", "failed");
53if (isatty(fileno(STDOUT))) {
54	$OK = "\033[32m" . $OK . "\033[m";
55	$FAILED = "\033[31m\033[1m" . $FAILED . "\033[m";
56}
57
58sub exec_test($$);
59sub process_test($$$$);
60
61my ($prog, $in, $out) = ([], [], []);
62my $prog_line = 0;
63my ($tests, $failed) = (0,0);
64my $lineno;
65my $width = ($ENV{COLUMNS} || 80) >> 1;
66
67for (;;) {
68  my $line = <>; $lineno++;
69  if (defined $line) {
70    # Substitute %VAR and %{VAR} with environment variables.
71    $line =~ s[%(\w+)][$ENV{$1}]eg;
72    $line =~ s[%\{(\w+)\}][$ENV{$1}]eg;
73  }
74  if (defined $line) {
75    if ($line =~ s/^\s*< ?//) {
76      push @$in, $line;
77    } elsif ($line =~ s/^\s*> ?//) {
78      push @$out, $line;
79    } else {
80      process_test($prog, $prog_line, $in, $out);
81      last if $prog_line >= $opt_l;
82
83      $prog = [];
84      $prog_line = 0;
85    }
86    if ($line =~ s/^\s*\$ ?//) {
87      $prog = [ map { s/\\(.)/$1/g; $_ } split /(?<!\\)\s+/, $line ];
88      $prog_line = $lineno;
89      $in = [];
90      $out = [];
91    }
92  } else {
93    process_test($prog, $prog_line, $in, $out);
94    last;
95  }
96}
97
98my $status = sprintf("%d commands (%d passed, %d failed)",
99	$tests, $tests-$failed, $failed);
100if (isatty(fileno(STDOUT))) {
101	if ($failed) {
102		$status = "\033[31m\033[1m" . $status . "\033[m";
103	} else {
104		$status = "\033[32m" . $status . "\033[m";
105	}
106}
107print $status, "\n";
108exit $failed ? 1 : 0;
109
110
111sub process_test($$$$) {
112  my ($prog, $prog_line, $in, $out) = @_;
113
114  return unless @$prog;
115
116       my $p = [ @$prog ];
117       print "[$prog_line] \$ ", join(' ',
118             map { s/\s/\\$&/g; $_ } @$p), " -- ";
119       my $result = exec_test($prog, $in);
120       my @good = ();
121       my $nmax = (@$out > @$result) ? @$out : @$result;
122       for (my $n=0; $n < $nmax; $n++) {
123	   my $use_re;
124	   if (defined $out->[$n] && $out->[$n] =~ /^~ /) {
125		$use_re = 1;
126		$out->[$n] =~ s/^~ //g;
127	   }
128
129           if (!defined($out->[$n]) || !defined($result->[$n]) ||
130               (!$use_re && $result->[$n] ne $out->[$n]) ||
131               ( $use_re && $result->[$n] !~ /^$out->[$n]/)) {
132               push @good, ($use_re ? '!~' : '!=');
133	   }
134	   else {
135               push @good, ($use_re ? '=~' : '==');
136           }
137       }
138       my $good = !(grep /!/, @good);
139       $tests++;
140       $failed++ unless $good;
141       print $good ? $OK : $FAILED, "\n";
142       if (!$good || $opt_v) {
143         for (my $n=0; $n < $nmax; $n++) {
144	   my $l = defined($out->[$n]) ? $out->[$n] : "~";
145	   chomp $l;
146	   my $r = defined($result->[$n]) ? $result->[$n] : "~";
147	   chomp $r;
148	   print sprintf("%-" . ($width-3) . "s %s %s\n",
149			 $r, $good[$n], $l);
150         }
151       }
152}
153
154
155sub su($) {
156  my ($user) = @_;
157
158  $user ||= "root";
159
160  my ($login, $pass, $uid, $gid) = getpwnam($user)
161    or return [ "su: user $user does not exist\n" ];
162  my @groups = ();
163  my $fh = new FileHandle("/etc/group")
164    or return [ "opening /etc/group: $!\n" ];
165  while (<$fh>) {
166    chomp;
167    my ($group, $passwd, $gid, $users) = split /:/;
168    foreach my $u (split /,/, $users) {
169      push @groups, $gid
170	if ($user eq $u);
171    }
172  }
173  $fh->close;
174
175  my $groups = join(" ", ($gid, $gid, @groups));
176  #print STDERR "[[$groups]]\n";
177  $! = 0;  # reset errno
178  $> = 0;
179  $( = $gid;
180  $) = $groups;
181  if ($!) {
182    return [ "su: $!\n" ];
183  }
184  if ($uid != 0) {
185    $> = $uid;
186    #$< = $uid;
187    if ($!) {
188      return [ "su: $prog->[1]: $!\n" ];
189    }
190  }
191  #print STDERR "[($>,$<)($(,$))]";
192  return [];
193}
194
195
196sub sg($) {
197  my ($group) = @_;
198
199  my $gid = getgrnam($group)
200    or return [ "sg: group $group does not exist\n" ];
201  my %groups = map { $_ eq $gid ? () : ($_ => 1) } (split /\s/, $));
202
203  #print STDERR "<<", join("/", keys %groups), ">>\n";
204  my $groups = join(" ", ($gid, $gid, keys %groups));
205  #print STDERR "[[$groups]]\n";
206  $! = 0;  # reset errno
207  if ($> != 0) {
208	  my $uid = $>;
209	  $> = 0;
210	  $( = $gid;
211	  $) = $groups;
212	  $> = $uid;
213  } else {
214	  $( = $gid;
215	  $) = $groups;
216  }
217  if ($!) {
218    return [ "sg: $!\n" ];
219  }
220  print STDERR "[($>,$<)($(,$))]";
221  return [];
222}
223
224
225sub exec_test($$) {
226  my ($prog, $in) = @_;
227  local (*IN, *IN_DUP, *IN2, *OUT_DUP, *OUT, *OUT2);
228  my $needs_shell = (join('', @$prog) =~ /[][|<>"'`\$\*\?]/);
229
230  if ($prog->[0] eq "umask") {
231    umask oct $prog->[1];
232    return [];
233  } elsif ($prog->[0] eq "cd") {
234    if (!chdir $prog->[1]) {
235      return [ "chdir: $prog->[1]: $!\n" ];
236    }
237    $ENV{PWD} = getcwd;
238    return [];
239  } elsif ($prog->[0] eq "su") {
240    return su($prog->[1]);
241  } elsif ($prog->[0] eq "sg") {
242    return sg($prog->[1]);
243  } elsif ($prog->[0] eq "export") {
244    my ($name, $value) = split /=/, $prog->[1];
245    # FIXME: need to evaluate $value, so that things like this will work:
246    # export dir=$PWD/dir
247    $ENV{$name} = $value;
248    return [];
249  } elsif ($prog->[0] eq "unset") {
250    delete $ENV{$prog->[1]};
251    return [];
252  }
253
254  pipe *IN2, *OUT
255    or die "Can't create pipe for reading: $!";
256  open *IN_DUP, "<&STDIN"
257    or *IN_DUP = undef;
258  open *STDIN, "<&IN2"
259    or die "Can't duplicate pipe for reading: $!";
260  close *IN2;
261
262  open *OUT_DUP, ">&STDOUT"
263    or die "Can't duplicate STDOUT: $!";
264  pipe *IN, *OUT2
265    or die "Can't create pipe for writing: $!";
266  open *STDOUT, ">&OUT2"
267    or die "Can't duplicate pipe for writing: $!";
268  close *OUT2;
269
270  *STDOUT->autoflush();
271  *OUT->autoflush();
272
273  $SIG{CHLD} = 'IGNORE';
274
275  if (fork()) {
276    # Server
277    if (*IN_DUP) {
278      open *STDIN, "<&IN_DUP"
279        or die "Can't duplicate STDIN: $!";
280      close *IN_DUP
281        or die "Can't close STDIN duplicate: $!";
282    }
283    open *STDOUT, ">&OUT_DUP"
284      or die "Can't duplicate STDOUT: $!";
285    close *OUT_DUP
286      or die "Can't close STDOUT duplicate: $!";
287
288    foreach my $line (@$in) {
289      #print "> $line";
290      print OUT $line;
291    }
292    close *OUT
293      or die "Can't close pipe for writing: $!";
294
295    my $result = [];
296    while (<IN>) {
297      #print "< $_";
298      if ($needs_shell) {
299	s#^/bin/sh: line \d+: ##;
300      }
301      push @$result, $_;
302    }
303    return $result;
304  } else {
305    # Client
306    $< = $>;
307    close IN
308      or die "Can't close read end for input pipe: $!";
309    close OUT
310      or die "Can't close write end for output pipe: $!";
311    close OUT_DUP
312      or die "Can't close STDOUT duplicate: $!";
313    local *ERR_DUP;
314    open ERR_DUP, ">&STDERR"
315      or die "Can't duplicate STDERR: $!";
316    open STDERR, ">&STDOUT"
317      or die "Can't join STDOUT and STDERR: $!";
318
319    if ($needs_shell) {
320      exec ('/bin/sh', '-c', join(" ", @$prog));
321    } else {
322      exec @$prog;
323    }
324    print STDERR $prog->[0], ": $!\n";
325    exit;
326  }
327}
328
329