In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/16acebfd4bd4723d04bc78197c2f63138974bfc8?hp=0f0aa27e84651bcff0f03646d2b397fa9f3ca003>
- Log ----------------------------------------------------------------- commit 16acebfd4bd4723d04bc78197c2f63138974bfc8 Author: Nicholas Clark <[email protected]> Date: Sun Mar 13 13:19:29 2011 +0000 Convert t/op/pwent.t to test.pl, strict and warnings. Move most of the logic for "hunt the password data" out of the BEGIN block, as it has no special reason to be in one. M t/op/pwent.t commit a572cf217aac07991cbc820abacc022f4199cbae Author: Nicholas Clark <[email protected]> Date: Sun Mar 13 12:50:14 2011 +0000 C<not> should be C<!> in pwent.t, to fix a precedence bug. Fortunately the effects are mostly benign. There are two boolean conditions - $where defined, and PerlIO available, making 4 possible combinations. As was, the code was: if (not defined $where && $Config{useperlio} eq 'define') { ... if (-x '/usr/bin/dscl') { ... if (open (PW, '<', \$data)) { $where = ...; would enter the first if block for 3 out of 4 possibilities, skipping only if *both* $where as defined *and* PerlIO was available. This was not the intent. However, if PerlIO is unavailable, then the open will fail, $where won't be set, and the logic continues on below, falling back to /etc/passwd The intended logic is if (!defined $where && $Config{useperlio} eq 'define') { ... ie only enter on 1 of the 4 possibilities - skip unless $where was undefined and PerlIO was available. The net effect was that usually the behaviour was the same. The only difference will be if PerlIO is not available (not the default, and rarely changed), the password data *is* available from one of the services tested earlier, and an /usr/bin/dscl executable is present. In this case, the old code would have reached the open, which would have failed, but would have closed PW as a side effect. However, because $where would be defined, the fallback to /etc/passwd would not have been tried. This would have caused the regression test to fail. Also, the test C<$Config{useperlio} eq 'define'> is not quite correct, as $Config{useperlio} will be undef if PerlIO is disabled, and the eq will warn. M t/op/pwent.t ----------------------------------------------------------------------- Summary of changes: t/op/pwent.t | 222 +++++++++++++++++++++++++++++---------------------------- 1 files changed, 113 insertions(+), 109 deletions(-) diff --git a/t/op/pwent.t b/t/op/pwent.t index 7880582..2ebd5dc 100644 --- a/t/op/pwent.t +++ b/t/op/pwent.t @@ -1,5 +1,19 @@ #!./perl +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require './test.pl'; +} + +use strict; +use warnings; + +eval {my @n = getpwuid 0; setpwent()}; +skip_all($1) if $@ && $@ =~ /(The \w+ function is unimplemented)/; + +eval { require Config; }; + sub try_prog { my ($where, $args, @pathnames) = @_; foreach my $prog (@pathnames) { @@ -11,121 +25,112 @@ sub try_prog { return; } -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; - eval {my @n = getpwuid 0; setpwent()}; - if ($@ && $@ =~ /(The \w+ function is unimplemented)/) { - print "1..0 # Skip: $1\n"; - exit 0; - } - eval { require Config; import Config; }; - - # Try NIS. - $where = try_prog('NIS passwd', 'passwd', - qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)); - - # Try NetInfo. - $where //= try_prog('NetInfo passwd', 'passwd .', '/usr/bin/nidump'); - - # Try NIS+. - $where //= try_prog('NIS+', 'passwd.org_dir', '/bin/niscat'); - - if (not defined $where && # Try dscl - $Config{useperlio} eq 'define') { # need perlio - - # Map dscl items to passwd fields, and provide support for - # mucking with the dscl output if we need to (and we do). - my %want = do { - my $inx = 0; - map {$_ => {inx => $inx++, mung => sub {$_[0]}}} - qw{RecordName Password UniqueID PrimaryGroupID - RealName NFSHomeDirectory UserShell}; - }; - - # The RecordName for a /User record is the username. In some - # cases there are synonyms (e.g. _www and www), in which case we - # get a blank-delimited list. We prefer the first entry in the - # list because getpwnam() does. - $want{RecordName}{mung} = sub {(split '\s+', $_[0], 2)[0]}; - - # The UniqueID and PrimaryGroupID for a /User record are the - # user ID and the primary group ID respectively. In cases where - # the high bit is set, 'dscl' returns a negative number, whereas - # getpwnam() returns its twos complement. This mungs the dscl - # output to agree with what getpwnam() produces. Interestingly - # enough, getpwuid(-2) returns the right record ('nobody'), even - # though it returns the uid as 4294967294. If you track uid_t - # on an i386, you find it is an unsigned int, which makes the - # unsigned version the right one; but both /etc/passwd and - # /etc/master.passwd contain negative numbers. - $want{UniqueID}{mung} = $want{PrimaryGroupID}{mung} = sub { - unpack 'L', pack 'l', $_[0]}; - - foreach my $dscl (qw(/usr/bin/dscl)) { - -x $dscl or next; - open (my $fh, '-|', join (' ', $dscl, qw{. -readall /Users}, - keys %want, '2>/dev/null')) or next; - my $data; - my @rec; - while (<$fh>) { - chomp; - if ($_ eq '-') { - @rec and $data .= join (':', @rec) . "\n"; +# Try NIS. +my $where = try_prog('NIS passwd', 'passwd', + qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)); + +# Try NetInfo. +$where //= try_prog('NetInfo passwd', 'passwd .', '/usr/bin/nidump'); + +# Try NIS+. +$where //= try_prog('NIS+', 'passwd.org_dir', '/bin/niscat'); + +# Try dscl +if (!defined $where && $Config::Config{useperlio}) { + # Map dscl items to passwd fields, and provide support for + # mucking with the dscl output if we need to (and we do). + my %want = do { + my $inx = 0; + map {$_ => {inx => $inx++, mung => sub {$_[0]}}} + qw{RecordName Password UniqueID PrimaryGroupID + RealName NFSHomeDirectory UserShell}; + }; + + # The RecordName for a /User record is the username. In some + # cases there are synonyms (e.g. _www and www), in which case we + # get a blank-delimited list. We prefer the first entry in the + # list because getpwnam() does. + $want{RecordName}{mung} = sub {(split '\s+', $_[0], 2)[0]}; + + # The UniqueID and PrimaryGroupID for a /User record are the + # user ID and the primary group ID respectively. In cases where + # the high bit is set, 'dscl' returns a negative number, whereas + # getpwnam() returns its twos complement. This mungs the dscl + # output to agree with what getpwnam() produces. Interestingly + # enough, getpwuid(-2) returns the right record ('nobody'), even + # though it returns the uid as 4294967294. If you track uid_t + # on an i386, you find it is an unsigned int, which makes the + # unsigned version the right one; but both /etc/passwd and + # /etc/master.passwd contain negative numbers. + $want{UniqueID}{mung} = $want{PrimaryGroupID}{mung} = sub { + unpack 'L', pack 'l', $_[0]}; + + foreach my $dscl (qw(/usr/bin/dscl)) { + next unless -x $dscl; + next unless open my $fh, '-|', "$dscl . -readall /Users @{[keys %want]} 2>/dev/null"; + my @lines; + my @rec; + while (<$fh>) { + chomp; + if ($_ eq '-') { + if (@rec) { + push @lines, join (':', @rec) . "\n"; @rec = (); - next; - } - my ($name, $value) = split ':\s+', $_, 2; - unless (defined $value) { - s/:$//; - $name = $_; - $value = <$fh>; - chomp $value; - $value =~ s/^\s+//; - } - if (defined (my $info = $want{$name})) { - $rec[$info->{inx}] = $info->{mung}->($value); } + next; + } + my ($name, $value) = split ':\s+', $_, 2; + unless (defined $value) { + s/:$//; + $name = $_; + $value = <$fh>; + chomp $value; + $value =~ s/^\s+//; } - @rec and $data .= join (':', @rec) . "\n"; - if (open (PW, '<', \$data)) { - $where = "dscl . -readall /Users"; - last; + if (defined (my $info = $want{$name})) { + $rec[$info->{inx}] = $info->{mung}->($value); } } + if (@rec) { + push @lines, join (':', @rec) . "\n"; + } + my $data = join '', @lines; + if (open PW, '<', \$data) { + $where = "dscl . -readall /Users"; + last; + } } +} - if (not defined $where) { - # Try local. - my $no_i_pwd = !$Config{i_pwd} && '$Config{i_pwd} undefined'; - - my $PW = "/etc/passwd"; - if (!-f $PW) { - skip_all($no_i_pwd) if $no_i_pwd; - skip_all("no $PW file"); - } elsif (open PW, '<', $PW) { - if(defined <PW>) { - $where = $PW; - } else { - skip_all($no_i_pwd) if $no_i_pwd; - die "\$Config{i_pwd} is defined, $PW exists but has no entries, all other approaches failed, giving up"; - } +if (not defined $where) { + # Try local. + my $no_i_pwd = !$Config::Config{i_pwd} && '$Config{i_pwd} undefined'; + + my $PW = "/etc/passwd"; + if (!-f $PW) { + skip_all($no_i_pwd) if $no_i_pwd; + skip_all("no $PW file"); + } elsif (open PW, '<', $PW) { + if(defined <PW>) { + $where = $PW; } else { - die "Can't open $PW: $!"; + skip_all($no_i_pwd) if $no_i_pwd; + die "\$Config{i_pwd} is defined, $PW exists but has no entries, all other approaches failed, giving up"; } + } else { + die "Can't open $PW: $!"; } } # By now the PW filehandle should be open and full of juicy password entries. -print "1..2\n"; +plan(tests => 2); # Go through at most this many users. # (note that the first entry has been read away by now) my $max = 25; my $n = 0; -my $tst = 1; my %perfect; my %seen; @@ -138,7 +143,7 @@ while (<PW>) { # LIMIT -1 so that users with empty shells don't fall off my @s = split /:/, $_, -1; my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s); - (my $v) = $Config{osvers} =~ /^(\d+)/; + (my $v) = $Config::Config{osvers} =~ /^(\d+)/; if ($^O eq 'darwin' && $v < 9) { ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9]; } else { @@ -159,7 +164,7 @@ while (<PW>) { # In principle we could whine if @s != 7 but do we know enough # of passwd file formats everywhere? if (@s == 7 || ($^O eq 'darwin' && @s == 10)) { - @n = getpwuid($uid_s); + my @n = getpwuid($uid_s); # 'nobody' et al. next unless @n; my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n; @@ -185,9 +190,12 @@ endpwent(); print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n"; -if (keys %perfect == 0 && $n) { - $max++; - print <<EOEX; +SKIP: { + skip("Found no password entries", 1) unless $n; + + if (keys %perfect == 0) { + $max++; + print <<EOEX; # # The failure of op/pwent test is not necessarily serious. # It may fail due to local password administration conventions. @@ -201,14 +209,11 @@ if (keys %perfect == 0 && $n) { # matches at all, it suspects something is wrong. # EOEX - print "not "; - $not = 1; -} else { - $not = 0; + } + + cmp_ok(keys %perfect, '>', 0) + or note("(not necessarily serious: run t/op/pwent.t by itself)"); } -print "ok ", $tst++; -print "\t# (not necessarily serious: run t/op/pwent.t by itself)" if $not; -print "\n"; # Test both the scalar and list contexts. @@ -232,7 +237,6 @@ for (1..$max) { } endpwent(); -print "not " unless "@pw1" eq "@pw2"; -print "ok ", $tst++, "\n"; +is("@pw1", "@pw2"); close(PW); -- Perl5 Master Repository
