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";
30 my ($prog, $in, $out) = ([], [], []);
33 my ($tests, $failed) = (0,0);
36 my $line = <>; $line_number++;
38 # Substitute %VAR and %{VAR} with environment variables.
39 $line =~ s[%(?:(\w+)|\{(\w+)\})][$ENV{"$1$2"}]eg;
42 if ($line =~ s/^\s*< ?//) {
44 } elsif ($line =~ s/^\s*> ?//) {
47 process_test($prog, $prog_line, $in, $out);
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;
60 process_test($prog, $prog_line, $in, $out);
65 my $status = sprintf("%d commands (%d passed, %d failed)",
66 $tests, $tests-$failed, $failed);
67 if (isatty(fileno(STDOUT))) {
69 $status = "\033[31m\033[1m" . $status . "\033[m";
71 $status = "\033[32m" . $status . "\033[m";
78 sub process_test($$$$) {
79 my ($prog, $prog_line, $in, $out) = @_;
84 print "[$prog_line] \$ ", join(' ',
85 map { s/\s/\\$&/g; $_ } @$p), " -- ";
86 my $result = exec_test($prog, $in);
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]) {
96 $failed++ unless $good;
97 print $good ? $OK : $FAILED, "\n";
99 for (my $n=0; $n < $nmax; $n++) {
100 my $l = defined($out->[$n]) ? $out->[$n] : "~";
102 my $r = defined($result->[$n]) ? $result->[$n] : "~";
104 print sprintf("%-37s %s %-39s\n", $l, $l eq $r ? "|" : "?", $r);
107 print join('', @$result);
117 my ($login, $pass, $uid, $gid) = getpwnam($user)
118 or return [ "su: user $user does not exist\n" ];
120 my $fh = new FileHandle("/etc/group")
121 or return [ "opening /etc/group: $!\n" ];
124 my ($group, $passwd, $gid, $users) = split /:/;
125 foreach my $u (split /,/, $users) {
132 my $groups = join(" ", ($gid, $gid, @groups));
133 #print STDERR "[[$groups]]\n";
134 $! = 0; # reset errno
139 return [ "su: $!\n" ];
145 return [ "su: $prog->[1]: $!\n" ];
148 #print STDERR "[($>,$<)($(,$))]";
156 my $gid = getgrnam($group)
157 or return [ "sg: group $group does not exist\n" ];
158 my %groups = map { $_ eq $gid ? () : ($_ => 1) } (split /\s/, $));
160 #print STDERR "<<", join("/", keys %groups), ">>\n";
161 my $groups = join(" ", ($gid, $gid, keys %groups));
162 #print STDERR "[[$groups]]\n";
163 $! = 0; # reset errno
175 return [ "sg: $!\n" ];
177 print STDERR "[($>,$<)($(,$))]";
183 my ($prog, $in) = @_;
184 local (*IN, *IN_DUP, *IN2, *OUT_DUP, *OUT, *OUT2);
185 my $needs_shell = (join('', @$prog) =~ /[][|<>"'`\$\*\?]/);
187 if ($prog->[0] eq "umask") {
188 umask oct $prog->[1];
190 } elsif ($prog->[0] eq "cd") {
191 if (!chdir $prog->[1]) {
192 return [ "chdir: $prog->[1]: $!\n" ];
195 } elsif ($prog->[0] eq "su") {
196 return su($prog->[1]);
197 } elsif ($prog->[0] eq "sg") {
198 return sg($prog->[1]);
202 or die "Can't create pipe for reading: $!";
203 open *IN_DUP, "<&STDIN"
206 or die "Can't duplicate pipe for reading: $!";
209 open *OUT_DUP, ">&STDOUT"
210 or die "Can't duplicate STDOUT: $!";
212 or die "Can't create pipe for writing: $!";
213 open *STDOUT, ">&OUT2"
214 or die "Can't duplicate pipe for writing: $!";
217 *STDOUT->autoflush();
223 open *STDIN, "<&IN_DUP"
224 or die "Can't duplicate STDIN: $!";
226 or die "Can't close STDIN duplicate: $!";
228 open *STDOUT, ">&OUT_DUP"
229 or die "Can't duplicate STDOUT: $!";
231 or die "Can't close STDOUT duplicate: $!";
233 foreach my $line (@$in) {
238 or die "Can't close pipe for writing: $!";
244 s#^/bin/sh: line \d+: ##;
245 s#^/bin/sh: ##; # temporarily added by ericm
254 or die "Can't close read end for input pipe: $!";
256 or die "Can't close write end for output pipe: $!";
258 or die "Can't close STDOUT duplicate: $!";
260 open ERR_DUP, ">&STDERR"
261 or die "Can't duplicate STDERR: $!";
262 open STDERR, ">&STDOUT"
263 or die "Can't join STDOUT and STDERR: $!";
266 exec ('/bin/sh', '-c', join(" ", @$prog));
270 print STDERR $prog->[0], ": $!\n";