Start with a very minimal test suite

1 files changed, 226 insertions, 0 deletions

diff --git a/test/run b/test/run
new file mode 100755
index 0000000..c6d09f6
--- /dev/null
+++ b/test/run
@@ -0,0 +1,226 @@
+#! /usr/bin/perl -w -U
+
+use strict;
+use FileHandle;
+use Getopt::Std;
+use POSIX qw(isatty setuid);
+use vars qw($opt_v);
+
+no warnings qw(taint);
+
+getopts('v');
+
+my ($OK, $FAILED) = ("ok", "failed");
+if (isatty(fileno(STDOUT))) {
+	$OK = "\033[32m" . $OK . "\033[m";
+	$FAILED = "\033[31m\033[1m" . $FAILED . "\033[m";
+}
+
+sub exec_test($$);
+
+my ($prog, $in, $out) = ([], [], []);
+my $line = 0;
+my $prog_line;
+my ($tests, $failed) = (0,0);
+
+for (;;) {
+  my $script = <>; $line++;
+  if (defined $script) {
+    # Substitute %VAR and %{VAR} with environment variables.
+    $script =~ s[%(?:(\w+)|\{(\w+)\})][$ENV{"$1$2"}]eg;
+  }
+  next if (defined($script) && $script =~ /^!/);
+  if (!defined($script) || $script =~ s/^\$ ?//) {
+    if (@$prog) {
+       #print "[$prog_line] \$ ", join(' ', @$prog), " -- ";
+       my $p = [ @$prog ];
+       print "[$prog_line] \$ ", join(' ',
+             map { s/\s/\\$&/g; $_ } @$p), " -- ";
+       my $result = exec_test($prog, $in);
+       my $good = 1;
+       my $nmax = (@$out > @$result) ? @$out : @$result;
+       for (my $n=0; $n < $nmax; $n++) {
+	 if (!defined($out->[$n]) || !defined($result->[$n]) ||
+	     $out->[$n] ne $result->[$n]) {
+		 $good = 0;
+		 #chomp $out->[$n];
+		 #chomp $result->[$n];
+		 #print "$out->[$n] != $result->[$n]";
+	 }
+       }
+       $tests++;
+       $failed++ unless $good;
+       print $good ? $OK : $FAILED, "\n";
+       if (!$good) {
+         for (my $n=0; $n < $nmax; $n++) {
+	   my $l = defined($out->[$n]) ? $out->[$n] : "~";
+	   chomp $l;
+	   my $r = defined($result->[$n]) ? $result->[$n] : "~";
+	   chomp $r;
+	   print sprintf("%-37s | %-39s\n", $l, $r);
+         }
+       } elsif ($opt_v) {
+	 print join('', @$result);
+       }
+    }
+    #$prog = [ split /\s+/, $script ] if $script;
+    $prog = [ map { s/\\(.)/$1/g; $_ } split /(?<!\\)\s+/, $script ] if $script;
+    $prog_line = $line;
+    $in = [];
+    $out = [];
+  } elsif ($script =~ s/^> ?//) {
+    push @$in, $script;
+  } else {
+    push @$out, $script;
+  }
+  last unless defined($script);
+}
+my $status = sprintf("%d commands (%d passed, %d failed)",
+	$tests, $tests-$failed, $failed);
+if (isatty(fileno(STDOUT))) {
+	if ($failed) {
+		$status = "\033[31m\033[1m" . $status . "\033[m";
+	} else {
+		$status = "\033[32m" . $status . "\033[m";
+	}
+}
+print $status, "\n";
+exit $failed ? 1 : 0;
+
+sub su($) {
+  my ($user) = @_;
+
+  my ($login, $pass, $uid, $gid) = getpwnam($user)
+    or return [ "su: user $prog->[1] does not exist\n" ];
+  my @groups = ();
+  my $fh = new FileHandle("/etc/group")
+    or return [ "opening /etc/group: $!\n" ];
+  while (<$fh>) {
+    chomp;
+    my ($group, $passwd, $gid, $users) = split /:/;
+    foreach my $u (split /,/, $users) {
+      push @groups, $gid
+	if ($user eq $u);
+    }
+  }
+  $fh->close;
+
+  my $groups = join(" ", ($gid, $gid, @groups));
+  #print STDERR "[[$groups]]\n";
+  $> = 0;
+  $( = $gid;
+  $) = $groups;
+  if ($!) {
+    return [ "setgroups: $!\n" ];
+  }
+  if ($uid != 0) {
+    $> = $uid;
+    #$< = $uid;
+    if ($!) {
+      return [ "seteuid: $prog->[1]: $!\n" ];
+    }
+  }
+  #print STDERR "[($>,$<)($(,$))]";
+  return [];
+}
+
+sub exec_test($$) {
+  my ($prog, $in) = @_;
+  local (*IN, *IN_DUP, *IN2, *OUT_DUP, *OUT, *OUT2);
+  my $needs_shell = (join('', @$prog) =~ /[|<>"'`\$]/);
+
+  if ($prog->[0] eq "umask") {
+    umask oct $prog->[1];
+    return [];
+  } elsif ($prog->[0] eq "cd") {
+    if (!chdir $prog->[1]) {
+      return [ "chdir: $prog->[1]: $!\n" ];
+    }
+    return [];
+  } elsif ($prog->[0] eq "su") {
+    return su($prog->[1]);
+  } elsif ($prog->[0] eq "seteuid") {
+    my $user = $prog->[1];
+    my ($login,$pass,$uid,$gid) = getpwnam($user) or
+      return [ "seteuid: user $prog->[1] does not exist\n" ];
+    $> = $uid;
+    if ($> != $uid) {
+      return [ "seteuid: $prog->[1]: $!\n" ];
+    }
+    return [];
+  }
+
+  pipe *IN2, *OUT
+    or die "Can't create pipe for reading: $!";
+  open *IN_DUP, "<&STDIN"
+    or *IN_DUP = undef;
+  open *STDIN, "<&IN2"
+    or die "Can't duplicate pipe for reading: $!";
+  close *IN2;
+
+  open *OUT_DUP, ">&STDOUT"
+    or die "Can't duplicate STDOUT: $!";
+  pipe *IN, *OUT2
+    or die "Can't create pipe for writing: $!";
+  open *STDOUT, ">&OUT2"
+    or die "Can't duplicate pipe for writing: $!";
+  close *OUT2;
+
+  *STDOUT->autoflush();
+  *OUT->autoflush();
+
+  if (fork()) {
+    # Server
+    if (*IN_DUP) {
+      open *STDIN, "<&IN_DUP"
+        or die "Can't duplicate STDIN: $!";
+      close *IN_DUP
+        or die "Can't close STDIN duplicate: $!";
+    }
+    open *STDOUT, ">&OUT_DUP"
+      or die "Can't duplicate STDOUT: $!";
+    close *OUT_DUP
+      or die "Can't close STDOUT duplicate: $!";
+
+    foreach my $line (@$in) {
+      #print "> $line";
+      print OUT $line;
+    }
+    close *OUT
+      or die "Can't close pipe for writing: $!";
+
+    my $result = [];
+    while (<IN>) {
+      #print "< $_";
+      if ($needs_shell) {
+	s#^/bin/sh: line \d+: ##;
+      }
+      push @$result, $_;
+    }
+    return $result;
+  } else {
+    # Client
+    $< = $>;
+    close IN
+      or die "Can't close read end for input pipe: $!";
+    close OUT
+      or die "Can't close write end for output pipe: $!";
+    close OUT_DUP
+      or die "Can't close STDOUT duplicate: $!";
+    local *ERR_DUP;
+    open ERR_DUP, ">&STDERR"
+      or die "Can't duplicate STDERR: $!";
+    open STDERR, ">&STDOUT"
+      or die "Can't join STDOUT and STDERR: $!";
+
+    #print ERR_DUP "<", join(' ', @$prog), ">\n";
+    if ($needs_shell) {
+      exec ('/bin/sh', '-c', join(" ", @$prog));
+    } else {
+      exec @$prog;
+    }
+    print ERR_DUP $prog->[0], ": $!\n";
+    exit;
+  }
+}
+