view release on metacpan or  search on metacpan

lib/Test/Unix/User.pm  view on Meta::CPAN

being concerned about the numeric UID.  Use both of these together to
ensure that the UID and the owner name match.

C<gid> is to C<group> as C<uid> is to C<owner>.

=cut

sub homedir_ok {
  return unless _check_spec(@_);

  my($spec, $test_name) = @_;

  if(! defined $test_name) {
    $test_name = "Home directory for user '$spec->{name}'";
    $test_name .= ' (' . join(', ', sort keys %$spec) . ')';
  }

  my @diag;

  foreach my $field (keys %$spec) {
    if(! exists $HDIR_FIELDS{$field}) {
      push @diag, "    Invalid field '$field' given";
      delete $spec->{$field};
      next;
    }

    if(! defined $spec->{$field} or $spec->{$field} =~ /^\s*$/) {
      push @diag, "    Empty field '$field' given";
      delete $spec->{$field};
      next;
    }
  }
  
  my $u = getpwnam($spec->{name});

  if(! defined $u) {
    my $ok = $Test->ok(0, $test_name);
    $Test->diag("    User '$spec->{name}' does not exist");
    return $ok;
  }

  if(! -d $u->dir) {
    my $ok = $Test->ok(0, $test_name);
    $Test->diag("    Home directory '" . $u->dir . "' for '$spec->{name}' is not a directory");
    return $ok;
  }

  my $sb = stat($u->dir);

  foreach my $field (qw(uid gid)) {
    if(exists $spec->{$field}) {
      if($sb->$field != $spec->{$field}) {
        push @diag, "    Field: $field\n";
        push @diag, "    expected: $spec->{$field}\n";
        push @diag, "         got: " . $sb->$field . "\n";
      }
    }
  }

  if(exists $spec->{owner}) {
    my $owner = getpwuid($sb->uid)->name();
    if($spec->{owner} ne $owner) {
      push @diag, "    Field: owner\n";
      push @diag, "    expected: $spec->{owner}\n";
      push @diag, "         got: $owner\n";
    }
  }

  if(exists $spec->{group}) {
    my $group = getgrgid($sb->gid);
    if($spec->{group} ne $group) {
      push @diag, "    Field: group\n";
      push @diag, "    expected: $spec->{group}\n";
      push @diag, "         got: $group\n";
    }
  }

  if(exists $spec->{perm}) {
    if(($sb->mode & 07777) != $spec->{perm}) {
      push @diag, "    Field: perm\n";
      push @diag, sprintf("    expected: %04o\n", $spec->{perm});
      push @diag, sprintf("         got: %04o\n", $sb->mode & 07777);
    }
  }

  if(@diag) {
    my $ok = $Test->ok(0, $test_name);
    $Test->diag(@diag);
    return $ok;
  }

  return $Test->ok(1, $test_name);
}

sub _check_spec {
  my($spec, $test_name) = @_;
  my $sub = (caller(1))[3];

  $sub =~ s/Test::Unix::User:://;

  if(! defined $spec) {
    my $ok = $Test->ok(0, "$sub()");
    $Test->diag("    $sub() called with no arguments");
    return $ok;
  }

  if(ref($spec) ne 'HASH') {
    my $t = $test_name;
    $t = "$sub(...)" unless defined $t;
    my $ok = $Test->ok(0, $t);
    $Test->diag("    First argument to $sub() must be a hash ref");
    return $ok;
  }

  if(! exists $spec->{name} or 
     ! defined $spec->{name} or 
       $spec->{name} =~ /^\s*$/) {
    my $t = $test_name;
    $t = "$sub(...)" unless defined $t;
    my $ok = $Test->ok(0, $t);
    $Test->diag("    $sub() called with no user name");