3 $ENV{PATH} = '/bin:/usr/bin:/usr/xpg4/bin:/usr/ucb';
5 # We have to find a command that prints all (effective
6 # and real) group names (not ids). The known commands are:
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)
15 # That is, we might meet the following:
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
23 # and the groups= might be after, before, or between uid=... and gid=...
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)
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)+$/;
38 if (($groups = `groups 2>/dev/null`) ne '') {
39 # may not reflect all groups in some places, so do a sanity check
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
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.
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=|$)/) {
62 my @g0 = split /,/, $gr;
64 # prefer names over numbers
67 if (/^(\d+)(?:\(([^)]+)\))?$/) {
71 elsif (/^([^(]*)\((\d+)\)$/) {
75 print "# ignoring group entry [$_]\n";
78 print "# groups=$gr\n";
87 ($pwgnam) = getgrgid($pwgid);
88 @basegroup{$pwgid,$pwgnam} = (1,1);
92 for (split(' ', $()) {
94 ($group) = getgrgid($_);
103 if ($^O eq "uwin") { # Or anybody else who can have spaces in group names.
104 $gr1 = join(' ', grep(!$did{$_}++, sort split(' ', join(' ', @gr))));
106 $gr1 = join(' ', sort @gr);
109 $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups)));
115 print "#gr1 is <$gr1>\n";
116 print "#gr2 is <$gr2>\n";
120 # multiple 0's indicate GROUPSTYPE is currently long but should be short
122 if ($pwgid == 0 || $seen{0} < 2) {
126 print "not ok 2 (groupstype should be type short, not long)\n";