view release on metacpan or  search on metacpan

t/40fs_complex.t  view on Meta::CPAN

my %acl = ();

foreach my $pathname ( @$paths ) {

    my $path = $result->getPath($pathname);
    if ( ref $path && $path->isa("AFS::Object::Path") ) {
	print "ok $TestCounter\n";
	$TestCounter++;
    } else {
	print "not ok $TestCounter..$TestTotal\n";
	die("Unable to get Path object from result of fs->listacl:\n" .
	    Data::Dumper->Dump([$result],['result']));
    }

    if ( $pathname eq $mtpath ) {

	my $normal = $path->getACL();
	if ( ref $normal && $normal->isa("AFS::Object::ACL") ) {
	    print "ok $TestCounter\n";
	    $TestCounter++;
	} else {
	    print "not ok $TestCounter..$TestTotal\n";
	    die("Unable to get normal ACL object from Path object:\n" .
		Data::Dumper->Dump([$path],['path']));
	}

	my $negative = $path->getACL('negative');
	if ( ref $negative && $negative->isa("AFS::Object::ACL") ) {
	    print "ok $TestCounter\n";
	    $TestCounter++;
	} else {
	    print "not ok $TestCounter..$TestTotal\n";
	    die("Unable to get negative ACL object from Path object:\n" .
		Data::Dumper->Dump([$path],['path']));
	}

	%acl =
	  (
	   normal		=> $normal,
	   negative		=> $negative,
	  );

    } else {
	
	my $ok = 'ok';
	unless ( $path->error() ) {
	    warn("Pathname '$pathname' should have given an error()\n");
	    $ok = 'not ok';
	}
	for ( my $count = 1 ; $count <= 2 ; $count++ ) {
	    print "$ok $TestCounter\n";
	    $TestCounter++;
	}

    }

}

#
# Sadly, if the localhost is not in the same AFS cell as that being
# tested, the setacl command is guaranteed to fail, because the test
# pts entries will not be defined.
#
# Thus, we use a different, existing pts entry for these tests, and
# not the ones we created above.
#
my %entries =
  (
   $ptsexisting			=> 'rlidwk',
  );

foreach my $type ( qw(normal negative) ) {

    $result = $fs->setacl
      (
       dir			=> $mtpath,
       acl			=> \%entries,
       (
	$type eq 'negative' ?
	( negative		=> 1 ) : ()
       ),
      );
    if ( $result ) {
	print "ok $TestCounter\n";
	$TestCounter++;
    } else {
	print "not ok $TestCounter..$TestTotal\n";
	die("Unable to setacl dirs:" .
	    $fs->errors() .
	    Data::Dumper->Dump([$fs],['fs']));
    }

    $result = $fs->listacl
      (
       path			=> $mtpath,
      );
    if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
	print "ok $TestCounter\n";
	$TestCounter++;
    } else {
	print "not ok $TestCounter..$TestTotal\n";
	die("Unable to listacl dirs:" .
	    $fs->errors() .
	    Data::Dumper->Dump([$fs],['fs']));
    }

    my $path = $result->getPath($mtpath);
    if ( ref $path && $path->isa("AFS::Object::Path") ) {
	print "ok $TestCounter\n";
	$TestCounter++;
    } else {
	print "not ok $TestCounter..$TestTotal\n";
	die("Unable to get Path object from result of fs->listacl:\n" .
	    Data::Dumper->Dump([$result],['result']));
    }

    my $acl = $path->getACL($type);
    if ( ref $acl && $acl->isa("AFS::Object::ACL") ) {
	print "ok $TestCounter\n";
	$TestCounter++;
    } else {
	print "not ok $TestCounter..$TestTotal\n";
	die("Unable to get ACL object from Path object:\n" .
	    Data::Dumper->Dump([$path],['path']));
    }

    foreach my $principal ( keys %entries ) {

	if ( $acl->getRights($principal) eq $entries{$principal} ) {
	    print "ok $TestCounter\n";
	} else {
	    print "not ok $TestCounter\n";
	    warn("Unable to verify ACL entry for $principal:\n" .
		 Data::Dumper->Dump([$acl],['acl']));
	}
	$TestCounter++;

    }

}

#
# Unmount it
#
$result = $fs->rmmount
  (
   dir			=> $mtpath,
  );