t/op/groups.t

   1 #!./perl
   2
   3 $ENV{PATH} = '/usr/xpg4/bin:/bin:/usr/bin:/usr/ucb';
   4
   5 # We have to find a command that prints all (effective
   6 # and real) group names (not ids).  The known commands are:
   7 # groups
   8 # id -Gn
   9 # id -a
  10 # Beware 1: some systems do just 'id -G' even when 'id -Gn' is used.
  11 # Beware 2: the 'id -a' output format is tricky.
  12
  13 GROUPS: {
  14     last GROUPS if ($groups = `groups 2>/dev/null`) ne '';
  15     if ($groups = `id -Gn 2>/dev/null` ne '') {
  16         last GROUPS unless $groups =~ /^(\d+)(\s+\d)*$/;
  17     }
  18     if ($groups = `id -a 2>/dev/null` ne '') {
  19         if (/groups=/g && (@g = /\((.+?)\)/g)) {
  20             $groups = join(" ", @g);
  21             last GROUPS;
  22         }
  23     }
  24     # Okay, not today.
  25     print "1..0\n";
  26     exit 0;
  27 }
  28
  29 print "1..2\n";
  30
  31 $pwgid = $( + 0;
  32 ($pwgnam) = getgrgid($pwgid);
  33 @basegroup{$pwgid,$pwgnam} = (1,1);
  34
  35 $seen{$pwgid}++;
  36
  37 for (split(' ', $()) {
  38     next if $seen{$_}++;
  39     ($group) = getgrgid($_);
  40     if (defined $group) {
  41         push(@gr, $group);
  42     }
  43     else {
  44         push(@gr, $_);
  45     }
  46 }
  47
  48 if ($^O eq "uwin") { # Or anybody else who can have spaces in group names.
  49         $gr1 = join(' ', grep(!$did{$_}++, sort split(' ', join(' ', @gr))));
  50 } else {
  51         $gr1 = join(' ', sort @gr);
  52 }
  53
  54 $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups)));
  55
  56 if ($gr1 eq $gr2) {
  57     print "ok 1\n";
  58 }
  59 else {
  60     print "#gr1 is <$gr1>\n";
  61     print "#gr2 is <$gr2>\n";
  62     print "not ok 1\n";
  63 }
  64
  65 # multiple 0's indicate GROUPSTYPE is currently long but should be short
  66
  67 if ($pwgid == 0 || $seen{0} < 2) {
  68     print "ok 2\n";
  69 }
  70 else {
  71     print "not ok 2 (groupstype should be type short, not long)\n";
  72 }