test/run: Drop support for su and sg

The su and sg commands can only work if running as root. The quilt
test cases do not use these commands and I certainly wouldn't
recommend running the test suite as root, so drop the feature.

2 files changed, 2 insertions, 77 deletions

diff --git a/quilt.changes b/quilt.changes
index 94a976c..ffba039 100644
--- a/quilt.changes
+++ b/quilt.changes
@@ -3,6 +3,7 @@ Wed Feb 12 20:57:35 CET 2014 - jdelvare@suse.de
 
 - test/run: Delay command line splitting.
 - test/run: Use perl module Text::ParseWords.
+- test/run: Drop support for su and sg.
 
 -------------------------------------------------------------------
 Mon Feb 10 13:07:14 CET 2014 - jdelvare@suse.de
diff --git a/test/run b/test/run
index 920e8bc..ecfea0e 100755
--- a/test/run
+++ b/test/run
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w -U
+#!/usr/bin/perl -w
 
 # Copyright (c) 2007, 2008 Andreas Gruenbacher.
 # All rights reserved.
@@ -51,8 +51,6 @@ use POSIX qw(isatty setuid getcwd);
 use Text::ParseWords;
 use vars qw($opt_l $opt_q $opt_v %output);
 
-no warnings qw(taint);
-
 $opt_l = ~0;  # a really huge number
 getopts('l:qv');
 
@@ -195,76 +193,6 @@ sub process_test($$$$) {
 }
 
 
-sub su($) {
-  my ($user) = @_;
-
-  $user ||= "root";
-
-  my ($login, $pass, $uid, $gid) = getpwnam($user)
-    or return 1, [ "su: user $user does not exist\n" ];
-  my @groups = ();
-  my $fh = new FileHandle("/etc/group")
-    or return 1, [ "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 1, [ "su: $!\n" ];
-  }
-  if ($uid != 0) {
-    $> = $uid;
-    #$< = $uid;
-    if ($!) {
-      return 1, [ "su: $prog->[1]: $!\n" ];
-    }
-  }
-  #print STDERR "[($>,$<)($(,$))]";
-  return 0, [];
-}
-
-
-sub sg($) {
-  my ($group) = @_;
-
-  my $gid = getgrnam($group)
-    or return 1, [ "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 1, [ "sg: $!\n" ];
-  }
-  print STDERR "[($>,$<)($(,$))]";
-  return 0, [];
-}
-
-
 sub exec_test($$) {
   my ($raw_prog, $in) = @_;
   local (*IN, *IN_DUP, *IN2, *OUT_DUP, *OUT, *OUT2);
@@ -280,10 +208,6 @@ sub exec_test($$) {
     }
     $ENV{PWD} = getcwd;
     return 0, [];
-  } 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];
     $ENV{$name} = $value;