t/op/pwent.t

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