diff options
Diffstat (limited to 'test/run')
| -rw-r--r-- | test/run | 145 |
1 files changed, 145 insertions, 0 deletions
diff --git a/test/run b/test/run new file mode 100644 index 0000000..b545a53 --- /dev/null +++ b/test/run @@ -0,0 +1,145 @@ +#!/usr/bin/perl + +use strict; +use FileHandle; +use POSIX qw(geteuid getegid isatty); + +my $owner = getpwuid(geteuid()); +my $group = getgrgid(getegid()); + +my ($OK, $FAILED) = ("ok", "failed"); +if (isatty(fileno(STDOUT))) { + $OK = "\033[32m" . $OK . "\033[m"; + $FAILED = "\033[31m\033[1m" . $FAILED . "\033[m"; +} + +my ($prog, $in, $out) = ([], [], []); +my $line = 0; +my $prog_line; +for (;;) { + my $script = <>; $line++; + $script =~ s/\@OWNER\@/$owner/g; + $script =~ s/\@GROUP\@/$group/g; + 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]"; + } + } + 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); + } + } + } + #$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); +} + +sub exec_test($$) { + my ($prog, $in) = @_; + local (*IN, *IN_DUP, *IN2, *OUT_DUP, *OUT, *OUT2); + + 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 []; + } + + 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 "< $_"; + 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"; + exec @$prog; + print ERR_DUP $prog->[0], ": $!\n"; + exit; + } +} + |