t/op/groups.t

   1 #!./perl
   2
   3 $ENV{PATH} = '/bin:/usr/bin:/usr/xpg4/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 # Beware 4: groups can have spaces ('id -a' being the only defense against this)
  14 #
  15 # That is, we might meet the following:
  16 #
  17 # foo bar zot                           # accept
  18 # foo 22 42 bar zot                     # accept
  19 # 1 22 42 2 3                           # reject
  20 # groups=(42),foo(1),bar(2),zot me(3)   # parse
  21 # groups=22,42,1(foo),2(bar),3(zot me)  # parse
  22 #
  23 # and the groups= might be after, before, or between uid=... and gid=...
  24
  25 GROUPS: {
  26     # prefer 'id' over 'groups' (is this ever wrong anywhere?)
  27     # and 'id -a' over 'id -Gn' (the former is good about spaces in group names)
  28     if (($groups = `id -a 2>/dev/null`) ne '') {
  29         # $groups is of the form:
  30         # uid=39957(gsar) gid=22(users) groups=33536,39181,22(users),0(root),1067(dev)
  31         last GROUPS;
  32     }
  33     if (($groups = `id -Gn 2>/dev/null`) ne '') {
  34         # $groups could be of the form:
  35         # users 33536 39181 root dev
  36         last GROUPS if $groups !~ /^(\d|\s)+$/;
  37     }
  38     if (($groups = `groups 2>/dev/null`) ne '') {
  39         # may not reflect all groups in some places, so do a sanity check
  40         if (-d '/afs') {
  41             print <<EOM;
  42 # These test results *may* be bogus, as you appear to have AFS,
  43 # and I can't find a working 'id' in your PATH (which I have set
  44 # to '$ENV{PATH}').
  45 #
  46 # If these tests fail, report the particular incantation you use
  47 # on this platform to find *all* the groups that an arbitrary
  48 # luser may belong to, using the 'perlbug' program.
  49 EOM
  50         }
  51         last GROUPS;
  52     }
  53     # Okay, not today.
  54     print "1..0\n";
  55     exit 0;
  56 }
  57
  58 # Remember that group names can contain whitespace, '-', et cetera.
  59 # That is: do not \w, do not \S.
  60 if ($groups =~ /groups=(.+)( [ug]id=|$)/) {
  61     my $gr = $1;
  62     my @g0 = split /,/, $gr;
  63     my @g1;
  64     # prefer names over numbers
  65     for (@g0) {
  66         # 42(zot me)
  67         if (/^(\d+)(?:\(([^)]+)\))?$/) {
  68             push @g1, ($2 || $1);
  69         }
  70         # zot me(42)
  71         elsif (/^([^(]*)\((\d+)\)$/) {
  72             push @g1, ($1 || $2);
  73         }
  74         else {
  75             print "# ignoring group entry [$_]\n";
  76         }
  77     }
  78     print "# groups=$gr\n";
  79     print "# g0 = @g0\n";
  80     print "# g1 = @g1\n";
  81     $groups = "@g1";
  82 }
  83
  84 print "1..2\n";
  85
  86 $pwgid = $( + 0;
  87 ($pwgnam) = getgrgid($pwgid);
  88 @basegroup{$pwgid,$pwgnam} = (1,1);
  89
  90 $seen{$pwgid}++;
  91
  92 for (split(' ', $()) {
  93     next if $seen{$_}++;
  94     ($group) = getgrgid($_);
  95     if (defined $group) {
  96         push(@gr, $group);
  97     }
  98     else {
  99         push(@gr, $_);
 100     }
 101 }
 102
 103 if ($^O eq "uwin") { # Or anybody else who can have spaces in group names.
 104         $gr1 = join(' ', grep(!$did{$_}++, sort split(' ', join(' ', @gr))));
 105 } else {
 106         $gr1 = join(' ', sort @gr);
 107 }
 108
 109 $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups)));
 110
 111 if ($gr1 eq $gr2) {
 112     print "ok 1\n";
 113 }
 114 else {
 115     print "#gr1 is <$gr1>\n";
 116     print "#gr2 is <$gr2>\n";
 117     print "not ok 1\n";
 118 }
 119
 120 # multiple 0's indicate GROUPSTYPE is currently long but should be short
 121
 122 if ($pwgid == 0 || $seen{0} < 2) {
 123     print "ok 2\n";
 124 }
 125 else {
 126     print "not ok 2 (groupstype should be type short, not long)\n";
 127 }