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