AFS-Command
view release on metacpan or search on metacpan
--- #YAML:1.0
name: AFS-Command
version: 1.99
abstract: ~
author:
- W. Phillip Moore <Phil.Moore@MorganStanley.com>
license: unknown
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
build_requires:
ExtUtils::MakeMaker: 0
requires: {}
no_index:
directory:
- t
- inc
generated_by: ExtUtils::MakeMaker version 6.56
lib/AFS/Command.pod view on Meta::CPAN
this class, or one of its base classes.
The subclasses are associated with data structures such as volume
headers, a VLDB entry, or a partition on a server. Each of these
classes has methods to retrieve the objects they "contain", such as a
method to query the list of volume names on a partition object, and a
method to get a list of VLDB entries from a VLDB site.
The data structures, and their varying relationships, are documented
in details of the methods for each of the commands, and the specific
interfaces for each object type are documented in the corresponding
class documentation.
The subclasses for encapsulating the VLDB data are:
AFS::Object::VLDB
AFS::Object::VLDBEntry
AFS::Object::VLDBSite
The subclasses for encapsulating the volume headers are:
lib/AFS/Command/BOS.pm view on Meta::CPAN
if ( defined $instance ) {
$result->_addInstance($instance);
}
$instance = AFS::Object::Instance->new( instance => $1 );
#
# This is ugly, since the order and number of these
# strings varies.
#
if ( /\(type is (\S+)\)/ ) {
$instance->_setAttribute( type => $1 );
}
if ( /(disabled|temporarily disabled|temporarily enabled),/ ) {
$instance->_setAttribute( state => $1 );
}
if ( /stopped for too many errors/ ) {
$instance->_setAttribute( errorstop => 1 );
}
lib/AFS/Command/BOS.pod view on Meta::CPAN
B<AFS::Object::Instance>
The following attributes are always present:
Attributes Values
---------- ------
instance Name of the instance
status Status string (running normally, shutdown, etc.)
The following attribute is always present is the instance is of type
'cron':
Attributes Values
---------- ------
auxiliary Auxiliary status (date the next execution)
The following attributes are always available when the 'long' argument
is specified:
Attributes Values
---------- ------
type "cron", "simple", or "fs"
startdate Date when the process was last started
startcount Number of times the process has started,
since the bosserver was started
exitdate Date when the process last exited
The following attributes are optionally available, depending on the
state of the instance, when the 'long' argument is specified:
Attributes Values
---------- ------
lib/AFS/Command/BOS.pod view on Meta::CPAN
noauth => 1,
localauth => 1,
);
=head2 create
The bos help string is:
bos create: create a new server instance
Usage: bos create -server <machine name> -instance <server process name>
-type <server type> -cmd <command lines>+ [-notifier <Notifier program>]
[-cell <cell name>] [-noauth] [-localauth]
The corresponding method invocation looks like:
my $result = $bos->create
(
# Required arguments
server => $server,
instance => $instance,
type => $type,
cmd => $cmd, # OR [ $cmd1, $cmd2, ... ]
# Optional arguments
notifier => $notifier,
cell => $cell,
noauth => 1,
localauth => 1,
);
=head2 delete
lib/AFS/Command/Base.pm view on Meta::CPAN
my %operations = ();
#
# This hack is necessary to support the offline/online "hidden"
# vos commands. These won't show up in the normal help output,
# so we have to check for them individually. Since offline and
# online are implemented as a pair, we can just check one of
# them, and assume the other is there, too.
#
foreach my $type ( qw(default hidden) ) {
if ( $type eq 'hidden' ) {
next unless $self->isa("AFS::Command::VOS");
}
my $pipe = IO::Pipe->new() || do {
$self->_Carp("Unable to create pipe: $ERRNO\n");
return;
};
my $pid = fork();
lib/AFS/Command/Base.pm view on Meta::CPAN
return;
}
if ( $pid == 0 ) {
STDERR->fdopen( STDOUT->fileno(), "w" ) ||
$self->_Croak("Unable to redirect stderr: $ERRNO\n");
STDOUT->fdopen( $pipe->writer()->fileno(), "w" ) ||
$self->_Croak("Unable to redirect stdout: $ERRNO\n");
if ( $type eq 'default' ) {
exec @{$self->{command}}, 'help';
} else {
exec @{$self->{command}}, 'offline', '-help';
}
die "Unable to exec @{$self->{command}} help: $ERRNO\n";
} else {
$pipe->reader();
while ( defined($_ = $pipe->getline()) ) {
if ( $type eq 'default' ) {
next if /Commands are:/;
my ($command) = split;
next if $command =~ /^(apropos|help)$/;
$operations{$command}++;
} else {
if ( /^Usage:/ ) {
$operations{offline}++;
$operations{online}++;
}
}
lib/AFS/Command/Base.pm view on Meta::CPAN
foreach my $key ( qw( noauth localauth encrypt ) ) {
next unless $self->{$key};
$args{$key}++ if exists $arguments->{required}->{$key};
$args{$key}++ if exists $arguments->{optional}->{$key};
}
unless ( $self->{quiet} ) {
$args{verbose}++ if exists $arguments->{optional}->{verbose};
}
foreach my $type ( qw( required optional ) ) {
foreach my $key ( keys %{$arguments->{$type}} ) {
my $hasvalue = $arguments->{$type}->{$key};
if ( $type eq 'required' ) {
unless ( exists $args{$key} ) {
$self->_Carp("Required argument '$key' not provided");
return;
}
} else {
next unless exists $args{$key};
}
if ( $hasvalue ) {
if ( ref $args{$key} eq 'HASH' || ref $args{$key} eq 'ARRAY' ) {
lib/AFS/Command/FS.pm view on Meta::CPAN
if ( $operation eq 'listacl' ) {
if ( /^Access list for (.*) is/ ) {
$path->_setAttribute( path => $1 );
delete $paths{$1};
my $normal = AFS::Object::ACL->new();
my $negative = AFS::Object::ACL->new();
my $type = 0;
while ( defined($_ = $self->{handle}->getline()) ) {
s/^\s+//g;
s/\s+$//g;
last if /^\s*$/;
$type = 1, next if /^Normal rights:/;
$type = -1, next if /^Negative rights:/;
my ($principal,$rights) = split;
if ( $type == 1 ) {
$normal->_addEntry( $principal => $rights );
} elsif ( $type == -1 ) {
$negative->_addEntry( $principal => $rights );
}
}
$path->_setACLNormal($normal);
$path->_setACLNegative($negative);
}
lib/AFS/Command/FS.pod view on Meta::CPAN
=head2 exportafs
=over
=item Arguments
The fs help string is:
fs exportafs: enable/disable translators to AFS
Usage: fs exportafs -type <exporter name> [-start <start/stop translator (on | off)>]
[-convert <convert from afs to unix mode (on | off)>]
[-uidcheck <run on strict 'uid check' mode (on | off)>]
[-submounts <allow nfs mounts to subdirs of /afs/.. (on | off)>]
The corresponding method invocation looks like:
my $result = $fs->exportafs
(
# Required arguments
type => $type, # 'nfs' is the only supported value
# Optional arguments
start => $start, # 'on' or 'off'
convert => $convert, # 'on' or 'off'
uidcheck => $uidcheck, # 'on' or 'off'
submounts => $submounts, # 'on' or 'off'
);
NOTE: In a future release, the 4 optional arguments will probably take
boolean values, with "off" being a special case that means false, in
order to simply the interface (and be backwards compatible).
=item Return Values
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>
lib/AFS/Command/FS.pod view on Meta::CPAN
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
getPathNames() list of strings, each of which is a single pathname
getPaths() list of AFS::Object::Path objects, one for each path
getPath($pathname) a single AFS::Object::Path object, for the pathname $pathname
B<AFS::Object::Path>
Methods Returns
------- -------
getACLNormal() the AFS::Object::ACL object for the normal rights
getACLNegative() the AFS::Object::ACL object for the negative rights
getACL($type) the AFS::Object::ACL object for rights of type $type,
where $type is either 'normal' or 'negative'
B<AFS::Object::ACL>
Methods Returns
------- -------
getPrincipals() a list of the principals (users, groups) on the ACL
getRights($principal) the rights (permissions) of the specified $principal
getEntries() a list of key/value pairs, where the keys are the principals,
and the values are the rights for that principal
lib/AFS/Command/VOS.pm view on Meta::CPAN
} elsif ( /^(\S+)\s+(\d+)\s+(RW|RO|BK)\s+(\d+)\s+K/ ) {
my $header = AFS::Object::VolumeHeader->new();
if ( /^(\S+)\s+(\d+)\s+(RW|RO|BK)\s+(\d+)\s+K\s+([\w-]+)/ ) {
$header->_setAttribute
(
name => $1,
id => $2,
type => $3,
size => $4,
);
$header->_setAttribute( rwrite => $2 ) if $3 eq 'RW';
$header->_setAttribute( ronly => $2 ) if $3 eq 'RO';
$header->_setAttribute( backup => $2 ) if $3 eq 'BK';
my $status = $5;
$status = 'offline' if $status eq 'Off-line';
$status = 'online' if $status eq 'On-line';
$header->_setAttribute
lib/AFS/Command/VOS.pm view on Meta::CPAN
status => $status,
attached => 1,
);
} elsif ( /^(\S+)\s+(\d+)\s+(RW|RO|BK)\s+(\d+)\s+K\s+used\s+(\d+)\s+files\s+([\w-]+)/ ) {
$header->_setAttribute
(
name => $1,
id => $2,
type => $3,
size => $4,
files => $5,
);
$header->_setAttribute( rwrite => $2 ) if $3 eq 'RW';
$header->_setAttribute( ronly => $2 ) if $3 eq 'RO';
$header->_setAttribute( backup => $2 ) if $3 eq 'BK';
my $status = $6;
$status = 'offline' if $status eq 'Off-line';
$status = 'online' if $status eq 'On-line';
lib/AFS/Command/VOS.pm view on Meta::CPAN
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
last unless m:^\s+server\s+(\S+)\s+partition\s+(/vicep\w+)\s+([A-Z]{2})\s+Site\s*(--\s+)?(.*)?:;
my $site = AFS::Object::VLDBSite->new
(
server => $1,
partition => $2,
type => $3,
status => $5,
);
$entry->_addVLDBSite($site);
}
}
#
lib/AFS/Command/VOS.pm view on Meta::CPAN
chomp;
next unless m:^\s+server\s+(\S+)\s+partition\s+(/vicep\w+)\s+([A-Z]{2})\s+Site\s*(--\s+)?(.*)?:;
$sites--;
my $site = AFS::Object::VLDBSite->new
(
server => $1,
partition => $2,
type => $3,
status => $5,
);
$entry->_addVLDBSite( $site );
last if $sites == 0;
}
}
lib/AFS/Command/VOS.pm view on Meta::CPAN
next;
}
#
# We have to handle multiple formats here. For
# now, just parse the "fast" and normal output.
# Extended is not yet supported.
#
my (@array) = split;
my ($name,$id,$type,$size,$status) = ();
my $volume = AFS::Object::VolumeHeader->new();
if ( @array == 6 ) {
($name,$id,$type,$size,$status) = @array[0..3,5];
$status = 'offline' if $status eq 'Off-line';
$status = 'online' if $status eq 'On-line';
$volume->_setAttribute
(
id => $id,
name => $name,
type => $type,
size => $size,
status => $status,
attached => 1,
);
} elsif ( @array == 1 ) {
$volume->_setAttribute
(
id => $_,
status => 'online',
attached => 1,
lib/AFS/Command/VOS.pod view on Meta::CPAN
The following attributes should always be present:
Attributes Values
---------- ------
name Volume name
rwrite Numeric Volume ID for the RW volume
locked Boolean value, indicating the VLDB entry is locked or not
The following attributes may be present, if there are volumes of the
associated type in the VLDB entry:
Attributes Values
---------- ------
ronly Numeric Volume ID for the RO volume
backup Numeric Volume ID for the BK volume
rclone Numeric Volume ID for the RClone volume, if present
Note that the 'rclone' attribute is only present if the volume was
actively being cloned while being examined. This is true when a 'vos
release' command is actively updating the RO volumes.
lib/AFS/Command/VOS.pod view on Meta::CPAN
VLDB entry, namely the lines such as:
server pasafq5 partition /vicepg RO Site
The following attributes are always available:
Attributes Values
---------- ------
server Fileserver hostname
partition Fileserver /vice partition name
type "RO" | "RW" | "BK"
status Site status.
Note that the status is the field indicating the state of the volume
during a 'vos release' command, and this will be an empty string for
VLDB entries which are completely in sync.
B<AFS::Object::VolumeHeader>
This object is created by parsing the volume header stanza, such as:
lib/AFS/Command/VOS.pod view on Meta::CPAN
unattached (attached == 0), but a volume can be offline for other
reasons, (eg. vos offline, or more than one volume with the same ID on
the same server), and still be attached (attached == 1).
The following attributes are present only if the volume's status is
'online':
Attributes Values
---------- ------
name Volume Name
type "RO" | "RW" | "BK"
size Numeric size in KB
server Fileserver hostname
partition Fileserver /vice partition
maxquota Volume quota in KB
creation Volume creation date (ctime format, eg: Sat Oct 6 04:39:50 2001)
copyTime Volume copy date (also in ctime format)
backupTime Volume backup date (also in ctime format)
access Volume Last Access date (also in ctime format)
update Volume update date (also in ctime format)
accesses Number of volume accesses since the last reset
lib/AFS/Command/VOS.pod view on Meta::CPAN
getVLDBSites() list of AFS::Object::VLDBSite objects
B<AFS::Object::VLDBSite>
The following attributes are always available:
Attributes Values
---------- ------
server Fileserver hostname
partition Fileserver /vice partition name
type "RO" | "RW" | "BK"
status Site status.
This object has no special methods.
=back
=head2 listvol
=over
lib/AFS/Command/VOS.pod view on Meta::CPAN
If the 'fast' argument was specified, then none of the other
attributes will be present.
The following attributes are present only if the volume's status is
'online':
Attributes Values
---------- ------
name Volume Name
type "RO" | "RW" | "BK"
size Numeric size in KB
The following attributes are present only if the 'long' argument was
specified:
Attributes Values
---------- ------
server Fileserver hostname
partition Fileserver /vice partition
maxquota Volume quota in KB
lib/AFS/Object/Path.pm view on Meta::CPAN
package AFS::Object::Path;
use strict;
our @ISA = qw(AFS::Object);
our $VERSION = '1.99';
sub getACL {
my $self = shift;
my $type = shift || 'normal';
return unless ref $self->{_acl};
return $self->{_acl}->{"_$type"};
}
sub getACLNormal {
my $self = shift;
return $self->getACL();
}
sub getACLNegative {
my $self = shift;
return $self->getACL('negative');
t/00vos_basic.t view on Meta::CPAN
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();
t/00vos_basic.t view on Meta::CPAN
#
# 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";
t/00vos_basic.t view on Meta::CPAN
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";
t/00vos_basic.t view on Meta::CPAN
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 {
t/01vos_dumprestore.t view on Meta::CPAN
);
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
t/01vos_dumprestore.t view on Meta::CPAN
);
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());
t/01vos_dumprestore.t view on Meta::CPAN
print "ok $TestCounter\n";
$Volnames{$volname}++;
} else {
print "not ok $TestCounter\n";
warn("Unable to restore volume '$volname' from file '$files{raw}',\n" .
"to server '$server_primary', partition '$partition_primary', name '$volname':\n" .
$vos->errors());
}
$TestCounter++;
foreach my $ctype ( qw(gunzip bunzip2) ) {
unless ( $enabled{$ctype} ) {
for ( my $count = 0 ; $count < 1 ; $count++ ) {
print "ok $TestCounter # skip Compression support for $ctype disabled\n";
$TestCounter++;
}
next;
}
$result = $vos->restore
(
server => $server_primary,
partition => $partition_primary,
name => $volname,
file => $files{$ctype},
overwrite => 'full',
cell => $cell,
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to restore volume '$volname' from file '$files{$ctype}',\n" .
"to server '$server_primary', partition '$partition_primary', name '$volname':\n" .
$vos->errors());
}
$TestCounter++;
}
if ( $restorefilter ) {
$result = $vos->restore
t/01vos_dumprestore.t view on Meta::CPAN
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to restore volume '$volname' from file '$files{raw}',\n" .
"using restore filter '$restorefilter', " .
"to server '$server_primary', partition '$partition_primary', name '$volname':\n" .
$vos->errors());
}
$TestCounter++;
my ($ctype) = ( $enabled{gunzip} ? 'gunzip' :
$enabled{bunzip2} ? 'bunzip2' : '' );
if ( $ctype ) {
$result = $vos->restore
(
server => $server_primary,
partition => $partition_primary,
name => $volname,
file => $files{$ctype},
overwrite => 'full',
cell => $cell,
filterin => [$restorefilter],
);
if ( $result ) {
print "ok $TestCounter\n";
} else {
print "not ok $TestCounter\n";
warn("Unable to restore volume '$volname' from file '$files{$ctype}',\n" .
"using restore filter '$restorefilter', " .
"to server '$server_primary', partition '$partition_primary', name '$volname':\n" .
$vos->errors());
}
} else {
print "ok $TestCounter # skip Compression support disabled\n";
}
$TestCounter++;
t/10bos_basic.t view on Meta::CPAN
}
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();
t/20fs_basic.t view on Meta::CPAN
}
#
# 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()) ) {
t/30pts_basic.t view on Meta::CPAN
} 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++;
t/30pts_basic.t view on Meta::CPAN
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");
}
t/30pts_basic.t view on Meta::CPAN
}
#
# pts listentries
#
if ( $pts->supportsOperation('listentries') ) {
foreach my $name ( $ptsgroup, $ptsuser ) {
my $flag = $name eq $ptsgroup ? 'groups' : 'users';
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";
t/30pts_basic.t view on Meta::CPAN
}
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++;
t/40fs_complex.t view on Meta::CPAN
#
# Mount it (several different ways)
#
my %mtpath =
(
rw => "$pathafs/$volname-rw",
cell => "$pathafs/$volname-cell",
plain => "$pathafs/$volname-plain",
);
foreach my $type ( keys %mtpath ) {
$result = $fs->mkmount
(
dir => $mtpath{$type},
vol => $volname,
(
$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
t/40fs_complex.t view on Meta::CPAN
# pts entries will not be defined.
#
# Thus, we use a different, existing pts entry for these tests, and
# not the ones we created above.
#
my %entries =
(
$ptsexisting => 'rlidwk',
);
foreach my $type ( qw(normal negative) ) {
$result = $fs->setacl
(
dir => $mtpath,
acl => \%entries,
(
$type eq 'negative' ?
( negative => 1 ) : ()
),
);
if ( $result ) {
print "ok $TestCounter\n";
$TestCounter++;
} else {
print "not ok $TestCounter..$TestTotal\n";
die("Unable to setacl dirs:" .
$fs->errors() .
t/40fs_complex.t view on Meta::CPAN
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 ) {
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_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/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,$_);
}
( run in 1.557 second using v1.01-cache-2.11-cpan-9bca49b1385 )