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             push @lines, join (':', @rec) . "\n";
 100         }
 101         my $data = join '', @lines;
 102         if (open PW, '<', \$data) {
 103             $where = "dscl . -readall /Users";
 104             last;
 105         }
 106     }
 107 }
 108
 109 if (not defined $where) {
 110     # Try local.
 111     my $no_i_pwd = !$Config::Config{i_pwd} && '$Config{i_pwd} undefined';
 112
 113     my $PW = "/etc/passwd";
 114     if (!-f $PW) {
 115         skip_all($no_i_pwd) if $no_i_pwd;
 116         skip_all("no $PW file");
 117     } elsif (open PW, '<', $PW) {
 118         if(defined <PW>) {
 119             $where = $PW;
 120         } else {
 121             skip_all($no_i_pwd) if $no_i_pwd;
 122             die "\$Config{i_pwd} is defined, $PW exists but has no entries, all other approaches failed, giving up";
 123         }
 124     } else {
 125         die "Can't open $PW: $!";
 126     }
 127 }
 128
 129 # By now the PW filehandle should be open and full of juicy password entries.
 130
 131 plan(tests => 2);
 132
 133 # Go through at most this many users.
 134 # (note that the first entry has been read away by now)
 135 my $max = 25;
 136
 137 my $n = 0;
 138 my %perfect;
 139 my %seen;
 140
 141 print "# where $where\n";
 142
 143 setpwent();
 144
 145 while (<PW>) {
 146     chomp;
 147     # LIMIT -1 so that users with empty shells don't fall off
 148     my @s = split /:/, $_, -1;
 149     my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s);
 150     (my $v) = $Config::Config{osvers} =~ /^(\d+)/;
 151     if ($^O eq 'darwin' && $v < 9) {
 152        ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9];
 153     } else {
 154        ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
 155     }
 156     next if /^\+/; # ignore NIS includes
 157     if (@s) {
 158         push @{ $seen{$name_s} }, $.;
 159     } else {
 160         warn "# Your $where line $. is empty.\n";
 161         next;
 162     }
 163     if ($n == $max) {
 164         local $/;
 165         my $junk = <PW>;
 166         last;
 167     }
 168     # In principle we could whine if @s != 7 but do we know enough
 169     # of passwd file formats everywhere?
 170     if (@s == 7 || ($^O eq 'darwin' && @s == 10)) {
 171         my @n = getpwuid($uid_s);
 172         # 'nobody' et al.
 173         next unless @n;
 174         my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
 175         # Protect against one-to-many and many-to-one mappings.
 176         if ($name_s ne $name) {
 177             @n = getpwnam($name_s);
 178             ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
 179             next if $name_s ne $name;
 180         }
 181         $perfect{$name_s}++
 182             if $name    eq $name_s    and
 183                $uid     eq $uid_s     and
 184 # Do not compare passwords: think shadow passwords.
 185                $gid     eq $gid_s     and
 186                $gcos    eq $gcos_s    and
 187                $home    eq $home_s    and
 188                $shell   eq $shell_s;
 189     }
 190     $n++;
 191 }
 192
 193 endpwent();
 194
 195 print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";
 196
 197 SKIP: {
 198     skip("Found no password entries", 1) unless $n;
 199
 200     if (keys %perfect == 0) {
 201         $max++;
 202         print <<EOEX;
 203 #
 204 # The failure of op/pwent test is not necessarily serious.
 205 # It may fail due to local password administration conventions.
 206 # If you are for example using both NIS and local passwords,
 207 # test failure is possible.  Any distributed password scheme
 208 # can cause such failures.
 209 #
 210 # What the pwent test is doing is that it compares the $max first
 211 # entries of $where
 212 # with the results of getpwuid() and getpwnam() call.  If it finds no
 213 # matches at all, it suspects something is wrong.
 214 #
 215 EOEX
 216     }
 217
 218     cmp_ok(keys %perfect, '>', 0)
 219         or note("(not necessarily serious: run t/op/pwent.t by itself)");
 220 }
 221
 222 # Test both the scalar and list contexts.
 223
 224 my @pw1;
 225
 226 setpwent();
 227 for (1..$max) {
 228     my $pw = scalar getpwent();
 229     last unless defined $pw;
 230     push @pw1, $pw;
 231 }
 232 endpwent();
 233
 234 my @pw2;
 235
 236 setpwent();
 237 for (1..$max) {
 238     my ($pw) = (getpwent());
 239     last unless defined $pw;
 240     push @pw2, $pw;
 241 }
 242 endpwent();
 243
 244 is("@pw1", "@pw2");
 245
 246 close(PW);