nfs4acl/run

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