xref: /freebsd/tests/sys/acl/run (revision c697fb7f) 
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# $FreeBSD$
31#
32
33#
34# Possible improvements:
35#
36# - distinguish stdout and stderr output
37# - add environment variable like assignments
38# - run up to a specific line
39# - resume at a specific line
40#
41
42use strict;
43use FileHandle;
44use Getopt::Std;
45use POSIX qw(isatty setuid getcwd);
46use vars qw($opt_l $opt_v);
47
48no warnings qw(taint);
49
50$opt_l = ~0;  # a really huge number
51getopts('l:v');
52
53my ($OK, $FAILED) = ("ok", "failed");
54if (isatty(fileno(STDOUT))) {
55	$OK = "\033[32m" . $OK . "\033[m";
56	$FAILED = "\033[31m\033[1m" . $FAILED . "\033[m";
57}
58
59sub exec_test($$);
60sub process_test($$$$);
61
62my ($prog, $in, $out) = ([], [], []);
63my $prog_line = 0;
64my ($tests, $failed) = (0,0);
65my $lineno;
66my $width = ($ENV{COLUMNS} || 80) >> 1;
67
68for (;;) {
69  my $line = <>; $lineno++;
70  if (defined $line) {
71    # Substitute %VAR and %{VAR} with environment variables.
72    $line =~ s[%(\w+)][$ENV{$1}]eg;
73    $line =~ s[%\{(\w+)\}][$ENV{$1}]eg;
74  }
75  if (defined $line) {
76    if ($line =~ s/^\s*< ?//) {
77      push @$in, $line;
78    } elsif ($line =~ s/^\s*> ?//) {
79      push @$out, $line;
80    } else {
81      process_test($prog, $prog_line, $in, $out);
82      last if $prog_line >= $opt_l;
83
84      $prog = [];
85      $prog_line = 0;
86    }
87    if ($line =~ s/^\s*\$ ?//) {
88      $prog = [ map { s/\\(.)/$1/g; $_ } split /(?<!\\)\s+/, $line ];
89      $prog_line = $lineno;
90      $in = [];
91      $out = [];
92    }
93  } else {
94    process_test($prog, $prog_line, $in, $out);
95    last;
96  }
97}
98
99my $status = sprintf("%d commands (%d passed, %d failed)",
100	$tests, $tests-$failed, $failed);
101if (isatty(fileno(STDOUT))) {
102	if ($failed) {
103		$status = "\033[31m\033[1m" . $status . "\033[m";
104	} else {
105		$status = "\033[32m" . $status . "\033[m";
106	}
107}
108print $status, "\n";
109exit $failed ? 1 : 0;
110
111
112sub process_test($$$$) {
113  my ($prog, $prog_line, $in, $out) = @_;
114
115  return unless @$prog;
116
117       my $p = [ @$prog ];
118       print "[$prog_line] \$ ", join(' ',
119             map { s/\s/\\$&/g; $_ } @$p), " -- ";
120       my $result = exec_test($prog, $in);
121       my @good = ();
122       my $nmax = (@$out > @$result) ? @$out : @$result;
123       for (my $n=0; $n < $nmax; $n++) {
124	   my $use_re;
125	   if (defined $out->[$n] && $out->[$n] =~ /^~ /) {
126		$use_re = 1;
127		$out->[$n] =~ s/^~ //g;
128	   }
129
130           if (!defined($out->[$n]) || !defined($result->[$n]) ||
131               (!$use_re && $result->[$n] ne $out->[$n]) ||
132               ( $use_re && $result->[$n] !~ /^$out->[$n]/)) {
133               push @good, ($use_re ? '!~' : '!=');
134	   }
135	   else {
136               push @good, ($use_re ? '=~' : '==');
137           }
138       }
139       my $good = !(grep /!/, @good);
140       $tests++;
141       $failed++ unless $good;
142       print $good ? $OK : $FAILED, "\n";
143       if (!$good || $opt_v) {
144         for (my $n=0; $n < $nmax; $n++) {
145	   my $l = defined($out->[$n]) ? $out->[$n] : "~";
146	   chomp $l;
147	   my $r = defined($result->[$n]) ? $result->[$n] : "~";
148	   chomp $r;
149	   print sprintf("%-" . ($width-3) . "s %s %s\n",
150			 $r, $good[$n], $l);
151         }
152       }
153}
154
155
156sub su($) {
157  my ($user) = @_;
158
159  $user ||= "root";
160
161  my ($login, $pass, $uid, $gid) = getpwnam($user)
162    or return [ "su: user $user does not exist\n" ];
163  my @groups = ();
164  my $fh = new FileHandle("/etc/group")
165    or return [ "opening /etc/group: $!\n" ];
166  while (<$fh>) {
167    chomp;
168    my ($group, $passwd, $gid, $users) = split /:/;
169    foreach my $u (split /,/, $users) {
170      push @groups, $gid
171	if ($user eq $u);
172    }
173  }
174  $fh->close;
175
176  my $groups = join(" ", ($gid, $gid, @groups));
177  #print STDERR "[[$groups]]\n";
178  $! = 0;  # reset errno
179  $> = 0;
180  $( = $gid;
181  $) = $groups;
182  if ($!) {
183    return [ "su: $!\n" ];
184  }
185  if ($uid != 0) {
186    $> = $uid;
187    #$< = $uid;
188    if ($!) {
189      return [ "su: $prog->[1]: $!\n" ];
190    }
191  }
192  #print STDERR "[($>,$<)($(,$))]";
193  return [];
194}
195
196
197sub sg($) {
198  my ($group) = @_;
199
200  my $gid = getgrnam($group)
201    or return [ "sg: group $group does not exist\n" ];
202  my %groups = map { $_ eq $gid ? () : ($_ => 1) } (split /\s/, $));
203
204  #print STDERR "<<", join("/", keys %groups), ">>\n";
205  my $groups = join(" ", ($gid, $gid, keys %groups));
206  #print STDERR "[[$groups]]\n";
207  $! = 0;  # reset errno
208  if ($> != 0) {
209	  my $uid = $>;
210	  $> = 0;
211	  $( = $gid;
212	  $) = $groups;
213	  $> = $uid;
214  } else {
215	  $( = $gid;
216	  $) = $groups;
217  }
218  if ($!) {
219    return [ "sg: $!\n" ];
220  }
221  print STDERR "[($>,$<)($(,$))]";
222  return [];
223}
224
225
226sub exec_test($$) {
227  my ($prog, $in) = @_;
228  local (*IN, *IN_DUP, *IN2, *OUT_DUP, *OUT, *OUT2);
229  my $needs_shell = (join('', @$prog) =~ /[][|<>"'`\$\*\?]/);
230
231  if ($prog->[0] eq "umask") {
232    umask oct $prog->[1];
233    return [];
234  } elsif ($prog->[0] eq "cd") {
235    if (!chdir $prog->[1]) {
236      return [ "chdir: $prog->[1]: $!\n" ];
237    }
238    $ENV{PWD} = getcwd;
239    return [];
240  } elsif ($prog->[0] eq "su") {
241    return su($prog->[1]);
242  } elsif ($prog->[0] eq "sg") {
243    return sg($prog->[1]);
244  } elsif ($prog->[0] eq "export") {
245    my ($name, $value) = split /=/, $prog->[1];
246    # FIXME: need to evaluate $value, so that things like this will work:
247    # export dir=$PWD/dir
248    $ENV{$name} = $value;
249    return [];
250  } elsif ($prog->[0] eq "unset") {
251    delete $ENV{$prog->[1]};
252    return [];
253  }
254
255  pipe *IN2, *OUT
256    or die "Can't create pipe for reading: $!";
257  open *IN_DUP, "<&STDIN"
258    or *IN_DUP = undef;
259  open *STDIN, "<&IN2"
260    or die "Can't duplicate pipe for reading: $!";
261  close *IN2;
262
263  open *OUT_DUP, ">&STDOUT"
264    or die "Can't duplicate STDOUT: $!";
265  pipe *IN, *OUT2
266    or die "Can't create pipe for writing: $!";
267  open *STDOUT, ">&OUT2"
268    or die "Can't duplicate pipe for writing: $!";
269  close *OUT2;
270
271  *STDOUT->autoflush();
272  *OUT->autoflush();
273
274  $SIG{CHLD} = 'IGNORE';
275
276  if (fork()) {
277    # Server
278    if (*IN_DUP) {
279      open *STDIN, "<&IN_DUP"
280        or die "Can't duplicate STDIN: $!";
281      close *IN_DUP
282        or die "Can't close STDIN duplicate: $!";
283    }
284    open *STDOUT, ">&OUT_DUP"
285      or die "Can't duplicate STDOUT: $!";
286    close *OUT_DUP
287      or die "Can't close STDOUT duplicate: $!";
288
289    foreach my $line (@$in) {
290      #print "> $line";
291      print OUT $line;
292    }
293    close *OUT
294      or die "Can't close pipe for writing: $!";
295
296    my $result = [];
297    while (<IN>) {
298      #print "< $_";
299      if ($needs_shell) {
300	s#^/bin/sh: line \d+: ##;
301      }
302      push @$result, $_;
303    }
304    return $result;
305  } else {
306    # Client
307    $< = $>;
308    close IN
309      or die "Can't close read end for input pipe: $!";
310    close OUT
311      or die "Can't close write end for output pipe: $!";
312    close OUT_DUP
313      or die "Can't close STDOUT duplicate: $!";
314    local *ERR_DUP;
315    open ERR_DUP, ">&STDERR"
316      or die "Can't duplicate STDERR: $!";
317    open STDERR, ">&STDOUT"
318      or die "Can't join STDOUT and STDERR: $!";
319
320    if ($needs_shell) {
321      exec ('/bin/sh', '-c', join(" ", @$prog));
322    } else {
323      exec @$prog;
324    }
325    print STDERR $prog->[0], ": $!\n";
326    exit;
327  }
328}
329
330