AFS
view release on metacpan or search on metacpan
LICENCES/Artistic view on Meta::CPAN
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
LICENCES/COPYING view on Meta::CPAN
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
LICENCES/COPYING view on Meta::CPAN
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.
LICENCES/IBM-LICENCE view on Meta::CPAN
"Program" means the Original Program and Contributions.
"Recipient" means anyone who receives the Program under this
Agreement, including all Contributors.
2. GRANT OF RIGHTS
a) Subject to the terms of this Agreement, each Contributor hereby
grants Recipient a non-exclusive, worldwide, royalty-free
copyright license to reproduce, prepare derivative works of,
publicly display, publicly perform, distribute and sublicense the
Contribution of such Contributor, if any, and such derivative
works, in source code and object code form.
b) Subject to the terms of this Agreement, each Contributor hereby
grants Recipient a non-exclusive, worldwide, royalty-free patent
license under Licensed Patents to make, use, sell, offer to sell,
import and otherwise transfer the Contribution of such
Contributor, if any, in source code and object code form. This
patent license shall apply to the combination of the Contribution
and the Program if, at the time the Contribution is added by the
LICENCES/IBM-LICENCE view on Meta::CPAN
Program.
Each Contributor must include the following in a conspicuous location
in the Program:
Copyright © {date here}, International Business Machines Corporation
and others. All Rights Reserved.
In addition, each Contributor must identify itself as the originator
of its Contribution, if any, in a manner that reasonably allows
subsequent Recipients to identify the originator of the Contribution.
4. COMMERCIAL DISTRIBUTION
Commercial distributors of software may accept certain
responsibilities with respect to end users, business partners and the
like. While this license is intended to facilitate the commercial use
of the Program, the Contributor who includes the Program in a
commercial product offering should do so in a manner which does not
create potential liability for other Contributors. Therefore, if a
Contributor includes the Program in a commercial product offering,
LICENCES/IBM-LICENCE view on Meta::CPAN
time after becoming aware of such noncompliance. If all Recipient's
rights under this Agreement terminate, Recipient agrees to cease use
and distribution of the Program as soon as reasonably practicable.
However, Recipient's obligations under this Agreement and any licenses
granted by Recipient relating to the Program shall continue and
survive.
IBM may publish new versions (including revisions) of this Agreement
from time to time. Each new version of the Agreement will be given a
distinguishing version number. The Program (including Contributions)
may always be distributed subject to the version of the Agreement
under which it was received. In addition, after a new version of the
Agreement is published, Contributor may elect to distribute the
Program (including its Contributions) under the new version. No one
other than IBM has the right to modify this Agreement. Except as
expressly stated in Sections 2(a) and 2(b) above, Recipient receives
no rights or licenses to the intellectual property of any Contributor
under this Agreement, whether expressly, by implication, estoppel or
otherwise. All rights in the Program not expressly granted under this
Agreement are reserved.
Makefile.PL view on Meta::CPAN
WriteMakefile(
'NAME' => 'AFS',
'VERSION' => $VERSION,
($] >= 5.005 ?
('AUTHOR' => 'Norbert E Gruener <nog@MPA-Garching.MPG.de>',
'ABSTRACT' => 'Perl interface to AFS programming APIs',
) : () ),
'realclean' => {FILES => "Makefile.bak lib" },
);
sub MY::postamble {
'
html:
cp ./pod/v2/Makefile.inp lib/Makefile
cp ./pod/v2/zpod2html lib/
cd lib && $(MAKE) html
';
}
examples/README view on Meta::CPAN
conform with the interface version 2. For more details read the
appropriate POD documentations.
HOW TO USE THE EXAMPLES
All scripts in "v2" are designed that you can run them without
prior installation of the AFS module bundle. After you have
performed the steps "perl Makefile.pl", "make", and eventually
"make test" you can run these test scripts. Just step into the
different subdirectories and run the available examples, e.g:
cd AFS-2.6.4/examples/v2/base
./error_test
examples/v2/bos/constructor view on Meta::CPAN
$server = shift;
$cellname = shift;
if ($cellname) { $bos = AFS::BOS->new($server, 0, 0, $cellname); }
else { $bos = AFS::BOS->new($server); }
if ($AFS::CODE) { print "AFS::CODE = $AFS::CODE\n"; }
else { print "OK \n"; }
test_it($bos);
sub test_it {
my $self = shift;
$self->DESTROY;
}
examples/v2/bos/listkeys view on Meta::CPAN
}
}
}
chomp($lastmod = strftime('%d %b %R %Y', localtime($lastmod)));
print "Keys last changed on $lastmod\n";
print "All done.\n";
$bos->DESTROY;
sub print_key {
my $key = shift;
print "key is: ";
my (@val) = unpack("C*", $key);
foreach (@val) { printf("\\%o", $_); }
print "\n";
}
examples/v2/kas/constructor view on Meta::CPAN
use AFS::KTC_TOKEN;
die "Usage: $0 \n" if $#ARGV != -1;
my $kas = AFS::KAS->AuthServerConn(AFS::KTC_TOKEN->nulltoken, &AFS::KA_MAINTENANCE_SERVICE);
if ($AFS::CODE) { print "Error Code: $AFS::CODE\n"; }
else { print "OK \n"; }
test_it($kas);
sub test_it {
my $self = shift;
$self->DESTROY;
}
examples/v2/ktct/tokens view on Meta::CPAN
my $index = 0;
while (my $service = AFS::KTC_PRINCIPAL->ListTokens($index)) {
if(my ($token, my $client) = AFS::KTC_TOKEN->GetToken($service)) {
my $user = $client->name;
$user .= "." . $client->instance if ($client->instance);
if ($user eq '' || $user =~ /Unix UID/) { printf("Tokens"); }
elsif ($user =~ /AFS ID/) { printf("User's (%s) tokens",$user); }
print " for ", $service->principal," ";
if ($token->endTime <= time) { print "[>> Expired <<]\n"; }
else {
chomp(my $expire = substr(ctime($token->endTime),4,13));
print "[Expires $expire]\n";
}
}
}
print" --End of list--\n";
examples/v2/pts/constructor view on Meta::CPAN
$sec = shift unless $sec;
$cell = shift unless $cell;
$pts = AFS::PTS->new($sec, $cell);
if ($AFS::CODE) { print "Error Code: $AFS::CODE\n"; }
else { print "OK \n"; }
test_it($pts);
sub test_it {
my $self = shift;
$self->DESTROY;
}
examples/v2/vldb/constructor view on Meta::CPAN
die "Usage: $0 [verbose]\n" if $#ARGV > 0;
$verbose = shift // 0;
$vldb = AFS::VLDB->new($verbose);
if ($AFS::CODE) { print "AFS::CODE = $AFS::CODE\n"; }
else { print "OK \n"; }
test_it($vldb);
sub test_it {
my $self = shift;
$self->DESTROY;
}
examples/v2/vldb/listvldb view on Meta::CPAN
$vldb = AFS::VLDB->new;
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
my $vldblist = $vldb->listvldb($serv, $part, $lock);
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
$Debugging && print_debug($vldblist);
print_vldblist($vldblist);
sub print_vldblist {
my ($vldblist) = @_;
foreach my $val (keys %$vldblist) {
print "Key: $val\n";
foreach my $ent (keys %{$vldblist->{$val}}) {
if ($ent eq 'server') {
my $i = 1;
foreach my $srv (@{$vldblist->{$val}->{$ent}}) {
print "\tServer number $i:\n";
$i++;
examples/v2/vldb/listvldb view on Meta::CPAN
}
}
}
else {
print "\tKey: $ent, Value: $vldblist->{$val}->{$ent}\n";
}
}
}
}
sub print_debug {
my ($vldblist) = @_;
foreach my $val (keys %$vldblist) {
print "$val:\n";
foreach my $ent (keys %{$vldblist->{$val}}) {
if ($ent eq 'server') {
printf "\t%10s \n", $ent;
foreach my $srv (@{$vldblist->{$val}->{$ent}}) {
foreach my $s (keys %{$srv}) {
printf "\t\t%12s: %s\n", $s, $srv->{$s};
examples/v2/vldb/listvldbentry view on Meta::CPAN
$vol = shift;
$vldb = AFS::VLDB->new;
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
my $vldblist = $vldb->listvldbentry($vol);
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
print_vldblist($vldblist);
sub print_vldblist {
my ($vldblist) = @_;
foreach my $val (keys %$vldblist) {
print "Key: $val\n";
foreach my $ent (keys %{$vldblist->{$val}}) {
if ($ent eq 'server') {
my $i = 1;
foreach my $srv (@{$vldblist->{$val}->{$ent}}) {
print "\tServer number $i:\n";
$i++;
examples/v2/vos/constructor view on Meta::CPAN
die "Usage: $0 [verbose]\n" if $#ARGV > 0;
$verbose = shift // 0;
$vos = AFS::VOS->new($verbose);
if ($AFS::CODE) { print "AFS::CODE = $AFS::CODE\n"; }
else { print "OK \n"; }
test_it($vos);
sub test_it {
my $self = shift;
$self->DESTROY;
}
examples/v2/vos/examine view on Meta::CPAN
$vldb = AFS::VLDB->new;
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
$vldblist = $vldb->listvldbentry($volume);
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
print_vol($vollist);
print_vldb($vldblist);
sub print_vol {
my $vollist = shift;
print "$vollist->{name} \t$vollist->{volid} $vollist->{type} \t $vollist->{size} K $vollist->{inUse}\n";
print "\t$vollist->{server} $vollist->{partition}\n";
print "\tRWrite $vollist->{parentID} ROnly $vollist->{cloneID} Backup $vollist->{backupID}\n";
print "\tMaxQuota $vollist->{maxquota} K\n";
print "\tCreation ", ctime($vollist->{creationDate}), "\n";
print "\tCopy ", ctime($vollist->{copyDate}), "\n";
print "\tBackup ", ctime($vollist->{backupDate}), "\n";
print "\tLast Update ", ctime($vollist->{updateDate}), "\n";
print "\t$vollist->{dayUse} accesses in the past day (i.e., vnode references)\n";
}
sub print_vldb {
my ($vldblist) = @_;
print "\tRWrite: $vldblist->{$volume}->{RWrite} \n";
print "\tnumber of sites -> $vldblist->{$volume}->{nServers}\n";
foreach my $srv (@{$vldblist->{$volume}->{server}}) {
print "\t\tserver $srv->{name} partition $srv->{partition} $srv->{type} site\n";
}
}
examples/v2/vos/listvol view on Meta::CPAN
my $partlist = $vos->listvol($server, $part, $fast, $extend);
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n" and die;
if ($fast) { print_fast($partlist); }
elsif ($extend) { print_ext($partlist); }
elsif ($Debugging) { print_debug($partlist); }
elsif ($long) { print_long($partlist); }
else { print_default($partlist); }
sub print_fast {
my $partlist = shift;
my $totvol = 0;
foreach my $part (sort keys %$partlist) {
foreach my $vol (sort keys %{$partlist->{$part}}) {
if ($vol =~ /totalBusy/) { next; }
elsif ($vol =~ /totalNotOK/) { next; }
$totvol++;
if ($vol !~ /total/) {
foreach my $key (sort keys %{$partlist->{$part}->{$vol}}) {
print "$partlist->{$part}->{$vol}->{$key}\n";
}
}
}
}
print "Total number of volumes on server $server partition /vicep$part: $totvol \n";
}
sub print_ext {
my $partlist = shift;
foreach my $part (sort keys %$partlist) {
print "Partition $part:\n";
foreach my $vol (sort keys %{$partlist->{$part}}) {
if ($vol !~ /total/) {
if ($vol =~ /volume_busy/) {
print "\t**** Volume $partlist->{$part}->{$vol}->{volid} is busy **** \n";
}
elsif ($vol =~ /volume_notok/) {
examples/v2/vos/listvol view on Meta::CPAN
}
print "\n";
}
}
print "\ttotalOK: $partlist->{$part}->{' totalOK'}\n";
print "\ttotalBusy: $partlist->{$part}->{' totalBusy'}\n";
print "\ttotalNotOK: $partlist->{$part}->{' totalNotOK'}\n";
}
}
sub print_long {
my $partlist = shift;
foreach my $part (sort keys %$partlist) {
print "$part:\n";
foreach my $vol (sort keys %{$partlist->{$part}}) {
if ($vol !~ /total/) {
if ($vol =~ /volume_busy/) {
print "\t**** Volume $partlist->{$part}->{$vol}->{'volid'} is busy **** \n";
}
elsif ($vol =~ /volume_notok/) {
examples/v2/vos/listvol view on Meta::CPAN
}
print "\n";
}
}
print "\ttotalOK: $partlist->{$part}->{' totalOK'}\n";
print "\ttotalBusy: $partlist->{$part}->{' totalBusy'}\n";
print "\ttotalNotOK: $partlist->{$part}->{' totalNotOK'}\n";
}
}
sub print_default {
my $partlist = shift;
my $totvol = 0;
foreach my $part (sort keys %$partlist) {
print "List of volumes on server $server Partition $part: \n";
foreach my $vol (sort keys %{$partlist->{$part}}) {
if ($vol =~ /totalOK/) { next; }
elsif ($vol =~ /totalBusy/) { next; }
elsif ($vol =~ /totalNotOK/) { next; }
elsif ($vol =~ /volume_busy/) {
examples/v2/vos/listvol view on Meta::CPAN
# foreach (keys %{$partlist->{$part}->{$vol}}) {
# print "\t\tKey: $_, Value: $partlist->{$part}->{$vol}->{$_}\n";
# }
}
print "\nTotal volumes onLine $partlist->{$part}->{' totalOK'} ;";
print "\tTotal volumes offLine $partlist->{$part}->{' totalNotOK'} ;";
print "\tTotal busy $partlist->{$part}->{' totalBusy'} \n";
}
}
sub print_debug {
my $partlist = shift;
foreach my $part (sort keys %$partlist) {
print "$part:\n";
foreach my $vol (sort keys %{$partlist->{$part}}) {
if ($vol =~ /total/) {
print "\t$vol: $partlist->{$part}->{$vol}\n";
}
else {
print "\t$vol:\n";
examples/v2/vos/listvolume view on Meta::CPAN
$vos = AFS::VOS->new;
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
my $vollist = $vos->listvolume($volume);
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
$Debugging && print_debug($vollist) && exit;
print_volume($vollist);
sub print_volume {
my $vollist = shift;
print "$vollist->{name} \t$vollist->{parentID} $vollist->{type} \t $vollist->{size} K $vollist->{inUse}\n";
print "\t$vollist->{server} $vollist->{partition}\n";
print "\tRWrite $vollist->{parentID} ROnly $vollist->{cloneID} Backup $vollist->{backupID}\n";
print "\tMaxQuota $vollist->{maxquota} K\n";
print "\tCreation ", ctime($vollist->{creationDate}), "\n";
print "\tCopy ", ctime($vollist->{copyDate}), "\n";
print "\tBackup ", ctime($vollist->{backupDate}), "\n";
print "\tLast Access ", ctime($vollist->{accessDate}), "\n";
print "\tLast Update ", ctime($vollist->{updateDate}), "\n";
print "\t$vollist->{dayUse} accesses in the past day (i.e., vnode references)\n";
}
sub print_debug {
my $vollist = shift;
foreach my $key (sort keys %{$vollist}) {
printf("%20s %s\n", $key, $vollist->{$key});
}
print "\n\n";
}
examples/v2/vos/partinfo view on Meta::CPAN
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
$Debugging && print_debug($partinfo) && exit;
foreach my $part (keys %$partinfo) {
print "Free space on partition $part: ";
print "$partinfo->{$part}->{free} K blocks out of total $partinfo->{$part}->{minFree}\n";
}
sub print_debug {
my $partinfo = shift;
foreach my $key1 (sort keys %{$partinfo}) {
foreach my $key2 (sort keys %{$partinfo->{$key1}}) {
printf("%10s %10s %s\n", $key1, $key2, $partinfo->{$key1}->{$key2});
}
}
print "\n\n";
}
pod/v2/README view on Meta::CPAN
GENERATING HTML DOCUMENTATION
If you have some WWW browser available, it might be worthwhile to
build HTML docs. Unfortunately the perl Makefile.PL
infrastructure won't do this for you automatically. You have to
generate it explicitly. 'cd' into the top directory and 'make'
the HTML documentation. This is the sequence of commands to build
the docs:
cd AFS-2.6.4
perl Makefile.PL ;#(if you have not submitted already)
make html
After this you can start your browser with the file
AFS-2.6.4/lib/AFS.html
and go ahead with reading docs.
pod/v2/afsperlbos.pod view on Meta::CPAN
$ok = $bos->setcellname('newcell.example.com');
=head1 DESCRIPTION
This class is used to communicate with a B<AFS Basic Overseer Server>,
which runs on every AFS server machine. It monitors and administers
the other server processes on that machine. It has also methods to
maintain system configuration files.
Before you can submit any tasks to a Basic OverSeer (BOS) Server you
must establish a connection to a BOS Server. This is done by the
constructor method I<new> which returns a BOS object. A BOS object is
essentially a handle to talk to a Basic OverSeer Server on a given
server machine. Such a BOS object is required before any of the other
BOS instance methods can be called.
=head1 COMPATIBILITY
There was no version 1 implementation and hence there are no version
conflicts :-)
pod/v2/afsperlvos.pod view on Meta::CPAN
=head1 DESCRIPTION
This class is used to communicate with the B<AFS Volume Server>, which
runs on every AFS server machine. The Volume Server allows
administrative tasks and probes to be performed on the set of AFS
volumes residing on the machine on which it is running. This class
provides methods to create, move, delete, replicate, back up and
examine AFS volumes. It has also methods to provide information about
AFS partitions.
Before you can submit any tasks to a Volume Server you must establish
a connection to it. This is done by the constructor method I<new>
which returns a VOS object. A VOS object is essentially a handle to
talk to the Volume Server in a given cell. Such a VOS object is
required before any of the other VOS instance methods can be called.
=head1 COMPATIBILITY
There was no version 1 implementation and hence there are no version
conflicts :-)
src/ACL/ACL.pm view on Meta::CPAN
# under the same terms as Perl itself.
#------------------------------------------------------------------------------
use AFS ();
use vars qw(@ISA $VERSION);
@ISA = qw(AFS);
$VERSION = 'v2.6.4';
sub new {
my ($this, $class);
# this whole construct is to please the old version from Roland
if ($_[0] =~ /AFS::ACL/) {
$this = shift;
$class = ref($this) || $this;
}
else {
$class = 'AFS::ACL';
}
my $pos_rights = shift;
my $neg_rights = shift;
my $self = [{}, {}];
if (defined $pos_rights) { %{$self->[0]} = %$pos_rights; }
if (defined $neg_rights) { %{$self->[1]} = %$neg_rights; }
bless $self, $class;
}
sub copy {
my $self = shift;
my $class = ref($self) || $self;
my $new = [{}, {}];
%{$new->[0]} = %{$self->[0]};
%{$new->[1]} = %{$self->[1]};
bless $new, $class;
}
sub apply {
my $self = shift;
my $path = shift;
my $follow = shift;
$follow = 1 unless defined $follow;
AFS::setacl($path, $self, $follow);
}
sub retrieve {
my $class = shift;
my $path = shift;
my $follow = shift;
$follow = 1 unless defined $follow;
AFS::_getacl($path, $follow);
}
sub modifyacl {
my $self = shift;
my $path = shift;
my $follow = shift;
my $newacl;
$follow = 1 unless defined $follow;
if ($newacl = AFS::_getacl($path, $follow)) {
$newacl->add($self);
AFS::setacl($path, $newacl, $follow);
}
else { return 0; }
}
sub copyacl {
my $class = shift;
my $from = shift;
my $to = shift;
my $follow = shift;
my $acl;
$follow = 1 unless defined $follow;
if ($acl = AFS::_getacl($from, $follow)) { AFS::setacl($to, $acl, $follow); }
else { return 0; }
}
sub cleanacl {
my $class = shift;
my $path = shift;
my $follow = shift;
my $acl;
$follow = 1 unless defined $follow;
if (! defined ($acl = AFS::_getacl($path, $follow))) { return 0; }
if ($acl->is_clean) { return 1; }
AFS::setacl($path, $acl, $follow);
}
sub crights {
my $class = shift;
AFS::crights(@_);
}
sub ascii2rights {
my $class = shift;
AFS::ascii2rights(@_);
}
sub rights2ascii {
my $class = shift;
AFS::rights2ascii(@_);
}
# old form DEPRECATED !!!!
sub addacl {
my $self = shift;
my $macl = shift;
foreach my $key ($macl->keys) { $self->set($key, $macl->get($key)); }
foreach my $key ($macl->nkeys) { $self->nset($key, $macl->nget($key)); }
return $self;
}
sub add {
my $self = shift;
my $acl = shift;
foreach my $user ($acl->get_users) { $self->set($user, $acl->get_rights($user)); }
foreach my $user ($acl->nget_users) { $self->nset($user, $acl->nget_rights($user)); }
return $self;
}
sub is_clean {
my $self = shift;
foreach ($self->get_users, $self->nget_users) { return 0 if (m/^-?\d+$/); }
return 1;
}
# comment Roland Schemers: I hope I don't have to debug these :-)
sub empty { $_[0] = bless [ {},{} ]; }
sub get_users { CORE::keys %{$_[0]->[0]}; }
sub length { int(CORE::keys %{$_[0]->[0]}); }
sub get_rights { ${$_[0]->[0]}{$_[1]}; }
sub exists { CORE::exists ${$_[0]->[0]}{$_[1]}; }
sub set { ${$_[0]->[0]}{$_[1]} = $_[2]; }
sub remove { delete ${$_[0]->[0]}{$_[1]}; }
sub clear { $_[0]->[0] = {}; }
sub keys { CORE::keys %{$_[0]->[0]}; } # old form: DEPRECATED !!!!
sub get { ${$_[0]->[0]}{$_[1]}; } # old form: DEPRECATED !!!!
sub del { delete ${$_[0]->[0]}{$_[1]}; } # old form: DEPRECATED !!!!
# comment Roland Schemers: same for negative entries
sub nget_users { CORE::keys %{$_[0]->[1]}; }
sub nlength { int(CORE::keys %{$_[0]->[1]}); }
sub nget_rights { ${$_[0]->[1]}{$_[1]}; }
sub nexists { CORE::exists ${$_[0]->[1]}{$_[1]}; }
sub nset { ${$_[0]->[1]}{$_[1]} = $_[2]; }
sub nremove { delete ${$_[0]->[1]}{$_[1]}; }
sub nclear { $_[0]->[1] = {}; }
sub nkeys { CORE::keys %{$_[0]->[1]}; } # old form: DEPRECATED !!!!
sub nget { ${$_[0]->[1]}{$_[1]}; } # old form: DEPRECATED !!!!
sub ndel { delete ${$_[0]->[1]}{$_[1]}; } # old form: DEPRECATED !!!!
1;
@EXPORT_OK = qw(
raise_exception
constant
convert_numeric_names
error_message
);
@ALL = (@EXPORT, @EXPORT_OK);
# convenience functions
#sub newacl { use AFS::ACL; AFS::ACL->new(@_); }
sub newacl { require AFS::ACL; AFS::ACL->import; AFS::ACL->new(@_); }
sub newpts { AFS::PTS->_new(@_); }
sub newprincipal { AFS::KTC_PRINCIPAL->_new(@_); }
sub ktc_principal { AFS::KTC_PRINCIPAL->_new(@_); }
sub ka_LocalCell { return &localcell; }
sub ka_ExpandCell { expandcell($_[0]); }
sub ka_CellToRealm { uc(expandcell($_[0])); }
sub afsok { $AFS::CODE == 0; }
sub checkafs { die "$_[0]: $AFS::CODE" if $AFS::CODE; }
sub get_server_version {
my $server = shift;
my $hostname = shift;
my $verbose = shift;
my %port = (
'fs' => 7000,
'cm' => 7001,
'pts' => 7002,
'vls' => 7003,
'kas' => 7004,
if (! defined $port{$server}) { die "Server $server unknown ...\n"; }
$hostname = 'localhost' unless defined $hostname;
$verbose = 0 unless defined $verbose;
AFS::_get_server_version($port{$server}, $hostname, $verbose);
}
# acl helpers...
sub getacl { require AFS::ACL; AFS::ACL->import; AFS::_getacl(@_); }
sub modifyacl {
my($path, $macl) = @_;
my($acl);
if ($acl = getacl($path)) {
$acl->addacl($macl);
return setacl($path, $acl);
}
else { return 0; }
}
sub copyacl {
my($from, $to, $follow) = @_;
my($acl);
$follow = 1 unless defined $follow;
if ($acl = _getacl($from, $follow)) { return setacl($to, $acl, $follow); }
else { return 0; }
}
sub cleanacl {
my($path, $follow) = @_;
my($acl);
$follow = 1 unless defined $follow;
if ($acl = _getacl($path, $follow)) { return setacl($path, $acl, $follow); }
else { return 0; }
}
# package AFS::PTS_SERVER;
# sub new { AFS::PTS->_new(@_); }
use AFS::KTC_PRINCIPAL;
# package AFS::KTC_PRINCIPAL;
# sub new { AFS::KTC_PRINCIPAL->_new(@_); }
use AFS::KAS;
# *** CAUTION ***
# these functions are now stored in AFS::KAS.pm !!!
#package AFS::KA_AUTHSERVER;
# package AFS::KAS;
# sub getentry { $_[0]->KAM_GetEntry($_[1],$_[2]); }
# sub debug { $_[0]->KAM_Debug(&AFS::KAMAJORVERSION); }
# sub getstats { $_[0]->KAM_GetStats(&AFS::KAMAJORVERSION); }
# sub randomkey { $_[0]->KAM_GetRandomKey; }
# sub create { $_[0]->KAM_CreateUser($_[1],$_[2],$_[3]); }
# sub setpassword { $_[0]->KAM_SetPassword($_[1],$_[2],$_[3],$_[4]); }
# sub delete { $_[0]->KAM_DeleteUser($_[1],$_[2]); }
# sub listentry { $_[0]->KAM_ListEntry($_[1],$_[2],$_[3]); }
# sub setfields { $_[0]->KAM_SetFields($_[1],$_[2],$_[3],$_[4],$_[5],$_[6],$_[7],$_[8]); }
package AFS;
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function. If a constant is not found then control is passed
# to the AUTOLOAD in AutoLoader.
# taken from perl v5.005_02 for backward compatibility
my $constname;
($constname = $AUTOLOAD) =~ s/.*:://;
croak "& not defined" if $constname eq 'constant';
my $val = constant($constname, @_ ? $_[0] : 0);
goto &AutoLoader::AUTOLOAD;
}
else {
croak "Your vendor has not defined AFS macro $constname";
}
}
{
no strict 'refs';
# Fixed between 5.005_53 and 5.005_61
if ($] >= 5.00561) {
*$AUTOLOAD = sub () { $val };
}
else {
*$AUTOLOAD = sub { $val };
}
}
goto &$AUTOLOAD;
}
END {
AFS::_finalize();
}
bootstrap AFS;
src/BOS/BOS.pm view on Meta::CPAN
#------------------------------------------------------------------------------
use Carp;
use AFS ();
use vars qw(@ISA $VERSION);
@ISA = qw(AFS);
$VERSION = 'v2.6.4';
sub DESTROY {
my (undef, undef, undef, $subroutine) = caller(1);
if (! defined $subroutine or $subroutine !~ /eval/) { undef $_[0]; } # self->DESTROY
else { AFS::BOS::_DESTROY($_[0]); } # undef self
}
sub create {
my $self = shift;
my $process = shift;
my $type = shift;
my $command = shift;
my $notifier = shift;
if (! defined $process ||
! defined $type ||
! defined $command) {
carp "AFS::BOS->create: incomplete arguements specified ...\n";
src/BOS/BOS.pm view on Meta::CPAN
$commands[0] = $command;
if ($notifier) { $self->_create($process, $type, \@commands, $notifier); }
else { $self->_create($process, $type, \@commands); }
}
else {
carp "AFS::BOS->create: not a valid COMMAND input ...\n";
return 0;
}
}
sub restart {
my $self = shift;
if ($#_ == 0 and ref($_[0]) eq 'ARRAY') { # SERVER is array ref
$self->_restart(0, 0, @_);
}
elsif ($#_ == 0 and ref($_[0]) eq '') { # SERVER is scalar
my @server;
$server[0] = shift;
$self->_restart(0, 0, \@server);
}
else {
carp "AFS::BOS->restart: not a valid input ...\n";
return undef;
}
}
sub restart_all {
my $self = shift;
$self->_restart(0, 1);
}
sub restart_bos {
my $self = shift;
$self->_restart(1);
}
sub start {
my $self = shift;
if ($#_ == 0 and ref($_[0]) eq 'ARRAY') { # SERVER is array ref
$self->_start(@_);
}
elsif ($#_ == 0 and ref($_[0]) eq '') { # SERVER is scalar
my @server;
$server[0] = shift;
$self->_start(\@server);
}
else {
carp "AFS::BOS->start: not a valid input ...\n";
return undef;
}
}
sub startup {
my $self = shift;
if ($#_ == -1) { # no input given
$self->_startup();
}
elsif ($#_ == 0 and ref($_[0]) eq 'ARRAY') { # SERVER is array ref
$self->_startup(@_);
}
elsif ($#_ == 0 and ref($_[0]) eq '') { # SERVER is scalar
my @server;
$server[0] = shift;
$self->_startup(\@server);
}
else {
carp "AFS::BOS->startup: not a valid input ...\n";
return undef;
}
}
sub status {
my $self = shift;
if ($#_ > 0 and ! defined $_[1]) { $_[1] = ''; } # INSTANCE is not defined
if (ref($_[1]) eq 'ARRAY' or $#_ <= 0) { # INSTANCE is array ref
$self->_status(@_);
}
elsif ($_[1] eq '') { # INSTANCE is not defined
$self->_status($_[0]);
}
src/BOS/BOS.pm view on Meta::CPAN
$server[0] = $args[1];
$args[1] = \@server;
$self->_status(@args);
}
else {
carp "AFS::BOS->status: not a valid input ...\n";
return undef;
}
}
sub stop {
my $self = shift;
if ($#_ == -1 or ($#_ > -1 and ! defined $_[0])) {
carp "AFS::BOS->stop: not a valid input ...\n";
return undef;
}
if (ref($_[0]) eq 'ARRAY') { # SERVER is array ref
$self->_stop(@_);
}
src/BOS/BOS.pm view on Meta::CPAN
my @server;
$server[0] = shift;
$self->_stop(\@server, @_);
}
else {
carp "AFS::BOS->stop: not a valid input ...\n";
return undef;
}
}
sub shutdown {
my $self = shift;
if ($#_ == 1 and ref($_[0]) eq 'ARRAY') { # SERVER is array ref
$self->_shutdown(@_);
}
elsif ($#_ == 1 and ref($_[0]) eq '') { # SERVER is scalar
my @server;
$server[0] = shift;
$self->_shutdown(\@server, @_);
}
src/BOS/t/BOS.t view on Meta::CPAN
can_ok('AFS::BOS', qw(setauth));
can_ok('AFS::BOS', qw(setrestricted));
can_ok('AFS::BOS', qw(shutdown));
can_ok('AFS::BOS', qw(start));
can_ok('AFS::BOS', qw(startup));
can_ok('AFS::BOS', qw(stop));
$bos->DESTROY;
ok(! defined $bos, 'bos->DESTROY');
sub leak_test {
my $count = 0;
my $verb = 1;
while(1) {
$count++;
my $bos = AFS::BOS->new($verb);
$bos->DESTROY();
if ($count == 1210) { last; }
}
return $count;
}
src/KAS/KAS.pm view on Meta::CPAN
use AFS ();
use vars qw(@ISA $VERSION);
@ISA = qw(AFS);
$VERSION = 'v2.6.4';
# not suported anymore
# please use the functions from AFS::Cell !!!
#
# sub LocalCell {
# my $class = shift;
# AFS::localcell;
# }
# sub ExpandCell {
# my $class = shift;
# AFS::expandcell(@_);
# }
# sub CellToRealm {
# my $class = shift;
# uc(AFS::expandcell(@_));
# }
sub DESTROY {
my (undef, undef, undef, $subroutine) = caller(1);
if (! defined $subroutine or $subroutine !~ /eval/) { undef $_[0]; } # self->DESTROY
else { AFS::KAS::_DESTROY($_[0]); } # undef self
}
sub AuthServerConn {
my $class = shift;
AFS::ka_AuthServerConn(@_);
}
sub SingleServerConn {
my $class = shift;
AFS::ka_SingleServerConn(@_)
}
sub ChangePassword {
my $self = shift;
$self->ka_ChangePassword(@_)
}
sub Authenticate {
my $self = shift;
$self->ka_Authenticate(@_);
}
sub GetToken {
my $self = shift;
$self->ka_GetToken(@_)
}
# *** CAUTION ***
# these functions are redundant, they are also stored in AFS.pm !!!
sub getentry { $_[0]->KAM_GetEntry($_[1],$_[2]); }
sub debug { $_[0]->KAM_Debug(&AFS::KAMAJORVERSION); }
sub getstats { $_[0]->KAM_GetStats(&AFS::KAMAJORVERSION); }
sub randomkey { $_[0]->KAM_GetRandomKey; }
sub create { $_[0]->KAM_CreateUser($_[1],$_[2],$_[3]); }
sub setpassword { $_[0]->KAM_SetPassword($_[1],$_[2],$_[3],$_[4]); }
sub delete { $_[0]->KAM_DeleteUser($_[1],$_[2]); }
sub listentry { $_[0]->KAM_ListEntry($_[1],$_[2],$_[3]); }
sub setfields { $_[0]->KAM_SetFields($_[1],$_[2],$_[3],$_[4],$_[5],$_[6],$_[7]); }
1;
src/KTC_EKEY/KTC_EKEY.pm view on Meta::CPAN
# under the same terms as Perl itself.
#------------------------------------------------------------------------------
use AFS ();
use vars qw(@ISA $VERSION);
@ISA = qw(AFS);
$VERSION = 'v2.6.4';
sub UserReadPassword {
my $class = shift;
AFS::ka_UserReadPassword(@_);
}
sub ReadPassword {
my $class = shift;
AFS::ka_ReadPassword(@_);
}
sub StringToKey {
my $class = shift;
AFS::ka_StringToKey(@_);
}
sub des_string_to_key {
my $class = shift;
AFS::ka_des_string_to_key(@_);
}
# struct ktc_encryptionKey {
# char data[8];
# };
src/KTC_PRINCIPAL/KTC_PRINCIPAL.pm view on Meta::CPAN
# under the same terms as Perl itself.
#------------------------------------------------------------------------------
use AFS ();
use vars qw(@ISA $VERSION);
@ISA = qw(AFS);
$VERSION = 'v2.6.4';
sub ListTokens {
my $class = shift;
AFS::ktc_ListTokens(@_);
}
sub ParseLoginName {
my $class = shift;
AFS::ka_ParseLoginName(@_);
}
sub new {
# this whole construct is to please the old version from Roland
if ($_[0] =~ /AFS::KTC_PRINCIPAL/) { my $class = shift; }
my $name = shift;
my $inst = shift;
my $cell = shift;
my @args = ();
push @args, $name if defined $name;
push @args, $inst if defined $inst;
push @args, $cell if defined $cell;
src/KTC_TOKEN/KTC_TOKEN.pm view on Meta::CPAN
# under the same terms as Perl itself.
#------------------------------------------------------------------------------
use AFS ();
use vars qw(@ISA $VERSION);
@ISA = qw(AFS);
$VERSION = 'v2.6.4';
sub nulltoken {
my $class = shift;
AFS::ka_nulltoken;
}
sub GetAdminToken {
my $class = shift;
AFS::ka_GetAdminToken(@_);
}
sub GetAuthToken {
my $class = shift;
AFS::ka_GetAuthToken(@_);
}
sub GetServerToken {
my $class = shift;
AFS::ka_GetServerToken(@_);
}
sub GetToken {
my $class = shift;
AFS::ktc_GetToken(@_);
}
sub FromString {
my $class = shift;
AFS::ktc_FromString(@_);
}
sub SetToken {
my $class = shift;
AFS::ktc_SetToken(@_);
}
sub UserAuthenticateGeneral {
my $class = shift;
AFS::ka_UserAthenticateGeneral(@_);
}
sub ForgetAllTokens {
my $class = shift;
AFS::ktc_ForgetAllTokens;
}
# struct ktc_token {
# afs_int32 startTime;
# afs_int32 endTime;
# struct ktc_encryptionKey sessionKey;
src/PTS/PTS.pm view on Meta::CPAN
# under the same terms as Perl itself.
#------------------------------------------------------------------------------
use AFS ();
use vars qw(@ISA $VERSION);
@ISA = qw(AFS);
$VERSION = 'v2.6.4';
sub new {
# this whole construct is to please the old version from Roland
if ($_[0] =~ /AFS::PTS/) { my $class = shift; }
my $sec = shift;
my $cell = shift;
my @args = ();
push @args, $sec if defined $sec;
push @args, $cell if defined $cell;
AFS::PTS::_new('AFS::PTS', @args);
}
sub DESTROY {
my (undef, undef, undef, $subroutine) = caller(1);
if (! defined $subroutine or $subroutine !~ /eval/) { undef $_[0]; } # self->DESTROY
else { AFS::PTS::_DESTROY($_[0]); } # undef self
}
sub ascii2ptsaccess {
my $class = shift;
AFS::ascii2ptsaccess(@_);
}
sub ptsaccess2ascii {
my $class = shift;
AFS::ptsaccess2ascii(@_);
}
sub convert_numeric_names {
my $class = shift;
AFS::convert_numeric_names(@_);
}
1;
( run in 1.085 second using v1.01-cache-2.11-cpan-88abd93f124 )