AFS-Command
view release on metacpan or search on metacpan
=head2 AFS::Object::VolumeHeader 'accesses' attribute was incorrect
The actual attribute on the objects was named "access". Oops. The
attribute was changed to "accesses" to match the documentation, and
the string that is parsed in vos output.
=head1 Changes in 1.4
=head1 Enhancements
=head2 Test suite is disabled by default.
There is a well intentioned effort to automatically test all new
submissions to CPAN (see http://testers.cpan.org). Unfortunately, the
AFS-Command package can't be tested automatically, since it requires a
fair amount of configuration. You have to specify a cell name, some
fileserver names and partitions, etc.
By default, the tests will all be skipped if the configured cell name
in the CONFIG file has not been modified, thus allowing the automated
CPAN testing to continue, automatically, without the author getting a
Changes.html view on Meta::CPAN
<LI><A HREF="#Bugs">Bugs</A>
<UL>
<LI><A HREF="#AFS_Object_VolumeHeader_acces">AFS::Object::VolumeHeader 'accesses' attribute was incorrect</A>
</UL>
<LI><A HREF="#Changes_in_1_4">Changes in 1.4</A>
<LI><A HREF="#Enhancements">Enhancements</A>
<UL>
<LI><A HREF="#Test_suite_is_disabled_by_defaul">Test suite is disabled by default.</A>
</UL>
<LI><A HREF="#Bugs">Bugs</A>
<UL>
<LI><A HREF="#Volume_status_value_inconsistenc">Volume status value inconsistency</A>
<LI><A HREF="#AFS_Command_VOS_examine_parse">AFS::Command::VOS->examine parses busy and offline messages</A>
</UL>
<LI><A HREF="#Changes_in_1_3">Changes in 1.3</A>
Changes.html view on Meta::CPAN
<H1><A NAME="Changes_in_1_4">Changes in 1.4
</A></H1>
<P>
<HR>
<H1><A NAME="Enhancements">Enhancements
</A></H1>
<P>
<HR>
<H2><A NAME="Test_suite_is_disabled_by_defaul">Test suite is disabled by default.
</A></H2>
There is a well intentioned effort to automatically test all new
submissions to CPAN (see <A
HREF="http://testers.cpan.org).">http://testers.cpan.org).</A>
Unfortunately, the AFS-Command package can't be tested automatically, since
it requires a fair amount of configuration. You have to specify a cell
name, some fileserver names and partitions, etc.
# see the fs examine/diskfree and similar api calls)
#
while ( defined($_ = $self->_stderr() ) ) {
}
Maybe something like that. By the time _exec_cmds returns, we have
reaped the commands, and collected *ALL* of the output into arrays in
the object.
=head2 Test Suite: fs lsmount using multiple dirs
We should create several mount points and then query then all with one
lsmount method call, to verify we can parse output for multiple dirs.
We should pass in some bogus paths, too, to verify the error handling
is correct as well (that code feels dubious to me).
=head1 Bugs
=head2 stdout/stderr buffering will break the fs examine/diskfree commands
<!-- INDEX BEGIN -->
<UL>
<LI><A HREF="#NAME">NAME</A>
<LI><A HREF="#Enhancements">Enhancements</A>
<UL>
<LI><A HREF="#Accept_AFS_Object_objects_as_ar">Accept AFS::Object objects as arguments</A>
<LI><A HREF="#stderr_handling">stderr handling</A>
<LI><A HREF="#Test_Suite_fs_lsmount_using_mul">Test Suite: fs lsmount using multiple dirs</A>
</UL>
<LI><A HREF="#Bugs">Bugs</A>
<UL>
<LI><A HREF="#stdout_stderr_buffering_will_bre">stdout/stderr buffering will break the fs examine/diskfree commands</A>
</UL>
</UL>
<!-- INDEX END -->
<P>
Maybe something like that. By the time _exec_cmds returns, we have reaped
the commands, and collected *ALL* of the output into arrays in the object.
<P>
<P>
<HR>
<H2><A NAME="Test_Suite_fs_lsmount_using_mul">Test Suite: fs lsmount using multiple dirs
</A></H2>
We should create several mount points and then query then all with one
lsmount method call, to verify we can parse output for multiple dirs. We
should pass in some bogus paths, too, to verify the error handling is
correct as well (that code feels dubious to me).
<P>
t/00vos_basic.t view on Meta::CPAN
# See ..../src/LICENSE for terms of distribution.
#
# print STDERR Data::Dumper->Dump([$vos],['vos']);
use strict;
use English;
use Data::Dumper;
use vars qw(
$TestCounter
$TestTotal
$Loaded
%Volnames
);
BEGIN {
require "./util/lib/parse_config";
}
BEGIN {
$| = 1;
if ( $AFS::Command::Tests::Config{AFS_COMMAND_DISABLE_TESTS} =~ /\bvos\b/ ) {
$TestTotal = 0;
} elsif ( $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} eq 'your.cell.name' ) {
$TestTotal = 0;
} else {
$TestTotal = 77;
}
print "1..$TestTotal\n";
}
END {print "not ok 1\n" unless $Loaded;}
use AFS::Command::VOS 1.99;
$Loaded = 1;
$TestCounter = 1;
print "ok $TestCounter\n";
$TestCounter++;
exit 0 unless $TestTotal;
#
# First, let's get all the config data we need.
#
my $volname_prefix = $AFS::Command::Tests::Config{AFS_COMMAND_VOLNAME_PREFIX} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_VOLNAME_PREFIX\n";
};
my $cell = $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_CELLNAME\n";
};
my $partition_list = $AFS::Command::Tests::Config{AFS_COMMAND_PARTITION_LIST} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PARTITION_LIST\n";
};
my $binary = $AFS::Command::Tests::Config{AFS_COMMAND_BINARY_VOS} || 'vos';
my @servers = ();
my @partitions = ();
my $server_primary = "";
my $partition_primary = "";
#
# In order to have a predictable number of tests, we only use the
# first 2 server:/vicep* you specify.
#
foreach my $serverpart ( (split(/\s+/,$partition_list))[0..1] ) {
my ($server,$partition) = split(/:/,$serverpart);
unless ( $server && $partition ) {
print "not ok $TestCounter..$TestTotal\n";
die "Invalid server:/partition specification: '$serverpart'\n";
}
$server_primary = $server unless $server_primary;
$partition_primary = $partition unless $partition_primary;
push(@servers,$server);
push(@partitions,$partition);
}
#
# If the constructor fails, we're doomed.
#
my $vos = AFS::Command::VOS->new
(
command => $binary,
);
if ( ref $vos && $vos->isa("AFS::Command::VOS") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to instantiate AFS::Command::VOS object\n";
}
#
# Create a volume.
#
my $volname = $volname_prefix . $PID;
my $volname_readonly = $volname . ".readonly";
$Volnames{$volname}++;
my $result = $vos->create
(
server => $server_primary,
partition => $partition_primary,
name => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to create volume '$volname' on server '$server_primary:$partition_primary' " .
"in cell '$cell'\n" . "Errors from vos command:\n" . $vos->errors());
}
#
# Examine it.
#
$result = $vos->examine
(
id => $volname,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::Volume") ) {
print "ok $TestCounter\n";
$TestCounter++;
my $errors = 0;
#
# First, sanity check the volume header. There should be ONE of them only.
#
my @headers = $result->getVolumeHeaders();
if ( $#headers == 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn "Incorrect number of headers returned by getVolumeHeaders()\n";
$errors++;
}
$TestCounter++;
my $header = $headers[0];
my $rwrite = 0;
if ( ref $header && $header->isa("AFS::Object::VolumeHeader") ) {
print "ok $TestCounter\n";
$TestCounter++;
#
# This had better be on the server and partition we created
# it on, and have the same name/id, obviously.
#
if ( $header->name() eq $volname ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Volume header 'name' is '" .
$header->name() . "', should be '$volname'\n");
$errors++;
}
$TestCounter++;
if ( $header->partition() eq $partition_primary ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'partition' is '" .
$header->partition() . "', should be '$partition_primary'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->server() eq $server_primary ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'server' is '" .
$header->server() . "', should be '$server_primary'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
#
# The volume has to be RW
#
if ( $header->type() eq 'RW' ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'type' is '" .
$header->type() . "', should be 'RW'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
#
# Check the volume IDs. rwrite shold be numeric, ronly and
# backup should b e 0.
#
$rwrite = $header->rwrite();
if ( $rwrite =~ /^\d+$/ ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'rwrite' is '$rwrite', should be a numeric value\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->ronly() == 0 ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'ronly' is '" .
$header->ronly() . "', should be zero\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->backup() == 0 ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'backup' is '" .
$header->backup() . "', should be zero\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
#
# This is a new volume, so access should be 0, and size 2
#
if ( $header->accesses() == 0 ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'accesses' is '" .
$header->access() . "', should be zero\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->size() == 2 ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'size' is '" .
$header->size() . "', should be 2\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
#
# Both the update and creation times should be ctime values.
# NOTE: This test may very well break if LANG is set, and
# affects vos output syntax. Note that in that case, we'll
# need code in VOS.pm to deal with more generic time strings.
#
foreach my $method ( qw( update creation ) ) {
if ( $header->$method() =~ /^\S+\s+\S+\s+\d+\s+\d{2}:\d{2}:\d{2}\s+\d{4}$/ ) {
print "ok $TestCounter\n";
} else {
warn("Volume header '$method' is '" .
$header->$method() . "', should be a ctime date value\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
}
#
# Finally, maxauota must be numeric, and status should be
# 'online'
#
if ( $header->maxquota() =~ /^\d+$/ ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'maxquota' is '" .
$header->maxquota() . "', should be numeric\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->status() eq 'online' ) {
print "ok $TestCounter\n";
} else {
warn("Volume header 'status' is '" .
$header->status() . "', should be 'online'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
} else {
warn("Invalid object -- getVolumeHeaders() did not return an " .
"AFS::Object::VolumeHeader object\n");
print "not ok $TestCounter\n";
$errors++;
}
#
# Second, we check the VLDB entry for this volume.
#
my $vldbentry = $result->getVLDBEntry();
if ( ref $vldbentry && $vldbentry->isa("AFS::Object::VLDBEntry") ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Invalid object type: getVLDBEntry() method call returned bogus data\n" .
Data::Dumper->Dump([$result],['result']));
}
$TestCounter++;
if ( $vldbentry->rwrite() =~ /^\d+$/ ) {
print "ok $TestCounter\n";
} else {
warn("VLDB Entry 'rwrite' is '" .
$vldbentry->rwrite() . "', should be a numeric value\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
#
# This should match the rwrite ID found in the volume headers,
# too.
#
if ( $vldbentry->rwrite() == $rwrite ) {
print "ok $TestCounter\n";
} else {
warn("VLDB entry rwrite id (" . $vldbentry->rwrite() .
"), does not match volume header rwrite id ($rwrite)\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
my @vldbsites = $vldbentry->getVLDBSites();
if ( $#vldbsites == 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn "Incorrect number of sites returned by getVLDBSites()\n";
$errors++;
}
$TestCounter++;
my $vldbsite = $vldbsites[0];
if ( ref $vldbsite && $vldbsite->isa("AFS::Object::VLDBSite") ) {
print "ok $TestCounter\n";
$TestCounter++;
if ( $vldbsite->partition() eq $partition_primary ) {
print "ok $TestCounter\n";
} else {
warn("VLDB Site 'partition' is '" .
$vldbsite->partition() . "', should be '$partition_primary'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $vldbsite->server() eq $server_primary ) {
print "ok $TestCounter\n";
} else {
warn("Volume VLDB Site 'server' is '" .
$vldbsite->server() . "', should be '$server_primary'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
} else {
warn("Invalid object -- getVLDBSites() did not return an " .
"AFS::Object::VLDBSite object\n");
print "not ok $TestCounter..$TestTotal\n";
$errors++;
}
die Data::Dumper->Dump([$result],['result']) if $errors;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to examine volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
#
# Create a backup, an verify that the changes in the examine output.
#
$result = $vos->backup
(
id => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to backup volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
$result = $vos->examine
(
id => $volname,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::Volume") ) {
print "ok $TestCounter\n";
$TestCounter++;
my $errors = 0;
my @headers = $result->getVolumeHeaders();
if ( $#headers == 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn "Incorrect number of headers returned by getVolumeHeaders()\n";
$errors++;
}
$TestCounter++;
my $header = $headers[0];
my $rwrite = 0;
if ( ref $header && $header->isa("AFS::Object::VolumeHeader") ) {
print "ok $TestCounter\n";
$TestCounter++;
#
# This time through, we're looking for just the things we
# expect a vos backup to change, and nothing else.
#
if ( $header->backup() =~ /^\d+/ ) {
print "ok $TestCounter\n";
$TestCounter++;
if ( $header->backup() > 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Volume header 'backup' is '" .
$header->backup() . "', should be non-zero\n");
}
} else {
print "not ok $TestCounter\n";
$TestCounter++;
print "not ok $TestCounter\n";
warn("Volume header 'backup' is '" .
$header->backup() . "', should be numeric\n");
$errors++;
}
$TestCounter++;
} else {
warn("Invalid object -- getVolumeHeaders() did not return an " .
"AFS::Object::VolumeHeader object\n");
print "not ok $TestCounter\n";
$errors++;
}
die Data::Dumper->Dump([$result],['result']) if $errors;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to examine volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
#
# Now let's add the other replica sites, and release the volume.
#
for ( my $index = 0 ; $index <= $#servers ; $index++ ) {
my $server = $servers[$index];
my $partition = $partitions[$index];
$result = $vos->addsite
(
id => $volname,
server => $server,
partition => $partition,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to addsite '$server:$partition' to volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
}
$result = $vos->listvldb
(
name => $volname,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::VLDB") ) {
print "ok $TestCounter\n";
$TestCounter++;
my $errors = 0;
my @volnames = $result->getVolumeNames();
if ( $#volnames == 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn "Incorrect number of volnames returned by getVolumeNames()\n";
$errors++;
}
$TestCounter++;
my $volname_queried = $volnames[0];
if ( $volname eq $volname_queried ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn "Volname returned by query ($volname_queried) does not match that specified ($volname)\n";
$errors++;
}
$TestCounter++;
#
# If either of the above failed, we can't go on...
#
die Data::Dumper->Dump([$result],['result']) if $errors;
my $vldbentry = $result->getVLDBEntryByName($volname);
if ( ref $vldbentry && $vldbentry->isa("AFS::Object::VLDBEntry") ) {
print "ok $TestCounter\n";
$TestCounter++;
my $rwrite = $vldbentry->rwrite();
my $altentry = $result->getVLDBEntryById($rwrite);
if ( ref $altentry && $altentry->isa("AFS::Object::VLDBEntry") &&
$altentry->rwrite() == $rwrite &&
$altentry->name() eq $volname ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
}
$TestCounter++;
my @vldbsites = $vldbentry->getVLDBSites();
if ( $#vldbsites == ($#servers+1) ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Incorrect number of vldbsites returned by getVLDBSites\n" .
"Should be " . ($#servers+1) . ", but is " . $#vldbsites . "\n");
}
for ( my $index = 0 ; $index <= $#vldbsites ; $index++ ) {
my $vldbsite = $vldbsites[$index];
my $serverindex = $index - 1;
$serverindex = 0 if $serverindex == -1;
if ( $vldbsite->server() eq $servers[$serverindex] ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("VLDB Site [$index] server is '" . $vldbsite->server() . "'\n" .
"Should be '" . $servers[$serverindex] . "'\n");
$errors++;
}
$TestCounter++;
if ( $vldbsite->partition() eq $partitions[$serverindex] ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("VLDB Site [$index] partition is '" . $vldbsite->partition() . "'\n" .
"Should be '" . $partitions[$serverindex] . "'\n");
$errors++;
}
$TestCounter++;
my $typeshould = $index == 0 ? "RW" : "RO";
if ( $vldbsite->type() eq $typeshould ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("VLDB Site [$index] type is '" . $vldbsite->type() . "'\n" .
"Should be '$typeshould'\n");
$errors++;
}
$TestCounter++;
my $statusshould = $index == 0 ? "" : "Not released";
if ( $vldbsite->status() eq $statusshould ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("VLDB Site [$index] status is '" . $vldbsite->status() . "'\n" .
"Should be '$statusshould'\n");
$errors++;
}
$TestCounter++;
}
die Data::Dumper->Dump([$vldbentry],['vldbentry']) if $errors;
} else {
warn("Invalid object -- getVLDBEntry() did not return an " .
"AFS::Object::VLDBEntry object\n");
print "not ok $TestCounter\n";
$errors++;
}
die Data::Dumper->Dump([$result],['result']) if $errors;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to listvldb volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
foreach my $force ( qw( none f force ) ) {
$result = $vos->release
(
id => $volname,
cell => $cell,
(
$force eq 'none' ? () :
( $force => 1 )
),
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to release volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
$TestCounter++;
}
#
# The volume is released, so now, let's examine the readonly, and make
# sure we get the correct volume headers.
#
$result = $vos->examine
(
id => $volname_readonly,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::Volume") ) {
print "ok $TestCounter\n";
$TestCounter++;
my $errors = 0;
my @headers = $result->getVolumeHeaders();
if ( $#headers == $#servers ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Number of headers returned by getVolumeHeaders ($#headers) " .
"does not match number of servers ($#servers)\n");
$errors++;
}
$TestCounter++;
for ( my $index = 0 ; $index <= $#headers ; $index++ ) {
my $header = $headers[$index];
if ( $header->name() eq $volname_readonly ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Volume header [$index] 'name' is '" .
$header->name() . "', should be '$volname_readonly'\n");
$errors++;
}
$TestCounter++;
if ( $header->partition() eq $partitions[$index] ) {
print "ok $TestCounter\n";
} else {
warn("Volume header [$index] 'partition' is '" .
$header->partition() . "', should be '$partitions[$index]'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->server() eq $servers[$index] ) {
print "ok $TestCounter\n";
} else {
warn("Volume header [$index] 'server' is '" .
$header->server() . "', should be '$servers[$index]'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
if ( $header->type() eq 'RO' ) {
print "ok $TestCounter\n";
} else {
warn("Volume header [$index] 'type' is '" .
$header->type() . "', should be 'RO'\n");
print "not ok $TestCounter\n";
$errors++;
}
$TestCounter++;
}
die Data::Dumper->Dump([$result],['result']) if $errors;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to examine volume '$volname' in cell '$cell':\n" .
$vos->errors());
}
#
# Finally, let's clean up after ourselves.
#
for ( my $index = 0 ; $index <= $#servers ; $index++ ) {
$result = $vos->remove
(
id => $volname_readonly,
server => $servers[$index],
partition => $partitions[$index],
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove volume '$volname_readonly' from server '$servers[$index]', " .
"partition '$partitions[$index]', in cell '$cell':\n" .
$vos->errors());
}
$TestCounter++;
}
#
# Test the vos offline functionality, if supported.
#
if ( $vos->supportsOperation('offline') ) {
foreach my $method ( qw(offline online) ) {
$result = $vos->$method
(
id => $volname,
server => $servers[0],
partition => $partitions[0],
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
die("Unable to $method volume '$volname' from server '$servers[0]', " .
"partition '$partitions[0]', in cell '$cell':\n" .
$vos->errors());
}
$TestCounter++;
$result = $vos->examine
(
id => $volname,
cell => $cell,
);
if ( ref $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
die("Unable to examine volume '$volname' on server '$servers[0]', " .
"partition '$partitions[0]', in cell '$cell':\n" .
$vos->errors());
}
$TestCounter++;
my ($header) = $result->getVolumeHeaders();
if ( $header->status() eq $method ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Volume '$volname' on server '$servers[0]', " .
"partition '$partitions[0]', in cell '$cell' was not $method");
}
$TestCounter++;
if ( $header->attached() ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Volume '$volname' on server '$servers[0]', " .
"partition '$partitions[0]', in cell '$cell' does not appear to be attached");
}
$TestCounter++;
}
} else {
for ( my $index = 0 ; $index <= 7 ; $index++ ) {
print "ok $TestCounter\n";
$TestCounter++;
}
}
$result = $vos->remove
(
id => $volname,
server => $servers[0],
partition => $partitions[0],
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
delete $Volnames{$volname};
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove volume '$volname' from server '$servers[0]', " .
"partition '$partitions[0]', in cell '$cell':\n" .
$vos->errors());
}
$TestCounter++;
#
# Finally, one we *expect* to fail...
#
$result = $vos->examine
(
id => $volname,
cell => $cell,
);
if ( $result ) {
print "not ok $TestCounter..$TestTotal\n";
die("Volume '$volname' in cell '$cell', still exists after a successful vos remove!!\n");
} elsif ( $vos->errors() =~ /VLDB: no such entry/i ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unexpected result from vos examine:\n" . $vos->errors());
}
$TestCounter++;
exit 0;
END {
#$TestCounter--;
#warn "Total number of tests == $TestCounter\n";
if ( %Volnames ) {
warn("The following temporary volumes were created, and may be left over:\n\t" .
join("\n\t",sort keys %Volnames) . "\n");
}
}
t/01vos_dumprestore.t view on Meta::CPAN
# See ..../src/LICENSE for terms of distribution.
#
# print STDERR Data::Dumper->Dump([$vos],['vos']);
use strict;
use English;
use Data::Dumper;
use vars qw(
$TestCounter
$TestTotal
$Loaded
%Volnames
);
BEGIN {
require "./util/lib/parse_config";
}
BEGIN {
$| = 1;
if ( $AFS::Command::Tests::Config{AFS_COMMAND_DISABLE_TESTS} =~ /\bvos\b/ ) {
$TestTotal = 0;
} elsif ( $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} eq 'your.cell.name' ) {
$TestTotal = 0;
} else {
$TestTotal = 19;
}
print "1..$TestTotal\n";
}
END {print "not ok 1\n" unless $Loaded;}
use AFS::Command::VOS 1.99;
$Loaded = 1;
$TestCounter = 1;
print "ok $TestCounter\n";
$TestCounter++;
exit 0 unless $TestTotal;
#
# First, let's get all the config data we need.
#
my $volname_prefix = $AFS::Command::Tests::Config{AFS_COMMAND_VOLNAME_PREFIX} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_VOLNAME_PREFIX\n";
};
my $cell = $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_CELLNAME\n";
};
my $partition_list = $AFS::Command::Tests::Config{AFS_COMMAND_PARTITION_LIST} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PARTITION_LIST\n";
};
my $binary = $AFS::Command::Tests::Config{AFS_COMMAND_BINARY_VOS} || 'vos';
my %enabled =
(
gzip => $AFS::Command::Tests::Config{AFS_COMMAND_GZIP_ENABLED},
bzip2 => $AFS::Command::Tests::Config{AFS_COMMAND_BZIP2_ENABLED},
);
$enabled{gunzip} = $enabled{gzip};
$enabled{bunzip2} = $enabled{bzip2};
my $dumpfilter = $AFS::Command::Tests::Config{AFS_COMMAND_DUMP_FILTER};
my $restorefilter = $AFS::Command::Tests::Config{AFS_COMMAND_RESTORE_FILTER};
my $tmproot = $AFS::Command::Tests::Config{AFS_COMMAND_TMP_ROOT};
my @servers = ();
my @partitions = ();
my $server_primary = "";
my $partition_primary = "";
foreach my $serverpart ( split(/\s+/,$partition_list) ) {
my ($server,$partition) = split(/:/,$serverpart);
unless ( $server && $partition ) {
print "not ok $TestCounter..$TestTotal\n";
die "Invalid server:/partition specification: '$serverpart'\n";
}
$server_primary = $server unless $server_primary;
$partition_primary = $partition unless $partition_primary;
push(@servers,$server);
push(@partitions,$partition);
}
#
# If the constructor fails, we're doomed.
#
my $vos = AFS::Command::VOS->new
(
command => $binary,
);
if ( ref $vos && $vos->isa("AFS::Command::VOS") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to instantiate AFS::Command::VOS object\n";
}
#
# Create a volume.
#
my $volname = $volname_prefix . $PID;
my $result = $vos->create
(
server => $server_primary,
partition => $partition_primary,
name => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
$Volnames{$volname}++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to create volume '$volname' on server '$server_primary:$partition_primary'" .
"in cell '$cell'\n" . "Errors from vos command:\n" . $vos->errors());
}
#
# OK, let's create a few dump files, in different ways.
#
# First, a vanilla dump, nothing special.
#
my %files =
t/01vos_dumprestore.t view on Meta::CPAN
$files{bunzip2} = $files{bzip2};
$result = $vos->dump
(
id => $volname,
time => 0,
file => $files{raw},
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to dump volume '$volname' in cell '$cell' to file '$files{raw}':\n" .
$vos->errors());
}
$TestCounter++;
foreach my $ctype ( qw(gzip bzip2) ) {
unless ( $enabled{$ctype} ) {
for ( my $count = 0 ; $count < 3 ; $count++ ) {
print "ok $TestCounter # skip Compression support for $ctype disabled\n";
$TestCounter++;
}
next;
}
#
# Now, with *implicit* use of gzip (via the filename)
#
$result = $vos->dump
(
id => $volname,
time => 0,
file => $files{$ctype},
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to dump volume '$volname' in cell '$cell' to file '$files{$ctype}':\n" .
$vos->errors());
}
$TestCounter++;
#
# Next, explicitly, using the gzip/bzip2 argument
#
$result = $vos->dump
(
id => $volname,
time => 0,
file => $files{raw},
cell => $cell,
$ctype => 4,
);
if ( $result ) {
if ( -f $files{$ctype} ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unexpected result: dump method did not produce an output file\n");
}
} else {
print "not ok $TestCounter\n";
warn("Unable to dump volume '$volname' in cell '$cell' to file '$files{$ctype}':\n" .
$vos->errors());
}
$TestCounter++;
#
# Finally, when both are given.
#
$result = $vos->dump
(
id => $volname,
time => 0,
file => $files{$ctype},
cell => $cell,
$ctype => 4,
);
if ( $result ) {
if ( -f $files{$ctype} ) {
print "ok $TestCounter\n";
} elsif ( -f $files{raw} ) {
print "not ok $TestCounter\n";
warn("Unexpected result: dump method created file '$files{raw}', " .
"should have been '$files{$ctype}'\n" .
"(Both -file $files{$ctype}, and -$ctype specified)\n");
} else {
print "not ok $TestCounter\n";
warn("Unexpected result: dump method did not produce an output file\n");
}
} else {
print "not ok $TestCounter\n";
warn("Unable to dump volume '$volname' in cell '$cell' to file '$files{$ctype}':\n" .
$vos->errors());
die Data::Dumper->Dump([$vos],['vos']);
}
$TestCounter++;
}
if ( $dumpfilter ) {
$result = $vos->dump
(
id => $volname,
time => 0,
file => $files{raw},
cell => $cell,
filterout => [$dumpfilter],
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to dump volume '$volname' in cell '$cell' to file '$files{raw}':\n" .
$vos->errors());
}
$TestCounter++;
my ($ctype) = ( $enabled{gzip} ? 'gzip' :
$enabled{bzip2} ? 'bzip2' : '' );
if ( $ctype ) {
$result = $vos->dump
(
id => $volname,
time => 0,
file => $files{$ctype},
cell => $cell,
filterout => [$dumpfilter],
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to dump volume '$volname' in cell '$cell' to file '$files{raw}':\n" .
"(Testing dump filter with compression)\n" .
$vos->errors());
}
} else {
print "ok $TestCounter # skip Compression support disabled\n";
}
$TestCounter++;
} else {
for ( my $count = 0 ; $count < 2 ; $count++ ) {
print "ok $TestCounter # skip Dump filter tests disabled\n";
$TestCounter++;
}
}
#
# Finally, let's remove that volume, so we can reuse the name for the
# restore tests.
#
$result = $vos->remove
(
server => $server_primary,
partition => $partition_primary,
id => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove volume '$volname' from server '$server_primary', " .
"partition '$partition_primary', in cell '$cell':\n" .
$vos->errors());
}
#
# If we made it this far, dump works fine. Now let's test restore...
#
$result = $vos->restore
(
server => $server_primary,
partition => $partition_primary,
name => $volname,
file => $files{raw},
overwrite => 'full',
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$Volnames{$volname}++;
} else {
print "not ok $TestCounter\n";
warn("Unable to restore volume '$volname' from file '$files{raw}',\n" .
"to server '$server_primary', partition '$partition_primary', name '$volname':\n" .
$vos->errors());
}
$TestCounter++;
foreach my $ctype ( qw(gunzip bunzip2) ) {
unless ( $enabled{$ctype} ) {
for ( my $count = 0 ; $count < 1 ; $count++ ) {
print "ok $TestCounter # skip Compression support for $ctype disabled\n";
$TestCounter++;
}
next;
}
$result = $vos->restore
(
server => $server_primary,
partition => $partition_primary,
name => $volname,
file => $files{$ctype},
overwrite => 'full',
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to restore volume '$volname' from file '$files{$ctype}',\n" .
"to server '$server_primary', partition '$partition_primary', name '$volname':\n" .
$vos->errors());
}
$TestCounter++;
}
if ( $restorefilter ) {
$result = $vos->restore
(
server => $server_primary,
partition => $partition_primary,
name => $volname,
file => $files{raw},
overwrite => 'full',
cell => $cell,
filterin => [$restorefilter],
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to restore volume '$volname' from file '$files{raw}',\n" .
"using restore filter '$restorefilter', " .
"to server '$server_primary', partition '$partition_primary', name '$volname':\n" .
$vos->errors());
}
$TestCounter++;
my ($ctype) = ( $enabled{gunzip} ? 'gunzip' :
$enabled{bunzip2} ? 'bunzip2' : '' );
if ( $ctype ) {
$result = $vos->restore
(
server => $server_primary,
partition => $partition_primary,
name => $volname,
file => $files{$ctype},
overwrite => 'full',
cell => $cell,
filterin => [$restorefilter],
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to restore volume '$volname' from file '$files{$ctype}',\n" .
"using restore filter '$restorefilter', " .
"to server '$server_primary', partition '$partition_primary', name '$volname':\n" .
$vos->errors());
}
} else {
print "ok $TestCounter # skip Compression support disabled\n";
}
$TestCounter++;
} else {
for ( my $count = 0 ; $count < 2 ; $count++ ) {
print "ok $TestCounter # skip Restoreg filter tests disabled\n";
$TestCounter++;
}
}
$result = $vos->remove
(
server => $server_primary,
partition => $partition_primary,
id => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
delete $Volnames{$volname};
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove volume '$volname' from server '$server_primary', " .
"partition '$partition_primary', in cell '$cell':\n" .
$vos->errors());
}
exit 0;
END {
#$TestCounter--;
#warn "Total number of tests == $TestCounter\n";
if ( %Volnames ) {
warn("The following temporary volumes were created, and may be left over:\n\t" .
join("\n\t",sort keys %Volnames) . "\n");
}
}
t/02vos_volserver.t view on Meta::CPAN
# See ..../src/LICENSE for terms of distribution.
#
# print STDERR Data::Dumper->Dump([$vos],['vos']);
use strict;
use English;
use Data::Dumper;
use vars qw(
$TestCounter
$TestTotal
$Loaded
%Volnames
);
BEGIN {
require "./util/lib/parse_config";
}
BEGIN {
$| = 1;
if ( $AFS::Command::Tests::Config{AFS_COMMAND_DISABLE_TESTS} =~ /\bvos\b/ ) {
$TestTotal = 0;
} elsif ( $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} eq 'your.cell.name' ) {
$TestTotal = 0;
} else {
$TestTotal = 17;
}
print "1..$TestTotal\n";
}
END {print "not ok 1\n" unless $Loaded;}
use AFS::Command::VOS 1.99;
$Loaded = 1;
$TestCounter = 1;
print "ok $TestCounter\n";
$TestCounter++;
exit 0 unless $TestTotal;
#
# First, let's get all the config data we need.
#
my $volname_prefix = $AFS::Command::Tests::Config{AFS_COMMAND_VOLNAME_PREFIX} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_VOLNAME_PREFIX\n";
};
my $cell = $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_CELLNAME\n";
};
my $partition_list = $AFS::Command::Tests::Config{AFS_COMMAND_PARTITION_LIST} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PARTITION_LIST\n";
};
my $binary = $AFS::Command::Tests::Config{AFS_COMMAND_BINARY_VOS} || 'vos';
my @servers = ();
my @partitions = ();
my $server_primary = "";
my $partition_primary = "";
foreach my $serverpart ( split(/\s+/,$partition_list) ) {
my ($server,$partition) = split(/:/,$serverpart);
unless ( $server && $partition ) {
print "not ok $TestCounter..$TestTotal\n";
die "Invalid server:/partition specification: '$serverpart'\n";
}
$server_primary = $server unless $server_primary;
$partition_primary = $partition unless $partition_primary;
push(@servers,$server);
push(@partitions,$partition);
}
#
# If the constructor fails, we're doomed.
#
my $vos = AFS::Command::VOS->new
(
command => $binary,
);
if ( ref $vos && $vos->isa("AFS::Command::VOS") ) {
print "# AFS::Command::VOS->new()\n";
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to instantiate AFS::Command::VOS object\n";
}
#
# Thi test is kinda boring... Just verifying that partinfo and
# listpart are consistent.
#
my $listpart = $vos->listpart
(
server => $server_primary,
cell => $cell,
);
if ( ref $listpart && $listpart->isa("AFS::Object::FileServer") ) {
print "# AFS::Command::VOS->listpart()\n";
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to query partinfo on server '$server_primary', in cell '$cell':\n" .
$vos->errors());
}
my $partinfo = $vos->partinfo
(
server => $server_primary,
cell => $cell,
);
if ( ref $partinfo && $partinfo->isa("AFS::Object::FileServer") ) {
print "# AFS::Command::VOS->partinfo()\n";
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to query partinfo on server '$server_primary', in cell '$cell':\n" .
$vos->errors());
}
foreach my $objectpair ( [ $partinfo, $listpart ], [ $listpart, $partinfo ] ) {
my ($src,$dst) = @$objectpair;
my @partitions = $src->getPartitionNames();
if ( @partitions ) {
print "# AFS::Command::VOS->getPartitionNames()\n";
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get list of partition names for server '$server_primary', in cell '$cell':\n");
}
my $attribute_test = 1;
foreach my $partname ( @partitions ) {
my $partition = $dst->getPartition($partname);
unless ( ref $partition && $partition->isa("AFS::Object::Partition") ) {
print "not ok $TestCounter..$TestTotal\n";
die("Inconsistent data in listpart and partinfo output\n" .
"Found partname '$partname' in one, but not the other");
}
if ( $partition->hasAttribute('available') ) {
my $available = $partition->available();
my $total = $partition->total();
unless ( $available =~ /^\d+$/ && $total =~ /^\d+$/ && $available < $total ) {
t/02vos_volserver.t view on Meta::CPAN
"Available is '$available', total is '$total'\n" .
"both must be numeric, and available less than total\n");
}
}
}
print "# AFS::Command::VOS->hasAttribute()\n";
print "not " unless $attribute_test;
print "ok $TestCounter\n";
$TestCounter++;
}
#
# Now that we can trust listpart and partinfo, let's see if we can
# trust listvol.
#
#
# First, let's make sure the partition lists are consisent.
#
my $listvol = $vos->listvol
(
server => $server_primary,
cell => $cell,
fast => 1,
);
unless ( ref $listvol && $listvol->isa("AFS::Object::VolServer") ) {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to query listvol for server '$server_primary', in cell '$cell':\n" .
Data::Dumper->Dump([$vos],['vos']));
}
print "# AFS::Command::VOS->listvol()\n";
print "ok $TestCounter\n";
$TestCounter++;
my $listpart_names = { map { $_ => 1 } $listpart->getPartitionNames() };
my $listvol_names = { map { $_ => 1 } $listvol->getPartitionNames() };
my $partname_errors = 0;
foreach my $hashpair ( [ $listpart_names, $listvol_names ],
[ $listvol_names, $listpart_names ] ) {
my ($src,$dst) = @$hashpair;
foreach my $partname ( keys %$src ) {
$partname_errors++ unless $dst->{$partname};
}
}
if ( $partname_errors ) {
print "not ok $TestCounter\n";
warn("Partition lists from listpart and listvol are inconsistent:\n" .
Data::Dumper->Dump([$listpart_names,$listvol_names],['listpart','listvol']));
} else {
print "# AFS::Command::VOS, listpart vs. listvol comparison\n";
print "ok $TestCounter\n";
}
$TestCounter++;
#
# Now, let's get more verbose output, for just one partition.
#
$listvol = $vos->listvol
(
server => $server_primary,
partition => $partition_primary,
cell => $cell,
);
unless ( ref $listvol && $listvol->isa("AFS::Object::VolServer") ) {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to query listvol for server '$server_primary', " .
"partition '$partition_primary', in cell '$cell':\n" .
Data::Dumper->Dump([$vos],['vos']));
}
print "# AFS::Command::VOS->listvol()\n";
print "ok $TestCounter\n";
$TestCounter++;
my $partition = $listvol->getPartition($partition_primary);
unless ( ref $partition && $partition->isa("AFS::Object::Partition") ) {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to query listvol for server '$server_primary', " .
"partition '$partition_primary', in cell '$cell':\n" .
Data::Dumper->Dump([$listvol],['listvol']));
}
print "# AFS::Command::VOS->getPartition()\n";
print "ok $TestCounter\n";
$TestCounter++;
my $id_errors = 0;
my @ids = $partition->getVolumeIds();
unless ( @ids ) {
warn "Empty volume id list returned by getVolumeIds()\n";
$id_errors++;
}
foreach my $id ( @ids ) {
t/02vos_volserver.t view on Meta::CPAN
warn("Objects returned by getVolumeHeaderById and getVolumeHeader do not match:\n" .
Data::Dumper->Dump([$volume_byid,$volume_generic],
['getVolumeHeaderById','getVolumeHeader']));
$id_errors++;
}
}
print "not " if $id_errors;
print "# AFS::Command::VOS->getPartition id check\n";
print "ok $TestCounter\n";
$TestCounter++;
my $name_errors = 0;
my @names = $partition->getVolumeNames();
unless ( @names ) {
warn "Empty volume name list returned by get VolumeNames()\n";
$name_errors++;
}
my $volume_online = "";
t/02vos_volserver.t view on Meta::CPAN
}
if ( $volume_byname->status() eq 'online' && not ref $volume_online ) {
$volume_online = $volume_byname;
}
}
print "not " if $name_errors;
print "# AFS::Command::VOS->getPartition name check\n";
print "ok $TestCounter\n";
$TestCounter++;
#
# Since we trust examine by this point, we can examine the one online
# volume we kept track of, and make sure the headers match.
#
my $volname = $volume_online->name();
my $examine = $vos->examine
(
id => $volname,
cell => $cell,
);
unless ( ref $examine && $examine->isa("AFS::Object::Volume") ) {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to exmine volume '$volname' in cell '$cell':\n" .
Data::Dumper->Dump([$vos],['vos']));
}
print "# AFS::Command::VOS->examine()\n";
print "ok $TestCounter\n";
$TestCounter++;
my @headers = $examine->getVolumeHeaders();
unless ( @headers ) {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get volume headers from examine call:\n" .
Data::Dumper->Dump([$examine],['examine']));
}
print "# AFS::Command::VOS->getVolumeHeaders()\n";
print "ok $TestCounter\n";
$TestCounter++;
my $volume_header = "";
foreach my $header ( @headers ) {
unless ( ref $header && $header->isa("AFS::Object::VolumeHeader") ) {
print "not ok $TestCounter..$TestTotal\n";
die("Objects returned by getVolumeHeaders are not AFS::Object::VolumeHeader:\n" .
Data::Dumper->Dump([$examine],['examine']));
}
if ( $header->server() eq $server_primary &&
$header->partition() eq $partition_primary ) {
$volume_header = $header;
last;
}
}
unless ( ref $volume_header && $volume_header->isa("AFS::Object::VolumeHeader") ) {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to locate matching volume header in examine output:\n" .
Data::Dumper->Dump([$examine],['examine']));
}
print "# AFS::Command::VOS->getVolumeHeaders header check\n";
print "ok $TestCounter\n";
$TestCounter++;
exit 0;
END {
# $TestCounter--;
# warn "Total number of tests == $TestCounter\n";
if ( %Volnames ) {
warn("The following temporary volumes were created, and may be left over:\n\t" .
join("\n\t",sort keys %Volnames) . "\n");
}
}
t/10bos_basic.t view on Meta::CPAN
# See ..../src/LICENSE for terms of distribution.
#
# print STDERR Data::Dumper->Dump([$bos],['bos']);
use strict;
use English;
use Data::Dumper;
use vars qw(
$TestCounter
$TestTotal
$Loaded
);
BEGIN {
require "./util/lib/parse_config";
}
BEGIN {
$| = 1;
if ( $AFS::Command::Tests::Config{AFS_COMMAND_DISABLE_TESTS} =~ /\bbos\b/ ) {
$TestTotal = 0;
} elsif ( $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} eq 'your.cell.name' ) {
$TestTotal = 0;
} else {
$TestTotal = 48;
}
print "1..$TestTotal\n";
}
END {print "not ok 1\n" unless $Loaded;}
use AFS::Command::BOS 1.99;
$Loaded = 1;
$TestCounter = 1;
print "ok $TestCounter\n";
$TestCounter++;
my $cell = $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_CELLNAME\n";
};
my $dbserver = $AFS::Command::Tests::Config{AFS_COMMAND_DBSERVER} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PARTITION_LIST\n";
};
my $binary = $AFS::Command::Tests::Config{AFS_COMMAND_BINARY_BOS} || 'bos';
exit 0 unless $TestTotal;
#
# First, test the constructor
#
my $bos = AFS::Command::BOS->new
(
command => $binary,
);
if ( ref $bos && $bos->isa("AFS::Command::BOS") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to instantiate AFS::Command::BOS object\n";
}
#
# bos getdate
#
my $result = $bos->getdate
(
server => $dbserver,
cell => $cell,
file => 'bosserver',
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to getdate for bosserver:\n" . $bos->errors());
}
my @files = $result->getFileNames();
if ( grep($_ eq 'bosserver',@files) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Didn't find 'bosserver' in results from bos->getdate()");
}
$TestCounter++;
my $file = $result->getFile('bosserver');
if ( ref $file && $file->isa("AFS::Object") ) {
print "ok $TestCounter\n";
$TestCounter++;
my $date = $file->date();
if ( $date ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("No date found for file 'bosserver' in results from bos->getdate()");
}
$TestCounter++;
} else {
print "not ok $TestCounter\n";
$TestCounter++;
print "not ok $TestCounter\n";
$TestCounter++;
warn("Didn't find 'bosserver' in results from bos->getdate()");
}
#
# bos getlog
#
$result = $bos->getlog
(
server => $dbserver,
cell => $cell,
file => '/usr/afs/logs/BosLog',
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to getlog for bosserver:\n" . $bos->errors());
}
my $log = $result->log();
if ( $log ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to getlog for bosserver:\n" . $bos->errors());
}
my ($firstline) = split(/\n+/,$log);
my $tmpfile = "/var/tmp/.bos.getlog.results.$$";
$result = $bos->getlog
(
server => $dbserver,
cell => $cell,
file => '/usr/afs/logs/BosLog',
redirect => $tmpfile,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to getlog for bosserver:\n" . $bos->errors());
}
$log = $result->log();
if ( $log eq $tmpfile ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to getlog for bosserver:\n" . $bos->errors());
}
$file = IO::File->new($tmpfile) || do {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to read $tmpfile: $ERRNO\n";
};
if ( $file->getline() eq "$firstline\n" ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter..$TestTotal\n";
warn("Contents of bos->getlog() do not match when fetched\n" .
"with and without 'redirect' option\n");
}
$TestCounter++;
#
# bos getrestart
#
$result = $bos->getrestart
(
server => $dbserver,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to getrestart for bosserver:\n" . $bos->errors());
}
foreach my $attr ( qw(restart binaries) ) {
if ( $result->$attr() ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to get $attr time from bos->getrestart()\n");
}
$TestCounter++;
}
#
# bos listhosts
#
$result = $bos->listhosts
(
server => $dbserver,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to listhosts for bosserver:\n" . $bos->errors());
}
if ( $result->cell() eq $cell ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Cell name returned by listhosts '" . $result->cell() .
"' does not match '$cell'");
}
$TestCounter++;
my $hosts = $result->hosts();
if ( ref $hosts eq 'ARRAY' ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Not an ARRAY ref: bos->listhosts->hosts()\n");
}
$TestCounter++;
#
# bos listkeys
#
$result = $bos->listkeys
(
server => $dbserver,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to listkeys for bosserver:\n" . $bos->errors());
}
my @indexes = $result->getKeyIndexes();
if ( @indexes ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get indexes from listkeys for bosserver\n");
}
foreach my $index ( @indexes ) {
my $key = $result->getKey($index);
if ( ref $result && $result->isa("AFS::Object") ) {
print "ok $TestCounter\n";
$TestCounter++;
if ( $key->cksum() ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Key for index '$index' has no cksum\n");
}
$TestCounter++;
} else {
print "not ok $TestCounter\n";
$TestCounter++;
print "not ok $TestCounter\n";
$TestCounter++;
warn("Unable to get key for index '$index' from listkeys result\n");
}
}
#
# bos listusers
#
$result = $bos->listusers
(
server => $dbserver,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to listusers for bosserver:\n" . $bos->errors());
}
my $susers = $result->susers();
if ( ref $susers eq 'ARRAY' ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Not an ARRAY ref: bos->listusers->susers()\n");
}
$TestCounter++;
#
# bos status
#
$result = $bos->status
(
server => $dbserver,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get status from bosserver:\n" . $bos->errors());
}
my @instancenames = $result->getInstanceNames();
if ( @instancenames ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get instance names from bos->status->getInstanceNames()\n");
}
foreach my $name ( qw(vlserver ptserver) ) {
if ( grep($_ eq $name,@instancenames) ) {
print "ok $TestCounter\n";
$TestCounter++;
my $instance = $result->getInstance($name);
if ( ref $instance && $instance->isa("AFS::Object::Instance") ) {
print "ok $TestCounter\n";
$TestCounter++;
if ( $instance->status() ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("No status attribute for instance '$name' from getInstance()\n");
}
$TestCounter++;
} else {
print "not ok $TestCounter\n";
$TestCounter++;
warn("Unable to get instance '$name' from getInstance()\n");
}
} else {
print "not ok $TestCounter.." . ($TestCounter+3) ."\n";
$TestCounter += 3;
warn("Did not find instance '$name' in bos status output\n");
}
}
$result = $bos->status
(
server => $dbserver,
cell => $cell,
long => 1,
);
if ( ref $result && $result->isa("AFS::Object::BosServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get status from bosserver:\n" . $bos->errors());
}
foreach my $name ( qw(vlserver ptserver) ) {
my $instance = $result->getInstance($name);
if ( ref $instance && $instance->isa("AFS::Object::Instance") ) {
print "ok $TestCounter\n";
$TestCounter++;
foreach my $attr ( qw(status type startdate startcount) ) {
if ( $instance->$attr() ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("No attribute '$attr' for instance '$name' from getInstance()\n");
}
$TestCounter++;
}
my @commands = $instance->getCommands();
if ( $#commands == 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Instance '$name' has more than one command\n");
}
$TestCounter++;
my $command = $commands[0];
if ( $command->index() == 1 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Command should have index == 1, but has index == " .
$command->index() . "\n");
}
$TestCounter++;
if ( $command->command() =~ /$name/) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Command should have command attr matching '/$name/', but is " .
$command->command() . "\n");
}
$TestCounter++;
} else {
print "not ok $TestCounter.." . ($TestCounter+7) . "\n";
$TestCounter += 7;
warn("Unable to get instance '$name' from getInstance()\n");
}
}
exit 0;
END {
#$TestCounter--;
#warn "Total number of tests == $TestCounter\n";
}
t/20fs_basic.t view on Meta::CPAN
# See ..../src/LICENSE for terms of distribution.
#
# print STDERR Data::Dumper->Dump([$vos],['vos']);
use strict;
use English;
use Data::Dumper;
use vars qw(
$TestCounter
$TestTotal
$Loaded
);
BEGIN {
require "./util/lib/parse_config";
}
BEGIN {
$| = 1;
if ( $AFS::Command::Tests::Config{AFS_COMMAND_DISABLE_TESTS} =~ /\bfs\b/ ) {
$TestTotal = 0;
} elsif ( $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} eq 'your.cell.name' ) {
$TestTotal = 0;
} else {
$TestTotal = 124;
}
print "1..$TestTotal\n";
}
END {print "not ok 1\n" unless $Loaded;}
use AFS::Command::FS 1.99;
$Loaded = 1;
$TestCounter = 1;
print "ok $TestCounter\n";
$TestCounter++;
exit 0 unless $TestTotal;
my $cell = $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_CELLNAME\n";
};
my $pathafs = $AFS::Command::Tests::Config{AFS_COMMAND_PATHNAME_AFS} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PATHNAME_AFS\n";
};
my $pathnotafs = "/var/tmp";
my $pathbogus = "/this/does/not/exist";
my $binary = $AFS::Command::Tests::Config{AFS_COMMAND_BINARY_FS} || 'fs';
#
# If the constructor fails, we're doomed.
#
my $fs = AFS::Command::FS->new
(
command => $binary,
);
if ( ref $fs && $fs->isa("AFS::Command::FS") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to instantiate AFS::Command::FS object\n";
}
#
# fs checkservers
#
my $result = $fs->checkservers();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call checkservers:\n" . $fs->errors();
}
my $servers = $result->servers();
if ( ref $servers eq 'ARRAY' ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Not an ARRAY ref: fs->checkservers->servers()\n");
}
$TestCounter++;
$result = $fs->checkservers
(
interval => 0,
);
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call checkservers:\n" . $fs->errors();
}
if ( $result->interval() =~ /^\d+$/ ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Not an integer: fs->checkservers->interval()\n");
}
$TestCounter++;
#
# All the common _paths_method methods
#
my $paths = [ $pathafs, $pathnotafs, $pathbogus ];
my %pathops =
(
diskfree => [qw( volname total used avail percent )],
examine => [qw( volname total avail id quota )],
t/20fs_basic.t view on Meta::CPAN
whereis => [qw( hosts )],
whichcell => [qw( cell )],
);
foreach my $pathop ( keys %pathops ) {
unless ( $fs->supportsOperation($pathop) ) {
my $total = scalar(@{$pathops{$pathop}}) + 2;
$total++ if $pathop eq 'storebehind';
for ( my $count = 1 ; $count <= $total ; $count++ ) {
print "ok $TestCounter # skipping... fs->$pathop() is unsupported \n";
$TestCounter++;
}
next;
}
$result = $fs->$pathop
(
( $pathop eq 'storebehind' ? 'files' : 'path' ) => $paths,
);
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to call fs->$pathop:\n" . $fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
if ( $pathop eq 'storebehind' ) {
if ( defined($result->asynchrony()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Result object for fs->storebehind() has no attr 'asynchrony'\n");
}
} else {
print "ok $TestCounter\n";
}
$TestCounter++;
foreach my $pathname ( @$paths ) {
my $path = $result->getPath($pathname);
if ( ref $path && $path->isa("AFS::Object::Path") ) {
print "ok $TestCounter\n";
$TestCounter++;
if ( $pathname eq $pathafs ) {
foreach my $attr ( @{$pathops{$pathop}} ) {
if ( defined($path->$attr()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Path object for '$pathname' has no attr '$attr'\n");
}
$TestCounter++;
}
} else {
my $ok = 'ok';
unless ( $path->error() ) {
warn("Pathname '$pathname' should have given an error()\n");
$ok = 'not ok';
}
for ( my $count = 1 ; $count <= scalar(@{$pathops{$pathop}}) ; $count++ ) {
print "$ok $TestCounter\n";
$TestCounter++;
}
}
} else {
warn("Unable to retreive path object for '$pathname' from fs->$pathop()\n");
for ( my $count = 1 ; $count <= (scalar(@{$pathops{$pathop}})+1) ; $count++ ) {
print "not ok $TestCounter\n";
$TestCounter++;
}
}
}
}
#
# fs exportafs -- this one is hard to really test, since we can't
# verify all the parsing unless it is actually supported and enabled,
# so fake it.
#
$result = $fs->exportafs
(
type => 'nfs',
);
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
if ( defined($result->enabled()) ) {
print "ok $TestCounter\n";
$TestCounter++;
foreach my $attr ( qw(convert uidcheck submounts) ) {
if ( defined($result->$attr()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("No attr '$attr' for fs->exportafs results\n");
}
$TestCounter++;
}
} else {
warn("Unable to determine if translator is enabled or not\n");
for ( my $count = 1 ; $count <= 4 ; $count++ ) {
print "not ok $TestCounter\n";
$TestCounter++;
}
}
} elsif ( $fs->errors() =~ /not supported/ ) {
for ( my $count = 1 ; $count <= 5 ; $count++ ) {
print "ok $TestCounter\n";
$TestCounter++;
}
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call exportafs:\n" . $fs->errors();
}
#
# fs getcacheparms
#
$result = $fs->getcacheparms();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call getcacheparms:\n" . $fs->errors();
}
foreach my $attr ( qw(avail used) ) {
if ( defined($result->$attr()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Result object from getcacheparms has no attr '$attr'\n");
}
$TestCounter++;
}
#
# fs getcellstatus
#
$result = $fs->getcellstatus
(
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call getcellstatus:\n" . $fs->errors();
}
my $cellobj = $result->getCell($cell);
if ( ref $cellobj && $cellobj->isa("AFS::Object::Cell") ) {
print "ok $TestCounter\n";
$TestCounter++;
foreach my $attr ( qw(cell status) ) {
if ( defined($cellobj->$attr()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Cell object for cell '$cell' has no attr '$attr'\n");
}
$TestCounter++;
}
} else {
warn("Unable to get cell object from fs->getcellstatus->getCell()\n");
for ( my $count = 1 ; $count <= 3 ; $count++ ) {
print "no ok $TestCounter\n";
$TestCounter++;
}
}
#
# fs getclientaddrs
#
if ( $fs->supportsOperation('getclientaddrs') ) {
$result = $fs->getclientaddrs();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call getclientaddrs:\n" . $fs->errors();
}
my $addresses = $result->addresses();
if ( ref $addresses eq 'ARRAY' ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Result object for fs->getclientaddrs() has no attr 'addresses'\n");
}
$TestCounter++;
} else {
for ( my $count = 1 ; $count <= 2 ; $count++ ) {
print "ok $TestCounter\n";
$TestCounter++;
}
}
#
# fs getcrypt
#
if ( $fs->supportsOperation('getcrypt') ) {
$result = $fs->getcrypt();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call getcrypt:\n" . $fs->errors();
}
if ( defined($result->crypt()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Result object for fs->getcrypt() has no attr 'crypt'\n");
}
$TestCounter++;
} else {
for ( my $count = 1 ; $count <= 2 ; $count++ ) {
print "ok $TestCounter\n";
$TestCounter++;
}
}
#
# fs getserverprefs
#
$result = $fs->getserverprefs();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call getserverprefs:\n" . $fs->errors();
}
my ($server) = $result->getServers();
if ( ref $server && $server->isa("AFS::Object::Server") ) {
print "ok $TestCounter\n";
$TestCounter++;
foreach my $attr ( qw(server preference) ) {
if ( defined($server->$attr()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Server object from fs->getserverprefs() has no attr '$attr'\n");
}
$TestCounter++;
}
} else {
warn("Unable to get server object from fs->getserverprefs result\n");
for ( my $count = 1 ; $count <= 3 ; $count++ ) {
print "not ok $TestCounter\n";
$TestCounter++;
}
}
#
# fs listacl -- tested in 40fs_complex.t
#
#
# fs listaliases -- not tested, but I supposed we could define an
# alias, and then remove it. Might be kinda intrusive, though.
#
#
# fs listcells
#
$result = $fs->listcells();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call listcells:\n" . $fs->errors();
}
$cellobj = $result->getCell($cell);
if ( ref $cellobj && $cellobj->isa("AFS::Object::Cell") ) {
print "ok $TestCounter\n";
$TestCounter++;
if ( $cellobj->cell() eq $cell ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Cell returned by fs->listcells->getCell() doesn't match '$cell'\n");
}
$TestCounter++;
my $servers = $cellobj->servers();
if ( ref $servers eq 'ARRAY' ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to get list of servers from fs->listcells->getCell()\n");
}
$TestCounter++;
} else {
warn("Unable to get cell objects for cell '$cell' from fs->listcells()\n");
for ( my $count = 1 ; $count <= 3 ; $count++ ) {
print "not ok $TestCounter\n";
$TestCounter++;
}
}
#
# fs lsmount -- tested in 40fs_complex.t
#
#
# fs sysname
#
$result = $fs->sysname();
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call sysname:\n" . $fs->errors();
}
if ( defined($result->sysname()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Result object for fs->sysname() has no attr 'sysname'\n");
}
$TestCounter++;
END {
#$TestCounter--;
#warn "Total number of tests == $TestCounter\n";
}
t/30pts_basic.t view on Meta::CPAN
# See ..../src/LICENSE for terms of distribution.
#
# print STDERR Data::Dumper->Dump([$vos],['vos']);
use strict;
use English;
use Data::Dumper;
use vars qw(
$TestCounter
$TestTotal
$Loaded
);
BEGIN {
require "./util/lib/parse_config";
}
BEGIN {
$| = 1;
if ( $AFS::Command::Tests::Config{AFS_COMMAND_DISABLE_TESTS} =~ /\bpts\b/ ) {
$TestTotal = 0;
} elsif ( $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} eq 'your.cell.name' ) {
$TestTotal = 0;
} else {
$TestTotal = 59;
}
print "1..$TestTotal\n";
}
END {print "not ok 1\n" unless $Loaded;}
use AFS::Command::PTS 1.99;
$Loaded = 1;
$TestCounter = 1;
print "ok $TestCounter\n";
$TestCounter++;
exit 0 unless $TestTotal;
my $cell = $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_CELLNAME\n";
};
my $ptsgroup = $AFS::Command::Tests::Config{AFS_COMMAND_PTS_GROUP} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PTS_GROUP\n";
};
my $ptsuser = $AFS::Command::Tests::Config{AFS_COMMAND_PTS_USER} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PTS_USER\n";
};
my $binary = $AFS::Command::Tests::Config{AFS_COMMAND_BINARY_PTS} || 'pts';
#
# If the constructor fails, we're doomed.
#
my $pts = AFS::Command::PTS->new
(
command => $binary,
);
if ( ref $pts && $pts->isa("AFS::Command::PTS") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to instantiate AFS::Command::PTS object\n";
}
#
# pts listmax
#
my $result = $pts->listmax
(
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call listmax:\n" . $pts->errors();
}
foreach my $attr ( qw( maxuserid maxgroupid ) ) {
if ( defined($result->$attr()) ) {
my $id = $result->$attr();
my $ok ='not ok';
if ( $attr eq 'maxuserid' ) {
$ok = 'ok' if $id > 0;
} else {
$ok = 'ok' if $id < 0;
}
print "$ok $TestCounter\n";
if ( $ok eq 'not ok' ) {
warn("pts->listmax attr '$attr' has the wrong sign (+/-)\n");
}
} else {
print "not ok $TestCounter\n";
warn("pts->listmax result has no attr '$attr'\n");
}
$TestCounter++;
}
#
# pts creategroup, createuser, examine
#
foreach my $name ( $ptsgroup, $ptsuser ) {
#
# First, let's make sure our test IDs aren't defined, so we can
# redefine them.
#
my $result = $pts->delete
(
nameorid => $name,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} elsif ( defined($pts->errors()) && $pts->errors() =~ /unable to find entry/ ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to delete the test pts id ($name), or verify it doesn't exist\n" .
Data::Dumper->Dump([$pts],['pts']));
}
$TestCounter++;
my $method = $name eq $ptsgroup ? 'creategroup' : 'createuser';
my $type = $name eq $ptsgroup ? 'Group' : 'User';
my $class = 'AFS::Object::' . ( $name eq $ptsgroup ? 'Group' : 'User' );
$result = $pts->$method
(
name => $name,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call $method:\n" . $pts->errors();
}
my $byname = $name eq $ptsgroup ? 'getGroupByName' : 'getUserByName';
my $byid = $name eq $ptsgroup ? 'getGroupById' : 'getUserById';
my $getall = $name eq $ptsgroup ? 'getGroups' : 'getUsers';
my $entry = $result->$byname($name);
if ( ref $entry && $entry->isa($class) ) {
print "ok $TestCounter\n";
$TestCounter++;
my $id = $entry->id();
if ( $name eq $ptsgroup ) {
if ( $id < 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Group $name doesn't have a negative id as expected\n");
}
} else {
if ( $id > 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("User $name doesn't have a positive id as expected\n");
}
}
$TestCounter++;
$entry = $result->$byid($id);
if ( ref $entry && $entry->isa($class) ) {
print "ok $TestCounter\n";
$TestCounter++;
my $othername = $entry->name();
if ( $name eq $othername ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("PTS entry '$name' doesn't match '$othername'\n");
}
$TestCounter++;
} else {
warn("Unable to retreive pts entry using $byid\n");
for ( my $count = 1 ; $count <= 2 ; $count++ ) {
print "not ok $TestCounter\n";
$TestCounter++;
}
}
} else {
warn("Unable to retreive pts entry using $byname\n");
for ( my $count = 1 ; $count <= 4 ; $count++ ) {
print "not ok $TestCounter\n";
$TestCounter++;
}
}
($entry) = $result->$getall();
if ( ref $entry && $entry->isa($class) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to retreive pts entry from pts->$method using $getall\n");
}
$TestCounter++;
$result = $pts->examine
(
nameorid => $name,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call examine:\n" . $pts->errors();
}
($entry) = $result->$getall();
if ( ref $entry && $entry->isa($class) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to retreive pts entry from pts->examine using $getall\n");
}
$TestCounter++;
foreach my $attr ( qw( name id owner creator membership flags groupquota ) ) {
if ( defined($entry->$attr()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Result from pts->examine of '$name' is missing attr '$attr'\n");
}
$TestCounter++;
}
}
#
# pts chown, listowned
#
$result = $pts->chown
(
name => $ptsgroup,
owner => $ptsuser,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter\n";
die("Unable to chown $ptsgroup to $ptsuser:" . $pts->errors());
}
$result = $pts->listowned
(
nameorid => $ptsuser,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call listowned:\n" . $pts->errors();
}
my ($user) = $result->getUsers();
if ( ref $user && $user->isa("AFS::Object::User") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to get User object from pts->listowned result\n");
}
my @owned = $user->getOwned();
if ( $#owned == 0 && $owned[0] eq $ptsgroup ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("User $ptsuser doesn't appear to own $ptsgroup\n");
}
$TestCounter++;
#
# pts adduser, membership
#
$result = $pts->adduser
(
user => $ptsuser,
group => $ptsgroup,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call adduser:\n" . $pts->errors();
}
foreach my $name ( $ptsgroup, $ptsuser ) {
$result = $pts->membership
(
nameorid => $name,
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call membership:\n" . $pts->errors();
}
my $type = $name eq $ptsgroup ? 'Group' : 'User';
my $class = 'AFS::Object::' . ( $name eq $ptsgroup ? 'Group' : 'User' );
my $getall = $name eq $ptsgroup ? 'getGroups' : 'getUsers';
my ($entry) = $result->$getall();
if ( ref $entry && $entry->isa($class) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to retreive pts entry from pts->membership using $getall\n");
}
$TestCounter++;
my @membership = $entry->getMembership();
if ( $#membership == 0 ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("The entry $name should only have a membership of 1, but has " . ($#membership+1) . "\n");
}
$TestCounter++;
if ( $name eq $ptsgroup ) {
if ( $membership[0] eq $ptsuser ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Group $ptsgroup should have $ptsuser as a member, but doesn't\n");
}
} else {
if ( $membership[0] eq $ptsgroup ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("User $ptsuser should be a member of group $ptsgroup, but isn't\n");
}
}
$TestCounter++;
}
#
# pts listentries
#
if ( $pts->supportsOperation('listentries') ) {
foreach my $name ( $ptsgroup, $ptsuser ) {
t/30pts_basic.t view on Meta::CPAN
my $type = $name eq $ptsgroup ? 'Group' : 'User';
my $class = 'AFS::Object::' . ( $name eq $ptsgroup ? 'Group' : 'User' );
my $getentry = $name eq $ptsgroup ? 'getGroupByName' : 'getUserByName';
my $result = $pts->listentries
(
cell => $cell,
$flag => 1,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to call listentries:\n" . $pts->errors();
}
my $entry = $result->$getentry($name);
if ( ref $entry && $entry->isa($class) ) {
foreach my $attr ( qw(id owner creator) ) {
if ( defined($entry->$attr()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("$type $name is missing the attr '$attr'\n");
}
$TestCounter++;
}
} else {
warn("Unable to retreive pts entry from pts->listentries using $getentry\n");
for ( my $count = 1 ; $count <= 3 ; $count++ ) {
print "not ok $TestCounter\n";
$TestCounter++;
}
}
}
} else {
for ( my $count = 1 ; $count <= 8 ; $count++ ) {
print "ok $TestCounter\n";
$TestCounter++;
}
}
#
# Test membership error checking
#
$result = $pts->membership
(
nameorid => "ThisSurelyDoesNotExist",
cell => $cell,
);
if ( ref $result && $result->isa("AFS::Object::PTServer") ) {
print "not ok $TestCounter\n";
warn("membership should have failed, not succeeded for 'ThisSurelyDoesNotExist'");
} else {
print "ok $TestCounter\n";
}
$TestCounter++;
exit 0;
# END {
# $TestCounter--;
# warn "Total number of tests == $TestCounter\n";
# }
t/40fs_complex.t view on Meta::CPAN
# See ..../src/LICENSE for terms of distribution.
#
# print STDERR Data::Dumper->Dump([$vos],['vos']);
use strict;
use English;
use Data::Dumper;
use vars qw(
$TestCounter
$TestTotal
$Loaded
%Volnames
);
BEGIN {
require "./util/lib/parse_config";
}
BEGIN {
$| = 1;
if ( $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} eq 'your.cell.name' ) {
$TestTotal = 0;
} else {
$TestTotal = 44;
}
print "1..$TestTotal\n";
}
END {print "not ok 1\n" unless $Loaded;}
use AFS::Command::PTS 1.99;
use AFS::Command::FS 1.99;
use AFS::Command::VOS 1.99;
$Loaded = 1;
$TestCounter = 1;
print "ok $TestCounter\n";
$TestCounter++;
exit 0 unless $TestTotal;
my $cell = $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_CELLNAME\n";
};
my $ptsgroup = $AFS::Command::Tests::Config{AFS_COMMAND_PTS_GROUP} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PTS_GROUP\n";
};
my $ptsuser = $AFS::Command::Tests::Config{AFS_COMMAND_PTS_USER} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PTS_USER\n";
};
my $ptsexisting = $AFS::Command::Tests::Config{AFS_COMMAND_PTS_EXISTING} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PTS_EXISTING\n";
};
my $volname_prefix = $AFS::Command::Tests::Config{AFS_COMMAND_VOLNAME_PREFIX} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_VOLNAME_PREFIX\n";
};
my $partition_list = $AFS::Command::Tests::Config{AFS_COMMAND_PARTITION_LIST} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PARTITION_LIST\n";
};
my $pathafs = $AFS::Command::Tests::Config{AFS_COMMAND_PATHNAME_AFS} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PATHNAME_AFS\n";
};
my $pathnotafs = "/var/tmp";
my $pathbogus = "/this/does/not/exist";
my ($server,$partition) = split(/:/,(split(/\s+/,$partition_list))[0]);
unless ( $server && $partition ) {
print "not ok $TestCounter..$TestTotal\n";
die "Invalid server:/partition specification: '$partition_list'\n";
}
my %binary =
(
pts => ($AFS::Command::Tests::Config{AFS_COMMAND_BINARY_PTS} || 'pts'),
vos => ($AFS::Command::Tests::Config{AFS_COMMAND_BINARY_VOS} || 'vos'),
fs => ($AFS::Command::Tests::Config{AFS_COMMAND_BINARY_FS} || 'fs'),
);
my $pts = AFS::Command::PTS->new
(
command => $binary{pts},
);
if ( ref $pts && $pts->isa("AFS::Command::PTS") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to instantiate AFS::Command::PTS object\n";
}
my $vos = AFS::Command::VOS->new
(
command => $binary{vos},
);
if ( ref $vos && $vos->isa("AFS::Command::VOS") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to instantiate AFS::Command::VOS object\n";
}
my $fs = AFS::Command::FS->new
(
command => $binary{fs},
);
if ( ref $fs && $fs->isa("AFS::Command::FS") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to instantiate AFS::Command::FS object\n";
}
#
# Create a sample volume
#
my $volname = $volname_prefix . $PID;
$Volnames{$volname}++;
my $result = $vos->create
(
server => $server,
partition => $partition,
name => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to create volume '$volname' on server '$server:$partition'" .
"in cell '$cell'\n" . "Errors from vos command:\n" . $vos->errors());
}
#
# Mount it (several different ways)
#
my %mtpath =
(
rw => "$pathafs/$volname-rw",
t/40fs_complex.t view on Meta::CPAN
(
$type eq 'cell' ?
( cell => $cell ) : ()
),
(
$type eq 'rw' ?
( rw => 1 ) : ()
),
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to create mount point for $volname in $cell on $mtpath{$type}:" .
$fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
}
$result = $fs->lsmount
(
dir => [values %mtpath],
);
if ( ref $result && $result->isa("AFS::Object::CacheManager") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to lsmount dirs:" .
$fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
foreach my $type ( keys %mtpath ) {
my $mtpath = $mtpath{$type};
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->lsmount:\n" .
Data::Dumper->Dump([$result],['result']));
}
if ( defined($path->volname()) && $path->volname() eq $volname ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Volname in mtpt for $mtpath doesn't match '$volname':\n" .
Data::Dumper->Dump([$path],['path']));
}
$TestCounter++;
if ( $type eq 'cell' ) {
if ( defined($path->cell() && $path->cell() eq $cell ) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Cell in mtpt for $mtpath doesn't match '$cell':\n" .
Data::Dumper->Dump([$path],['path']));
}
} else {
print "ok $TestCounter\n";
}
$TestCounter++;
if ( $type eq 'rw' ) {
if ( defined($path->readwrite()) ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Mount point $mtpath{$type} doesn't appear to be rw:\n" .
Data::Dumper->Dump([$path],['path']));
}
} else {
print "ok $TestCounter\n";
}
$TestCounter++;
}
$result = $fs->rmmount
(
dir => [ $mtpath{rw}, $mtpath{plain} ],
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove mount points for $volname in $cell:\n" .
"[ $mtpath{rw}, $mtpath{plain} ]\n" .
$fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
#
# This is the one mtpt we know will work. The AFS pasth you gave me
# might NOT be in the same cell you specified, so using the
# cell-specific mount is necessary.
t/40fs_complex.t view on Meta::CPAN
#
# Set and test the ACL (several different ways)
#
my $paths = [ $mtpath, $pathnotafs, $pathbogus ];
$result = $fs->listacl
(
path => $paths,
);
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 %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.
t/40fs_complex.t view on Meta::CPAN
$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,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove mount points for $volname in $cell:\n" .
$fs->errors() .
Data::Dumper->Dump([$fs],['fs']));
}
#
# Blow away the volume
#
$result = $vos->remove
(
server => $server,
partition => $partition,
id => $volname,
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to remove volume '$volname' from server '$server:$partition'" .
"in cell '$cell'\n" . "Errors from vos command:\n" . $vos->errors());
}
delete $Volnames{$volname};
END {
#$TestCounter--;
#warn "Total number of tests == $TestCounter\n";
if ( %Volnames ) {
warn("The following temporary volumes were created, and may be left over:\n\t" .
join("\n\t",sort keys %Volnames) . "\n");
}
}
t/99pts_cleanup.t view on Meta::CPAN
# See ..../src/LICENSE for terms of distribution.
#
# print STDERR Data::Dumper->Dump([$vos],['vos']);
use strict;
use English;
use Data::Dumper;
use vars qw(
$TestCounter
$TestTotal
$Loaded
);
BEGIN {
require "./util/lib/parse_config";
}
BEGIN {
$| = 1;
if ( $AFS::Command::Tests::Config{AFS_COMMAND_DISABLE_TESTS} =~ /\bpts\b/ ) {
$TestTotal = 0;
} elsif ( $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} eq 'your.cell.name' ) {
$TestTotal = 1;
} else {
$TestTotal = 3;
}
print "1..$TestTotal\n";
}
END {print "not ok 1\n" unless $Loaded;}
use AFS::Command::PTS 1.99;
$Loaded = 1;
$TestCounter = 1;
print "ok $TestCounter\n";
$TestCounter++;
exit 0 unless $TestTotal > 1;
my $cell = $AFS::Command::Tests::Config{AFS_COMMAND_CELLNAME} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_CELLNAME\n";
};
my $ptsgroup = $AFS::Command::Tests::Config{AFS_COMMAND_PTS_GROUP} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PTS_GROUP\n";
};
my $ptsuser = $AFS::Command::Tests::Config{AFS_COMMAND_PTS_USER} || do {
print "not ok $TestCounter..$TestTotal\n";
die "Missing configuration variable AFS_COMMAND_PTS_USER\n";
};
my $binary = $AFS::Command::Tests::Config{AFS_COMMAND_BINARY_PTS} || 'pts';
#
# If the constructor fails, we're doomed.
#
my $pts = AFS::Command::PTS->new
(
command => $binary,
);
if ( ref $pts && $pts->isa("AFS::Command::PTS") ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die "Unable to instantiate AFS::Command::PTS object\n";
}
my $result = $pts->delete
(
nameorid => [ $ptsgroup, $ptsuser ],
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to delete pts entries:\n" .
$pts->errors() .
Data::Dumper->Dump([$pts],['pts']));
}
exit 0;
# END {
# $TestCounter--;
# warn "Total number of tests == $TestCounter\n";
# }
util/lib/parse_config view on Meta::CPAN
#
# (c) 2003-2004 Morgan Stanley and Co.
# See ..../src/LICENSE for terms of distribution.
#
# Parse our config file to get the parameters we need for the tests
#
# NOTE: this is used ONLY for the installation procedures, and not in
# the production code itself.
package AFS::Command::Tests;
use vars qw(%Config);
my $config = "/no/such/path";
foreach my $relpath ( qw( . .. ../.. ../../.. ) ) {
next unless -f "$relpath/CONFIG";
$config = "$relpath/CONFIG";
last;
}
( run in 1.080 second using v1.01-cache-2.11-cpan-a5abf4f5562 )