#! /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;
}
}