mirror of
https://github.com/linux-apfs/apfstests.git
synced 2026-05-01 15:01:44 -07:00
Tim Shimmin
841b609ec9
Merge of master-melb:xfs-cmds:32058a by kenmcd. Run all the tests in xfstests/nfs4acl
299 lines
6.8 KiB
Perl
Executable File
299 lines
6.8 KiB
Perl
Executable File
#!/usr/bin/perl -w -U
|
|
|
|
#
|
|
# Possible improvements:
|
|
#
|
|
# - distinguish stdout and stderr output
|
|
# - add environment variable like assignments
|
|
# - run up to a specific line
|
|
# - resume at a specific line
|
|
#
|
|
|
|
use strict;
|
|
use FileHandle;
|
|
use Getopt::Std;
|
|
use POSIX qw(isatty setuid getcwd);
|
|
use vars qw($opt_l $opt_v);
|
|
|
|
no warnings qw(taint);
|
|
|
|
$opt_l = ~0; # a really huge number
|
|
getopts('l:v');
|
|
|
|
my ($OK, $FAILED) = ("ok", "failed");
|
|
if (isatty(fileno(STDOUT))) {
|
|
$OK = "\033[32m" . $OK . "\033[m";
|
|
$FAILED = "\033[31m\033[1m" . $FAILED . "\033[m";
|
|
}
|
|
|
|
sub exec_test($$);
|
|
sub process_test($$$$);
|
|
|
|
my ($prog, $in, $out) = ([], [], []);
|
|
my $prog_line = 0;
|
|
my ($tests, $failed) = (0,0);
|
|
my $lineno;
|
|
my $width = ($ENV{COLUMNS} || 80) >> 1;
|
|
|
|
for (;;) {
|
|
my $line = <>; $lineno++;
|
|
if (defined $line) {
|
|
# Substitute %VAR and %{VAR} with environment variables.
|
|
$line =~ s[%(\w+)][$ENV{$1}]eg;
|
|
$line =~ s[%{(\w+)}][$ENV{$1}]eg;
|
|
}
|
|
if (defined $line) {
|
|
if ($line =~ s/^\s*< ?//) {
|
|
push @$in, $line;
|
|
} elsif ($line =~ s/^\s*> ?//) {
|
|
push @$out, $line;
|
|
} else {
|
|
process_test($prog, $prog_line, $in, $out);
|
|
last if $prog_line >= $opt_l;
|
|
|
|
$prog = [];
|
|
$prog_line = 0;
|
|
}
|
|
if ($line =~ s/^\s*\$ ?//) {
|
|
$line =~ s/\s+#.*//; # remove comments here...
|
|
$prog = [ map { s/\\(.)/$1/g; $_ } split /(?<!\\)\s+/, $line ];
|
|
$prog_line = $lineno;
|
|
$in = [];
|
|
$out = [];
|
|
}
|
|
} else {
|
|
process_test($prog, $prog_line, $in, $out);
|
|
last;
|
|
}
|
|
}
|
|
|
|
my $status = sprintf("%d commands (%d passed, %d failed)",
|
|
$tests, $tests-$failed, $failed);
|
|
if (isatty(fileno(STDOUT))) {
|
|
if ($failed) {
|
|
$status = "\033[31m\033[1m" . $status . "\033[m";
|
|
} else {
|
|
$status = "\033[32m" . $status . "\033[m";
|
|
}
|
|
}
|
|
print $status, "\n";
|
|
exit $failed ? 1 : 0;
|
|
|
|
|
|
sub process_test($$$$) {
|
|
my ($prog, $prog_line, $in, $out) = @_;
|
|
|
|
return unless @$prog;
|
|
|
|
my $p = [ @$prog ];
|
|
print "[$prog_line] \$ ", join(' ',
|
|
map { s/\s/\\$&/g; $_ } @$p), " -- ";
|
|
my $result = exec_test($prog, $in);
|
|
my @good = ();
|
|
my $nmax = (@$out > @$result) ? @$out : @$result;
|
|
for (my $n=0; $n < $nmax; $n++) {
|
|
my $use_re;
|
|
if (defined $out->[$n] && $out->[$n] =~ /^~ /) {
|
|
$use_re = 1;
|
|
$out->[$n] =~ s/^~ //g;
|
|
}
|
|
|
|
if (!defined($out->[$n]) || !defined($result->[$n]) ||
|
|
(!$use_re && $result->[$n] ne $out->[$n]) ||
|
|
( $use_re && $result->[$n] !~ /^$out->[$n]/)) {
|
|
push @good, ($use_re ? '!~' : '!=');
|
|
}
|
|
else {
|
|
push @good, ($use_re ? '=~' : '==');
|
|
}
|
|
}
|
|
my $good = !(grep /!/, @good);
|
|
$tests++;
|
|
$failed++ unless $good;
|
|
print $good ? $OK : $FAILED, "\n";
|
|
if (!$good || $opt_v) {
|
|
for (my $n=0; $n < $nmax; $n++) {
|
|
my $l = defined($out->[$n]) ? $out->[$n] : "~";
|
|
chomp $l;
|
|
my $r = defined($result->[$n]) ? $result->[$n] : "~";
|
|
chomp $r;
|
|
print sprintf("%-" . ($width-3) . "s %s %s\n",
|
|
$r, $good[$n], $l);
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub su($) {
|
|
my ($user) = @_;
|
|
|
|
$user ||= "root";
|
|
|
|
my ($login, $pass, $uid, $gid) = getpwnam($user)
|
|
or return [ "su: user $user does not exist\n" ];
|
|
my @groups = ();
|
|
my $fh = new FileHandle("/etc/group")
|
|
or return [ "opening /etc/group: $!\n" ];
|
|
while (<$fh>) {
|
|
chomp;
|
|
my ($group, $passwd, $gid, $users) = split /:/;
|
|
foreach my $u (split /,/, $users) {
|
|
push @groups, $gid
|
|
if ($user eq $u);
|
|
}
|
|
}
|
|
$fh->close;
|
|
|
|
my $groups = join(" ", ($gid, $gid, @groups));
|
|
#print STDERR "[[$groups]]\n";
|
|
$! = 0; # reset errno
|
|
$> = 0;
|
|
$( = $gid;
|
|
$) = $groups;
|
|
if ($!) {
|
|
return [ "su: $!\n" ];
|
|
}
|
|
if ($uid != 0) {
|
|
$> = $uid;
|
|
#$< = $uid;
|
|
if ($!) {
|
|
return [ "su: $prog->[1]: $!\n" ];
|
|
}
|
|
}
|
|
#print STDERR "[($>,$<)($(,$))]";
|
|
return [];
|
|
}
|
|
|
|
|
|
sub sg($) {
|
|
my ($group) = @_;
|
|
|
|
my $gid = getgrnam($group)
|
|
or return [ "sg: group $group does not exist\n" ];
|
|
my %groups = map { $_ eq $gid ? () : ($_ => 1) } (split /\s/, $));
|
|
|
|
#print STDERR "<<", join("/", keys %groups), ">>\n";
|
|
my $groups = join(" ", ($gid, $gid, keys %groups));
|
|
#print STDERR "[[$groups]]\n";
|
|
$! = 0; # reset errno
|
|
if ($> != 0) {
|
|
my $uid = $>;
|
|
$> = 0;
|
|
$( = $gid;
|
|
$) = $groups;
|
|
$> = $uid;
|
|
} else {
|
|
$( = $gid;
|
|
$) = $groups;
|
|
}
|
|
if ($!) {
|
|
return [ "sg: $!\n" ];
|
|
}
|
|
print STDERR "[($>,$<)($(,$))]";
|
|
return [];
|
|
}
|
|
|
|
|
|
sub exec_test($$) {
|
|
my ($prog, $in) = @_;
|
|
local (*IN, *IN_DUP, *IN2, *OUT_DUP, *OUT, *OUT2);
|
|
my $needs_shell = (join('', @$prog) =~ /[][|<>"'`\$\*\?]/);
|
|
|
|
if ($prog->[0] eq "umask") {
|
|
umask oct $prog->[1];
|
|
return [];
|
|
} elsif ($prog->[0] eq "cd") {
|
|
if (!chdir $prog->[1]) {
|
|
return [ "chdir: $prog->[1]: $!\n" ];
|
|
}
|
|
$ENV{PWD} = getcwd;
|
|
return [];
|
|
} elsif ($prog->[0] eq "su") {
|
|
return su($prog->[1]);
|
|
} elsif ($prog->[0] eq "sg") {
|
|
return sg($prog->[1]);
|
|
} elsif ($prog->[0] eq "export") {
|
|
my ($name, $value) = split /=/, $prog->[1];
|
|
# FIXME: need to evaluate $value, so that things like this will work:
|
|
# export dir=$PWD/dir
|
|
$ENV{$name} = $value;
|
|
return [];
|
|
} elsif ($prog->[0] eq "unset") {
|
|
delete $ENV{$prog->[1]};
|
|
return [];
|
|
}
|
|
|
|
pipe *IN2, *OUT
|
|
or die "Can't create pipe for reading: $!";
|
|
open *IN_DUP, "<&STDIN"
|
|
or *IN_DUP = undef;
|
|
open *STDIN, "<&IN2"
|
|
or die "Can't duplicate pipe for reading: $!";
|
|
close *IN2;
|
|
|
|
open *OUT_DUP, ">&STDOUT"
|
|
or die "Can't duplicate STDOUT: $!";
|
|
pipe *IN, *OUT2
|
|
or die "Can't create pipe for writing: $!";
|
|
open *STDOUT, ">&OUT2"
|
|
or die "Can't duplicate pipe for writing: $!";
|
|
close *OUT2;
|
|
|
|
*STDOUT->autoflush();
|
|
*OUT->autoflush();
|
|
|
|
if (fork()) {
|
|
# Server
|
|
if (*IN_DUP) {
|
|
open *STDIN, "<&IN_DUP"
|
|
or die "Can't duplicate STDIN: $!";
|
|
close *IN_DUP
|
|
or die "Can't close STDIN duplicate: $!";
|
|
}
|
|
open *STDOUT, ">&OUT_DUP"
|
|
or die "Can't duplicate STDOUT: $!";
|
|
close *OUT_DUP
|
|
or die "Can't close STDOUT duplicate: $!";
|
|
|
|
foreach my $line (@$in) {
|
|
#print "> $line";
|
|
print OUT $line;
|
|
}
|
|
close *OUT
|
|
or die "Can't close pipe for writing: $!";
|
|
|
|
my $result = [];
|
|
while (<IN>) {
|
|
#print "< $_";
|
|
if ($needs_shell) {
|
|
s#^/bin/sh: line \d+: ##;
|
|
}
|
|
push @$result, $_;
|
|
}
|
|
return $result;
|
|
} else {
|
|
# Client
|
|
$< = $>;
|
|
close IN
|
|
or die "Can't close read end for input pipe: $!";
|
|
close OUT
|
|
or die "Can't close write end for output pipe: $!";
|
|
close OUT_DUP
|
|
or die "Can't close STDOUT duplicate: $!";
|
|
local *ERR_DUP;
|
|
open ERR_DUP, ">&STDERR"
|
|
or die "Can't duplicate STDERR: $!";
|
|
open STDERR, ">&STDOUT"
|
|
or die "Can't join STDOUT and STDERR: $!";
|
|
|
|
if ($needs_shell) {
|
|
exec ('/bin/sh', '-c', join(" ", @$prog));
|
|
} else {
|
|
exec @$prog;
|
|
}
|
|
print STDERR $prog->[0], ": $!\n";
|
|
exit;
|
|
}
|
|
}
|
|
|