1185304Strasz#!/usr/bin/perl -w -U 2185304Strasz 3185304Strasz# Copyright (c) 2007, 2008 Andreas Gruenbacher. 4185304Strasz# All rights reserved. 5185304Strasz# 6185304Strasz# Redistribution and use in source and binary forms, with or without 7185304Strasz# modification, are permitted provided that the following conditions 8185304Strasz# are met: 9185304Strasz# 1. Redistributions of source code must retain the above copyright 10185304Strasz# notice, this list of conditions, and the following disclaimer, 11185304Strasz# without modification, immediately at the beginning of the file. 12185304Strasz# 2. The name of the author may not be used to endorse or promote products 13185304Strasz# derived from this software without specific prior written permission. 14185304Strasz# 15185304Strasz# Alternatively, this software may be distributed under the terms of the 16185304Strasz# GNU Public License ("GPL"). 17185304Strasz# 18185304Strasz# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 19185304Strasz# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20185304Strasz# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21185304Strasz# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR 22185304Strasz# ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23185304Strasz# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 24185304Strasz# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 25185304Strasz# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 26185304Strasz# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 27185304Strasz# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 28185304Strasz# SUCH DAMAGE. 29185304Strasz# 30185304Strasz# $FreeBSD$ 31185304Strasz# 32185304Strasz 33185304Strasz# 34185304Strasz# Possible improvements: 35185304Strasz# 36185304Strasz# - distinguish stdout and stderr output 37185304Strasz# - add environment variable like assignments 38185304Strasz# - run up to a specific line 39185304Strasz# - resume at a specific line 40185304Strasz# 41185304Strasz 42185304Straszuse strict; 43185304Straszuse FileHandle; 44185304Straszuse Getopt::Std; 45185304Straszuse POSIX qw(isatty setuid getcwd); 46185304Straszuse vars qw($opt_l $opt_v); 47185304Strasz 48185304Straszno warnings qw(taint); 49185304Strasz 50185304Strasz$opt_l = ~0; # a really huge number 51185304Straszgetopts('l:v'); 52185304Strasz 53185304Straszmy ($OK, $FAILED) = ("ok", "failed"); 54185304Straszif (isatty(fileno(STDOUT))) { 55185304Strasz $OK = "\033[32m" . $OK . "\033[m"; 56185304Strasz $FAILED = "\033[31m\033[1m" . $FAILED . "\033[m"; 57185304Strasz} 58185304Strasz 59185304Straszsub exec_test($$); 60185304Straszsub process_test($$$$); 61185304Strasz 62185304Straszmy ($prog, $in, $out) = ([], [], []); 63185304Straszmy $prog_line = 0; 64185304Straszmy ($tests, $failed) = (0,0); 65185304Straszmy $lineno; 66185304Straszmy $width = ($ENV{COLUMNS} || 80) >> 1; 67185304Strasz 68185304Straszfor (;;) { 69185304Strasz my $line = <>; $lineno++; 70185304Strasz if (defined $line) { 71185304Strasz # Substitute %VAR and %{VAR} with environment variables. 72185304Strasz $line =~ s[%(\w+)][$ENV{$1}]eg; 73185304Strasz $line =~ s[%{(\w+)}][$ENV{$1}]eg; 74185304Strasz } 75185304Strasz if (defined $line) { 76185304Strasz if ($line =~ s/^\s*< ?//) { 77185304Strasz push @$in, $line; 78185304Strasz } elsif ($line =~ s/^\s*> ?//) { 79185304Strasz push @$out, $line; 80185304Strasz } else { 81185304Strasz process_test($prog, $prog_line, $in, $out); 82185304Strasz last if $prog_line >= $opt_l; 83185304Strasz 84185304Strasz $prog = []; 85185304Strasz $prog_line = 0; 86185304Strasz } 87185304Strasz if ($line =~ s/^\s*\$ ?//) { 88185304Strasz $prog = [ map { s/\\(.)/$1/g; $_ } split /(?<!\\)\s+/, $line ]; 89185304Strasz $prog_line = $lineno; 90185304Strasz $in = []; 91185304Strasz $out = []; 92185304Strasz } 93185304Strasz } else { 94185304Strasz process_test($prog, $prog_line, $in, $out); 95185304Strasz last; 96185304Strasz } 97185304Strasz} 98185304Strasz 99185304Straszmy $status = sprintf("%d commands (%d passed, %d failed)", 100185304Strasz $tests, $tests-$failed, $failed); 101185304Straszif (isatty(fileno(STDOUT))) { 102185304Strasz if ($failed) { 103185304Strasz $status = "\033[31m\033[1m" . $status . "\033[m"; 104185304Strasz } else { 105185304Strasz $status = "\033[32m" . $status . "\033[m"; 106185304Strasz } 107185304Strasz} 108185304Straszprint $status, "\n"; 109185304Straszexit $failed ? 1 : 0; 110185304Strasz 111185304Strasz 112185304Straszsub process_test($$$$) { 113185304Strasz my ($prog, $prog_line, $in, $out) = @_; 114185304Strasz 115185304Strasz return unless @$prog; 116185304Strasz 117185304Strasz my $p = [ @$prog ]; 118185304Strasz print "[$prog_line] \$ ", join(' ', 119185304Strasz map { s/\s/\\$&/g; $_ } @$p), " -- "; 120185304Strasz my $result = exec_test($prog, $in); 121185304Strasz my @good = (); 122185304Strasz my $nmax = (@$out > @$result) ? @$out : @$result; 123185304Strasz for (my $n=0; $n < $nmax; $n++) { 124185304Strasz my $use_re; 125185304Strasz if (defined $out->[$n] && $out->[$n] =~ /^~ /) { 126185304Strasz $use_re = 1; 127185304Strasz $out->[$n] =~ s/^~ //g; 128185304Strasz } 129185304Strasz 130185304Strasz if (!defined($out->[$n]) || !defined($result->[$n]) || 131185304Strasz (!$use_re && $result->[$n] ne $out->[$n]) || 132185304Strasz ( $use_re && $result->[$n] !~ /^$out->[$n]/)) { 133185304Strasz push @good, ($use_re ? '!~' : '!='); 134185304Strasz } 135185304Strasz else { 136185304Strasz push @good, ($use_re ? '=~' : '=='); 137185304Strasz } 138185304Strasz } 139185304Strasz my $good = !(grep /!/, @good); 140185304Strasz $tests++; 141185304Strasz $failed++ unless $good; 142185304Strasz print $good ? $OK : $FAILED, "\n"; 143185304Strasz if (!$good || $opt_v) { 144185304Strasz for (my $n=0; $n < $nmax; $n++) { 145185304Strasz my $l = defined($out->[$n]) ? $out->[$n] : "~"; 146185304Strasz chomp $l; 147185304Strasz my $r = defined($result->[$n]) ? $result->[$n] : "~"; 148185304Strasz chomp $r; 149185304Strasz print sprintf("%-" . ($width-3) . "s %s %s\n", 150185304Strasz $r, $good[$n], $l); 151185304Strasz } 152185304Strasz } 153185304Strasz} 154185304Strasz 155185304Strasz 156185304Straszsub su($) { 157185304Strasz my ($user) = @_; 158185304Strasz 159185304Strasz $user ||= "root"; 160185304Strasz 161185304Strasz my ($login, $pass, $uid, $gid) = getpwnam($user) 162185304Strasz or return [ "su: user $user does not exist\n" ]; 163185304Strasz my @groups = (); 164185304Strasz my $fh = new FileHandle("/etc/group") 165185304Strasz or return [ "opening /etc/group: $!\n" ]; 166185304Strasz while (<$fh>) { 167185304Strasz chomp; 168185304Strasz my ($group, $passwd, $gid, $users) = split /:/; 169185304Strasz foreach my $u (split /,/, $users) { 170185304Strasz push @groups, $gid 171185304Strasz if ($user eq $u); 172185304Strasz } 173185304Strasz } 174185304Strasz $fh->close; 175185304Strasz 176185304Strasz my $groups = join(" ", ($gid, $gid, @groups)); 177185304Strasz #print STDERR "[[$groups]]\n"; 178185304Strasz $! = 0; # reset errno 179185304Strasz $> = 0; 180185304Strasz $( = $gid; 181185304Strasz $) = $groups; 182185304Strasz if ($!) { 183185304Strasz return [ "su: $!\n" ]; 184185304Strasz } 185185304Strasz if ($uid != 0) { 186185304Strasz $> = $uid; 187185304Strasz #$< = $uid; 188185304Strasz if ($!) { 189185304Strasz return [ "su: $prog->[1]: $!\n" ]; 190185304Strasz } 191185304Strasz } 192185304Strasz #print STDERR "[($>,$<)($(,$))]"; 193185304Strasz return []; 194185304Strasz} 195185304Strasz 196185304Strasz 197185304Straszsub sg($) { 198185304Strasz my ($group) = @_; 199185304Strasz 200185304Strasz my $gid = getgrnam($group) 201185304Strasz or return [ "sg: group $group does not exist\n" ]; 202185304Strasz my %groups = map { $_ eq $gid ? () : ($_ => 1) } (split /\s/, $)); 203185304Strasz 204185304Strasz #print STDERR "<<", join("/", keys %groups), ">>\n"; 205185304Strasz my $groups = join(" ", ($gid, $gid, keys %groups)); 206185304Strasz #print STDERR "[[$groups]]\n"; 207185304Strasz $! = 0; # reset errno 208185304Strasz if ($> != 0) { 209185304Strasz my $uid = $>; 210185304Strasz $> = 0; 211185304Strasz $( = $gid; 212185304Strasz $) = $groups; 213185304Strasz $> = $uid; 214185304Strasz } else { 215185304Strasz $( = $gid; 216185304Strasz $) = $groups; 217185304Strasz } 218185304Strasz if ($!) { 219185304Strasz return [ "sg: $!\n" ]; 220185304Strasz } 221185304Strasz print STDERR "[($>,$<)($(,$))]"; 222185304Strasz return []; 223185304Strasz} 224185304Strasz 225185304Strasz 226185304Straszsub exec_test($$) { 227185304Strasz my ($prog, $in) = @_; 228185304Strasz local (*IN, *IN_DUP, *IN2, *OUT_DUP, *OUT, *OUT2); 229185304Strasz my $needs_shell = (join('', @$prog) =~ /[][|<>"'`\$\*\?]/); 230185304Strasz 231185304Strasz if ($prog->[0] eq "umask") { 232185304Strasz umask oct $prog->[1]; 233185304Strasz return []; 234185304Strasz } elsif ($prog->[0] eq "cd") { 235185304Strasz if (!chdir $prog->[1]) { 236185304Strasz return [ "chdir: $prog->[1]: $!\n" ]; 237185304Strasz } 238185304Strasz $ENV{PWD} = getcwd; 239185304Strasz return []; 240185304Strasz } elsif ($prog->[0] eq "su") { 241185304Strasz return su($prog->[1]); 242185304Strasz } elsif ($prog->[0] eq "sg") { 243185304Strasz return sg($prog->[1]); 244185304Strasz } elsif ($prog->[0] eq "export") { 245185304Strasz my ($name, $value) = split /=/, $prog->[1]; 246185304Strasz # FIXME: need to evaluate $value, so that things like this will work: 247185304Strasz # export dir=$PWD/dir 248185304Strasz $ENV{$name} = $value; 249185304Strasz return []; 250185304Strasz } elsif ($prog->[0] eq "unset") { 251185304Strasz delete $ENV{$prog->[1]}; 252185304Strasz return []; 253185304Strasz } 254185304Strasz 255185304Strasz pipe *IN2, *OUT 256185304Strasz or die "Can't create pipe for reading: $!"; 257185304Strasz open *IN_DUP, "<&STDIN" 258185304Strasz or *IN_DUP = undef; 259185304Strasz open *STDIN, "<&IN2" 260185304Strasz or die "Can't duplicate pipe for reading: $!"; 261185304Strasz close *IN2; 262185304Strasz 263185304Strasz open *OUT_DUP, ">&STDOUT" 264185304Strasz or die "Can't duplicate STDOUT: $!"; 265185304Strasz pipe *IN, *OUT2 266185304Strasz or die "Can't create pipe for writing: $!"; 267185304Strasz open *STDOUT, ">&OUT2" 268185304Strasz or die "Can't duplicate pipe for writing: $!"; 269185304Strasz close *OUT2; 270185304Strasz 271185304Strasz *STDOUT->autoflush(); 272185304Strasz *OUT->autoflush(); 273185304Strasz 274213170Strasz $SIG{CHLD} = 'IGNORE'; 275213170Strasz 276185304Strasz if (fork()) { 277185304Strasz # Server 278185304Strasz if (*IN_DUP) { 279185304Strasz open *STDIN, "<&IN_DUP" 280185304Strasz or die "Can't duplicate STDIN: $!"; 281185304Strasz close *IN_DUP 282185304Strasz or die "Can't close STDIN duplicate: $!"; 283185304Strasz } 284185304Strasz open *STDOUT, ">&OUT_DUP" 285185304Strasz or die "Can't duplicate STDOUT: $!"; 286185304Strasz close *OUT_DUP 287185304Strasz or die "Can't close STDOUT duplicate: $!"; 288185304Strasz 289185304Strasz foreach my $line (@$in) { 290185304Strasz #print "> $line"; 291185304Strasz print OUT $line; 292185304Strasz } 293185304Strasz close *OUT 294185304Strasz or die "Can't close pipe for writing: $!"; 295185304Strasz 296185304Strasz my $result = []; 297185304Strasz while (<IN>) { 298185304Strasz #print "< $_"; 299185304Strasz if ($needs_shell) { 300185304Strasz s#^/bin/sh: line \d+: ##; 301185304Strasz } 302185304Strasz push @$result, $_; 303185304Strasz } 304185304Strasz return $result; 305185304Strasz } else { 306185304Strasz # Client 307185304Strasz $< = $>; 308185304Strasz close IN 309185304Strasz or die "Can't close read end for input pipe: $!"; 310185304Strasz close OUT 311185304Strasz or die "Can't close write end for output pipe: $!"; 312185304Strasz close OUT_DUP 313185304Strasz or die "Can't close STDOUT duplicate: $!"; 314185304Strasz local *ERR_DUP; 315185304Strasz open ERR_DUP, ">&STDERR" 316185304Strasz or die "Can't duplicate STDERR: $!"; 317185304Strasz open STDERR, ">&STDOUT" 318185304Strasz or die "Can't join STDOUT and STDERR: $!"; 319185304Strasz 320185304Strasz if ($needs_shell) { 321185304Strasz exec ('/bin/sh', '-c', join(" ", @$prog)); 322185304Strasz } else { 323185304Strasz exec @$prog; 324185304Strasz } 325185304Strasz print STDERR $prog->[0], ": $!\n"; 326185304Strasz exit; 327185304Strasz } 328185304Strasz} 329185304Strasz 330