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: id -Gn or id -a format might be id(name) or name(id).
  12 # Beware 3: the groups= might be anywhere in the id output.
  13 #
  14 # That is, we might meet the following:
  15 #
  16 # foo bar zot                   # accept
  17 # 1 2 3                         # reject
  18 # groups=foo(1),bar(2),zot(3)   # parse
  19 # groups=1(foo),2(bar),3(zot)   # parse
  20 #
  21 # and the groups= might be after, before, or between uid=... and gid=...
  22
  23 GROUPS: {
  24     last GROUPS if ($groups = `groups 2>/dev/null`) ne '';
  25     if ($groups = `id -Gn 2>/dev/null` ne '') {
  26         last GROUPS unless $groups =~ /^(\d+)(\s+\d)*$/;
  27     }
  28     if ($groups = `id -a 2>/dev/null` ne '') {
  29         # Grok format soon.
  30         last GROUPS;
  31     }
  32     # Okay, not today.
  33     print "1..0\n";
  34     exit 0;
  35 }
  36
  37 # Remember that group names can contain whitespace, '-', et cetera.
  38 # That is: do not \w, do not \S.
  39 if ($groups =~ /groups=((.+?\(.+?\))(,.+?\(.+?\))*)( [ug]id=|$)/) {
  40     my $gr = $1;
  41     my @g0 = $gr =~ /(.+?)\((.+?)\),?/g;
  42     my @g1 = @g0[ map { $_ * 2     } 0..$#g0/2 ];
  43     my @g2 = @g0[ map { $_ * 2 + 1 } 0..$#g0/2 ];
  44     print "# g0 = @g0\n";
  45     print "# g1 = @g1\n";
  46     print "# g2 = @g2\n";
  47     if (grep /\D/, @g1) {
  48         $groups = join(" ", @g1);
  49     } elsif (grep /\D/, @g2) {
  50         $groups = join(" ", @g2);
  51     } else {
  52         # Let's fail.  We want to parse the output.  Really.
  53     }
  54 }
  55
  56 print "1..2\n";
  57
  58 $pwgid = $( + 0;
  59 ($pwgnam) = getgrgid($pwgid);
  60 @basegroup{$pwgid,$pwgnam} = (1,1);
  61
  62 $seen{$pwgid}++;
  63
  64 for (split(' ', $()) {
  65     next if $seen{$_}++;
  66     ($group) = getgrgid($_);
  67     if (defined $group) {
  68         push(@gr, $group);
  69     }
  70     else {
  71         push(@gr, $_);
  72     }
  73 }
  74
  75 if ($^O eq "uwin") { # Or anybody else who can have spaces in group names.
  76         $gr1 = join(' ', grep(!$did{$_}++, sort split(' ', join(' ', @gr))));
  77 } else {
  78         $gr1 = join(' ', sort @gr);
  79 }
  80
  81 $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups)));
  82
  83 if ($gr1 eq $gr2) {
  84     print "ok 1\n";
  85 }
  86 else {
  87     print "#gr1 is <$gr1>\n";
  88     print "#gr2 is <$gr2>\n";
  89     print "not ok 1\n";
  90 }
  91
  92 # multiple 0's indicate GROUPSTYPE is currently long but should be short
  93
  94 if ($pwgid == 0 || $seen{0} < 2) {
  95     print "ok 2\n";
  96 }
  97 else {
  98     print "not ok 2 (groupstype should be type short, not long)\n";
  99 }