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