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