t/op/pwent.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 use strict;
  10 use warnings;
  11
  12 eval {my @n = getpwuid 0; setpwent()};
  13 skip_all($1) if $@ && $@ =~ /(The \w+ function is unimplemented)/;
  14
  15 eval { require Config; };
  16
  17 sub 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.
  29 my $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
  39 DSCL: {
  40 my @dscl = qw(/usr/bin/dscl);
  41 if (!defined $where && $Config::Config{useperlio} && grep { -x } @dscl) {
  42     eval { require PerlIO::scalar; }; # Beware miniperl.
  43     if ($@) {
  44         print "# No PerlIO::scalar, will not try dscl\n";
  45         last DSCL;
  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 (@dscl) {
  76         next unless -x $dscl;
  77         next unless open my $fh, '-|', "$dscl . -readall /Users @{[keys %want]} 2>/dev/null";
  78         my @lines;
  79         my @rec;
  80         while (<$fh>) {
  81             chomp;
  82             if ($_ eq '-') {
  83                 if (@rec) {
  84                     # Some records do not have all items. In particular,
  85                     # the macports user has no real name. Here it's an undef,
  86                     # in the password file it becomes an empty string.
  87                     no warnings 'uninitialized';
  88                     push @lines, join (':', @rec) . "\n";
  89                     @rec = ();
  90                 }
  91                 next;
  92             }
  93             my ($name, $value) = split ':\s+', $_, 2;
  94             unless (defined $value) {
  95                 s/:$//;
  96                 $name = $_;
  97                 $value = <$fh>;
  98                 chomp $value;
  99                 $value =~ s/^\s+//;
 100             }
 101             if (defined (my $info = $want{$name})) {
 102                 $rec[$info->{inx}] = $info->{mung}->($value);
 103             }
 104         }
 105         if (@rec) {
 106         # see above
 107         no warnings 'uninitialized';
 108             push @lines, join (':', @rec) . "\n";
 109         }
 110         my $data = join '', @lines;
 111         if (open PW, '<', \$data) { # Needs PerlIO::scalar.
 112             $where = "dscl . -readall /Users";
 113             last;
 114         }
 115     }
 116 }
 117 } # DSCL:
 118
 119 if (not defined $where) {
 120     # Try local.
 121     my $no_i_pwd = !$Config::Config{i_pwd} && '$Config{i_pwd} undefined';
 122
 123     my $PW = "/etc/passwd";
 124     if (!-f $PW) {
 125         skip_all($no_i_pwd) if $no_i_pwd;
 126         skip_all("no $PW file");
 127     } elsif (open PW, '<', $PW) {
 128         if(defined <PW>) {
 129             $where = $PW;
 130         } else {
 131             skip_all($no_i_pwd) if $no_i_pwd;
 132             die "\$Config{i_pwd} is defined, $PW exists but has no entries, all other approaches failed, giving up";
 133         }
 134     } else {
 135         die "Can't open $PW: $!";
 136     }
 137 }
 138
 139 # By now the PW filehandle should be open and full of juicy password entries.
 140
 141 plan(tests => 2);
 142
 143 # Go through at most this many users.
 144 # (note that the first entry has been read away by now)
 145 my $max = 25;
 146
 147 my $n = 0;
 148 my %perfect;
 149 my %seen;
 150
 151 print "# where $where\n";
 152
 153 setpwent();
 154
 155 while (<PW>) {
 156     chomp;
 157     # LIMIT -1 so that users with empty shells don't fall off
 158     my @s = split /:/, $_, -1;
 159     my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s);
 160     (my $v) = $Config::Config{osvers} =~ /^(\d+)/;
 161     if ($^O eq 'darwin' && $v < 9) {
 162        ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9];
 163     } else {
 164        ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
 165     }
 166     next if /^\+/; # ignore NIS includes
 167     if (@s) {
 168         push @{ $seen{$name_s} }, $.;
 169     } else {
 170         warn "# Your $where line $. is empty.\n";
 171         next;
 172     }
 173     if ($n == $max) {
 174         local $/;
 175         my $junk = <PW>;
 176         last;
 177     }
 178     # In principle we could whine if @s != 7 but do we know enough
 179     # of passwd file formats everywhere?
 180     if (@s == 7 || ($^O eq 'darwin' && @s == 10)) {
 181         my @n = getpwuid($uid_s);
 182         # 'nobody' et al.
 183         next unless @n;
 184         my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
 185         # Protect against one-to-many and many-to-one mappings.
 186         if ($name_s ne $name) {
 187             @n = getpwnam($name_s);
 188             ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
 189             next if $name_s ne $name;
 190         }
 191         $perfect{$name_s}++
 192             if $name    eq $name_s    and
 193                $uid     eq $uid_s     and
 194 # Do not compare passwords: think shadow passwords.
 195                $gid     eq $gid_s     and
 196                $gcos    eq $gcos_s    and
 197                $home    eq $home_s    and
 198                $shell   eq $shell_s;
 199     }
 200     $n++;
 201 }
 202
 203 endpwent();
 204
 205 print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";
 206
 207 SKIP: {
 208     skip("Found no password entries", 1) unless $n;
 209
 210     if (keys %perfect == 0) {
 211         $max++;
 212         print <<EOEX;
 213 #
 214 # The failure of op/pwent test is not necessarily serious.
 215 # It may fail due to local password administration conventions.
 216 # If you are for example using both NIS and local passwords,
 217 # test failure is possible.  Any distributed password scheme
 218 # can cause such failures.
 219 #
 220 # What the pwent test is doing is that it compares the $max first
 221 # entries of $where
 222 # with the results of getpwuid() and getpwnam() call.  If it finds no
 223 # matches at all, it suspects something is wrong.
 224 #
 225 EOEX
 226     }
 227
 228     cmp_ok(keys %perfect, '>', 0, "pwent test satisfactory")
 229         or note("(not necessarily serious: run t/op/pwent.t by itself)");
 230 }
 231
 232 # Test both the scalar and list contexts.
 233
 234 my @pw1;
 235
 236 setpwent();
 237 for (1..$max) {
 238     my $pw = scalar getpwent();
 239     last unless defined $pw;
 240     push @pw1, $pw;
 241 }
 242 endpwent();
 243
 244 my @pw2;
 245
 246 setpwent();
 247 for (1..$max) {
 248     my ($pw) = (getpwent());
 249     last unless defined $pw;
 250     push @pw2, $pw;
 251 }
 252 endpwent();
 253
 254 is("@pw1", "@pw2",
 255     "getpwent() produced identical results in list and scalar contexts");
 256
 257 close(PW);