4 # Possible improvements:
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
15 use POSIX qw(isatty setuid);
18 no warnings qw(taint);
22 my ($OK, $FAILED) = ("ok", "failed");
23 if (isatty(fileno(STDOUT))) {
24 $OK = "\033[32m" . $OK . "\033[m";
25 $FAILED = "\033[31m\033[1m" . $FAILED . "\033[m";
29 sub process_test($$$$);
31 my ($prog, $in, $out) = ([], [], []);
34 my ($tests, $failed) = (0,0);
37 my $line = <>; $line_number++;
39 # Substitute %VAR and %{VAR} with environment variables.
40 $line =~ s[%(?:(\w+)|\{(\w+)\})][$ENV{"$1$2"}]eg;
43 if ($line =~ s/^\s*< ?//) {
45 } elsif ($line =~ s/^\s*> ?//) {
48 process_test($prog, $prog_line, $in, $out);
53 if ($line =~ s/^\s*\$ ?//) {
54 $line =~ s/\s+#.*//; # remove comments here...
55 $prog = [ map { s/\\(.)/$1/g; $_ } split /(?<!\\)\s+/, $line ];
56 $prog_line = $line_number;
61 process_test($prog, $prog_line, $in, $out);
66 my $status = sprintf("%d commands (%d passed, %d failed)",
67 $tests, $tests-$failed, $failed);
68 if (isatty(fileno(STDOUT))) {
70 $status = "\033[31m\033[1m" . $status . "\033[m";
72 $status = "\033[32m" . $status . "\033[m";
79 sub process_test($$$$) {
80 my ($prog, $prog_line, $in, $out) = @_;
85 print "[$prog_line] \$ ", join(' ',
86 map { s/\s/\\$&/g; $_ } @$p), " -- ";
87 my $result = exec_test($prog, $in);
89 my $nmax = (@$out > @$result) ? @$out : @$result;
90 for (my $n=0; $n < $nmax; $n++) {
91 if (!defined($out->[$n]) || !defined($result->[$n]) ||
92 $out->[$n] ne $result->[$n]) {
97 $failed++ unless $good;
98 print $good ? $OK : $FAILED, "\n";
100 for (my $n=0; $n < $nmax; $n++) {
101 my $l = defined($out->[$n]) ? $out->[$n] : "~";
103 my $r = defined($result->[$n]) ? $result->[$n] : "~";
105 print sprintf("%-37s %s %-39s\n", $l, $l eq $r ? "|" : "?", $r);
108 print join('', @$result);
118 my ($login, $pass, $uid, $gid) = getpwnam($user)
119 or return [ "su: user $user does not exist\n" ];
121 my $fh = new FileHandle("/etc/group")
122 or return [ "opening /etc/group: $!\n" ];
125 my ($group, $passwd, $gid, $users) = split /:/;
126 foreach my $u (split /,/, $users) {
133 my $groups = join(" ", ($gid, $gid, @groups));
134 #print STDERR "[[$groups]]\n";
135 $! = 0; # reset errno
140 return [ "su: $!\n" ];
146 return [ "su: $prog->[1]: $!\n" ];
149 #print STDERR "[($>,$<)($(,$))]";
157 my $gid = getgrnam($group)
158 or return [ "sg: group $group does not exist\n" ];
159 my %groups = map { $_ eq $gid ? () : ($_ => 1) } (split /\s/, $));
161 #print STDERR "<<", join("/", keys %groups), ">>\n";
162 my $groups = join(" ", ($gid, $gid, keys %groups));
163 #print STDERR "[[$groups]]\n";
164 $! = 0; # reset errno
176 return [ "sg: $!\n" ];
178 print STDERR "[($>,$<)($(,$))]";
184 my ($prog, $in) = @_;
185 local (*IN, *IN_DUP, *IN2, *OUT_DUP, *OUT, *OUT2);
186 my $needs_shell = (join('', @$prog) =~ /[][|<>"'`\$\*\?]/);
188 if ($prog->[0] eq "umask") {
189 umask oct $prog->[1];
191 } elsif ($prog->[0] eq "cd") {
192 if (!chdir $prog->[1]) {
193 return [ "chdir: $prog->[1]: $!\n" ];
196 } elsif ($prog->[0] eq "su") {
197 return su($prog->[1]);
198 } elsif ($prog->[0] eq "sg") {
199 return sg($prog->[1]);
203 or die "Can't create pipe for reading: $!";
204 open *IN_DUP, "<&STDIN"
207 or die "Can't duplicate pipe for reading: $!";
210 open *OUT_DUP, ">&STDOUT"
211 or die "Can't duplicate STDOUT: $!";
213 or die "Can't create pipe for writing: $!";
214 open *STDOUT, ">&OUT2"
215 or die "Can't duplicate pipe for writing: $!";
218 *STDOUT->autoflush();
224 open *STDIN, "<&IN_DUP"
225 or die "Can't duplicate STDIN: $!";
227 or die "Can't close STDIN duplicate: $!";
229 open *STDOUT, ">&OUT_DUP"
230 or die "Can't duplicate STDOUT: $!";
232 or die "Can't close STDOUT duplicate: $!";
234 foreach my $line (@$in) {
239 or die "Can't close pipe for writing: $!";
245 s#^/bin/sh: line \d+: ##;
246 s#^/bin/sh: ##; # temporarily added by ericm
255 or die "Can't close read end for input pipe: $!";
257 or die "Can't close write end for output pipe: $!";
259 or die "Can't close STDOUT duplicate: $!";
261 open ERR_DUP, ">&STDERR"
262 or die "Can't duplicate STDERR: $!";
263 open STDERR, ">&STDOUT"
264 or die "Can't join STDOUT and STDERR: $!";
267 exec ('/bin/sh', '-c', join(" ", @$prog));
271 print STDERR $prog->[0], ": $!\n";