tests/sys/acl/run

   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
  41 use strict;
  42 use FileHandle;
  43 use Getopt::Std;
  44 use POSIX qw(isatty setuid getcwd);
  45 use vars qw($opt_l $opt_v);
  46
  47 no warnings qw(taint);
  48
  49 $opt_l = ~0;  # a really huge number
  50 getopts('l:v');
  51
  52 my ($OK, $FAILED) = ("ok", "failed");
  53 if (isatty(fileno(STDOUT))) {
  54         $OK = "\033[32m" . $OK . "\033[m";
  55         $FAILED = "\033[31m\033[1m" . $FAILED . "\033[m";
  56 }
  57
  58 sub exec_test($$);
  59 sub process_test($$$$);
  60
  61 my ($prog, $in, $out) = ([], [], []);
  62 my $prog_line = 0;
  63 my ($tests, $failed) = (0,0);
  64 my $lineno;
  65 my $width = ($ENV{COLUMNS} || 80) >> 1;
  66
  67 for (;;) {
  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
  98 my $status = sprintf("%d commands (%d passed, %d failed)",
  99         $tests, $tests-$failed, $failed);
 100 if (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 }
 107 print $status, "\n";
 108 exit $failed ? 1 : 0;
 109
 110
 111 sub 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
 155 sub 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
 196 sub 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
 225 sub 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