#!./perl
-$ENV{PATH} = '/bin:/usr/bin:/usr/xpg4/bin:/usr/ucb';
+$ENV{PATH} ="/bin:/usr/bin:/usr/xpg4/bin:/usr/ucb" .
+ exists $ENV{PATH} ? ":$ENV{PATH}" : "" unless $^O eq 'VMS';
+$ENV{LC_ALL} = "C"; # so that external utilities speak English
+$ENV{LANGUAGE} = 'C'; # GNU locale extension
+
+BEGIN {
+ chdir 't';
+ @INC = '../lib';
+
+ require Config;
+ if ($@) {
+ print "1..0 # Skip: no Config\n";
+ } else {
+ Config->import;
+ }
+}
+
+sub quit {
+ print "1..0 # Skip: no `id` or `groups`\n";
+ exit 0;
+}
+
+unless (eval { getgrgid(0); 1 }) {
+ print "1..0 # Skip: getgrgid() not implemented\n";
+ exit 0;
+}
+
+quit() if (($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS')
+ or $^O =~ /lynxos/i);
# We have to find a command that prints all (effective
# and real) group names (not ids). The known commands are:
if (($groups = `id -a 2>/dev/null`) ne '') {
# $groups is of the form:
# uid=39957(gsar) gid=22(users) groups=33536,39181,22(users),0(root),1067(dev)
+ # FreeBSD since 6.2 has a fake id -a:
+ # uid=1001(tobez) gid=20(staff) groups=20(staff), 0(wheel), 68(dialer)
last GROUPS if $groups =~ /groups=/;
}
if (($groups = `id -Gn 2>/dev/null`) ne '') {
#
# If these tests fail, report the particular incantation you use
# on this platform to find *all* the groups that an arbitrary
-# luser may belong to, using the 'perlbug' program.
+# user may belong to, using the 'perlbug' program.
EOM
}
last GROUPS;
}
# Okay, not today.
- print "1..0\n";
- exit 0;
+ quit();
}
+chomp($groups);
+
+print "# groups = $groups\n";
+
# Remember that group names can contain whitespace, '-', et cetera.
# That is: do not \w, do not \S.
if ($groups =~ /groups=(.+)( [ug]id=|$)/) {
my $gr = $1;
- my @g0 = split /,/, $gr;
+ my @g0 = split /, ?/, $gr;
my @g1;
# prefer names over numbers
for (@g0) {
- # 42(zot me)
- if (/^(\d+)(?:\(([^)]+)\))?$/) {
+ # 42(zot me)
+ if (/^(\d+)(?:\(([^)]+)\))?/) {
push @g1, ($2 || $1);
}
- # zot me(42)
- elsif (/^([^(]*)\((\d+)\)$/) {
+ # zot me(42)
+ elsif (/^([^(]*)\((\d+)\)/) {
push @g1, ($1 || $2);
}
else {
$pwgid = $( + 0;
($pwgnam) = getgrgid($pwgid);
-@basegroup{$pwgid,$pwgnam} = (1,1);
-
$seen{$pwgid}++;
+print "# pwgid = $pwgid, pwgnam = $pwgnam\n";
+
for (split(' ', $()) {
- next if $seen{$_}++;
($group) = getgrgid($_);
+ next if (! defined $group or ! grep { $_ eq $group } @gr) and $seen{$_}++;
if (defined $group) {
push(@gr, $group);
}
else {
push(@gr, $_);
}
-}
+}
+
+print "# gr = @gr\n";
-if ($^O eq "uwin") { # Or anybody else who can have spaces in group names.
+my %did;
+if ($^O =~ /^(?:uwin|cygwin|interix|solaris|linux)$/) {
+ # Or anybody else who can have spaces in group names.
$gr1 = join(' ', grep(!$did{$_}++, sort split(' ', join(' ', @gr))));
} else {
- $gr1 = join(' ', sort @gr);
+ # Don't assume that there aren't duplicate groups
+ $gr1 = join(' ', sort grep defined $_ && !$did{$_}++, @gr);
}
+if ($Config{myuname} =~ /^cygwin_nt/i) { # basegroup on CYGWIN_NT has id = 0.
+ @basegroup{$pwgid,$pwgnam} = (0,0);
+} else {
+ @basegroup{$pwgid,$pwgnam} = (1,1);
+}
$gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups)));
-if ($gr1 eq $gr2) {
+my $ok1 = 0;
+if ($gr1 eq $gr2 || ($gr1 eq '' && $gr2 eq $pwgid)) {
print "ok 1\n";
+ $ok1++;
}
-else {
+elsif ($Config{myuname} =~ /^cygwin_nt/i) { # basegroup on CYGWIN_NT has id = 0.
+ # Retry in default unix mode
+ %basegroup = ( $pwgid => 1, $pwgnam => 1 );
+ $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups)));
+ if ($gr1 eq $gr2 || ($gr1 eq '' && $gr2 eq $pwgid)) {
+ print "ok 1 # This Cygwin behaves like Unix (Win2k?)\n";
+ $ok1++;
+ }
+}
+unless ($ok1) {
print "#gr1 is <$gr1>\n";
print "#gr2 is <$gr2>\n";
print "not ok 1\n";