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 if (!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
 111 if (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
 133 plan(tests => 2);
 134
 135 # Go through at most this many users.
 136 # (note that the first entry has been read away by now)
 137 my $max = 25;
 138
 139 my $n = 0;
 140 my %perfect;
 141 my %seen;
 142
 143 print "# where $where\n";
 144
 145 setpwent();
 146
 147 while (<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
 195 endpwent();
 196
 197 print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";
 198
 199 SKIP: {
 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 #
 217 EOEX
 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
 226 my @pw1;
 227
 228 setpwent();
 229 for (1..$max) {
 230     my $pw = scalar getpwent();
 231     last unless defined $pw;
 232     push @pw1, $pw;
 233 }
 234 endpwent();
 235
 236 my @pw2;
 237
 238 setpwent();
 239 for (1..$max) {
 240     my ($pw) = (getpwent());
 241     last unless defined $pw;
 242     push @pw2, $pw;
 243 }
 244 endpwent();
 245
 246 is("@pw1", "@pw2",
 247     "getpwent() produced identical results in list and scalar contexts");
 248
 249 close(PW);