summaryrefslogtreecommitdiffstats
path: root/sbin/mdconfig/tests/run.pl
diff options
context:
space:
mode:
Diffstat (limited to 'sbin/mdconfig/tests/run.pl')
-rw-r--r--sbin/mdconfig/tests/run.pl329
1 files changed, 0 insertions, 329 deletions
diff --git a/sbin/mdconfig/tests/run.pl b/sbin/mdconfig/tests/run.pl
deleted file mode 100644
index 383f47e..0000000
--- a/sbin/mdconfig/tests/run.pl
+++ /dev/null
@@ -1,329 +0,0 @@
-#!/usr/bin/perl -w -U
-
-# Copyright (c) 2007, 2008 Andreas Gruenbacher.
-# All rights reserved.
-#
-# Redistribution and use in source and binary forms, with or without
-# modification, are permitted provided that the following conditions
-# are met:
-# 1. Redistributions of source code must retain the above copyright
-# notice, this list of conditions, and the following disclaimer,
-# without modification, immediately at the beginning of the file.
-# 2. The name of the author may not be used to endorse or promote products
-# derived from this software without specific prior written permission.
-#
-# Alternatively, this software may be distributed under the terms of the
-# GNU Public License ("GPL").
-#
-# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
-# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR
-# ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-# SUCH DAMAGE.
-#
-# $FreeBSD$
-#
-
-#
-# 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*\$ ?//) {
- $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();
-
- $SIG{CHLD} = 'IGNORE';
-
- 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;
- }
-}
-
OpenPOWER on IntegriCloud