t/op/pwent.t

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