1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gate$ENV{PATH} ="/bin:/usr/bin:/usr/xpg4/bin:/usr/ucb" . 4*0Sstevel@tonic-gate exists $ENV{PATH} ? ":$ENV{PATH}" : ""; 5*0Sstevel@tonic-gate$ENV{LC_ALL} = "C"; # so that external utilities speak English 6*0Sstevel@tonic-gate$ENV{LANGUAGE} = 'C'; # GNU locale extension 7*0Sstevel@tonic-gate 8*0Sstevel@tonic-gateBEGIN { 9*0Sstevel@tonic-gate chdir 't'; 10*0Sstevel@tonic-gate @INC = '../lib'; 11*0Sstevel@tonic-gate 12*0Sstevel@tonic-gate require Config; 13*0Sstevel@tonic-gate if ($@) { 14*0Sstevel@tonic-gate print "1..0 # Skip: no Config\n"; 15*0Sstevel@tonic-gate } else { 16*0Sstevel@tonic-gate Config->import; 17*0Sstevel@tonic-gate } 18*0Sstevel@tonic-gate} 19*0Sstevel@tonic-gate 20*0Sstevel@tonic-gatesub quit { 21*0Sstevel@tonic-gate print "1..0 # Skip: no `id` or `groups`\n"; 22*0Sstevel@tonic-gate exit 0; 23*0Sstevel@tonic-gate} 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gateunless (eval { getgrgid(0); 1 }) { 26*0Sstevel@tonic-gate print "1..0 # Skip: getgrgid() not implemented\n"; 27*0Sstevel@tonic-gate exit 0; 28*0Sstevel@tonic-gate} 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gatequit() if (($^O eq 'MSWin32' || $^O eq 'NetWare') or $^O =~ /lynxos/i); 31*0Sstevel@tonic-gate 32*0Sstevel@tonic-gate# We have to find a command that prints all (effective 33*0Sstevel@tonic-gate# and real) group names (not ids). The known commands are: 34*0Sstevel@tonic-gate# groups 35*0Sstevel@tonic-gate# id -Gn 36*0Sstevel@tonic-gate# id -a 37*0Sstevel@tonic-gate# Beware 1: some systems do just 'id -G' even when 'id -Gn' is used. 38*0Sstevel@tonic-gate# Beware 2: id -Gn or id -a format might be id(name) or name(id). 39*0Sstevel@tonic-gate# Beware 3: the groups= might be anywhere in the id output. 40*0Sstevel@tonic-gate# Beware 4: groups can have spaces ('id -a' being the only defense against this) 41*0Sstevel@tonic-gate# Beware 5: id -a might not contain the groups= part. 42*0Sstevel@tonic-gate# 43*0Sstevel@tonic-gate# That is, we might meet the following: 44*0Sstevel@tonic-gate# 45*0Sstevel@tonic-gate# foo bar zot # accept 46*0Sstevel@tonic-gate# foo 22 42 bar zot # accept 47*0Sstevel@tonic-gate# 1 22 42 2 3 # reject 48*0Sstevel@tonic-gate# groups=(42),foo(1),bar(2),zot me(3) # parse 49*0Sstevel@tonic-gate# groups=22,42,1(foo),2(bar),3(zot me) # parse 50*0Sstevel@tonic-gate# 51*0Sstevel@tonic-gate# and the groups= might be after, before, or between uid=... and gid=... 52*0Sstevel@tonic-gate 53*0Sstevel@tonic-gateGROUPS: { 54*0Sstevel@tonic-gate # prefer 'id' over 'groups' (is this ever wrong anywhere?) 55*0Sstevel@tonic-gate # and 'id -a' over 'id -Gn' (the former is good about spaces in group names) 56*0Sstevel@tonic-gate if (($groups = `id -a 2>/dev/null`) ne '') { 57*0Sstevel@tonic-gate # $groups is of the form: 58*0Sstevel@tonic-gate # uid=39957(gsar) gid=22(users) groups=33536,39181,22(users),0(root),1067(dev) 59*0Sstevel@tonic-gate last GROUPS if $groups =~ /groups=/; 60*0Sstevel@tonic-gate } 61*0Sstevel@tonic-gate if (($groups = `id -Gn 2>/dev/null`) ne '') { 62*0Sstevel@tonic-gate # $groups could be of the form: 63*0Sstevel@tonic-gate # users 33536 39181 root dev 64*0Sstevel@tonic-gate last GROUPS if $groups !~ /^(\d|\s)+$/; 65*0Sstevel@tonic-gate } 66*0Sstevel@tonic-gate if (($groups = `groups 2>/dev/null`) ne '') { 67*0Sstevel@tonic-gate # may not reflect all groups in some places, so do a sanity check 68*0Sstevel@tonic-gate if (-d '/afs') { 69*0Sstevel@tonic-gate print <<EOM; 70*0Sstevel@tonic-gate# These test results *may* be bogus, as you appear to have AFS, 71*0Sstevel@tonic-gate# and I can't find a working 'id' in your PATH (which I have set 72*0Sstevel@tonic-gate# to '$ENV{PATH}'). 73*0Sstevel@tonic-gate# 74*0Sstevel@tonic-gate# If these tests fail, report the particular incantation you use 75*0Sstevel@tonic-gate# on this platform to find *all* the groups that an arbitrary 76*0Sstevel@tonic-gate# user may belong to, using the 'perlbug' program. 77*0Sstevel@tonic-gateEOM 78*0Sstevel@tonic-gate } 79*0Sstevel@tonic-gate last GROUPS; 80*0Sstevel@tonic-gate } 81*0Sstevel@tonic-gate # Okay, not today. 82*0Sstevel@tonic-gate quit(); 83*0Sstevel@tonic-gate} 84*0Sstevel@tonic-gate 85*0Sstevel@tonic-gatechomp($groups); 86*0Sstevel@tonic-gate 87*0Sstevel@tonic-gateprint "# groups = $groups\n"; 88*0Sstevel@tonic-gate 89*0Sstevel@tonic-gate# Remember that group names can contain whitespace, '-', et cetera. 90*0Sstevel@tonic-gate# That is: do not \w, do not \S. 91*0Sstevel@tonic-gateif ($groups =~ /groups=(.+)( [ug]id=|$)/) { 92*0Sstevel@tonic-gate my $gr = $1; 93*0Sstevel@tonic-gate my @g0 = split /,/, $gr; 94*0Sstevel@tonic-gate my @g1; 95*0Sstevel@tonic-gate # prefer names over numbers 96*0Sstevel@tonic-gate for (@g0) { 97*0Sstevel@tonic-gate # 42(zot me) 98*0Sstevel@tonic-gate if (/^(\d+)(?:\(([^)]+)\))?/) { 99*0Sstevel@tonic-gate push @g1, ($2 || $1); 100*0Sstevel@tonic-gate } 101*0Sstevel@tonic-gate # zot me(42) 102*0Sstevel@tonic-gate elsif (/^([^(]*)\((\d+)\)/) { 103*0Sstevel@tonic-gate push @g1, ($1 || $2); 104*0Sstevel@tonic-gate } 105*0Sstevel@tonic-gate else { 106*0Sstevel@tonic-gate print "# ignoring group entry [$_]\n"; 107*0Sstevel@tonic-gate } 108*0Sstevel@tonic-gate } 109*0Sstevel@tonic-gate print "# groups=$gr\n"; 110*0Sstevel@tonic-gate print "# g0 = @g0\n"; 111*0Sstevel@tonic-gate print "# g1 = @g1\n"; 112*0Sstevel@tonic-gate $groups = "@g1"; 113*0Sstevel@tonic-gate} 114*0Sstevel@tonic-gate 115*0Sstevel@tonic-gateprint "1..2\n"; 116*0Sstevel@tonic-gate 117*0Sstevel@tonic-gate$pwgid = $( + 0; 118*0Sstevel@tonic-gate($pwgnam) = getgrgid($pwgid); 119*0Sstevel@tonic-gate$seen{$pwgid}++; 120*0Sstevel@tonic-gate 121*0Sstevel@tonic-gateprint "# pwgid = $pwgid, pwgnam = $pwgnam\n"; 122*0Sstevel@tonic-gate 123*0Sstevel@tonic-gatefor (split(' ', $()) { 124*0Sstevel@tonic-gate ($group) = getgrgid($_); 125*0Sstevel@tonic-gate next if (! defined $group or ! grep { $_ eq $group } @gr) and $seen{$_}++; 126*0Sstevel@tonic-gate if (defined $group) { 127*0Sstevel@tonic-gate push(@gr, $group); 128*0Sstevel@tonic-gate } 129*0Sstevel@tonic-gate else { 130*0Sstevel@tonic-gate push(@gr, $_); 131*0Sstevel@tonic-gate } 132*0Sstevel@tonic-gate} 133*0Sstevel@tonic-gate 134*0Sstevel@tonic-gateprint "# gr = @gr\n"; 135*0Sstevel@tonic-gate 136*0Sstevel@tonic-gateif ($^O =~ /^(?:uwin|cygwin|solaris)$/) { 137*0Sstevel@tonic-gate # Or anybody else who can have spaces in group names. 138*0Sstevel@tonic-gate $gr1 = join(' ', grep(!$did{$_}++, sort split(' ', join(' ', @gr)))); 139*0Sstevel@tonic-gate} else { 140*0Sstevel@tonic-gate $gr1 = join(' ', sort @gr); 141*0Sstevel@tonic-gate} 142*0Sstevel@tonic-gate 143*0Sstevel@tonic-gateif ($Config{myuname} =~ /^cygwin_nt/i) { # basegroup on CYGWIN_NT has id = 0. 144*0Sstevel@tonic-gate @basegroup{$pwgid,$pwgnam} = (0,0); 145*0Sstevel@tonic-gate} else { 146*0Sstevel@tonic-gate @basegroup{$pwgid,$pwgnam} = (1,1); 147*0Sstevel@tonic-gate} 148*0Sstevel@tonic-gate$gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups))); 149*0Sstevel@tonic-gate 150*0Sstevel@tonic-gatemy $ok1 = 0; 151*0Sstevel@tonic-gateif ($gr1 eq $gr2 || ($gr1 eq '' && $gr2 eq $pwgid)) { 152*0Sstevel@tonic-gate print "ok 1\n"; 153*0Sstevel@tonic-gate $ok1++; 154*0Sstevel@tonic-gate} 155*0Sstevel@tonic-gateelsif ($Config{myuname} =~ /^cygwin_nt/i) { # basegroup on CYGWIN_NT has id = 0. 156*0Sstevel@tonic-gate # Retry in default unix mode 157*0Sstevel@tonic-gate %basegroup = ( $pwgid => 1, $pwgnam => 1 ); 158*0Sstevel@tonic-gate $gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',$groups))); 159*0Sstevel@tonic-gate if ($gr1 eq $gr2 || ($gr1 eq '' && $gr2 eq $pwgid)) { 160*0Sstevel@tonic-gate print "ok 1 # This Cygwin behaves like Unix (Win2k?)\n"; 161*0Sstevel@tonic-gate $ok1++; 162*0Sstevel@tonic-gate } 163*0Sstevel@tonic-gate} 164*0Sstevel@tonic-gateunless ($ok1) { 165*0Sstevel@tonic-gate print "#gr1 is <$gr1>\n"; 166*0Sstevel@tonic-gate print "#gr2 is <$gr2>\n"; 167*0Sstevel@tonic-gate print "not ok 1\n"; 168*0Sstevel@tonic-gate} 169*0Sstevel@tonic-gate 170*0Sstevel@tonic-gate# multiple 0's indicate GROUPSTYPE is currently long but should be short 171*0Sstevel@tonic-gate 172*0Sstevel@tonic-gateif ($pwgid == 0 || $seen{0} < 2) { 173*0Sstevel@tonic-gate print "ok 2\n"; 174*0Sstevel@tonic-gate} 175*0Sstevel@tonic-gateelse { 176*0Sstevel@tonic-gate print "not ok 2 (groupstype should be type short, not long)\n"; 177*0Sstevel@tonic-gate} 178