Commit | Line | Data |
fe14fcc3 |
1 | #!./perl |
2 | |
0f4592ef |
3 | $ENV{PATH} = '/usr/xpg4/bin:/bin:/usr/bin:/usr/ucb'; |
b9416812 |
4 | |
d0f88fcc |
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. |
98cfb1fc |
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=... |
d0f88fcc |
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 '') { |
98cfb1fc |
29 | # Grok format soon. |
30 | last GROUPS; |
d0f88fcc |
31 | } |
32 | # Okay, not today. |
fe14fcc3 |
33 | print "1..0\n"; |
34 | exit 0; |
35 | } |
36 | |
98cfb1fc |
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 | |
988174c1 |
56 | print "1..2\n"; |
57 | |
58 | $pwgid = $( + 0; |
59 | ($pwgnam) = getgrgid($pwgid); |
60 | @basegroup{$pwgid,$pwgnam} = (1,1); |
61 | |
62 | $seen{$pwgid}++; |
fe14fcc3 |
63 | |
64 | for (split(' ', $()) { |
65 | next if $seen{$_}++; |
6e21c824 |
66 | ($group) = getgrgid($_); |
67 | if (defined $group) { |
68 | push(@gr, $group); |
69 | } |
70 | else { |
71 | push(@gr, $_); |
72 | } |
fe14fcc3 |
73 | } |
988174c1 |
74 | |
b9416812 |
75 | if ($^O eq "uwin") { # Or anybody else who can have spaces in group names. |
72720e3c |
76 | $gr1 = join(' ', grep(!$did{$_}++, sort split(' ', join(' ', @gr)))); |
77 | } else { |
78 | $gr1 = join(' ', sort @gr); |
79 | } |
988174c1 |
80 | |
b9416812 |
81 | $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups))); |
988174c1 |
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 | } |