1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 require './test.pl'; 7} 8 9use strict; 10use warnings; 11 12eval {my @n = getpwuid 0; setpwent()}; 13skip_all($1) if $@ && $@ =~ /(The \w+ function is unimplemented)/; 14 15eval { require Config; }; 16 17sub try_prog { 18 my ($where, $args, @pathnames) = @_; 19 foreach my $prog (@pathnames) { 20 next unless -x $prog; 21 next unless open PW, '-|', "$prog $args 2>/dev/null"; 22 next unless defined <PW>; 23 return $where; 24 } 25 return; 26} 27 28# Try NIS. 29my $where = try_prog('NIS passwd', 'passwd', 30 qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)); 31 32# Try NetInfo. 33$where //= try_prog('NetInfo passwd', 'passwd .', '/usr/bin/nidump'); 34 35# Try NIS+. 36$where //= try_prog('NIS+', 'passwd.org_dir', '/bin/niscat'); 37 38# Try dscl 39if (!defined $where && $Config::Config{useperlio}) { 40 # Map dscl items to passwd fields, and provide support for 41 # mucking with the dscl output if we need to (and we do). 42 my %want = do { 43 my $inx = 0; 44 map {$_ => {inx => $inx++, mung => sub {$_[0]}}} 45 qw{RecordName Password UniqueID PrimaryGroupID 46 RealName NFSHomeDirectory UserShell}; 47 }; 48 49 # The RecordName for a /User record is the username. In some 50 # cases there are synonyms (e.g. _www and www), in which case we 51 # get a blank-delimited list. We prefer the first entry in the 52 # list because getpwnam() does. 53 $want{RecordName}{mung} = sub {(split '\s+', $_[0], 2)[0]}; 54 55 # The UniqueID and PrimaryGroupID for a /User record are the 56 # user ID and the primary group ID respectively. In cases where 57 # the high bit is set, 'dscl' returns a negative number, whereas 58 # getpwnam() returns its twos complement. This mungs the dscl 59 # output to agree with what getpwnam() produces. Interestingly 60 # enough, getpwuid(-2) returns the right record ('nobody'), even 61 # though it returns the uid as 4294967294. If you track uid_t 62 # on an i386, you find it is an unsigned int, which makes the 63 # unsigned version the right one; but both /etc/passwd and 64 # /etc/master.passwd contain negative numbers. 65 $want{UniqueID}{mung} = $want{PrimaryGroupID}{mung} = sub { 66 unpack 'L', pack 'l', $_[0]}; 67 68 foreach my $dscl (qw(/usr/bin/dscl)) { 69 next unless -x $dscl; 70 next unless open my $fh, '-|', "$dscl . -readall /Users @{[keys %want]} 2>/dev/null"; 71 my @lines; 72 my @rec; 73 while (<$fh>) { 74 chomp; 75 if ($_ eq '-') { 76 if (@rec) { 77 # Some records do not have all items. In particular, 78 # the macports user has no real name. Here it's an undef, 79 # in the password file it becomes an empty string. 80 no warnings 'uninitialized'; 81 push @lines, join (':', @rec) . "\n"; 82 @rec = (); 83 } 84 next; 85 } 86 my ($name, $value) = split ':\s+', $_, 2; 87 unless (defined $value) { 88 s/:$//; 89 $name = $_; 90 $value = <$fh>; 91 chomp $value; 92 $value =~ s/^\s+//; 93 } 94 if (defined (my $info = $want{$name})) { 95 $rec[$info->{inx}] = $info->{mung}->($value); 96 } 97 } 98 if (@rec) { 99 # see above 100 no warnings 'uninitialized'; 101 push @lines, join (':', @rec) . "\n"; 102 } 103 my $data = join '', @lines; 104 if (open PW, '<', \$data) { 105 $where = "dscl . -readall /Users"; 106 last; 107 } 108 } 109} 110 111if (not defined $where) { 112 # Try local. 113 my $no_i_pwd = !$Config::Config{i_pwd} && '$Config{i_pwd} undefined'; 114 115 my $PW = "/etc/passwd"; 116 if (!-f $PW) { 117 skip_all($no_i_pwd) if $no_i_pwd; 118 skip_all("no $PW file"); 119 } elsif (open PW, '<', $PW) { 120 if(defined <PW>) { 121 $where = $PW; 122 } else { 123 skip_all($no_i_pwd) if $no_i_pwd; 124 die "\$Config{i_pwd} is defined, $PW exists but has no entries, all other approaches failed, giving up"; 125 } 126 } else { 127 die "Can't open $PW: $!"; 128 } 129} 130 131# By now the PW filehandle should be open and full of juicy password entries. 132 133plan(tests => 2); 134 135# Go through at most this many users. 136# (note that the first entry has been read away by now) 137my $max = 25; 138 139my $n = 0; 140my %perfect; 141my %seen; 142 143print "# where $where\n"; 144 145setpwent(); 146 147while (<PW>) { 148 chomp; 149 # LIMIT -1 so that users with empty shells don't fall off 150 my @s = split /:/, $_, -1; 151 my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s); 152 (my $v) = $Config::Config{osvers} =~ /^(\d+)/; 153 if ($^O eq 'darwin' && $v < 9) { 154 ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9]; 155 } else { 156 ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s; 157 } 158 next if /^\+/; # ignore NIS includes 159 if (@s) { 160 push @{ $seen{$name_s} }, $.; 161 } else { 162 warn "# Your $where line $. is empty.\n"; 163 next; 164 } 165 if ($n == $max) { 166 local $/; 167 my $junk = <PW>; 168 last; 169 } 170 # In principle we could whine if @s != 7 but do we know enough 171 # of passwd file formats everywhere? 172 if (@s == 7 || ($^O eq 'darwin' && @s == 10)) { 173 my @n = getpwuid($uid_s); 174 # 'nobody' et al. 175 next unless @n; 176 my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n; 177 # Protect against one-to-many and many-to-one mappings. 178 if ($name_s ne $name) { 179 @n = getpwnam($name_s); 180 ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n; 181 next if $name_s ne $name; 182 } 183 $perfect{$name_s}++ 184 if $name eq $name_s and 185 $uid eq $uid_s and 186# Do not compare passwords: think shadow passwords. 187 $gid eq $gid_s and 188 $gcos eq $gcos_s and 189 $home eq $home_s and 190 $shell eq $shell_s; 191 } 192 $n++; 193} 194 195endpwent(); 196 197print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n"; 198 199SKIP: { 200 skip("Found no password entries", 1) unless $n; 201 202 if (keys %perfect == 0) { 203 $max++; 204 print <<EOEX; 205# 206# The failure of op/pwent test is not necessarily serious. 207# It may fail due to local password administration conventions. 208# If you are for example using both NIS and local passwords, 209# test failure is possible. Any distributed password scheme 210# can cause such failures. 211# 212# What the pwent test is doing is that it compares the $max first 213# entries of $where 214# with the results of getpwuid() and getpwnam() call. If it finds no 215# matches at all, it suspects something is wrong. 216# 217EOEX 218 } 219 220 cmp_ok(keys %perfect, '>', 0, "pwent test satisfactory") 221 or note("(not necessarily serious: run t/op/pwent.t by itself)"); 222} 223 224# Test both the scalar and list contexts. 225 226my @pw1; 227 228setpwent(); 229for (1..$max) { 230 my $pw = scalar getpwent(); 231 last unless defined $pw; 232 push @pw1, $pw; 233} 234endpwent(); 235 236my @pw2; 237 238setpwent(); 239for (1..$max) { 240 my ($pw) = (getpwent()); 241 last unless defined $pw; 242 push @pw2, $pw; 243} 244endpwent(); 245 246is("@pw1", "@pw2", 247 "getpwent() produced identical results in list and scalar contexts"); 248 249close(PW); 250