AFS-Command
view release on metacpan or search on metacpan
The code to parse the VLDB header was missing the LOCKED flag, if it
was present, so this attribute was not being set properly. It is now.
=head2 pts membership error checking was bogus
Well, it still is bogus, actually, since the code has to deal with the
fact that pts has never produced meaningful return codes, so a failed
pts membership command can still exit 0, and we have to figure out if
it failed by other means. This is done by looking for the known error
messages that pts prints out, which is a good example of why parsing
the ASCII test output of commands like this is a weak architecture.
=head1 Changes in 1.7
=head1 Enhancements
=head2 Boolean flags can be turned off, as well as on
If an argument to a method (and its corresponding command line
argument) doesn't take a value, it is treated like a Boolean flag.
releases, regardless of the value of $force, the mere existence of the
force key in the argument hash would have caused the -force option to
be used.
=head1 Bugs
=head2 vos examine by numeric ID did not parse Volume Headers
The code to parse the volume headers in the output from "vos examine"
was looking for a pattern match based on the "id" argument. However,
the headers always print the name first, and we were assuming that the
id argument was the volume name, when it can also be the volume ID.
The parsing is less strict now, and works for both a volume name od a
numeric ID.
=head1 Changes in 1.6
=head1 Enhancements
=head1 AFS::Object::VolumeHeader: new attribute 'attached'
offline
Off-line
These values have all been normalized to: online, offline
=head2 AFS::Command::VOS->examine parses busy and offline messages
When a volume is busy or can not be attached, "vos examine" will be
unable to display the volume headers. Instead, a one line message is
printed, such as one of the following:
**** Volume 123456789 is busy ****
**** Could not attach volume 123456789 ****
The examine method now parses these, and the AFS::Object::VolumeHeader
object will have only the 'id' and 'status' attributes. Previously,
those lines were incorrectly parsed and the 'name' attribute set to
'****', which is pretty obviously wrong.
Changes.html view on Meta::CPAN
<P>
<HR>
<H2><A NAME="pts_membership_error_checking_wa">pts membership error checking was bogus
</A></H2>
Well, it still is bogus, actually, since the code has to deal with the fact
that pts has never produced meaningful return codes, so a failed pts
membership command can still exit 0, and we have to figure out if it failed
by other means. This is done by looking for the known error messages that
pts prints out, which is a good example of why parsing the ASCII test
output of commands like this is a weak architecture.
<P>
<P>
<HR>
<H1><A NAME="Changes_in_1_7">Changes in 1.7
</A></H1>
Changes.html view on Meta::CPAN
<H1><A NAME="Bugs">Bugs
</A></H1>
<P>
<HR>
<H2><A NAME="vos_examine_by_numeric_ID_did_no">vos examine by numeric ID did not parse Volume Headers
</A></H2>
The code to parse the volume headers in the output from ``vos examine'' was
looking for a pattern match based on the ``id'' argument. However, the
headers always print the name first, and we were assuming that the id
argument was the volume name, when it can also be the volume ID.
<P>
The parsing is less strict now, and works for both a volume name od a
numeric ID.
<P>
Changes.html view on Meta::CPAN
<P>
<P>
<HR>
<H2><A NAME="AFS_Command_VOS_examine_parse">AFS::Command::VOS->examine parses busy and offline messages
</A></H2>
When a volume is busy or can not be attached, ``vos examine'' will be
unable to display the volume headers. Instead, a one line message is
printed, such as one of the following:
<P>
<PRE> **** Volume 123456789 is busy ****
**** Could not attach volume 123456789 ****
</PRE>
<P>
lib/AFS/Command/BOS.pm view on Meta::CPAN
my $errors = 0;
$errors++ unless $self->_exec_cmds();
my $log = "";
while ( defined($_ = $self->{handle}->getline()) ) {
next if /^Fetching log file/;
if ( $redirect ) {
$redirect->print($_);
} else {
$log .= $_;
}
}
if ( $redirect ) {
$redirect->close()|| do {
$self->_Carp("Unable to close $redirectname: $ERRNO");
$errors++
};
lib/AFS/Command/BOS.pod view on Meta::CPAN
specified in the arguments.
my $result = $bos->getdate
(
file => [ 'bosserver', 'vlserver', 'ptserver' ],
cell => $cell,
) || die $bos->errors();
foreach my $fileobj ( $result->getFiles() ) {
my ($file,$date) = ($fileobj->file(),$fileobj->date());
print "File $file has date $date\n";
}
Each of these objects has the following attributes and methods:
B<AFS::Object::BosServer>
This object is nothing more than a container for the generic objects
for each file. It has several methods for extracting the file objects:
Methods Returns
lib/AFS/Command/BOS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::BosServer object, which
contains two attributes.
my $result = $bos->getrestart
(
server => $server,
cell => $cell,
) || die $bos->errors();
print "Binary restart time is " . $result->binaries() . "\n";
print "Server restart time is " . $result->restart() . "\n";
The object has the following attributes:
B<AFS::Object::BosServer>
Attributes Values
---------- ------
restart The server restart time
binaries The restart time when there are new, updated binaries
lib/AFS/Command/BOS.pod view on Meta::CPAN
This method returns an AFS::Object::BosServer object, which
contains one attribute.
my $result = $bos->listhosts
(
server => $server,
cell => $cell,
) || die $bos->errors();
my $hosts = $result->hosts();
print "Server $server in cell $cell has hosts:\n"
foreach my $host ( @$hosts ) {
print "\t$host\n";
}
The object has the following attributes:
B<AFS::Object::BosServer>
Attributes Values
---------- ------
hosts ARRAY reference of hostnames
cell Cell name
lib/AFS/Command/BOS.pod view on Meta::CPAN
This method returns an AFS::Object::BosServer object, which
contains one or more AFS::Object objects, each of which
represents a single authentication key on the server.
my $result = $bos->listkeys
(
server => $server,
cell => $cell,
) || die $bos->errors();
print "Server $server in cell $cell has the following keys:\n";
foreach my $key ( $result->getKeys() ) {
my ($index,$cksum) = ($key->index(),$key->cksum());
print "\t$index => $cksum\n";
}
my $result = $bos->listkeys
(
server => $server,
cell => $cell,
showkey => 1,
) || die $bos->errors();
print "Server $server in cell $cell has the following keys:\n";
foreach my $key ( $result->getKeys() ) {
my ($index,$value) = ($key->index(),$key->value());
print "\t$index => $cksum\n";
}
The objects have the following attributes and methods:
B<AFS::Object::BosServer>
Attributes Values
---------- ------
keychanged Date the keys were last changed
lib/AFS/Command/BOS.pod view on Meta::CPAN
This method returns an AFS::Object::BosServer object, which
contains one attribute.
my $result = $bos->listusers
(
server => $server,
cell => $cell,
) || die $bos->errors();
my $users = $result->susers();
print "Server $server in cell $cell has users:\n"
foreach my $user ( @$users ) {
print "\t$user\n";
}
The object has the following attribute:
B<AFS::Object::BosServer>
Attributes Values
---------- ------
susers ARRAY reference of super user names
lib/AFS/Command/BOS.pod view on Meta::CPAN
single instance of a bosserver managed process on the server.
my $result = $bos->status
(
server => $server,
long => 1,
) || die $bos->errors();
foreach my $instanceobj ( $result->getInstances() ) {
my $instance = $instanceobj->instance();
my $status = $instanceobj->status();
print "Instance $instance has status $status\n";
foreach my $commandobj ( $instance->getCommands() ) {
my $index = $commandobj->index();
my $command = $commandobj->command();
print "\tCmd $index is '$command'\n";
}
}
The objects have the following attributes and methods:
B<AFS::Object::BosServer>
The following attribute is only present when "bos status" reports
inappropriate access on directories:
lib/AFS/Command/Base.pod view on Meta::CPAN
release, restore, etc. Commands that return complex structures of
objects, such as listvldb, listvol, etc will not be affected.
=back
=head2 setCarp
This class method configures the carp and/or croak subroutines used
throughout the API. By default, the obviously sensible thing is done:
the carp an croak subroutines exported by the Carp module are used.
These normally print output to stderr, and this method provides a
mechanism for trapping these errors and redirecting them elsewhere.
For example, stderr in a system daemon may be entirely ignored, and
syslog may be a more appropriate destination. In this case, the
setCarp method may be used to configure this, globally, for the entire
API.
AFS::Command->setCarp
(
lib/AFS/Command/FS.pod view on Meta::CPAN
);
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more attributes.
my $result = $fs->checkservers() || die $fs->errors();
my @servers = $result->servers();
foreach my $server ( @servers ) {
print "Server $server appears to be down\n";
}
The object has the following attributes:
Attributes Values
---------- ------
servers ARRAY reference of strings, each of which is
the hostname of a server which is down
interval The value of the probe interval, in seconds
lib/AFS/Command/FS.pod view on Meta::CPAN
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->diskfree
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
foreach my $attr ( qw( volname used total avail percent ) ) {
print "Path '$path' has '$attr' of '" . $pathobj->$attr() . "'\n";
}
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
lib/AFS/Command/FS.pod view on Meta::CPAN
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->examine
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
foreach my $attr ( qw( id volname quota used avail total ) ) {
print "Path '$path' has '$attr' of '" . $pathobj->$attr() . "'\n";
}
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
lib/AFS/Command/FS.pod view on Meta::CPAN
This method returns an AFS::Object::CacheManager object with one or
more attributes.
my $result = $fs->exportafs
(
type => 'nfs',
start => 'on',
) || die $fs->errors();
foreach my $attr ( qw( convert uidcheck submounts ) ) {
print "Translator has '$attr' set to '" . $result->$attr() . "'\n";
}
The object has the following attribute:
B<AFS::Object::CacheManager>
Attributes Values
---------- ------
enabled Boolean, true means the translator is on, false means off
convert Boolean, true means mode bits are converted from AFS to UNIX, false means off
lib/AFS/Command/FS.pod view on Meta::CPAN
my $result = $fs->getcacheparms();
=item Return Values
This method returns an AFS::Object::CacheManager object with one or
more attributes.
my $result = $fs->getcacheparms() || die $fs->errors();
my $used = $result->used();
my $avail = $result->avail();
print "Cache is using $used KB of $availa KB available\n";
The object has the following attributes:
B<AFS::Object::CacheManager>
Attributes Values
---------- ------
used Number of KB of the AFS cache in use
avail Size of the AFS cache, in KB
lib/AFS/Command/FS.pod view on Meta::CPAN
This method returns an AFS::Object::CacheManager object which contains
one or more AFS::Object::Cell objects.
my $result = $fs->getcellstatus
(
cell => [ $cell1 , $cell2 ],
) || die $fs->errors();
foreach my $cellobj ( $result->getCells() ) {
my $cell = $cellobj->cell();
if ( $cellobj->status() ) {
print("This client allows setuid binaries from cell '$cell'\n";
} else {
print("This client does NOT allow setuid binaries from cell '$cell'\n";
}
}
The objects have the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getCellNames() list of cell names
lib/AFS/Command/FS.pod view on Meta::CPAN
The corresponding method invocation looks like:
my $result = $fs->getclientaddrs();
=item Return Values
This method returns an AFS::Object::CacheManager object with one attribute.
my $result = $fs->getclientaddrs() || die $fs->errors();
print "This client has the following addressed configured for AFS:\n";
foreach my $address ( @{$result->addresses()} ) {
print "\t$address\n";
}
The object has the following attribute:
B<AFS::Object::CacheManager>
Attributes Values
---------- ------
addresses ARRAY reference of IP addresses
lib/AFS/Command/FS.pod view on Meta::CPAN
The corresponding method invocation looks like:
my $result = $fs->getcrypt();
=item Return Values
This method returns an AFS::Object::CacheManager object with one attribute.
my $result = $fs->getcrypt() || die $fs->errors();
print "This client has encryption turned " . ( $result->crypt() ? "on" : "off" ) . "\n";
The object has the following attribute:
B<AFS::Object::CacheManager>
Attributes Values
---------- ------
crypt Boolean, indicating whether or not encryption is enabled
=back
lib/AFS/Command/FS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::CacheManager object which contains
one or more AFS::Object::Server objects.
my $result = $fs->getserverprefs() || die $fs->errors();
foreach my $serverobj ( $result->getServers() ) {
my $server = $serverobj->server();
my $pref = $serverobj->preference();
print "Server '$server' has preference '$preference'\n";
}
The objects have the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getServerNames() list of server hostnames (or addresses)
getServers() list of AFS::Object::Server objects
lib/AFS/Command/FS.pod view on Meta::CPAN
one or two AFS::Object::ACL objects (one for normal, and one for
negative).
my $result = $fs->listacl
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
foreach my $type ( qw( normal negative ) ) {
my $acl = $pathobj->getACL($type);
my %entries = $acl->getEntries();
foreach my $principal ( keys %entries ) {
my $rights = $acl->getRights($principal);
print "$type rights for $principal are $rights\n";
}
}
}
}
The objects have the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
lib/AFS/Command/FS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Cell objects.
my $result = $fs->listaliases() || die $fs->errors();
foreach my $cellobj ( $result->getCells() ) {
my $cell = $cellobj->cell();
my $alias = $cellobj->alias();
print "Cell '$cell' has alias '$alias'\n";
}
The objects have the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getCellNames() list of cell names
getCells() list of AFS::Object::Cell objects
lib/AFS/Command/FS.pod view on Meta::CPAN
);
=item Return Values
This method returns an AFS::Object::CacheManager object, which
contains one or more AFS::Object::Cell objects.
my $result = $fs->listcells() || die $fs->errors();
foreach my $cellobj ( $result->getCells() ) {
my $servers = $cellobj->servers();
print "Cell $cell has servers " . join(" ",@$servers) . "\n";
}
The objects have the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getCellNames() list of cell names
getCells() list of AFS::Object::Cell objects
lib/AFS/Command/FS.pod view on Meta::CPAN
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->listquota
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
foreach my $attr ( qw( volname quota used percent partition ) ) {
print "Path '$path' has '$attr' of '" . $pathobj->$attr() . "'\n";
}
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
lib/AFS/Command/FS.pod view on Meta::CPAN
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->lsmount
(
dir => [ $dir1, $dir2 ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
my $volname = $pathobj->volname();
my $cell = $pathobj->cell();
print("Path '$path' is a mtpt for volume $volname" .
( $cell ? ", in cell '$cell'\n" : "\n" ));
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
lib/AFS/Command/FS.pod view on Meta::CPAN
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->quota
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
print "Path '$path' has quota '" . $pathobj->quota() . "'\n";
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getPathNames() list of strings, each of which is a single pathname
lib/AFS/Command/FS.pod view on Meta::CPAN
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->quota
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
foreach my $attr ( qw( volname quota used percent partition ) ) {
print "Path '$path' has '$attr' of '" . $pathobj->$attr() . "'\n";
}
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Attributes Values
---------- ------
lib/AFS/Command/FS.pod view on Meta::CPAN
);
=item Return Values
This method returns an AFS::Object::CacheManager object which has one
of two possible attributes.
my $result = $fs->sysname() || die $fs->errors();
my $sysname = $result->sysname();
my $sysnames = $result->sysnames();
print "This client has a primary sysname of '$sysname'\n";
if ( ref $sysnames eq 'ARRAY' ) {
print "This client has a list of sysnames: " . join(" ,",@$sysnames) . "\n";
}
The object has the following attributes:
B<AFS::Object::CacheManager>
Attributes Values
---------- ------
sysname The primary sysname of the client
sysnames An ARRAY reference of sysnames
lib/AFS/Command/FS.pod view on Meta::CPAN
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->whereis
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
print "Path '$path' is on hosts " . join(" ,",@{pathobj->hosts()}) . "\n";
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getPathNames() list of strings, each of which is a single pathname
lib/AFS/Command/FS.pod view on Meta::CPAN
contains one or more AFS::Object::Path objects, one for each path
specified in the arguments.
my $result = $fs->whichcell
(
path => [ $afspath, $ufspath, $boguspath ],
) || die $fs->errors();
foreach my $pathobj ( $result->getPaths() ) {
my $path = $pathobj->path();
if ( $pathobj->hasAttribute('error') ) {
print "Path '$path' has errors '" . $pathobj->error() . "'\n";
} else {
print "Path '$path' is in cell '" . $pathobj->cell() . "'\n";
}
}
Each of these objects has the following attributes and methods:
B<AFS::Object::CacheManager>
Methods Returns
------- -------
getPathNames() list of strings, each of which is a single pathname
lib/AFS/Command/FS.pod view on Meta::CPAN
The corresponding method invocation looks like:
my $result = $fs->wscell();
=item Return Values
This method returns an AFS::Object::CacheManager object which has one
attribute.
my $result = $fs->wscell() || die $fs->errors();
print "This client lives in cell '" . $result->cell() . "'\n";
The object has the following attribute:
Attributes Values
---------- ------
cell The AFS cell of the client
=back
=head1 METHODS (with simple return values)
lib/AFS/Command/PTS.pod view on Meta::CPAN
This method returns an AFS::Object::PTServer object, which
contains one AFS::Object::Group for each group created.
my $result = $pts->creategroup
(
name => $name,
owner => $owner,
) || die $pts->errors();
foreach my $group ( $result->getGroups() ) {
my ($grname,$grid) = ($group->name(),$group->id());
print "New group $grname has id $grid\n";
}
Each of these objects has the following attributes and methods:
B<AFS::Object::PTServer>
Methods Returns
------- -------
getGroupNames() list of group names
getGroupIds() list of group ids
lib/AFS/Command/PTS.pod view on Meta::CPAN
This method returns an AFS::Object::PTServer object, which
contains one AFS::Object::User for each user created.
my $result = $pts->createuser
(
name => $name,
owner => $owner,
) || die $pts->errors();
foreach my $user ( $result->getUsers() ) {
my ($username,$userid) = ($user->name(),$user->id());
print "New user $username has id $userid\n";
}
Each of these objects has the following attributes and methods:
B<AFS::Object::PTServer>
Methods Returns
------- -------
getUserNames() list of user names
getUserIds() list of user ids
lib/AFS/Command/PTS.pod view on Meta::CPAN
contains one AFS::Object::User or AFS::Object::Group
object for each user/group examined.
my $result = $pts->examine
(
nameorid => [ $name1, $name2 ],
cell => 1,
) || die $pts->errors();
foreach my $userobj ( $result->getUser() ) {
my ($name,$id) = ($userobj->name(),$userobj->id());
print "User $name has id $id\n";
}
foreach my $groupobj ( $result->getGroups() ) {
my ($name,$id) = ($groupobj->name(),$groupobj->id());
print "Group $name has id $id\n";
}
Each of these objects has the following attributes and methods:
B<AFS::Object::PTServer>
Methods Returns
------- -------
getGroupNames() list of group names
getGroupIds() list of group ids
lib/AFS/Command/PTS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::PTServer object, which
contains two attributes:
my $result = $pts->listmax
(
cell => $cell,
) || die $pts->errors();
print "Maximum group ID is " . $result->maxgroupid() . "\n";
print "Maximum user ID is " . $result->maxuserid() . "\n";
This object has the following attributes, which are always present:
Attributes Values
---------- ------
maxgroupid Numeric value of the highest group ID
maxuserid Numeric value of the highest user ID
=back
lib/AFS/Command/PTS.pod view on Meta::CPAN
This method returns an AFS::Object::PTServer object, which
contains one AFS::Object::User or AFS::Object::Group
object for each user/group specified.
my $result = $pts->listowned
(
nameorid => $user,
cell => $cell,
) || die $pts->errors();
my $userobj = $result->getUserbyName($user);
print "User $user owns the following groups:\n";
foreach my $owned ( $userobj->getOwned() ) {
print "\t$owned\n";
}
Each of these objects has the following attributes and methods:
B<AFS::Object::PTServer>
Methods Returns
------- -------
getGroupNames() list of group names
getGroupIds() list of group ids
lib/AFS/Command/PTS.pod view on Meta::CPAN
This method returns an AFS::Object::PTServer object, which
contains one AFS::Object::User or AFS::Object::Group
object for each user/group specified.
my $result = $pts->membership
(
nameorid => $user,
cell => $cell,
) || die $pts->errors();
my $userobj = $result->getUserbyName($user);
print "User $user is a member of these groups:\n";
foreach my $group ( $userobj->getMembership() ) {
print "\t$group\n";
}
Each of these objects has the following attributes and methods:
B<AFS::Object::PTServer>
Methods Returns
------- -------
getGroupNames() list of group names
getGroupIds() list of group ids
lib/AFS/Command/VOS.pm view on Meta::CPAN
$self->{operation} = "listaddrs";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
if ( $args{printuuid} ) {
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
if ( /^UUID:\s+(\S+)/ ) {
my $fileserver = AFS::Object::FileServer->new( uuid => $1 );
my @addresses = ();
lib/AFS/Command/VOS.pod view on Meta::CPAN
more AFS::Object::VLDBSite objects.
my $result = $vos->examine
(
id => $volname,
cell => $cell,
) || die $vos->errors();
foreach my $header ( $result->getVolumeHeaders() ) {
my ($server,$partition) = ($header->server(),$header->partition());
print "[header] server = $server, partition = $partition\n";
}
my $vldbentry = $result->getVLDBEntry();
foreach my $vldbsite ( $vldbentry->getVLDBSites() ) {
my ($server,$partition) = ($vldbsite->server(),$vldbsite->partition());
print "[vldbsite] server = $server, partition = $partition\n";
}
Each of these objects has the following attributes and methods:
B<AFS::Object::Volume>
This object is nothing more than a container for the VolumeHeader and
VLDBEntry objects, and has no attributes of its own. It has two
methods for extracting the objects it contains.
lib/AFS/Command/VOS.pod view on Meta::CPAN
Since attributes can most easily be accessed by calling the method of
the same name, one can easily dig into the hierarchy as follows:
my $result = $vos->examine
(
id => 'user.wpm',
cell => 'q.ny.ms.com',
extended => 1,
);
print $result->raw()->reads()->same()->total(); # 162, in the above output.
print $result->author()->10min()->dir()->same(); # 44, in the above output.
See? It's not as ugly as the pedantic description above implies.
=back
=head2 listaddrs
=over
=item Arguments
The vos help string is:
vos listaddrs: list the IP address of all file servers registered in the VLDB
Usage: vos listaddrs [-uuid <uuid of server>] [-host <address of host>]
[-noresolve] [-printuuid] [-cell <cell name>] [-noauth]
[-localauth] [-verbose] [-encrypt]
Where: -noresolve don't resolve addresses
-printuuid print uuid of hosts
The corresponding method invocation looks like:
my $result = $vos->listaddrs
(
# Optional arguments
uuid => $uuid,
host => $host,
noresolve => 1,
printuuid => 1,
cell => $cell,
noauth => 1,
localauth => 1,
verbose => 1,
encrypt => 1,
);
=item Return Values
This method returns a list of AFS::Object::FileServer
lib/AFS/Command/VOS.pod view on Meta::CPAN
correctness of the hostname resolution mechanism (usually DNS, of
course, but that is outside of vos' control).
my @result = $vos->listaddrs
(
cell => $cell,
);
foreach my $result ( @result ) {
if ( $result->hasAttribute('hostname') {
print "Hostname: " . $result-hostname() . "\n";
} elsif ( $result->hasAttribute('addresses') {
my $addresses = $result->addresses();
foreach my $address ( @addresses ) {
print "IP Address: $address\n";
}
}
}
If a specific 'host' or 'uuid' is specified, then only one object will
be returned (assuming the specified host or uuid is valid, of course,
otherwise, you get nothing).
B<AFS::Object::FileServer>
This object will have one or more of the following attributes,
depending on the choice of arguments to the method, as well as the
ability of vos to map the IP addresses back into hostnames.
Attributes Values
---------- ------
hostname Server's hostname (duh)
addresses ARRAY reference of IP addresses
uuid Servers's UUID (duh)
The 'uuid' will be present if the 'printuuid' or 'uuid' arguments were
passed to the method call. The 'addresses' will be present either
'noresolve' was specified, or vos has problems with hostname
resolution.
=back
=head2 listpart
=over
lib/AFS/Command/VOS.pod view on Meta::CPAN
'listpart' returns nothing other than the partition names, the
underlying Partition objects have only one attribute ('partition'), so
the API for access this data is trivial:
my $result = $vos->listpart
(
server => 'fs1.ms.com',
) || die $vos->errors();
foreach my $partition ( $result->getPartitionNames() ) {
print "Server '$server' has partition '$partition'\n";
}
The FileServer object has no attributes at all, it merely contains the
Partition objects. Since the Partition objects are indexed by name,
there's no need to extract the partition objects and query their
attributes, since once you have the names, you have all the information
already.
Compare this with 'vos partinfo', which provides a lot more
information. For pedantic completeness (the author is kinda
lib/AFS/Command/VOS.pod view on Meta::CPAN
the 'examine' method, since that command also queries the VLDB for
part of its return values. See that discussion above for some
relevant details on the parsing of those objects, which will no be
repeated here.
my $result = $vos->listvldb
(
cell => $cell,
) || die $vos->errors();
print("VLDB contains " . $result->total() " volumes, " .
$result->locked() . " of which are locked\n");
foreach my $entry ( $result->getVLDBEntries() ) {
my $name = $entry->name();
foreach my $attr ( $entry->listAttributes() ) {
print "Volume $name has attribute $attr => " . $entry->$attr() . "\n";
}
foreach my $site ( $entry->getVLDBSites() ) {
my %attrs = $site->getAttributes();
while ( my($attr,$value) = each %attrs ) {
print "Site has attribute $attr => $value\n";
}
}
}
Another way to slice and dice this data:
foreach my $name ( $result->getVolumeNames() ) {
my $entry = $result->getVLDBEntry( name => $name );
....
}
lib/AFS/Command/VOS.pod view on Meta::CPAN
(
server => $server,,
cell => $cell,
) || die $vos->errors();
foreach my $partition ( $result->getPartitions() ) {
my $partname = $partition->partition();
my $total = $partition->total();
my $online = $partition->online();
my $offline = $partition->offline();
my $busy = $partition->busy();
print("Partition $partname has $total total volumes, of which " .
"$online are online, $offline are offline, and $busy are busy.\n");
foreach my $header ( $partition->getVolumeHeaders() ) {
# Do something interesting with $header.
}
}
There are several other ways to get at the headers, of course.
foreach my $name ( $partition->getVolumeNames() ) {
my $header = $partition->getVolumeHeaderByName($name)
lib/AFS/Command/VOS.pod view on Meta::CPAN
my $result = $vos->partinfo
(
server => $server,
cell => $cell,
) || die $vos->errors();
foreach my $partition ( $result->getPartitions() ) {
my $partname = $partition->partition();
my $available = $partition->available();
my $total = $partition->total();
print("Partition $partname has $available KB of " .
"space available out of $total KB total\n");
}
B<AFS::Object::FileServer>
This object has no attributes, and is merely a container for the
AFS::Object::Partition objects. It has the following methods
for extracting the objects is contains.
Methods Returns
lib/AFS/Command/VOS.pod view on Meta::CPAN
=item Return Values
This method returns an AFS::Object::VolServer object with one
attribute, which also may or may not contain one or more
AFS::Object::Transaction objects.
my $result = $vos->status
(
server => $server,
) || die $vos->errors();
print "Server has " . $result->transactions() . "active transactions\n";
foreach my $transaction ( $result->getTransactions() ) {
print("There are active transactions for volume ID " .
$transaction->volume() . "\n");
}
B<AFS::Object::VolServer>
This object has exactly one attribute, and several methods:
Attributes Values
---------- ------
transactions Number of active transactions on the volserver
lib/AFS/Object.pod view on Meta::CPAN
AFS::Object object, or an object derived from it.
=head2 listAttributes
This method takes no arguments, and returns a list of the attribute
names available in the object.
my @attrs = $result->listAttributes();
foreach my $attr ( @attrs ) {
my $value = $result->getAttribute($attr);
print "Key '$attr' has value '$value\n";
}
=head2 getAttribute
This methods takes a single argument, the name of an attribute, and
returns the value of the attribute, if it exists in the object.
my $name = $result->getAttribute('name');
NOTE: Attributes may also be queried by calling the method of the same
lib/AFS/Object.pod view on Meta::CPAN
existence is interesting to you (or to your code, I suppose), use the
hasAttribute method.
=head2 getAttributes
This method takes no arguments, and returns the entire list of
attributes as list of key/value pairs.
my %attrs = $result->getAttributes();
while ( my ($key,$value) = each %attrs ) {
print "Key '$key' has value '$value'\n";
}
=head2 hasAttribute
This method takes a single argument, the name of a potentially
available attribute, and returns a boolean true/false value if the
attribute exists in the object.
if ( $result->hasAttribute('name') ) {
# Well, then it has a name attribute...
t/00vos_basic.t view on Meta::CPAN
#
# $Id: 00vos_basic.t,v 11.1 2004/11/18 13:31:27 wpm Exp $
#
# (c) 2003-2004 Morgan Stanley and Co.
# 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
t/00vos_basic.t view on Meta::CPAN
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.
t/00vos_basic.t view on Meta::CPAN
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";
t/01vos_dumprestore.t view on Meta::CPAN
#
# $Id: 01vos_dumprestore.t,v 11.1 2004/11/18 13:31:30 wpm Exp $
#
# (c) 2003-2004 Morgan Stanley and Co.
# 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
t/01vos_dumprestore.t view on Meta::CPAN
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},
);
t/01vos_dumprestore.t view on Meta::CPAN
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 ) {
t/01vos_dumprestore.t view on Meta::CPAN
(
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' : '' );
t/01vos_dumprestore.t view on Meta::CPAN
(
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--;
t/02vos_volserver.t view on Meta::CPAN
#
# $Id: 02vos_volserver.t,v 11.2 2004/11/18 16:49:00 wpm Exp $
#
# (c) 2003-2004 Morgan Stanley and Co.
# 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
t/02vos_volserver.t view on Meta::CPAN
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 ) {
$attribute_test = 0;
warn("Invalid attributes for partition '$partname'\n" .
"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++;
}
t/02vos_volserver.t view on Meta::CPAN
unless ( $volume_byid->id() == $volume_generic->id() ) {
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
$id_errors++;
next;
}
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 ) {
t/10bos_basic.t view on Meta::CPAN
#
# $Id: 10bos_basic.t,v 11.1 2004/11/18 13:31:35 wpm Exp $
#
# (c) 2003-2004 Morgan Stanley and Co.
# 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
);
t/10bos_basic.t view on Meta::CPAN
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--;
t/20fs_basic.t view on Meta::CPAN
#
# $Id: 20fs_basic.t,v 11.1 2004/11/18 13:31:37 wpm Exp $
#
# (c) 2003-2004 Morgan Stanley and Co.
# 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
);
t/20fs_basic.t view on Meta::CPAN
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 =
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
#
# $Id: 30pts_basic.t,v 11.1 2004/11/18 13:31:39 wpm Exp $
#
# (c) 2003-2004 Morgan Stanley and Co.
# 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
);
t/30pts_basic.t view on Meta::CPAN
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
#
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
#
# $Id: 40fs_complex.t,v 11.1 2004/11/18 13:31:41 wpm Exp $
#
# (c) 2003-2004 Morgan Stanley and Co.
# 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
t/40fs_complex.t view on Meta::CPAN
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
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";
t/99pts_cleanup.t view on Meta::CPAN
#
# $Id: 99pts_cleanup.t,v 11.1 2004/11/18 13:31:44 wpm Exp $
#
# (c) 2003-2004 Morgan Stanley and Co.
# 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
);
t/99pts_cleanup.t view on Meta::CPAN
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/bin/check_copyright view on Meta::CPAN
.msbaseline
.exclude
MANIFEST
Changes.html
README.html
ToDo.html
);
warn "Searching source tree for files...\n";
open(FIND,"find . -type f -print |") ||
die "Unable to fork find: $!\n";
while ( <FIND> ) {
chomp;
s|^\./||;
next if $skip{$_};
next if /~$/;
push(@file,$_);
}
util/bin/check_copyright view on Meta::CPAN
# system("perl -i -pe 's/(\(c\) 1999)/\1, 2000/g;' $old");
# die "Unable to update copyright years in $old\n" if $? >> 8;
#
open(NEW,">$old.new") || die "Unable to write to $old.new: $!\n";
open(OLD,$old) || die "Unable to read $old: $!\n";
while ( <OLD> ) {
s/(\(c\)) (\d{4}).* (Morgan Stanley and Co\.)/\1 \2-$thisyear \3/;
#s/(\(c\) 1999)/\1, 2000/g;
print NEW;
}
close(OLD) || die "Unable to close $old: $!\n";
close(NEW) || die "Unable to close $old.new: $!\n";
rename("$old.new",$old) || die "Unable to rename $old.new to $old: $!\n";
if ( $rcs ) {
system("echo 'Updated copyright year' | ci -u $old > /dev/null");
die "Unable to ci -u $old\n" if $? >> 8;
util/bin/check_version view on Meta::CPAN
unless ( $cwd =~ m:perl5/AFS-Command/([^/]+)/: ) {
die "Unable to determine MSDE version\n";
}
$newversion = $1;
}
warn "New \$VERSION is $newversion\n";
warn "Searching source tree for files...\n";
open(FIND,"find . -type f -print |") ||
die "Unable to fork find: $!\n";
while ( <FIND> ) {
chomp;
s|^\./||;
next if $skip{$_};
next if /~$/;
next unless /(\.pm(\.in)?|\.t)$/;
push(@file,$_);
}
util/bin/check_version view on Meta::CPAN
open(NEW,">$old.new") || die "Unable to write to $old.new: $!\n";
open(OLD,$old) || die "Unable to read $old: $!\n";
while ( <OLD> ) {
if ( $old =~ /\.pm(\.in)?$/ ) {
#
# Fix the module version
#
if ( /\$VERSION\s+=\s+\'([\d\.]+)\'/ ) {
print NEW "our \$VERSION = '$newversion';\n";
} else {
print NEW;
}
} else {
#
# Fix the use statements for tests
#
if ( /use\s+\S+\s+([\d\.]+)/ ) {
$oldversion = $1;
s/$oldversion/$newversion/;
}
print NEW;
}
}
close(OLD) || die "Unable to close $old: $!\n";
close(NEW) || die "Unable to close $old.new: $!\n";
rename("$old.new",$old) || die "Unable to rename $old.new to $old: $!\n";
if ( $rcs ) {
util/bin/write_exclude view on Meta::CPAN
@exclude =
qw(
.options/rcsMajor
.msbaseline
.exclude
);
warn "Searching source tree for RCS symlinks...\n";
open(FIND,"find . -name RCS -print |") ||
die "Unable to fork find: $!\n";
while ( <FIND> ) {
chomp;
s|^\./||;
push(@exclude,$_);
}
close(FIND) ||
die "Error running find: $!\n";
warn "Writing new .exclude file...\n";
$top = basename(cwd);
open(NEW,">.exclude.$$") ||
die "Unable to open .exclude.$$: $!\n";
foreach ( sort @exclude ) {
print NEW "$top/$_\n";
}
close(NEW) ||
die "Unable to close .exclude.$$: $!\n";
rename(".exclude.$$",".exclude") ||
die "Unable to rename .exclude.$$ to .exclude: $!\n";
exit 0;
END {
util/bin/write_manifest view on Meta::CPAN
%skip = map { $_ => 1 }
qw(
.options/rcsMajor
.msbaseline
.exclude
);
warn "Searching source tree for files...\n";
open(FIND,"find . -type f -print |") ||
die "Unable to fork find: $!\n";
while ( <FIND> ) {
chomp;
s|^\./||;
next if $skip{$_};
next if /~$/;
push(@new,$_);
}
close(FIND) ||
die "Error running find: $!\n";
warn "Writing new MANIFEST file...\n";
open(NEW,">MANIFEST.$$") ||
die "Unable to open MANIFEST.$$: $!\n";
foreach ( sort @new ) {
print NEW "$_\n";
}
close(NEW) ||
die "Unable to close MANIFEST.$$: $!\n";
rename("MANIFEST.$$","MANIFEST") ||
die "Unable to rename MANIFEST.$$ to MANIFEST: $!\n";
exit 0;
END {
util/lib/parse_config view on Meta::CPAN
die "Unable to locate CONFIG file\n" unless -f $config;
open(CONFIG,"$config") or
die "Unable to open CONFIG file: $ERRNO\n";
while ( <CONFIG> ) {
next if /^\#/;
next unless ($key,$value) = /^(\w+)\s*=\s*(.*)\s*$/;
if ( $ENV{$key} ) {
#print "Environment variable '$key' overrides CONFIG definition\n";
$Config{$key} = $ENV{$key};
} else {
$Config{$key} = $value;
}
}
close(CONFIG) or
die "Unable to close CONFIG file: $ERRNO\n";
foreach my $key ( keys %ENV ) {
( run in 0.713 second using v1.01-cache-2.11-cpan-de7293f3b23 )