From: Derrick Brashear Date: Tue, 15 Jan 2002 19:22:05 +0000 (+0000) Subject: test-suite-updates-20020115 X-Git-Tag: openafs-devel-1_3_0~78 X-Git-Url: https://git.michaelhowe.org/gitweb/?a=commitdiff_plain;h=966becc84430e952b6e226b068acf455697f9a07;p=packages%2Fo%2Fopenafs.git test-suite-updates-20020115 cleanup all target, get missing headers ==================== This delta was composed from multiple commits as part of the CVS->Git migration. The checkin message with each commit was inconsistent. The following are the additional commit messages. ==================== put perl modules in properly named subdir --- diff --git a/Makefile.in b/Makefile.in index 5ac9f2877..b64fb0195 100644 --- a/Makefile.in +++ b/Makefile.in @@ -663,7 +663,7 @@ distclean: clean src/sys/Makefile \ src/tbutc/Makefile \ src/tests/Makefile \ - src/tests/Dirpath.pm \ + src/tests/OpenAFS/Dirpath.pm \ src/tsm41/Makefile \ src/tviced/Makefile \ src/ubik/Makefile \ diff --git a/configure.in b/configure.in index f5672fd73..55e1b53f9 100644 --- a/configure.in +++ b/configure.in @@ -106,7 +106,7 @@ src/sia/Makefile \ src/sys/Makefile \ src/tbutc/Makefile \ src/tests/Makefile \ -src/tests/Dirpath.pm \ +src/tests/OpenAFS/Dirpath.pm \ src/tsm41/Makefile \ src/tviced/Makefile \ src/ubik/Makefile \ diff --git a/src/tests/Auth-Heimdal.pm b/src/tests/Auth-Heimdal.pm deleted file mode 100644 index f578c82df..000000000 --- a/src/tests/Auth-Heimdal.pm +++ /dev/null @@ -1,44 +0,0 @@ -# This is -*- perl -*- - -package OpenAFS::Auth; -use OpenAFS::Dirpath; - -use strict; -#use vars qw( @ISA @EXPORT ); -#@ISA = qw(Exporter); -#require Exporter; -#@EXPORT = qw($openafs-authadmin $openafs-authuser); - -sub getcell { - my($cell); - open(CELL, "$openafsdirpath->{'afsconfdir'}/ThisCell") - or die "Cannot open $openafsdirpath->{'afsconfdir'}/ThisCell: $!\n"; - $cell = ; - chomp $cell; - close CELL; - return $cell; -} - -sub getrealm { - my($cell); - open(CELL, "$openafsdirpath->{'afsconfdir'}/ThisCell") - or die "Cannot open $openafsdirpath->{'afsconfdir'}/ThisCell: $!\n"; - $cell = ; - chomp $cell; - close CELL; - $cell =~ tr/a-z/A-Z/; - return $cell; -} - -sub authadmin { - my $cell = &getrealm; - my $cmd = "kinit -k -t /usr/afs/etc/krb5.keytab admin\@${cell} ; afslog"; - system($cmd); -} -sub authuser { - my $cell = &getrealm; - my $cmd = "kinit -k -t /usr/afs/etc/krb5.keytab user\@${cell} ; afslog"; - system($cmd); -} - -1; diff --git a/src/tests/CMU_copyright.pm b/src/tests/CMU_copyright.pm deleted file mode 100644 index 8b3b5a058..000000000 --- a/src/tests/CMU_copyright.pm +++ /dev/null @@ -1,33 +0,0 @@ -## CMUCS AFStools -## Copyright (c) 1996, 2001 Carnegie Mellon University -## All Rights Reserved. -# -# Permission to use, copy, modify and distribute this software and its -# documentation is hereby granted, provided that both the copyright -# notice and this permission notice appear in all copies of the -# software, derivative works or modified versions, and any portions -# thereof, and that both notices appear in supporting documentation. -# -# CARNEGIE MELLON ALLOWS FREE USE OF THIS SOFTWARE IN ITS "AS IS" -# CONDITION. CARNEGIE MELLON DISCLAIMS ANY LIABILITY OF ANY KIND FOR -# ANY DAMAGES WHATSOEVER RESULTING FROM THE USE OF THIS SOFTWARE. -# -# Carnegie Mellon requests users of this software to return to -# -# Software Distribution Coordinator or Software_Distribution@CS.CMU.EDU -# School of Computer Science -# Carnegie Mellon University -# Pittsburgh PA 15213-3890 -# -# any improvements or extensions that they make and grant Carnegie Mellon -# the rights to redistribute these changes. -# -# CMU_copyright.pm - CMU copyright -# This isn't a real package; it merely provides a central location to keep -# information regarding redistribution of this set of modules, and to make -# sure that no one can use the modules (at least, as shipped) without also -# having a copy of these terms. - -package AFS::CMU_copyright; - -1; diff --git a/src/tests/ConfigUtils.pm b/src/tests/ConfigUtils.pm deleted file mode 100644 index ca56d60a7..000000000 --- a/src/tests/ConfigUtils.pm +++ /dev/null @@ -1,26 +0,0 @@ -# This is -*- perl -*- - -package OpenAFS::ConfigUtils; - -use strict; -use vars qw( @ISA @EXPORT @unwinds); -@ISA = qw(Exporter); -require Exporter; -@EXPORT = qw(@unwinds run unwind); - -sub run ($) { - print join(' ', @_); - print "\n"; - system (@_) == 0 - or die "Failed: $?\n"; -} - -# This subroutine takes a command to run in case of failure. After -# each succesful step, this routine should be run with a command to -# undo the successful step. - - sub unwind($) { - push @unwinds, $_[0]; - } - -1; diff --git a/src/tests/Dirpath.pm.in b/src/tests/Dirpath.pm.in deleted file mode 100644 index 32c001cdd..000000000 --- a/src/tests/Dirpath.pm.in +++ /dev/null @@ -1,25 +0,0 @@ -# This is -*- perl -*- - -package OpenAFS::Dirpath; - -use strict; -use vars qw( @ISA @EXPORT $openafsdirpath); -@ISA = qw(Exporter); -require Exporter; -@EXPORT = qw($openafsdirpath); - -# Dirpath configuration -$openafsdirpath = { - 'afsconfdir' => '@afsconfdir@', - 'viceetcdir' => '@viceetcdir@', - 'afssrvbindir' => '@afssrvbindir@', - 'afssrvsbindir' => '@afssrvsbindir@', - 'afssrvlibexecdir' => '@afssrvlibexecdir@', - 'afsdbdir' => '@afsdbdir@', - 'afslogsdir' => '@afslogsdir@', - 'afslocaldir' => '@afslocaldir@', - 'afsbackupdir' => '@afsbackupdir@', - 'afsbosconfigdir' => '@afsbosconfigdir@' -}; - -1; diff --git a/src/tests/Makefile.in b/src/tests/Makefile.in index 064b63a89..4baaa2713 100644 --- a/src/tests/Makefile.in +++ b/src/tests/Makefile.in @@ -164,8 +164,8 @@ TEST_SRCS = write-ro-file.c read-vs-mmap.c read-vs-mmap2.c \ EXTRA_OBJS = err.o errx.o warn.o warnx.o -OS.pm: OS-$(MKAFS_OSTYPE).pm - $(CP) OS-$(MKAFS_OSTYPE).pm OS.pm +OpenAFS/OS.pm: OpenAFS/OS-$(MKAFS_OSTYPE).pm + $(CP) OpenAFS/OS-$(MKAFS_OSTYPE).pm OpenAFS/OS.pm write-rand: write-rand.o $(EXTRA_OBJS) $(CC) $(LDFLAGS) -o $@ write-rand.o $(EXTRA_OBJS) $(LIBS) @@ -359,8 +359,7 @@ install: uninstall: -all: run-tests $(TEST_PROGRAMS) OS.pm ${TOP_LIBDIR}/libxfiles.a \ - ${TOP_LIBDIR}/libdumpscan.a \ +all: run-tests OpenAFS/OS.pm libxfiles.a libdumpscan.a $(TEST_PROGRAMS)\ afsdump_scan afsdump_dirlist afsdump_extract dumptool clean: diff --git a/src/tests/OS-LINUX.pm b/src/tests/OS-LINUX.pm deleted file mode 100644 index 70c7d3825..000000000 --- a/src/tests/OS-LINUX.pm +++ /dev/null @@ -1,23 +0,0 @@ -# This is -*- perl -*- - -package OpenAFS::OS; - -use strict; -use vars qw( @ISA @EXPORT $openafsinitcmd); -@ISA = qw(Exporter); -require Exporter; -@EXPORT = qw($openafsinitcmd); - -# OS-specific configuration -$openafsinitcmd = { - 'client-start' => '/etc/init.d/openafs-client start', - 'client-stop' => '/etc/init.d/openafs-client stop', - 'client-forcestart' => '/etc/init.d/openafs-client force-start', - 'client-restart' => '/etc/init.d/openafs-client restart', - 'filesrv-start' => '/etc/init.d/openafs-fileserver start', - 'filesrv-stop' => '/etc/init.d/openafs-fileserver stop', - 'filesrv-forcestart'=> '/etc/init.d/openafs-fileserver force-start', - 'filesrv-restart' => '/etc/init.d/openafs-fileserver restart', -}; - -1; diff --git a/src/tests/OS-SOLARIS.pm b/src/tests/OS-SOLARIS.pm deleted file mode 100644 index 3ba26456a..000000000 --- a/src/tests/OS-SOLARIS.pm +++ /dev/null @@ -1,23 +0,0 @@ -# This is -*- perl -*- - -package OpenAFS::OS; - -use strict; -use vars qw( @ISA @EXPORT $openafsinitcmd); -@ISA = qw(Exporter); -require Exporter; -@EXPORT = qw($openafsinitcmd); - -# OS-specific configuration -$openafsinitcmd = { - 'client-start' => 'modload /usr/vice/etc/modload/libafs.nonfs.o; /usr/vice/etc/afsd -nosettime', - 'client-stop' => 'echo Solaris client cannot be stopped', - 'client-forcestart' => 'modload /usr/vice/etc/modload/libafs.nonfs.o; /usr/vice/etc/afsd -nosettime', - 'client-restart' => 'echo Solaris client cannot be restarted', - 'filesrv-start' => '/usr/afs/bin/bosserver', - 'filesrv-stop' => '/usr/afs/bin/bos shutdown localhost -local -wait; pkill /usr/afs/bin/bosserver', - 'filesrv-forcestart'=> '/usr/afs/bin/bosserver', - 'filesrv-restart' => '/usr/afs/bin/bos shutdown localhost -local -wait; pkill /usr/afs/bin/bosserver; sleep 1; /usr/afs/bin/bosserver', -}; - -1; diff --git a/src/tests/OpenAFS/Auth-Heimdal.pm b/src/tests/OpenAFS/Auth-Heimdal.pm new file mode 100644 index 000000000..f578c82df --- /dev/null +++ b/src/tests/OpenAFS/Auth-Heimdal.pm @@ -0,0 +1,44 @@ +# This is -*- perl -*- + +package OpenAFS::Auth; +use OpenAFS::Dirpath; + +use strict; +#use vars qw( @ISA @EXPORT ); +#@ISA = qw(Exporter); +#require Exporter; +#@EXPORT = qw($openafs-authadmin $openafs-authuser); + +sub getcell { + my($cell); + open(CELL, "$openafsdirpath->{'afsconfdir'}/ThisCell") + or die "Cannot open $openafsdirpath->{'afsconfdir'}/ThisCell: $!\n"; + $cell = ; + chomp $cell; + close CELL; + return $cell; +} + +sub getrealm { + my($cell); + open(CELL, "$openafsdirpath->{'afsconfdir'}/ThisCell") + or die "Cannot open $openafsdirpath->{'afsconfdir'}/ThisCell: $!\n"; + $cell = ; + chomp $cell; + close CELL; + $cell =~ tr/a-z/A-Z/; + return $cell; +} + +sub authadmin { + my $cell = &getrealm; + my $cmd = "kinit -k -t /usr/afs/etc/krb5.keytab admin\@${cell} ; afslog"; + system($cmd); +} +sub authuser { + my $cell = &getrealm; + my $cmd = "kinit -k -t /usr/afs/etc/krb5.keytab user\@${cell} ; afslog"; + system($cmd); +} + +1; diff --git a/src/tests/OpenAFS/CMU_copyright.pm b/src/tests/OpenAFS/CMU_copyright.pm new file mode 100644 index 000000000..8b3b5a058 --- /dev/null +++ b/src/tests/OpenAFS/CMU_copyright.pm @@ -0,0 +1,33 @@ +## CMUCS AFStools +## Copyright (c) 1996, 2001 Carnegie Mellon University +## All Rights Reserved. +# +# Permission to use, copy, modify and distribute this software and its +# documentation is hereby granted, provided that both the copyright +# notice and this permission notice appear in all copies of the +# software, derivative works or modified versions, and any portions +# thereof, and that both notices appear in supporting documentation. +# +# CARNEGIE MELLON ALLOWS FREE USE OF THIS SOFTWARE IN ITS "AS IS" +# CONDITION. CARNEGIE MELLON DISCLAIMS ANY LIABILITY OF ANY KIND FOR +# ANY DAMAGES WHATSOEVER RESULTING FROM THE USE OF THIS SOFTWARE. +# +# Carnegie Mellon requests users of this software to return to +# +# Software Distribution Coordinator or Software_Distribution@CS.CMU.EDU +# School of Computer Science +# Carnegie Mellon University +# Pittsburgh PA 15213-3890 +# +# any improvements or extensions that they make and grant Carnegie Mellon +# the rights to redistribute these changes. +# +# CMU_copyright.pm - CMU copyright +# This isn't a real package; it merely provides a central location to keep +# information regarding redistribution of this set of modules, and to make +# sure that no one can use the modules (at least, as shipped) without also +# having a copy of these terms. + +package AFS::CMU_copyright; + +1; diff --git a/src/tests/OpenAFS/ConfigUtils.pm b/src/tests/OpenAFS/ConfigUtils.pm new file mode 100644 index 000000000..ca56d60a7 --- /dev/null +++ b/src/tests/OpenAFS/ConfigUtils.pm @@ -0,0 +1,26 @@ +# This is -*- perl -*- + +package OpenAFS::ConfigUtils; + +use strict; +use vars qw( @ISA @EXPORT @unwinds); +@ISA = qw(Exporter); +require Exporter; +@EXPORT = qw(@unwinds run unwind); + +sub run ($) { + print join(' ', @_); + print "\n"; + system (@_) == 0 + or die "Failed: $?\n"; +} + +# This subroutine takes a command to run in case of failure. After +# each succesful step, this routine should be run with a command to +# undo the successful step. + + sub unwind($) { + push @unwinds, $_[0]; + } + +1; diff --git a/src/tests/OpenAFS/Dirpath.pm.in b/src/tests/OpenAFS/Dirpath.pm.in new file mode 100644 index 000000000..32c001cdd --- /dev/null +++ b/src/tests/OpenAFS/Dirpath.pm.in @@ -0,0 +1,25 @@ +# This is -*- perl -*- + +package OpenAFS::Dirpath; + +use strict; +use vars qw( @ISA @EXPORT $openafsdirpath); +@ISA = qw(Exporter); +require Exporter; +@EXPORT = qw($openafsdirpath); + +# Dirpath configuration +$openafsdirpath = { + 'afsconfdir' => '@afsconfdir@', + 'viceetcdir' => '@viceetcdir@', + 'afssrvbindir' => '@afssrvbindir@', + 'afssrvsbindir' => '@afssrvsbindir@', + 'afssrvlibexecdir' => '@afssrvlibexecdir@', + 'afsdbdir' => '@afsdbdir@', + 'afslogsdir' => '@afslogsdir@', + 'afslocaldir' => '@afslocaldir@', + 'afsbackupdir' => '@afsbackupdir@', + 'afsbosconfigdir' => '@afsbosconfigdir@' +}; + +1; diff --git a/src/tests/OpenAFS/OS-LINUX.pm b/src/tests/OpenAFS/OS-LINUX.pm new file mode 100644 index 000000000..70c7d3825 --- /dev/null +++ b/src/tests/OpenAFS/OS-LINUX.pm @@ -0,0 +1,23 @@ +# This is -*- perl -*- + +package OpenAFS::OS; + +use strict; +use vars qw( @ISA @EXPORT $openafsinitcmd); +@ISA = qw(Exporter); +require Exporter; +@EXPORT = qw($openafsinitcmd); + +# OS-specific configuration +$openafsinitcmd = { + 'client-start' => '/etc/init.d/openafs-client start', + 'client-stop' => '/etc/init.d/openafs-client stop', + 'client-forcestart' => '/etc/init.d/openafs-client force-start', + 'client-restart' => '/etc/init.d/openafs-client restart', + 'filesrv-start' => '/etc/init.d/openafs-fileserver start', + 'filesrv-stop' => '/etc/init.d/openafs-fileserver stop', + 'filesrv-forcestart'=> '/etc/init.d/openafs-fileserver force-start', + 'filesrv-restart' => '/etc/init.d/openafs-fileserver restart', +}; + +1; diff --git a/src/tests/OpenAFS/OS-SOLARIS.pm b/src/tests/OpenAFS/OS-SOLARIS.pm new file mode 100644 index 000000000..3ba26456a --- /dev/null +++ b/src/tests/OpenAFS/OS-SOLARIS.pm @@ -0,0 +1,23 @@ +# This is -*- perl -*- + +package OpenAFS::OS; + +use strict; +use vars qw( @ISA @EXPORT $openafsinitcmd); +@ISA = qw(Exporter); +require Exporter; +@EXPORT = qw($openafsinitcmd); + +# OS-specific configuration +$openafsinitcmd = { + 'client-start' => 'modload /usr/vice/etc/modload/libafs.nonfs.o; /usr/vice/etc/afsd -nosettime', + 'client-stop' => 'echo Solaris client cannot be stopped', + 'client-forcestart' => 'modload /usr/vice/etc/modload/libafs.nonfs.o; /usr/vice/etc/afsd -nosettime', + 'client-restart' => 'echo Solaris client cannot be restarted', + 'filesrv-start' => '/usr/afs/bin/bosserver', + 'filesrv-stop' => '/usr/afs/bin/bos shutdown localhost -local -wait; pkill /usr/afs/bin/bosserver', + 'filesrv-forcestart'=> '/usr/afs/bin/bosserver', + 'filesrv-restart' => '/usr/afs/bin/bos shutdown localhost -local -wait; pkill /usr/afs/bin/bosserver; sleep 1; /usr/afs/bin/bosserver', +}; + +1; diff --git a/src/tests/OpenAFS/afsconf.pm b/src/tests/OpenAFS/afsconf.pm new file mode 100644 index 000000000..86db4605d --- /dev/null +++ b/src/tests/OpenAFS/afsconf.pm @@ -0,0 +1,234 @@ +# CMUCS AFStools +# Copyright (c) 1996, Carnegie Mellon University +# All rights reserved. +# +# See CMUCS/CMU_copyright.pm for use and distribution information + +package OpenAFS::afsconf; + +=head1 NAME + +OpenAFS::afsconf - Access to AFS config info + +=head1 SYNOPSIS + + use OpenAFS::afsconf; + + $cell = AFS_conf_localcell(); + $cell = AFS_conf_canoncell($cellname); + @servers = AFS_conf_cellservers($cellname); + @cells = AFS_conf_listcells(); + %info = AFS_conf_cacheinfo(); + +=head1 DESCRIPTION + +This module provides access to information about the local workstation's +AFS configuration. This includes information like the name of the +local cell, where AFS is mounted, and access to information in the +F. All information returned by this module is based on the +configuration files, and does not necessarily reflect changes made +on the afsd command line or using B commands. + +=cut + +use OpenAFS::CMU_copyright; +use OpenAFS::config; +use OpenAFS::util qw(:DEFAULT :afs_internal); +use Exporter; + +$VERSION = ''; +$VERSION = '1.00'; +@ISA = qw(Exporter); +@EXPORT = qw(&AFS_conf_localcell + &AFS_conf_canoncell + &AFS_conf_listcells + &AFS_conf_cellservers + &AFS_conf_cacheinfo); + + +# _confpath($file) - Return path to a configuration file +sub _confpath { + my($file) = @_; + + if ($conf_paths{$file}) { + $conf_paths{$file}; + } elsif ($AFS_Parms{confdir} && -r "$AFS_Parms{confdir}/$file") { + $conf_paths{$file} = "$AFS_Parms{confdir}/$file"; + } elsif (-r "$def_ConfDir/$file") { + $conf_paths{$file} = "$def_ConfDir/$file"; + } else { + die "Unable to locate $file\n"; + } +} + +=head2 AFS_conf_localcell() + +Return the canonical name of the local cell. This depends on the contents +of the F file in the AFS configuration directory. + +=cut + +$AFS_Help{conf_localcell} = '=> $lclcell'; +sub AFS_conf_localcell { + my($path) = _confpath(ThisCell); + my($result); + + return '' if (!$path); + if (open(THISCELL, $path)) { + chomp($result = ); + close(THISCELL); + $result; + } else { + die "Unable to open $path: $!\n"; + } +} + +=head2 AFS_conf_canoncell($cellname) + +Return the canonical name of the specified cell, as found in F. +I<$cellname> may be any unique prefix of a cell name, as with various AFS +commands that take cell names as arguments. + +=head2 AFS_conf_cellservers($cellname) + +Return a list of servers in the specified cell. As with B, +I<$cellname> may be any unique prefix of a cell name. The resulting list +contains server hostnames, as found in F. + +=cut + +$AFS_Help{conf_canoncell} = '$cellname => $canon'; +$AFS_Help{conf_cellservers} = '$cellname => @servers'; + +sub AFS_conf_canoncell { &_findcell($_[0], 0); } +sub AFS_conf_cellservers { &_findcell($_[0], 1); } + +sub _findcell { + my($cellname, $doservers) = @_; + my($path, $found, @servers, $looking); + + return $canon_name{$cellname} if (!$doservers && $canon_name{$cellname}); + $path = _confpath(CellServDB) || die "Unable to locate CellServDB\n"; + + if (open(CELLSERVDB, $path)) { + my($cellpat) = $cellname; + $cellpat =~ s/(\W)/\\$1/g; + while () { + $looking = 0 if (/^\>/); + if (/^\>$cellpat/) { + if ($found) { + close(CELLSERVDB); + die "Cell name $cellname is not unique\n"; + } else { + chop($found = $_); + $found =~ s/^\>(\S+).*/$1/; + $looking = 1 if ($doservers); + } + } elsif ($looking && (/^[\.\d]+\s*\#\s*(.*\S+)/ || /^([\.\d]+)/)) { + push(@servers, $1); + } + } + close(CELLSERVDB); + if ($found) { + $canon_name{$cellname} = $found; + $doservers ? @servers : ($found); + } else { + die "Cell $cellname not in CellServDB\n"; + } + } else { + die "Unable to open $path: $!\n"; + } +} + +=head2 AFS_conf_listcells() + +Return a list of canonical names (as found in F) of all +known AFS cells. + +=cut + +$AFS_Help{conf_listcells} = '=> @cells'; +sub AFS_conf_listcells { + my($path, @cells); + + $path = _confpath(CellServDB) || die "Unable to locate CellServDB!\n"; + + if (open(CELLSERVDB, $path)) { + while () { + if (/^\>(\S+)/) { + push(@cells, $1); + } + } + close(CELLSERVDB); + @cells; + } else { + die "Unable to open $path: $!\n"; + } +} + +=head2 AFS_conf_cacheinfo() + +Return a table of information about the local workstation's cache +configuration. This table may contain any or all of the following elements: + +=over 14 + +=item afsroot + +Mount point for the AFS root volume + +=item cachedir + +Location of the AFS cache directory + +=item cachesize + +AFS cache size + +=item hardcachesize + +Hard limit on AFS cache size (if specified; probably Mach-specific) + +=item translator + +Name of AFS/NFS translator server (if set) + +=back + +=cut + +$AFS_Help{conf_cacheinfo} = '=> %info'; +sub AFS_conf_cacheinfo { + my($path) = _confpath('cacheinfo'); + my(%result, $line, $hcs); + + if ($path) { + if (open(CACHEINFO, $path)) { + chop($line = ); + close(CACHEINFO); + (@result{'afsroot', 'cachedir', 'cachesize'} , $hcs) = split(/:/, $line); + $result{'hardcachesize'} = $hcs if ($hcs); + } else { + die "Unable to open $path: $!\n"; + } + } + if ($ENV{'AFSSERVER'}) { + $result{'translator'} = $ENV{'AFSSERVER'}; + } elsif (open(SRVFILE, "$ENV{HOME}/.AFSSERVER") + || open(SRVFILE, "/.AFSSERVER")) { + $result{'translator'} = ; + close(SRVFILE); + } + %result; +} + + +1; + +=head1 COPYRIGHT + +The CMUCS AFStools, including this module are +Copyright (c) 1996, Carnegie Mellon University. All rights reserved. +For use and redistribution information, see CMUCS/CMU_copyright.pm + +=cut diff --git a/src/tests/OpenAFS/bos.pm b/src/tests/OpenAFS/bos.pm new file mode 100644 index 000000000..9d857928b --- /dev/null +++ b/src/tests/OpenAFS/bos.pm @@ -0,0 +1,679 @@ +# CMUCS AFStools +# Copyright (c) 1996, Carnegie Mellon University +# All rights reserved. +# +# See CMU_copyright.ph for use and distribution information +# +#: * bos.pm - Wrappers around BOS commands (basic overseer server) +#: * This module provides wrappers around the various bosserver +#: * commands, giving them a nice perl-based interface. Someday, they might +#: * talk to the servers directly instead of using 'bos', but not anytime +#: * soon. +#: + +package OpenAFS::bos; +use OpenAFS::CMU_copyright; +use OpenAFS::util qw(:DEFAULT :afs_internal); +use OpenAFS::wrapper; +use Exporter; + +$VERSION = ''; +$VERSION = '1.00'; +@ISA = qw(Exporter); +@EXPORT = qw(&AFS_bos_create &AFS_bos_addhost + &AFS_bos_addkey &AFS_bos_adduser + &AFS_bos_delete &AFS_bos_exec + &AFS_bos_getdate &AFS_bos_getlog + &AFS_bos_getrestart &AFS_bos_install + &AFS_bos_listhosts &AFS_bos_listkeys + &AFS_bos_listusers &AFS_bos_prune + &AFS_bos_removehost &AFS_bos_removekey + &AFS_bos_removeuser &AFS_bos_restart + &AFS_bos_salvage &AFS_bos_setauth + &AFS_bos_setcellname &AFS_bos_setrestart + &AFS_bos_shutdown &AFS_bos_start + &AFS_bos_startup &AFS_bos_status + &AFS_bos_stop &AFS_bos_uninstall); + +#: AFS_bos_addhost($server, $host, [$clone], [$cell]) +#: Add a new database server host named $host to the database +#: on $server. +#: If $clone is specified, create an entry for a clone server. +#: On success, return 1. +#: +$AFS_Help{bos_addhost} = '$server, $host, [$clone], [$cell] => Success?'; +sub AFS_bos_addhost { + my($server, $host, $clone, $cell) = @_; + my(@args); + + @args = ('addhost', '-server', $server, '-host', $host); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-clone') if ($clone); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_addkey($server, $key, $kvno, [$cell]) +#: Add a key $key with key version number $kvno on server $server +#: On success, return 1. +#: +$AFS_Help{bos_addkey} = '$server, $key, $kvno, [$cell] => Success?'; +sub AFS_bos_addkey { + my($server, $key, $kvno, $cell) = @_; + my(@args); + + @args = ('addkey', '-server', $server, '-key', $key, '-kvno', $kvno); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_adduser($server, \@user, [$cell]) +#: Add users specified in @users to bosserver superuser list on $server. +#: On success, return 1. +#: +$AFS_Help{bos_adduser} = '$server, \@user, [$cell] => Success?'; +sub AFS_bos_adduser { + my($server, $user, $cell) = @_; + my(@args); + + @args = ('adduser', '-server', $server, '-user', @$user); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_create($server, $instance, $type, \@cmd, [$cell]) +#: Create a bnode with name $instance +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{bos_create} = '$server, $instance, $type, \@cmd, [$cell] => Success?'; +sub AFS_bos_create { + my($server, $instance, $type, $cmd, $cell) = @_; + my(@args); + + @args = ('create', '-server', $server, '-instance', $instance, '-type', + $type, '-cmd', @$cmd); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_delete($server, $instance, [$cell]) +#: Delete a bnode with name $instance +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{bos_delete} = '$server, $instance, [$cell] => Success?'; +sub AFS_bos_delete { + my($server, $instance, $cell) = @_; + my(@args); + + @args = ('delete', '-server', $server, '-instance', $instance); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_exec($server, $cmd, [$cell]) +#: Exec a process on server $server +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{bos_exec} = '$server, $cmd, [$cell] => Success?'; +sub AFS_bos_exec { + my($server, $cmd, $cell) = @_; + my(@args); + + @args = ('exec', '-server', $server, '-cmd', $cmd); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_getdate($server, $file, [$cell]) +#: Get the date for file $file from server $server +#: On success, return ($exedate, $bakdate, $olddate). +#: +$AFS_Help{bos_getdate} = '$server, $file, [$cell] => ($exedate, $bakdate, $olddate)'; +sub AFS_bos_getdate { + my($server, $file, $cell) = @_; + my(@args, $exedate, $bakdate, $olddate); + + @args = ('getdate', '-server', $server, '-file', $file); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args, + [[ 'dated (.*), (no )?\.BAK', \$exedate], + [ '\.BAK file dated (.*), (no )?\.OLD', \$bakdate], + [ '\.OLD file dated (.*)\.', \$olddate]]); + ($exedate, $bakdate, $olddate); +} + +#: AFS_bos_getlog($server, $file, [$cell]) +#: Get log named $file from server $server +#: On success, return 1. +#: +$AFS_Help{bos_getlog} = '$server, $file, [$cell] => Success?'; +sub AFS_bos_getlog { + my($server, $file, $cell) = @_; + my(@args); + + @args = ('getlog', '-server', $server, '-file', $file); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args, + [[ '^Fetching log file .*', '.']], { pass_stdout }); + 1; +} + +#: AFS_bos_getrestart($server, [$cell]) +#: Get the restart time for server $server +#: On success, return ($genrestart, $binrestart). +#: +$AFS_Help{bos_getrestart} = '$server, [$cell] => ($genrestart, $binrestart)'; +sub AFS_bos_getrestart { + my($server, $cell) = @_; + my(@args, $genrestart, $binrestart); + + @args = ('getrestart', '-server', $server); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args, + [[ '^Server .* restarts at\s*(.*\S+)', \$genrestart], + [ '^Server .* restarts for new binaries at\s*(.*\S+)', \$binrestart]]); + ($genrestart, $binrestart); +} + +#: AFS_bos_install($server, \@files, [$dir], [$cell]) +#: Install files in \@files on server $server in directory $dir +#: or the default directory. +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{bos_install} = '$server, \@files, [$dir], [$cell] => Success?'; +sub AFS_bos_install { + my($server, $files, $dir, $cell) = @_; + my(@args, $file); + + @args = ('install', '-server', $server, '-file', @$files); + push(@args, '-dir', $dir) if ($dir); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args, [[ 'bos: installed file .*', '.' ]], + { 'errors_last' => 1 }); + 1; +} + +#: AFS_bos_listhosts($server, [$cell]) +#: Get host list on server $server. +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, an array of hosts with the first entry being the cellname. +#: +$AFS_Help{bos_listhosts} = '$server, [$cell] => @ret'; +sub AFS_bos_listhosts { + my($server, $cell) = @_; + my(@args, @ret); + + @args = ('listhosts', '-server', $server); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args, + [[ '^Cell name is (.*)', sub { + push(@ret, $_[0]); + } ], + [ 'Host \S+ is (\S+)', sub { + push(@ret, $_[0]); + } ] + ]); + @ret; +} + +#: AFS_bos_listkeys($server, [$showkey], [$cell]) +#: Get key list on server $server. +#: The server name ($server) may be a hostname or IP address +#: If specified, $showkey indicates keys and not checksums should be shown. +#: If specified, work in $cell instead of the default cell. +#: On success, an array of hosts with the first entry being the cellname. +#: +$AFS_Help{bos_listkeys} = '$server, [$showkey], [$cell] => %ret'; +sub AFS_bos_listkeys { + my($server, $showkey, $cell) = @_; + my(@args, %ret); + + @args = ('listkeys', '-server', $server); + push(@args, '-showkey') if ($showkey); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + %ret = &wrapper('bos', \@args, + [[ '^key (\d+) has cksum (\d+)', sub { + my(%ret) = %OpenAFS::wrapper::result; + $ret{$_[0]} = $_[1]; + %OpenAFS::wrapper::result = %ret; + } ], + [ '^key (\d+) is \'(\S+)\'', sub { + my(%ret) = %OpenAFS::wrapper::result; + $ret{$_[0]} = $_[1]; + %OpenAFS::wrapper::result = %ret; + } ], + [ '^Keys last changed on\s*(.*\S+)', sub { + my(%ret) = %OpenAFS::wrapper::result; + $ret{'date'} = $_[0]; + %OpenAFS::wrapper::result = %ret; + } ], + [ 'All done.', '.']]); + %ret; +} + +#: AFS_bos_listusers($server, [$cell]) +#: Get superuser list on server $server. +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, an array of users. +#: +$AFS_Help{bos_listusers} = '$server, [$cell] => @ret'; +sub AFS_bos_listusers { + my($server, $cell) = @_; + my(@args, @ret); + + @args = ('listusers', '-server', $server); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args, [[ '^SUsers are: (\S+)', sub { + push(@ret, split(' ',$_[0])); + } ]]); + @ret; +} + +#: AFS_bos_prune($server, [$bak], [$old], [$core], [$all], [$cell]) +#: Prune files on server $server +#: If $bak is specified, remove .BAK files +#: If $old is specified, remove .OLD files +#: If $core is specified, remove core files +#: If $all is specified, remove all junk files +#: On success, return 1. +#: +$AFS_Help{bos_prune} = '$server, [$bak], [$old], [$core], [$all], [$cell] => Success?'; +sub AFS_bos_prune { + my($server, $bak, $old, $core, $all, $cell) = @_; + my(@args); + + @args = ('prune', '-server', $server, '-bak', $bak, '-old', $old, '-core', $core, '-all', $all); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-bak') if ($bak); + push(@args, '-old') if ($old); + push(@args, '-core') if ($core); + push(@args, '-all') if ($all); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_removehost($server, $host, [$cell]) +#: Remove a new database server host named $host from the database +#: on $server. +#: On success, return 1. +#: +$AFS_Help{bos_removehost} = '$server, $host, [$cell] => Success?'; +sub AFS_bos_removehost { + my($server, $host, $cell) = @_; + my(@args); + + @args = ('removehost', '-server', $server, '-host', $host); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_removekey($server, $kvno, [$cell]) +#: Remove a key with key version number $kvno on server $server +#: On success, return 1. +#: +$AFS_Help{bos_removekey} = '$server, $kvno, [$cell] => Success?'; +sub AFS_bos_removekey { + my($server, $kvno, $cell) = @_; + my(@args); + + @args = ('removekey', '-server', $server, '-kvno', $kvno); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_removeuser($server, \@user, [$cell]) +#: Remove users specified in @users to bosserver superuser list on $server. +#: On success, return 1. +#: +$AFS_Help{bos_removeuser} = '$server, \@user, [$cell] => Success?'; +sub AFS_bos_removeuser { + my($server, $user, $cell) = @_; + my(@args); + + @args = ('removeuser', '-server', $server, '-user', @$user); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_restart($server, [\@inst], [$bosserver], [$all], [$cell]) +#: Restart bosserver instances specified in \@inst, or if $all is +#: specified, all instances. +#: If $bosserver is specified, restart the bosserver. +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{bos_restart} = '$server, [\@inst], [$bosserver], [$all], [$cell] => Success?'; +sub AFS_bos_restart { + my($server, $inst, $bosserver, $all, $cell) = @_; + my(@args); + + @args = ('restart', '-server', $server); + push(@args, '-instance', @$inst) if ($inst); + push(@args, '-bosserver') if ($bosserver); + push(@args, '-all') if ($all); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_salvage($server, [$partition], [$volume], [$file], [$all], [$showlog], [$parallel], [$tmpdir], [$orphans], [$cell]) +#: Invoke the salvager, providing a partition $partition if specified, and +#: further a volume id $volume if specified. +#: If specified, $file is a file to write the salvager output into. +#: If specified, $all indicates all partitions should be salvaged. +#: If specified, $showlog indicates the log should be displayed on completion. +#: If specified, $parallel indicates the number salvagers that should be run +#: in parallel. +#: If specified, $tmpdir indicates a directory in which to store temporary +#: files. +#: If specified, $orphans indicates how to handle orphans in a volume +#: (valid options are ignore, remove and attach). +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{bos_salvage} = '$server, [$partition], [$volume], [$file], [$all], [$showlog], [$parallel], [$tmpdir], [$orphans], [$cell] => Success?'; +sub AFS_bos_salvage { + my($server, $partition, $volume, $file, $all, $showlog, $parallel, $tmpdir, $orphans, $cell) = @_; + my(@args); + + @args = ('salvage', '-server', $server); + push(@args, '-partition', $partition)if ($partition); + push(@args, '-volume', $volume) if ($volume); + push(@args, '-file', $file) if ($file); + push(@args, '-all') if ($all); + push(@args, '-showlog') if ($showlog); + push(@args, '-parallel', $parallel) if ($parallel); + push(@args, '-tmpdir', $tmpdir) if ($tmpdir); + push(@args, '-orphans', $orphans)if ($orphans); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args, [['bos: shutting down fs.', '.'], + ['Starting salvage.', '.'], + ['bos: waiting for salvage to complete.', '.'], + ['bos: salvage completed', '.'], + ['bos: restarting fs.', '.']], + { 'errors_last' => 1 }); + 1; +} + +#: AFS_bos_setauth($server, $authrequired, [$cell]) +#: Set the authentication required flag for server $server to +#: $authrequired. +#: On success, return 1. +#: +$AFS_Help{bos_setauth} = '$server, $authrequired, [$cell] => Success?'; +sub AFS_bos_setauth { + my($server, $authrequired, $cell) = @_; + my(@args); + + @args = ('setauth', '-server', $server, '-authrequired', $authrequired); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_setcellname($server, $name, [$cell]) +#: Set the cellname for server $server to $name +#: On success, return 1. +#: +$AFS_Help{bos_setcellname} = '$server, $name, [$cell] => Success?'; +sub AFS_bos_setcellname { + my($server, $name, $cell) = @_; + my(@args); + + @args = ('setcellname', '-server', $server, '-name', $name); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_setrestart($server, $time, [$general], [$newbinary], [$cell]) +#: Set the restart time for server $server to $time +#: If specified, $general indicates only the general restart time should be +#: set. +#: If specified, $newbinary indicates only the binary restart time should be +#: set. +#: On success, return 1. +#: +$AFS_Help{bos_setrestart} = '$server, $time, [$general], [$newbinary], [$cell] => Success?'; +sub AFS_bos_setrestart { + my($server, $time, $general, $newbinary, $cell) = @_; + my(@args); + + @args = ('setrestart', '-server', $server, '-time', $time); + push(@args, '-general') if ($general); + push(@args, '-newbinary') if ($newbinary); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_shutdown($server, [\@inst], [$wait], [$cell]) +#: Stop all bosserver instances or if \@inst is specified, +#: only those in \@inst on server $server +#: waiting for them to stop if $wait is specified. +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{bos_shutdown} = '$server, [\@inst], [$wait], [$cell] => Success?'; +sub AFS_bos_shutdown { + my($server, $inst, $wait, $cell) = @_; + my(@args); + + @args = ('shutdown', '-server', $server); + push(@args, '-instance', @$inst) if ($inst); + push(@args, '-wait') if ($wait); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_start($server, \@inst, [$cell]) +#: Start bosserver instances in \@inst on server $server . +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{bos_start} = '$server, \@inst, [$cell] => Success?'; +sub AFS_bos_start { + my($server, $inst, $cell) = @_; + my(@args); + + @args = ('start', '-server', $server, '-instance', @$inst); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_startup($server, [\@inst], [$cell]) +#: Start all bosserver instances or if \@inst is specified, only +#: those in \@inst on server $server . +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{bos_startup} = '$server, [\@inst], [$cell] => Success?'; +sub AFS_bos_startup { + my($server, $inst, $cell) = @_; + my(@args); + + @args = ('startup', '-server', $server); + push(@args, '-instance', @$inst) if ($inst); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_status($server, [\@bnodes], [$cell]) +#: Get status for the specified bnodes on $server, or for all bnodes +#: if none are given. +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, return an associative array whose keys are the names +#: of bnodes on the specified server, and each of whose values is +#: an associative array describing the status of the corresponding +#: bnode, containing some or all of the following elements: +#: - name Name of this bnode (same as key) +#: - type Type of bnode (simple, cron, fs) +#: - status Basic status +#: - aux_status Auxillary status string, for bnode types that provide it +#: - num_starts Number of process starts +#: - last_start Time of last process start +#: - last_exit Time of last exit +#: - last_error Time of last error exit +#: - error_code Exit code from last error exit +#: - error_signal Signal from last error exit +#: - commands Ref to list of commands +#: +$AFS_Help{bos_status} = '$server, [\@bnodes], [$cell] => %bnodes'; +sub AFS_bos_status { + my($server, $bnodes, $cell) = @_; + my(@args, %finres, %blist, @cmds); + + @args = ('status', '-server', $server, '-long'); + push(@args, '-instance', @$bnodes) if ($bnodes); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + %finres = &wrapper('bos', \@args, + [['^(Instance)', sub { + my(%binfo) = %OpenAFS::wrapper::result; + + if ($binfo{name}) { + $binfo{commands} = [@cmds] if (@cmds); + $blist{$binfo{name}} = \%binfo; + + @cmds = (); + %OpenAFS::wrapper::result = (); + } + }], + ['^Instance (.*), \(type is (\S+)\)\s*(.*)', 'name', 'type', 'status' ], + ['Auxilliary status is: (.*)\.', 'aux_status' ], + ['Process last started at (.*) \((\d+) proc starts\)', 'last_start', 'num_starts' ], + ['Last exit at (.*\S+)', 'last_exit' ], + ['Last error exit at (.*),', 'last_error' ], + ['by exiting with code (\d+)', 'error_code' ], + ['due to signal (\d+)', 'error_signal' ], + [q/Command \d+ is '(.*)'/, sub { push(@cmds, $_[0]) }], + ]); + if ($finres{name}) { + $finres{commands} = [@cmds] if (@cmds); + $blist{$finres{name}} = \%finres; + } + %blist; +} + +#: AFS_bos_stop($server, \@inst, [$wait], [$cell]) +#: Stop bosserver instances in \@inst on server $server +#: waiting for them to stop if $wait is specified. +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{bos_stop} = '$server, \@inst, [$wait], [$cell] => Success?'; +sub AFS_bos_stop { + my($server, $inst, $wait, $cell) = @_; + my(@args); + + @args = ('stop', '-server', $server, '-instance', @$inst); + push(@args, '-wait') if ($wait); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args); + 1; +} + +#: AFS_bos_uninstall($server, \@files, [$dir], [$cell]) +#: Uninstall files in \@files on server $server in directory $dir +#: or the default directory. +#: The server name ($server) may be a hostname or IP address +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{bos_uninstall} = '$server, \@files, [$dir], [$cell] => Success?'; +sub AFS_bos_uninstall { + my($server, $files, $dir, $cell) = @_; + my(@args); + + @args = ('uninstall', '-server', $server, '-file', @$files); + push(@args, '-dir', $dir) if ($dir); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('bos', \@args, [[ '^bos: uninstalled file .*', '.' ]], + { 'errors_last' => 1 }); + 1; +} + +1; diff --git a/src/tests/OpenAFS/config.pm b/src/tests/OpenAFS/config.pm new file mode 100644 index 000000000..0de0a54e1 --- /dev/null +++ b/src/tests/OpenAFS/config.pm @@ -0,0 +1,125 @@ +# CMUCS AFStools +# Copyright (c) 1996, Carnegie Mellon University +# All rights reserved. +# +# See CMU_copyright.pm for use and distribution information + +package OpenAFS::config; + +=head1 NAME + +OpenAFS::config - AFStools configuration + +=head1 SYNOPSIS + + use OpenAFS::config; + +=head1 DESCRIPTION + +This module contains various AFStools configuration variables which are used +by the other AFStools modules. These describe how AFStools should act in a +particular installation, and are mostly pretty mundane. All of the defaults +here are pretty reasonable, so you shouldn't have to change anything unless +your site is particularly exotic. + +Note that this file only describes how a particular B of AFStools +should act, not how it should act upon a particular B. Since the cell +AFStools is running in is not necessarily the same as the cell on which it +is acting, most configuration that is really per-cell should be located in a +cell-specific module. + +This module should only be used by other parts of AFStools. As such, the +variables described here are not normally visible to user programs, and this +file is mostly of interest to administrators who are installing AFStools. + +=over 4 + +=cut + +use OpenAFS::CMU_copyright; +use OpenAFS::Dirpath; +use Exporter; + +$VERSION = ''; +$VERSION = '1.00'; +@ISA = qw(Exporter); +@EXPORT = qw($def_ConfDir + @CmdList + @CmdPath + $err_table_dir + ); + +# The following configuration variables are defined here. Mention them +# all an extra time, to suppress annoying warnings. Doesn't perl have +# a way of doing this??? +@x = (); +@x = ($def_ConfDir, @CmdList, @CmdPath); + +=item $def_ConfDir - Default configuration directory + +This is the default AFS configuration directory, where files like ThisCell, +CellServDB, and so on are found. If the AFStools parameter I is +set, it will generally be searched before this directory. Normally, this +should be set to F and not changed, as that path is hardwired +into AFS. However, it might be necessary to modify this if your site uses +an exotic locally-compiled version of AFS. + +=cut + +$def_ConfDir = "$openafsdirpath->{'viceetcdir'}"; +#$def_ConfDir = "/usr/vice/etc"; + + +=item @CmdList - List of AFS commands + +This is a list of AFS commands that the AFStools package might want to invoke +using B. Don't remove anything from this list if you +know what's good for you. It's OK to add things, though, if you think you +might use the wrapper features for something. + +=cut + +@CmdList = ('fs', 'pts', 'vos', 'bos', 'kas', 'krbkas', 'sys'); + + +=item @CmdPath - Path to search for AFS commands + +This is the list of directories where B will look for +AFS commands. For AFStools to work properly, every command listed in +I<@OpenAFS::config::CmdList> must appear in one of these directories. The default +should be sufficient for most sites; we deal with Transarc's reccommendations +as well as common practice. Note that on machines for which /usr/afs/bin +exists (typically, AFS fileservers), that directory is first. This is probably +what you want... + +=cut + +@CmdPath = (split(/:/, $ENV{PATH}), + "$openafsdirpath->{'afssrvbindir'}", # For servers + '/usr/local/bin', # Many sites put AFS in /usr/local + '/usr/local/etc', + '/usr/afsws/bin', # For people who use Transarc's + '/usr/afsws/etc'); # silly reccommendations + +=item $err_table_dir - Error table directory + +This is the location of error tables used by the errcode and errstr +routines in OpenAFS::errtrans. Each file in this directory should be a +com_err error table (in source form), and should be named the same +as the com_err error package contained within. + +=cut + +$err_table_dir = '/usr/local/lib/errtbl'; + +1; + +=back + +=head1 COPYRIGHT + +The CMUCS AFStools, including this module are +Copyright (c) 1996, Carnegie Mellon University. All rights reserved. +For use and redistribution information, see CMUCS/CMU_copyright.pm + +=cut diff --git a/src/tests/OpenAFS/errtrans.pm b/src/tests/OpenAFS/errtrans.pm new file mode 100644 index 000000000..48cf96ae3 --- /dev/null +++ b/src/tests/OpenAFS/errtrans.pm @@ -0,0 +1,310 @@ +# CMUCS AFStools +# Copyright (c) 1996, Carnegie Mellon University +# All rights reserved. +# +# See CMUCS/CMU_copyright.pm for use and distribution information + +package OpenAFS::errtrans; + +=head1 NAME + +OpenAFS::errtrans - com_err error translation + +=head1 SYNOPSIS + + use OpenAFS::errtrans + $code = errcode($name); + $code = errcode($pkg, $err); + $string = errstr($code, [$volerrs]); + +=head1 DESCRIPTION + +This module translates "common" error codes such as those produced +by MIT's com_err package, and used extensively in AFS. It also knows +how to translate system error codes, negative error codes used by Rx, +and a few "special" error codes used by AFS's volume package. + +In order to work, these routines depend on the existence of error +table files in $err_table_dir, which is usually /usr/local/lib/errtbl. +Each file should be named after a com_err error package, and contain +the definition for that package. + +Note that the AFS version of com_err translates package names to uppercase +before generating error codes, so a table which claims to define the 'pt' +package actually defines the 'PT' package when compiled by AFS's compile_et. +Tables that are normally fed to AFS's compile_et should be installed using +the _uppercase_ version of the package name. + +The error tables used in AFS are part of copyrighted AFS source code, and +are not included with this package. However, I have included a utility +(gen_et) which can generate error tables from the .h files normally +produced by compile_et, and Transarc provides many of these header files +with binary AFS distributions (in .../include/afs). See the gen_et +program for more details. + +=cut + +use OpenAFS::CMU_copyright; +use OpenAFS::util qw(:DEFAULT :afs_internal); +use OpenAFS::config qw($err_table_dir); +use Symbol; +use Exporter; +use POSIX; + +$VERSION = ''; +$VERSION = '1.00'; +@ISA = qw(Exporter); +@EXPORT = qw(&errcode &errstr); + + +@NumToChar = ('', 'A'..'Z', 'a'..'z', '0'..'9', '_'); +%CharToNum = map(($NumToChar[$_], $_), (1 .. $#NumToChar)); + +%Vol_Codes = ( VSALVAGE => 101, + VNOVNODE => 102, + VNOVOL => 103, + VVOLEXISTS => 104, + VNOSERVICE => 105, + VOFFLINE => 106, + VONLINE => 107, + VDISKFULL => 108, + VOVERQUOTA => 109, + VBUSY => 110, + VMOVED => 111 + ); +%Vol_Desc = ( 101 => "volume needs to be salvaged", + 102 => "no such entry (vnode)", + 103 => "volume does not exist / did not salvage", + 104 => "volume already exists", + 105 => "volume out of service", + 106 => "volume offline (utility running)", + 107 => "volume already online", + 108 => "unknown volume error 108", + 109 => "unknown volume error 109", + 110 => "volume temporarily busy", + 111 => "volume moved" + ); +%Rx_Codes = ( RX_CALL_DEAD => -1, + RX_INVALID_OPERATION => -2, + RX_CALL_TIMEOUT => -3, + RX_EOF => -4, + RX_PROTOCOL_ERROR => -5, + RX_USER_ABORT => -6, + RX_ADDRINUSE => -7, + RX_MSGSIZE => -8, + RXGEN_CC_MARSHAL => -450, + RXGEN_CC_UNMARSHAL => -451, + RXGEN_SS_MARSHAL => -452, + RXGEN_SS_UNMARSHAL => -453, + RXGEN_DECODE => -454, + RXGEN_OPCODE => -455, + RXGEN_SS_XDRFREE => -456, + RXGEN_CC_XDRFREE => -457 + ); +%Rx_Desc = ( -1 => "server or network not responding", + -2 => "invalid RPC (Rx) operation", + -3 => "server not responding promptly", + -4 => "Rx unexpected EOF", + -5 => "Rx protocol error", + -6 => "Rx user abort", + -7 => "port address already in use", + -8 => "Rx message size incorrect", + -450 => "Rx client: XDR marshall failed", + -451 => "Rx client: XDR unmarshall failed", + -452 => "Rx server: XDR marshall failed", + -453 => "Rx server: XDR unmarshall failed", + -454 => "Rx: Decode failed", + -455 => "Rx: Invalid RPC opcode", + -456 => "Rx server: XDR free failed", + -457 => "Rx client: XDR free failed", + map(($_ => "RPC interface mismatch ($_)"), (-499 .. -458)), + -999 => "Unknown error" + ); + + +sub _tbl_to_num { + my(@tbl) = split(//, $_[0]); + my($n); + + @tbl = @tbl[0..3] if (@tbl > 4); + foreach (@tbl) { $n = ($n << 6) + $CharToNum{$_} } + $n << 8; +} + + +sub _num_to_tbl { + my($n) = $_[0] >> 8; + my($tbl); + + while ($n) { + $tbl = @NumToChar[$n & 0x3f] . $tbl; + $n >>= 6; + } + $tbl; +} + + +sub _load_system_errors { + my($file) = @_; + my($fh) = &gensym(); + + return if ($did_include{$file}); +# print "Loading $file...\n"; + $did_include{$file} = 'yes'; + if (open($fh, "/usr/include/$file")) { + while (<$fh>) { + if (/^\#define\s*(E\w+)\s*(\d+)/) { + $Codes{$1} = $2; + } elsif (/^\#include\s*\"([^"]+)\"/ + || /^\#include\s*\<([^>]+)\>/) { + &_load_system_errors($1); + } + } + close($fh); + } +} + + +# Load an error table into memory +sub _load_error_table { + my($pkg) = @_; + my($fh, @words, $curval, $tval, $nval); + my($tid, $tfn, $code, $val, $desc); + + return if ($Have_Table{$pkg}); + # Read in the input file, and split it into words + $fh = &gensym(); + return unless open($fh, "$err_table_dir/$pkg"); +# print "Loading $pkg...\n"; + line: while (<$fh>) { + s/^\s*//; # Strip leading whitespace + while ($_) { + next line if (/^#/); + if (/^(error_table|et)\s*/) { push(@words, 'et'); $_ = $' } + elsif (/^(error_code|ec)\s*/) { push(@words, 'ec'); $_ = $' } + elsif (/^end\s*/) { push(@words, 'end'); $_ = $' } + elsif (/^(\w+)\s*/) { push(@words, $1); $_ = $' } + elsif (/^\"([^"]*)\"\s*/) { push(@words, $1); $_ = $' } + elsif (/^([,=])\s*/) { push(@words, $1); $_ = $' } + else { close($fh); return } + } + } + close($fh); + + # Parse the table header + $_ = shift(@words); return unless ($_ eq 'et'); + if ($words[1] eq 'ec') { $tid = shift(@words) } + elsif ($words[2] eq 'ec') { ($tfn, $tid) = splice(@words, 0, 2) } + else { return; } + if ($tid ne $pkg) { + $Have_Table{$tid} = 'yes'; + $_ = $tid; + $_ =~ tr/a-z/A-Z/; + $tid = $_ if ($_ eq $pkg); + } + $tval = &_tbl_to_num($tid); + $Have_Table{$pkg} = 'yes'; +# print "Package $pkg: table-id = $tid, table-fun = $tfn, base = $tval\n"; + + while (@words) { + $_ = shift(@words); return unless ($_ eq 'ec'); + $code = shift(@words); + $_ = shift(@words); + if ($_ eq '=') { + $val = shift(@words); + $_ = shift(@words); + } else { + $val = $curval; + } + return unless ($_ eq ','); + $desc = shift(@words); + $nval = $tval + $val; + $curval = $val + 1; + $Desc{$nval} = $desc; + $Codes{$code} = $nval; +# print " code $code: value = $nval ($tval + $val), desc = \"$desc\"\n"; + } +} + +=head2 errcode($name) + +Returns the numeric error code corresponding to the specified error +name. This routine knows about names of system errors, a few special +Rx and volume-package errors, and any errors defined in installed +error tables. If the specified error code is not found, returns -999. + +=head2 errcode($pkg, $code) + +Shifts $code into the specified error package, and returns the +resulting com_err code. This can be used to generate error codes +for _any_ valid com_err package. + +=cut + +sub errcode { + if (@_ > 1) { + my($pkg, $code) = @_; + &_tbl_to_num($pkg) + $code; + } else { + my($name) = @_; + my($dir, @tbls, $code); + + &_load_system_errors("errno.h"); + if ($Vol_Codes{$name}) { $Vol_Codes{$name} } + elsif ($Rx_Codes{$name}) { $Rx_Codes{$name} } + elsif ($Codes{$name}) { $Codes{$name} } + else { + if ($name =~ /^E/) { # Might be a POSIX error constant + $! = 0; + $code = &POSIX::constant($name, 0); + if (!$!) { return $code; } + } + $dir = &gensym(); + if (opendir($dir, $err_table_dir)) { + @tbls = grep(!/^\.?\.$/, readdir($dir)); + close($dir); + foreach (@tbls) { &_load_error_table($_) } + } + $Codes{$name} ? $Codes{$name} : -999; + } + } +} + + +=head2 errstr($code, [$volerrs]) + +Returns the error string corresponding to a specified com_err, Rx, +or system error code. If $volerrs is specified and non-zero, then +volume-package errors are considered before system errors with the +same values. + +=cut + +sub errstr { + my($code, $volerrs) = @_; + my($pkg, $sub); + + if ($Rx_Desc{$code}) { return $Rx_Desc{$code} } + if ($volerrs && $Vol_Desc{$code}) { return $Vol_Desc{$code} } + $sub = $code & 0xff; + $pkg = &_num_to_tbl($code); + if ($pkg eq '') { + $! = $sub + 0; + $_ = $! . ''; + if (/^(Error )?\d+$/) { $Vol_Desc{$sub} ? $Vol_Desc{$sub} : "Error $sub" } + else { $_ } + } else { + &_load_error_table($pkg); + $Desc{$code} ? $Desc{$code} : "Unknown code $pkg $sub ($code)"; + } +} + +1; + +=head1 COPYRIGHT + +The CMUCS AFStools, including this module are +Copyright (c) 1996, Carnegie Mellon University. All rights reserved. +For use and redistribution information, see CMUCS/CMU_copyright.pm + +=cut diff --git a/src/tests/OpenAFS/fs.pm b/src/tests/OpenAFS/fs.pm new file mode 100644 index 000000000..40932377a --- /dev/null +++ b/src/tests/OpenAFS/fs.pm @@ -0,0 +1,817 @@ +# CMUCS AFStools +# Copyright (c) 1996, 2001 Carnegie Mellon University +# All rights reserved. +# +# See CMU_copyright.ph for use and distribution information +# +#: * fs.pm - Wrappers around the FS commands (fileserver/cache manager) +#: * This module provides wrappers around the various FS commands, which +#: * perform fileserver and cache manager control operations. Right now, +#: * these are nothing more than wrappers around 'fs'; someday, we might +#: * talk to the cache manager directly, but not anytime soon. +#: + +package OpenAFS::fs; +use OpenAFS::CMU_copyright; +use OpenAFS::util qw(:DEFAULT :afs_internal); +use OpenAFS::wrapper; +use Exporter; + +$VERSION = ''; +$VERSION = '1.00'; +@ISA = qw(Exporter); +@EXPORT = qw(&AFS_fs_getacl &AFS_fs_setacl + &AFS_fs_cleanacl &AFS_fs_getquota + &AFS_fs_setquota &AFS_fs_whereis + &AFS_fs_examine &AFS_fs_setvol + &AFS_fs_getmount &AFS_fs_mkmount + &AFS_fs_rmmount &AFS_fs_checkvolumes + &AFS_fs_flush &AFS_fs_flushmount + &AFS_fs_flushvolume &AFS_fs_messages + &AFS_fs_newcell &AFS_fs_rxstatpeer + &AFS_fs_rxstatproc &AFS_fs_setcachesize + &AFS_fs_setcell &AFS_fs_setcrypt + &AFS_fs_setclientaddrs &AFS_fs_copyacl + &AFS_fs_storebehind &AFS_fs_setserverprefs + &AFS_fs_checkservers &AFS_fs_checkservers_interval + &AFS_fs_exportafs &AFS_fs_getcacheparms + &AFS_fs_getcellstatus &AFS_fs_getclientaddrs + &AFS_fs_getcrypt &AFS_fs_getserverprefs + &AFS_fs_listcells &AFS_fs_setmonitor + &AFS_fs_getmonitor &AFS_fs_getsysname + &AFS_fs_setsysname &AFS_fs_whichcell + &AFS_fs_wscell); + +#: ACL-management functions: +#: AFS access control lists are represented as a Perl list (or usually, a +#: reference to such a list). Each element in such a list corresponds to +#: a single access control entry, and is a reference to a 2-element list +#: consisting of a PTS entity (name or ID), and a set of rights. The +#: rights are expressed in the usual publically-visible AFS notation, as +#: a string of characters drawn from the class [rlidwkaABCDEFGH]. No +#: rights are denoted by the empty string; such an ACE will never returned +#: by this library, but may be used as an argument to remove a particular +#: ACE from a directory's ACL. +#: +#: One might be inclined to ask why we chose this representation, instead of +#: using an associative array, as might seem obvious. The answer is that +#: doing so would have implied a nonambiguity that isn't there. Suppose you +#: have an ACL %x, and want to know if there is an entry for user $U on that +#: list. You might think you could do this by looking at $x{$U}. The +#: problem here is that two values for $U (one numeric and one not) refer to +#: the same PTS entity, even though they would reference different elements +#: in such an ACL. So, we instead chose a representation that wasn't a hash, +#: so people wouldn't try to do hash-like things to it. If you really want +#: to be able to do hash-like operations, you should turn the list-form ACL +#: into a hash table, and be sure to do name-to-number translation on all the +#: keys as you go. +#: +#: AFS_fs_getacl($path) +#: Get the ACL on a specified path. +#: On success, return a list of two references to ACLs; the first is the +#: positive ACL for the specified path, and the second is the negative ACL. +#: +$AFS_Help{fs_getacl} = '$path => (\@posacl, \@negacl)'; +sub AFS_fs_getacl { + my($path) = @_; + my(@args, @posacl, @negacl, $neg); + + @args = ('listacl', '-path', $path); + &wrapper('fs', \@args, + [ + [ '^(Normal|Negative) rights\:', sub { + $neg = ($_[0] eq 'Negative'); + }], + [ '^ (.*) (\S+)$', sub { #',{ + if ($neg) { + push(@negacl, [@_]); + } else { + push(@posacl, [@_]); + } + }]]); + (\@posacl, \@negacl); +} + +#: AFS_fs_setacl(\@paths, \@posacl, \@negacl, [$clear]) +#: Set the ACL on a specified path. Like the 'fs setacl' command, this +#: function normally only changes ACEs that are mentioned in one of the two +#: argument lists. If a given ACE already exists, it is changed; if not, it +#: is added. To delete a single ACE, specify the word 'none' or the empty +#: string in the rights field. ACEs that already exist but are not mentioned +#: are left untouched, unless $clear is specified. In that case, all +#: existing ACE's (both positive and negative) are deleted. +$AFS_Help{fs_setacl} = '\@paths, \@posacl, \@negacl, [$clear] => Success?'; +sub AFS_fs_setacl { + my($paths, $posacl, $negacl, $clear) = @_; + my($ace, $U, $access); + + if (@$posacl) { + @args = ('setacl', '-dir', @$paths); + push(@args, '-clear') if ($clear); + push(@args, '-acl'); + foreach $e (@$posacl) { + ($U, $access) = @$e; + $access = 'none' if ($access eq ''); + push(@args, $U, $access); + } + &wrapper('fs', \@args); + } + if (@$negacl) { + @args = ('setacl', '-dir', @$paths, '-negative'); + push(@args, '-clear') if ($clear && !@$posacl); + push(@args, '-acl'); + foreach $e (@$negacl) { + ($U, $access) = @$e; + $access = 'none' if ($access eq ''); + push(@args, $U, $access); + } + &wrapper('fs', \@args); + } + if ($clear && !@$posacl && !@$negacl) { + @args = ('setacl', '-dir', @$paths, + '-acl', 'system:anyuser', 'none', '-clear'); + &wrapper('fs', \@args); + } + 1; +} + +#: AFS_fs_cleanacl(\@paths) +#: Clean the ACL on the specified path, removing any ACEs which refer to PTS +#: entities that no longer exist. All the work is done by 'fs'. +#: +$AFS_Help{'fs_cleanacl'} = '\@paths => Success?'; +sub AFS_fs_cleanacl { + my($paths) = @_; + my(@args); + + @args = ('cleanacl', '-path', @$paths); + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_getquota($path) [listquota] +#: Get the quota on the specified path. +#: On success, returns the quota. +#: +$AFS_Help{'fs_getquota'} = '$path => $quota'; +sub AFS_fs_getquota { + my($path) = @_; + my(@args, $quota); + + @args = ('listquota', '-path', $path); + &wrapper('fs', \@args, + [[ '^\S+\s+(\d+)\s+\d+\s+\d+\%', \$quota ]]); + $quota; +} + +#: AFS_fs_setquota($path, $quota) [setquota] +#: Set the quota on the specified path to $quota. If $quota is +#: given as 0, there will be no limit to the volume's size. +#: On success, return 1 +#: +$AFS_Help{'fs_setquota'} = '$path, $quota => Success?'; +sub AFS_fs_setquota { + my($path, $quota) = @_; + my(@args); + + @args = ('setquota', '-path', $path, '-max', $quota); + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_whereis($path) [whereis, whichcell] +#: Locate the fileserver housing the specified path, and the cell in which it +#: is located. +#: On success, returns a list of 2 or more elements. The first element is the +#: name of the cell in which the volume is located. The remaining elements +#: the names of servers housing the volume; for a replicated volume, there may +#: (should) be more than one such server. +#: +$AFS_Help{'fs_whereis'} = '$path => ($cell, @servers)'; +sub AFS_fs_whereis { + my($path) = @_; + my(@args, $cell, @servers); + + @args = ('whichcell', '-path', $path); + &wrapper('fs', \@args, + [[ "lives in cell \'(.*)\'", \$cell ]]); + + @args = ('whereis', '-path', $path); + &wrapper('fs', \@args, + [[ 'is on host(s?)\s*(.*)', sub { + @servers = split(' ', $_[1]); + }]]); + ($cell, @servers); +} + +#: AFS_fs_examine($path) +#: Get information about the volume containing the specified path. +#: On success, return an associative array containing some or all +#: of the following elements: +#: - vol_name +#: - vol_id +#: - quota_max +#: - quota_used +#: - quota_pctused +#: - part_size +#: - part_avail +#: - part_used +#: - part_pctused +#: +$AFS_Help{'fs_examine'} = '$path => %info'; +sub AFS_fs_examine { + my($path) = @_; + my(@args, %info); + + @args = ('examine', '-path', $path); + %info = &wrapper('fs', \@args, + [[ 'vid = (\d+) named (\S+)', 'vol_id', 'vol_name' ], + [ 'disk quota is (\d+|unlimited)', 'quota_max' ], + [ 'blocks used are (\d+)', 'quota_used' ], + [ '(\d+) blocks available out of (\d+)', + 'part_avail', 'part_size']]); + if ($info{'quota_max'} eq 'unlimited') { + $info{'quota_max'} = 0; + $info{'quota_pctused'} = 0; + } else { + $info{'quota_pctused'} = ($info{'quota_used'} / $info{'quota_max'}) * 100; + $info{'quota_pctused'} =~ s/\..*//; + } + $info{'part_used'} = $info{'part_size'} - $info{'part_avail'}; + $info{'part_pctused'} = ($info{'part_used'} / $info{'part_size'}) * 100; + $info{'part_pctused'} =~ s/\..*//; + %info; +} + +#: AFS_fs_setvol($path, [$maxquota], [$motd]) +#: Set information about the volume containing the specified path. +#: On success, return 1. +$AFS_Help{'fs_setvol'} = '$path, [$maxquota], [$motd] => Success?'; +sub AFS_fs_setvol { + my($path, $maxquota, $motd) = @_; + my(@args); + + @args = ('setvol', '-path', $path); + push(@args, '-max', $maxquota) if ($maxquota || $maxquota eq '0'); + push(@args, '-motd', $motd) if ($motd); + &wrapper('fs', \@args); + 1; +} + + +#: AFS_fs_getmount($path) +#: Get the contents of the specified AFS mount point. +#: On success, return the contents of the specified mount point. +#: If the specified path is not a mount point, return the empty string. +$AFS_Help{'fs_getmount'} = '$path => $vol'; +sub AFS_fs_getmount { + my($path) = @_; + my(@args, $vol); + + @args = ('lsmount', '-dir', $path); + &wrapper('fs', \@args, + [[ "mount point for volume '(.+)'", \$vol ]]); + $vol; +} + + +#: AFS_fs_mkmount($path, $vol, [$cell], [$rwmount], [$fast]) +#: Create an AFS mount point at $path, leading to the volume $vol. +#: If $cell is specified, create a cellular mount point to that cell. +#: If $rwmount is specified and nonzero, create a read-write mount point. +#: If $fast is specified and nonzero, don't check to see if the volume exists. +#: On success, return 1. +$AFS_Help{'fs_mkmount'} = '$path, $vol, [$cell], [$rwmount], [$fast] => Success?'; +sub AFS_fs_mkmount { + my($path, $vol, $cell, $rwmount, $fast) = @_; + my(@args); + + @args = ('mkmount', '-dir', $path, '-vol', $vol); + push(@args, '-cell', $cell) if ($cell); + push(@args, '-rw') if ($rwmount); + push(@args, '-fast') if ($fast); + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_rmmount($path) [rmmount] +#: Remove an AFS mount point at $path +#: On success, return 1 +$AFS_Help{'fs_rmmount'} = '$path => Success?'; +sub AFS_fs_rmmount { + my($path) = @_; + my(@args); + + @args = ('rmmount', '-dir', $path); + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_checkvolumes() +#: Check/update volume ID cache +#: On success, return 1 +$AFS_Help{'fs_checkvolumes'} = '=> Success?'; +sub AFS_fs_checkvolumes { + my(@args); + + @args = ('checkvolumes'); + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_flush(\@paths) +#: Flush files named by @paths from the cache +#: On success, return 1 +$AFS_Help{'fs_flush'} = '\@paths => Success?'; +sub AFS_fs_flush { + my($paths) = @_; + my(@args); + + @args = ('flush'); + push(@args, '-path', @$paths) if $paths; + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_flushmount(\@paths) +#: Flush mount points named by @paths from the cache +#: On success, return 1 +$AFS_Help{'fs_flushmount'} = '\@paths => Success?'; +sub AFS_fs_flushmount { + my($paths) = @_; + my(@args); + + @args = ('flushmount'); + push(@args, '-path', @$paths) if $paths; + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_flushvolume(\@paths) +#: Flush volumes containing @paths from the cache +#: On success, return 1 +$AFS_Help{'fs_flushvolume'} = '\@paths => Success?'; +sub AFS_fs_flushvolume { + my($paths) = @_; + my(@args); + + @args = ('flushvolume'); + push(@args, '-path', @$paths) if $paths; + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_messages($mode) +#: Set cache manager message mode +#: Valid modes are 'user', 'console', 'all', 'none' +#: On success, return 1 +$AFS_Help{'fs_messages'} = '$mode => Success?'; +sub AFS_fs_messages { + my($mode) = @_; + my(@args); + + @args = ('messages', '-show', $mode); + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_newcell($cell, \@dbservers, [$linkedcell]) +#: Add a new cell to the cache manager's list, or updating an existing cell +#: On success, return 1 +$AFS_Help{'fs_newcell'} = '$cell, \@dbservers, [$linkedcell] => Success?'; +sub AFS_fs_newcell { + my($cell, $dbservers, $linkedcell) = @_; + my(@args); + + @args = ('newcell', '-name', $cell, '-servers', @$dbservers); + push(@args, '-linkedcell', $linkedcell) if $linkedcell; + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_rxstatpeer($enable, [$clear]) +#: Control per-peer Rx statistics: +#: - if $enable is 1, enable stats +#: - if $enable is 0, disable stats +#: - if $clear is 1, clear stats +#: On success, return 1 +$AFS_Help{'fs_rxstatpeer'} = '$enable, [$clear] => Success?'; +sub AFS_fs_rxstatpeer { + my($enable, $clear) = @_; + my(@args); + + @args = ('rxstatpeer'); + push(@args, '-enable') if $enable; + push(@args, '-disable') if defined($enable) && !$enable; + push(@args, '-clear') if $clear; + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_rxstatproc($enable, [$clear]) +#: Control per-process Rx statistics: +#: - if $enable is 1, enable stats +#: - if $enable is 0, disable stats +#: - if $clear is 1, clear stats +#: On success, return 1 +$AFS_Help{'fs_rxstatproc'} = '$enable, [$clear] => Success?'; +sub AFS_fs_rxstatproc { + my($enable, $clear) = @_; + my(@args); + + @args = ('rxstatproc'); + push(@args, '-enable') if $enable; + push(@args, '-disable') if defined($enable) && !$enable; + push(@args, '-clear') if $clear; + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_setcachesize($size) +#: Set the cache size to $size K +#: On success, return 1 +$AFS_Help{'fs_setcachesize'} = '$size => Success?'; +sub AFS_fs_setcachesize { + my($size) = @_; + my(@args); + + @args = ('setcachesize', '-blocks', $size); + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_setcell(\@cells, $suid) +#: Set cell control bits for @cells +#: - if $suid is 1, enable suid programs +#: - if $suid is 0, disable suid programs +#: On success, return 1 +$AFS_Help{'fs_setcell'} = '\@cells, [$suid] => Success?'; +sub AFS_fs_setcell { + my($cells, $suid) = @_; + my(@args); + + @args = ('setcell', '-cell', @$cells); + push(@args, '-suid') if $suid; + push(@args, '-nosuid') if defined($suid) && !$suid; + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_setcrypt($enable) +#: Control cache manager encryption +#: - if $enable is 1, enable encrypted connections +#: - if $enable is 0, disable encrypted connections +#: On success, return 1 +$AFS_Help{'fs_setcrypt'} = '$enable => Success?'; +sub AFS_fs_setcrypt { + my($enable) = @_; + my(@args); + + @args = ('setcrypt', '-crypt', $enable ? 'on' : 'off'); + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_setclientaddrs(\@addrs) +#: Set client network interface addresses +#: On success, return 1 +$AFS_Help{'fs_setclientaddrs'} = '\@addrs => Success?'; +sub AFS_fs_setclientaddrs { + my($addrs) = @_; + my(@args); + + @args = ('setclientaddrs'); + push(@args, '-address', @$addrs) if $addrs; + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_copyacl($from, \@to, [$clear]) +#: Copy the access control list on $from to each directory named in @to. +#: If $clear is specified and nonzero, the target ACL's are cleared first +#: On success, return 1 +$AFS_Help{'fs_copyacl'} = '$from, \@to, [$clear] => Success?'; +sub AFS_fs_copyacl { + my($from, $to, $clear) = @_; + my(@args); + + @args = ('copyacl', '-fromdir', $from, '-todir', @$to); + push(@args, '-clear') if $clear; + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_storebehind(\@paths, [$size], [$def]) +#: Set amount of date to store after file close +#: If $size is specified, the size for each file in @paths is set to $size. +#: If $default is specified, the default size is set to $default. +#: Returns the new or current default value, and a hash mapping filenames +#: to their storebehind sizes. A hash entry whose value is undef indicates +#: that the corresponding file will use the default size. +$AFS_Help{'fs_storebehind'} = '\@paths, [$size], [$def] => ($def, \%sizes)'; +sub AFS_fs_storebehind { + my($paths, $size, $def) = @_; + my(@args, %sizes, $ndef); + + @args = ('storebehind', '-verbose'); + push(@args, '-kbytes', $size) if defined($size); + push(@args, '-files', @$paths) if $paths && @$paths; + push(@args, '-allfiles', $def) if defined($def); + &wrapper('fs', \@args, [ + ['^Will store up to (\d+) kbytes of (.*) asynchronously', + sub { $sizes{$_[1]} = $_[0] }], + ['^Will store (.*) according to default', + sub { $sizes{$_[0]} = undef }], + ['^Default store asynchrony is (\d+) kbytes', \$ndef], + ]); + ($ndef, \%sizes); +} + +#: AFS_fs_setserverprefs(\%fsprefs, \%vlprefs) +#: Set fileserver and/or VLDB server preference ranks +#: Each of %fsprefs and %vlprefs maps server names to the rank to be +#: assigned to the specified servers. +#: On success, return 1. +$AFS_Help{'fs_setserverprefs'} = '\%fsprefs, \%vlprefs => Success?'; +sub AFS_fs_setserverprefs { + my($fsprefs, $vlprefs) = @_; + my(@args, $srv); + + @args = ('setserverprefs'); + if ($fsprefs && %$fsprefs) { + push(@args, '-servers'); + foreach $srv (keys %$fsprefs) { + push(@args, $srv, $$fsprefs{$srv}); + } + } + if ($vlprefs && %$vlprefs) { + push(@args, '-vlservers'); + foreach $srv (keys %$vlprefs) { + push(@args, $srv, $$vlprefs{$srv}); + } + } + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_checkservers([$fast], [$allcells], [$cell]) +#: Check to see what fileservers are down +#: If $cell is specified, fileservers in the specified cell are checked +#: If $allcells is specified and nonzero, fileservers in all cells are checked +#: If $fast is specified and nonzero, don't probe servers +$AFS_Help{'fs_checkservers'} = '[$fast], [$allcells], [$cell] => @down'; +sub AFS_fs_checkservers { + my($fast, $allcells, $cell) = @_; + my(@args, @down); + + @args = ('checkservers'); + push(@args, '-all') if $allcells; + push(@args, '-fast') if $fast; + push(@args, '-cell', $cell) if $cell; + &wrapper('fs', \@args, [ + ['^These servers unavailable due to network or server problems: (.*)\.', + sub { push(@down, split(' ', $_[0])) }], + ]); + @down; +} + +#: AFS_fs_checkservers_interval([$interval]) +#: Get and/or set the down server check interval +#: If $interval is specified and nonzero, it is set as the new interval +#: On success, returns the old interval in seconds +$AFS_Help{'fs_checkservers_interval'} = '$interval => $oldinterval'; +sub AFS_fs_checkservers_interval { + my($interval) = @_; + my(@args, $oldinterval); + + @args = ('checkservers', '-interval', $interval); + &wrapper('fs', \@args, [ + ['^The new down server probe interval \((\d+) secs\)', \$oldinterval], + ['^The current down server probe interval is (\d+) secs', \$oldinterval], + ]); + $oldinterval; +} + +#: AFS_fs_exportafs($type, \%options); +#: Get and/or modify protocol translator settings +#: $type is the translator type, which must be 'nfs' +#: %options specifies the options to be set. Each key is the name of an +#: option, which is enabled if the value is 1, and disabled if the value +#: is 0. The following options are supported: +#: start Enable exporting of AFS +#: convert Copy AFS owner mode bits to UNIX group/other mode bits +#: uidcheck Strict UID checking +#: submounts Permit mounts of /afs subdirectories +#: On success, returns an associative array %modes, which is of the same +#: form, indicating which options are enabled. +$AFS_Help{'fs_exportafs'} = '$type, \%options => %modes'; +sub AFS_fs_exportafs { + my($type, $options) = @_; + my(@args, %modes); + + @args = ('exportafs', '-type', $type); + foreach (qw(start convert uidcheck submounts)) { + push(@args, "-$_", $$options{$_} ? 'on' : 'off') if exists($$options{$_}); + } + + &wrapper('fs', \@args, [ + ['translator is disabled', sub { $modes{'start'} = 0 }], + ['translator is enabled', sub { $modes{'start'} = 1 }], + ['strict unix', sub { $modes{'convert'} = 0 }], + ['convert owner', sub { $modes{'convert'} = 1 }], + [q/no 'passwd sync'/, sub { $modes{'uidcheck'} = 0 }], + [q/strict 'passwd sync'/, sub { $modes{'uidcheck'} = 1 }], + ['Only mounts', sub { $modes{'submounts'} = 0 }], + ['Allow mounts', sub { $modes{'submounts'} = 1 }], + ]); + %modes; +} + + +#: AFS_fs_getcacheparms() +#: Returns the size of the cache, and the amount of cache space used. +#: Sizes are returned in 1K blocks. +$AFS_Help{'fs_getcacheparms'} = 'void => ($size, $used)'; +sub AFS_fs_getcacheparms { + my(@args, $size, $used); + + @args = ('getcacheparms'); + &wrapper('fs', \@args, [ + [q/AFS using (\d+) of the cache's available (\d+) 1K byte blocks/, + \$used, \$size], + ]); + ($size, $used); +} + +#: AFS_fs_getcellstatus(\@cells) +#: Get cell control bits for cells listed in @cells. +#: On success, returns a hash mapping cells to their status; keys are +#: cell names, and values are 1 if SUID programs are permitted for that +#: cell, and 0 if not. +$AFS_Help{'fs_getcellstatus'} = '\@cells => %status'; +sub AFS_fs_getcellstatus { + my($cells) = @_; + my(@args, %status); + + @args = ('getcellstatus', '-cell', @$cells); + &wrapper('fs', \@args, [ + ['Cell (.*) status: setuid allowed', sub { $status{$_[0]} = 1 }], + ['Cell (.*) status: no setuid allowed', sub { $status{$_[0]} = 0 }], + ]); + %status; +} + +#: AFS_fs_getclientaddrs +#: Returns a list of the client interface addresses +$AFS_Help{'fs_getclientaddrs'} = 'void => @addrs'; +sub AFS_fs_getclientaddrs { + my(@args, @addrs); + + @args = ('getclientaddrs'); + &wrapper('fs', \@args, [ + ['^(\d+\.\d+\.\d+\.\d+)', \@addrs ] + ]); + @addrs; +} + +#: AFS_fs_getcrypt +#: Returns the cache manager encryption flag +$AFS_Help{'fs_getcrypt'} = 'void => $crypt'; +sub AFS_fs_getcrypt { + my(@args, $crypt); + + @args = ('getcrypt'); + &wrapper('fs', \@args, [ + ['^Security level is currently clear', sub { $crypt = 0 }], + ['^Security level is currently crypt', sub { $crypt = 1 }], + ]); + $crypt; +} + +#: AFS_fs_getserverprefs([$vlservers], [$numeric]) +#: Get fileserver or vlserver preference ranks +#: If $vlservers is specified and nonzero, VLDB server ranks +#: are retrieved; otherwise fileserver ranks are retrieved. +#: If $numeric is specified and nonzero, servers are identified +#: by IP address instead of by hostname. +#: Returns a hash whose keys are server names or IP addresses, and +#: whose values are the ranks of those servers. +$AFS_Help{'fs_getserverprefs'} = '[$vlservers], [$numeric] => %prefs'; +sub AFS_fs_getserverprefs { + my($vlservers, $numeric) = @_; + my(@args, %prefs); + + @args = ('getserverprefs'); + push(@args, '-numeric') if $numeric; + push(@args, '-vlservers') if $vlservers; + &wrapper('fs', \@args, [ + ['^(\S+)\s*(\d+)', \%prefs], + ]); + %prefs; +} + +#: AFS_fs_listcells([$numeric') +#: Get a list of cells known to the cache manager, and the VLDB +#: servers for each cell. +#: If $numeric is specified and nonzero, VLDB servers are identified +#: by IP address instead of by hostname. +#: Returns a hash where each key is a cell name, and each value is +#: a list of VLDB servers for the corresponding cell. +$AFS_Help{'fs_listcells'} = '[$numeric] => %cells'; +sub AFS_fs_listcells { + my($numeric) = @_; + my(@args, %cells); + + @args = ('listcells'); + push(@args, '-numeric') if $numeric; + &wrapper('fs', \@args, [ + ['^Cell (\S+) on hosts (.*)\.', + sub { $cells{$_[0]} = [ split(' ', $_[1]) ] }], + ]); + %cells; +} + +#: AFS_fs_setmonitor($server) +#: Set the cache manager monitor host to $server. +#: If $server is 'off' or undefined, monitoring is disabled. +#: On success, return 1. +$AFS_Help{'fs_setmonitor'} = '$server => Success?'; +sub AFS_fs_setmonitor { + my($server) = @_; + my(@args); + + @args = ('monitor', '-server', defined($server) ? $server : 'off'); + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_getmonitor +#: Return the cache manager monitor host, or undef if monitoring is disabled. +$AFS_Help{'fs_getmonitor'} = 'void => $server'; +sub AFS_fs_getmonitor { + my(@args, $server); + + @args = ('monitor'); + &wrapper('fs', \@args, [ + ['Using host (.*) for monitor services\.', \$server], + ]); + $server; +} + +#: AFS_fs_getsysname +#: Returns the current list of system type names +$AFS_Help{'fs_getsysname'} = 'void => @sys'; +sub AFS_fs_getsysname { + my(@args, @sys); + + @args = ('sysname'); + &wrapper('fs', \@args, [ + [q/Current sysname is '(.*)'/, \@sys], + [q/Current sysname list is '(.*)'/, + sub { push(@sys, split(q/' '/, $_[0])) }], + ]); + @sys; +} + +#: AFS_fs_setsysname(\@sys) +#: Sets the system type list to @sys +#: On success, return 1. +$AFS_Help{'fs_setsysname'} = '$server => Success?'; +sub AFS_fs_setsysname { + my($sys) = @_; + my(@args); + + @args = ('sysname', '-newsys', @$sys); + &wrapper('fs', \@args); + 1; +} + +#: AFS_fs_whichcell(\@paths) +#: Get the cells containing the specified paths +#: Returns a hash in which each key is a pathname, and each value +#: is the name of the cell which contains the corresponding file. +$AFS_Help{'fs_whichcell'} = '\@paths => %where'; +sub AFS_fs_whichcell { + my($paths) = @_; + my(@args, %where); + + @args = ('whichcell', '-path', @$paths); + &wrapper('fs', \@args, [ + [q/^File (.*) lives in cell '(.*)'/, \%where], + ]); + %where; +} + +#: AFS_fs_wscell +#: Returns the name of the workstation's home cell +$AFS_Help{'fs_wscell'} = 'void => $cell'; +sub AFS_fs_wscell { + my(@args, $cell); + + @args = ('wscell'); + &wrapper('fs', \@args, [ + [q/^This workstation belongs to cell '(.*)'/, \$cell], + ]); + $cell; +} + diff --git a/src/tests/OpenAFS/kas.pm b/src/tests/OpenAFS/kas.pm new file mode 100644 index 000000000..376f62a9a --- /dev/null +++ b/src/tests/OpenAFS/kas.pm @@ -0,0 +1,325 @@ +# CMUCS AFStools +# Copyright (c) 1996, Carnegie Mellon University +# All rights reserved. +# +# See CMU_copyright.ph for use and distribution information +# +#: * kas.pm - Wrappers around KAS commands (authentication maintenance) +#: * This module provides wrappers around the various kaserver commands +#: * giving them a nice perl-based interface. At present, this module +#: * requires a special 'krbkas' which uses existing Kerberos tickets +#: * which the caller must have already required (using 'kaslog'). +#: + +package OpenAFS::kas; +use OpenAFS::CMU_copyright; +use OpenAFS::util qw(:DEFAULT :afs_internal); +use OpenAFS::wrapper; +use POSIX (); +use Exporter; + +$VERSION = ''; +$VERSION = '1.00'; +@ISA = qw(Exporter); +@EXPORT = qw(&AFS_kas_create &AFS_kas_setf + &AFS_kas_delete &AFS_kas_setkey + &AFS_kas_examine &AFS_kas_setpw + &AFS_kas_randomkey &AFS_kas_stringtokey + &AFS_kas_list); + +# Instructions to parse kas error messages +@kas_err_parse = ( [ ' : \[.*\] (.*), wait one second$', '.' ], + [ ' : \[.*\] (.*) \(retrying\)$', '.' ], + [ ' : \[.*\] (.*)', '-' ]); + +# Instructions to parse attributes of an entry +@kas_entry_parse = ( + [ '^User data for (.*) \((.*)\)$', 'princ', 'flags', '.' ], + [ '^User data for (.*)', 'princ' ], + [ 'key \((\d+)\) cksum is (\d+),', 'kvno', 'cksum' ], + [ 'last cpw: (.*)', \&parsestamp, 'stamp_cpw' ], + [ 'password will (never) expire', 'stamp_pwexp' ], + [ 'password will expire: ([^\.]*)', \&parsestamp, 'stamp_pwexp' ], + [ 'An (unlimited) number of', 'max_badauth' ], + [ '(\d+) consecutive unsuccessful', 'max_badauth' ], + [ 'for this user is ([\d\.]+) minutes', 'locktime' ], + [ 'for this user is (not limited)', 'locktime' ], + [ 'User is locked (forever)', 'locked' ], + [ 'User is locked until (.*)', \&parsestamp, 'locked' ], + [ 'entry (never) expires', 'stamp_expire' ], + [ 'entry expires on ([^\.]*)\.', \&parsestamp, 'stamp_expire' ], + [ 'Max ticket lifetime (.*) hours', 'maxlife' ], + [ 'Last mod on (.*) by', \&parsestamp, 'stamp_update' ], + [ 'Last mod on .* by (.*)', 'last_writer' ]); + + +@Months = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', + 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); +%Months = map(($Months[$_] => $_), 0..11); + +# Parse a timestamp +sub parsestamp { + my($stamp) = @_; + my($MM, $DD, $YYYY, $hh, $mm, $ss); + + if ($stamp =~ /^\S+ (\S+) (\d+) (\d+):(\d+):(\d+) (\d+)/) { + ($MM, $DD, $hh, $mm, $ss, $YYYY) = ($1, $2, $3, $4, $5, $6); + $YYYY -= 1900; + $MM = $Months{$MM}; + if (defined($MM)) { + $stamp = POSIX::mktime($ss, $mm, $hh, $DD, $MM, $YYYY); + } + } + $stamp; +} + + +# Turn an 8-byte key into a string we can give to kas +sub stringize_key { + my($key) = @_; + my(@chars) = unpack('CCCCCCCC', $key); + + sprintf("\\%03o" x 8, @chars); +} + + +# Turn a string into an 8-byte DES key +sub unstringize_key { + my($string) = @_; + my($char, $key); + + while ($string ne '') { + if ($string =~ /^\\(\d\d\d)/) { + $char = $1; + $string = $'; + $key .= chr(oct($char)); + } else { + $key .= substr($string, 0, 1); + $string =~ s/^.//; + } + } + $key; +} + + +#: AFS_kas_create($princ, $initpass, [$cell]) +#: Create a principal with name $princ, and initial password $initpass +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{kas_create} = '$princ, $initpass, [$cell] => Success?'; +sub AFS_kas_create { + my($print, $initpass, $cell) = @_; + my(@args, $id); + + @args = ('create', '-name', $princ, '-initial_password', $initpass); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('krbkas', \@args, [ @kas_err_parse ]); + 1; +} + + +#: AFS_kas_delete($princ, [$cell]) +#: Delete the principal $princ. +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{kas_delete} = '$princ, [$cell] => Success?'; +sub AFS_kas_delete { + my($princ, $cell) = @_; + my(@args); + + @args = ('delete', '-name', $princ); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('krbkas', \@args, [ @kas_err_parse ]); + 1; +} + + +#: AFS_kas_examine($princ, [$cell]) +#: Examine the prinicpal $princ, and return information about it. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return an associative array with some or all of the following: +#: - princ Name of this principal +#: - kvno Key version number +#: - cksum Key checksum +#: - maxlife Maximum ticket lifetime (in hours) +#: - stamp_expire Time this principal expires, or 'never' +#: - stamp_pwexp Time this principal's password expires, or 'never' +#: - stamp_cpw Time this principal's password was last changed +#: - stamp_update Time this princiapl was last modified +#: - last_writer Administrator who last modified this principal +#: - max_badauth Maximum number of bad auth attempts, or 'unlimited' +#: - locktime Penalty time for bad auth (in minutes), or 'not limited' +#: - locked Set and non-empty if account is locked +#: - expired Set and non-empty if account is expired +#: - flags Reference to a list of flags +#: +$AFS_Help{kas_examine} = '$princ, [$cell] => %info'; +sub AFS_kas_examine { + my($vol, $cell) = @_; + my(%result, @args, $flags); + + @args = ('examine', '-name', $princ); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + %result = &wrapper('krbkas', \@args, [ @kas_err_parse, @kas_entry_parse ]); + + if ($result{flags}) { + $result{expired} = 1 if ($result{flags} =~ /expired/); + $result{flags} = [ split(/\+/, $result{flags}) ]; + } + %result; +} + + +#: AFS_kas_list([$cell]) +#: Get a list of principals in the kaserver database +#: If specified, work in $cell instead of the default cell. +#: On success, return an associative array whose keys are names of kaserver +#: principals, and each of whose values is an associative array describing +#: the corresponding principal, containing some or all of the same elements +#: that may be returned by AFS_kas_examine +#: +$AFS_Help{kas_list} = '[$cell] => %princs'; +sub AFS_kas_list { + my($cell) = @_; + my(@args, %finres, %plist); + + @args = ('list', '-long'); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + %finres = &wrapper('krbkas', \@args, + [ @kas_err_parse, + [ '^User data for (.*)', sub { + my(%pinfo) = %OpenAFS::wrapper::result; + + if ($pinfo{name}) { + $plist{$pinfo{name}} = \%pinfo; + %OpenAFS::wrapper::result = (); + } + }], + @kas_entry_parse ]); + + if ($finres{name}) { + $plist{$finres{name}} = \%finres; + } + %plist; +} + + +#: AFS_kas_setf($princ, \%attrs, [$cell]) +#: Change the attributes of the principal $princ. +#: If specified, operate in cell $cell instead of the default cell. +#: The associative array %attrs specifies the attributes to change and +#: their new values. Any of the following attributes may be changed: +#: - flags Entry flags +#: - expire Expiration time (mm/dd/yy) +#: - lifetime Maximum ticket lifetime (seconds) +#: - pwexpires Maximum password lifetime (days) +#: - reuse Permit password reuse (yes/no) +#: - attempts Maximum failed authentication attempts +#: - locktime Authentication failure penalty (minutes or hh:mm) +#: +#: On success, return 1. +#: +$AFS_Help{kas_setf} = '$princ, \%attrs, [$cell] => Success?'; +sub AFS_kas_setf { + my($princ, $attrs, $cell) = @_; + my(%result, @args); + + @args = ('setfields', '-name', $princ); + push(@args, '-flags', $$attrs{flags}) if ($$attrs{flags}); + push(@args, '-expiration', $$attrs{expire}) if ($$attrs{expire}); + push(@args, '-lifetime', $$attrs{lifetime}) if ($$attrs{lifetime}); + push(@args, '-pwexpires', $$attrs{pwexpires}) if ($$attrs{pwexpires}); + push(@args, '-reuse', $$attrs{reuse}) if ($$attrs{reuse}); + push(@args, '-attempts', $$attrs{attempts}) if ($$attrs{attempts}); + push(@args, '-locktime', $$attrs{locktime}) if ($$attrs{locktime}); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('krbkas', \@args, [ @kas_err_parse ]); + 1; +} + + +#: AFS_kas_setkey($princ, $key, [$kvno], [$cell]) +#: Change the key of principal $princ to the specified value. +#: $key is the 8-byte DES key to use for this principal. +#: If specified, set the key version number to $kvno. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{kas_setkey} = '$princ, $key, [$kvno], [$cell] => Success?'; +sub AFS_kas_setkey { + my($princ, $key, $kvno, $cell) = @_; + my(@args); + + @args = ('setkey', '-name', $princ, '-new_key', &stringize_key($key)); + push(@args, '-kvno', $kvno) if (defined($kvno)); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('krbkas', \@args, [ @kas_err_parse ]); + 1; +} + + +#: AFS_kas_setpw($princ, $password, [$kvno], [$cell]) +#: Change the key of principal $princ to the specified value. +#: $password is the new password to use. +#: If specified, set the key version number to $kvno. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{kas_setpw} = '$princ, $password, [$kvno], [$cell] => Success?'; +sub AFS_kas_setpw { + my($princ, $password, $kvno, $cell) = @_; + my(@args); + + @args = ('setpasswd', '-name', $princ, '-new_password', $password); + push(@args, '-kvno', $kvno) if (defined($kvno)); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('krbkas', \@args, [ @kas_err_parse ]); + 1; +} + + +#: AFS_kas_stringtokey($string, [$cell]) +#: Convert the specified string to a DES key +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return the resulting key +$AFS_Help{kas_stringtokey} = '$string, [$cell] => $key'; +sub AFS_kas_stringtokey { + my($string, $cell) = @_; + my(@args, $key); + + @args = ('stringtokey', '-string', $string); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('krbkas', \@args, + [ @kas_err_parse, + [ q/^Converting .* in realm .* yields key='(.*)'.$/, \$key ]]); + &unstringize_key($key); +} + + +#: AFS_kas_randomkey([$cell]) +#: Ask the kaserver to generate a random DES key +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return the resulting key +$AFS_Help{kas_randomkey} = '[$cell] => $key'; +sub AFS_kas_randomkey { + my($cell) = @_; + my(@args, $key); + + @args = ('getrandomkey'); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('krbkas', \@args, + [ @kas_err_parse, + [ '^Key: (\S+)', \$key ]]); + &unstringize_key($key); +} + +1; diff --git a/src/tests/OpenAFS/pts.pm b/src/tests/OpenAFS/pts.pm new file mode 100644 index 000000000..715b5e1dd --- /dev/null +++ b/src/tests/OpenAFS/pts.pm @@ -0,0 +1,306 @@ +# CMUCS AFStools +# Copyright (c) 1996, Carnegie Mellon University +# All rights reserved. +# +# See CMU_copyright.ph for use and distribution information +# +#: * pts.pm - Wrappers around PTS commands (user/group maintenance) +#: * This module provides wrappers around the various PTS commands, giving +#: * them a nice perl-based interface. Someday, they might talk to the +#: * ptserver directly instead of using 'pts', but not anytime soon. +#: + +package OpenAFS::pts; +use OpenAFS::CMU_copyright; +use OpenAFS::util qw(:DEFAULT :afs_internal); +use OpenAFS::wrapper; +use Exporter; + +$VERSION = ''; +$VERSION = '1.00'; +@ISA = qw(Exporter); +@EXPORT = qw(&AFS_pts_createuser &AFS_pts_listmax + &AFS_pts_creategroup &AFS_pts_setmax + &AFS_pts_delete &AFS_pts_add + &AFS_pts_rename &AFS_pts_remove + &AFS_pts_examine &AFS_pts_members + &AFS_pts_chown &AFS_pts_listown + &AFS_pts_setf); + + +#: AFS_pts_createuser($user, [$id], [$cell]) +#: Create a PTS user with $user as its name. +#: If specified, use $id as the PTS id; otherwise, AFS picks one. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return the PTS id of the newly-created user. +#: +$AFS_Help{pts_createuser} = '$user, [$id], [$cell] => $uid'; +sub AFS_pts_createuser { + my($user, $id, $cell) = @_; + my(@args, $uid); + + @args = ('createuser', '-name', $user); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + push(@args, '-id', $id) if ($id); + &wrapper('pts', \@args, [[ '^User .* has id (\d+)', \$uid ]]); + $uid; +} + + +#: AFS_pts_creategroup($group, [$id], [$owner], [$cell]) +#: Create a PTS group with $group as its name. +#: If specified, use $id as the PTS id; otherwise, AFS picks one. +#: If specified, use $owner as the owner, instead of the current user. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return the PTS id of the newly-created group. +#: +$AFS_Help{pts_creategroup} = '$group, [$id], [$owner], [$cell] => $gid'; +sub AFS_pts_creategroup { + my($group, $id, $owner, $cell) = @_; + my(@args, $uid); + + @args = ('creategroup', '-name', $group); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + push(@args, '-id', $id) if ($id); + push(@args, '-owner', $owner) if ($owner); + &wrapper('pts', \@args, [[ '^group .* has id (\-\d+)', \$uid ]]); + $uid; +} + + +#: AFS_pts_delete(\@objs, [$cell]) +#: Attempt to destroy PTS objects listed in @objs. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return 1. +#: If multiple objects are specified and only some are destroyed, some +#: operations may be left untried. +#: +$AFS_Help{pts_delete} = '\@objs, [$cell] => Success?'; +sub AFS_pts_delete { + my($objs, $cell) = @_; + my(@args); + + @args = ('delete', '-nameorid', @$objs); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('pts', \@args); + 1; +} + + +#: AFS_pts_rename($old, $new, [$cell]) +#: Rename the PTS object $old to have the name $new. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{pts_rename} = '$old, $new, [$cell] => Success?'; +sub AFS_pts_rename { + my($old, $new, $cell) = @_; + my(@args); + + @args = ('rename', '-oldname', $old, '-newname', $new); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('pts', \@args); + 1; +} + + +#: AFS_pts_examine($obj, [$cell]) +#: Examine the PTS object $obj, and return information about it. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return an associative array with some or all of the following: +#: - name Name of this object +#: - id ID of this object +#: - owner Name or ID of owner +#: - creator Name or ID of creator +#: - mem_count Number of members (group) or memberships (user) +#: - flags Privacy/access flags (as a string) +#: - group_quota Remaining group quota +#: +$AFS_Help{pts_examine} = '$obj, [$cell] => %info'; +sub AFS_pts_examine { + my($obj, $cell) = @_; + my(@args); + + @args = ('examine', '-nameorid', $obj); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('pts', \@args, + [[ '^Name\: (.*)\, id\: ([\-0-9]+)\, owner\: (.*)\, creator\: (.*)\,$', #', + 'name', 'id', 'owner', 'creator' ], + [ '^ membership\: (\d+)\, flags\: (.....)\, group quota\: (\d+)\.$', #', + 'mem_count', 'flags', 'group_quota' ] + ]); +} + + +#: AFS_pts_chown($obj, $owner, [$cell]) +#: Change the owner of the PTS object $obj to be $owner. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{pts_chown} = '$obj, $owner, [$cell] => Success?'; +sub AFS_pts_chown { + my($obj, $owner, $cell) = @_; + my(@args); + + @args = ('chown', '-name', $obj, '-owner', $owner); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('pts', \@args); + 1; +} + + +#: AFS_pts_setf($obj, [$access], [$gquota], [$cell]) +#: Change the access flags and/or group quota for the PTS object $obj. +#: If specified, $access specifies the new access flags in the standard 'SOMAR' +#: format; individual flags may be specified as '.' to keep the current value. +#: If specified, $gquota specifies the new group quota. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{pts_setf} = '$obj, [$access], [$gquota], [$cell] => Success?'; +sub AFS_pts_setf { + my($obj, $access, $gquota, $cell) = @_; + my(%result, @args); + + @args = ('setfields', '-nameorid', $obj); + push(@args, '-groupquota', $gquota) if ($gquota ne ''); + if ($access) { + my(@old, @new, $i); + # Ensure access is 5 characters + if (length($access) < 5) { + $access .= ('.' x (5 - length($access))); + } elsif (length($access) > 5) { + substr($access, 5) = ''; + } + + %result = &AFS_pts_examine($obj, $cell); + + @old = split(//, $result{'flags'}); + @new = split(//, $access); + foreach $i (0 .. 4) { + $new[$i] = $old[$i] if ($new[$i] eq '.'); + } + $access = join('', @new); + if ($access ne $result{'flags'}) { + push(@args, '-access', $access); + } + } + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('pts', \@args); + 1; +} + + +#: AFS_pts_listmax([$cell]) +#: Fetch the maximum assigned group and user ID. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, returns (maxuid, maxgid) +#: +$AFS_Help{pts_listmax} = '[$cell] => ($maxuid, $maxgid)'; +sub AFS_pts_listmax { + my($cell) = @_; + my(@args, $uid, $gid); + + @args = ('listmax'); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('pts', \@args, + [[ '^Max user id is (\d+) and max group id is (\-\d+).', + \$uid, \$gid ]]); + ($uid, $gid); +} + + +#: AFS_pts_setmax([$maxuser], [$maxgroup], [$cell]) +#: Set the maximum assigned group and/or user ID. +#: If specified, $maxuser is the new maximum user ID +#: If specified, $maxgroup is the new maximum group ID +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{pts_setmax} = '[$maxuser], [$maxgroup], [$cell] => Success?'; +sub AFS_pts_setmax { + my($maxuser, $maxgroup, $cell) = @_; + my(@args); + + @args = ('setmax'); + push(@args, '-group', $maxgroup) if ($maxgroup); + push(@args, '-user', $maxuser) if ($maxuser); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('pts', \@args); + 1; +} + +#: AFS_pts_add(\@users, \@groups, [$cell]) +#: Add users specified in @users to groups specified in @groups. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return 1. +#: If multiple users and/or groups are specified and only some memberships +#: are added, some operations may be left untried. +#: +$AFS_Help{pts_add} = '\@users, \@groups, [$cell] => Success?'; +sub AFS_pts_add { + my($users, $groups, $cell) = @_; + my(@args); + + @args = ('adduser', '-user', @$users, '-group', @$groups); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('pts', \@args); + 1; +} + + +#: AFS_pts_remove(\@users, \@groups, [$cell]) +#: Remove users specified in @users from groups specified in @groups. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return 1. +#: If multiple users and/or groups are specified and only some memberships +#: are removed, some operations may be left untried. +#: +$AFS_Help{pts_remove} = '\@users, \@groups, [$cell] => Success?'; +sub AFS_pts_remove { + my($users, $groups, $cell) = @_; + my(@args); + + @args = ('removeuser', '-user', @$users, '-group', @$groups); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('pts', \@args); + 1; +} + + +#: AFS_pts_members($obj, [$cell]) +#: If $obj specifies a group, retrieve a list of its members. +#: If $obj specifies a user, retrieve a list of groups to which it belongs. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return the resulting list. +#: +$AFS_Help{pts_members} = '$obj, [$cell] => @members'; +sub AFS_pts_members { + my($obj, $cell) = @_; + my(@args, @grouplist); + + @args = ('membership', '-nameorid', $obj); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('pts', \@args, [[ '^ (.*)', \@grouplist ]]); + @grouplist; +} + + +#: AFS_pts_listown($owner, [$cell]) +#: Retrieve a list of PTS groups owned by the PTS object $obj. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return the resulting list. +#: +$AFS_Help{pts_listown} = '$owner, [$cell] => @owned'; +sub AFS_pts_listown { + my($owner, $cell) = @_; + my(@args, @grouplist); + + @args = ('listowned', '-nameorid', $owner); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('pts', \@args, [[ '^ (.*)', \@grouplist ]]); + @grouplist; +} + + +1; diff --git a/src/tests/OpenAFS/util.pm b/src/tests/OpenAFS/util.pm new file mode 100644 index 000000000..ec1c52af6 --- /dev/null +++ b/src/tests/OpenAFS/util.pm @@ -0,0 +1,356 @@ +# CMUCS AFStools +# Copyright (c) 1996, Carnegie Mellon University +# All rights reserved. +# +# See CMUCS/CMU_copyright.ph for use and distribution information + +package OpenAFS::util; + +=head1 NAME + +OpenAFS::util - General AFS utilities + +=head1 SYNOPSIS + + use OpenAFS::util; + + AFS_Init(); + AFS_Trace($subject, $level); + AFS_SetParm($parm, $value); + + use OpenAFS::util qw(GetOpts_AFS); + %options = GetOpts_AFS(\@argv, \@optlist); + +=head1 DESCRIPTION + +This module defines a variety of AFS-related utility functions. Virtually +every application that uses AFStools will need to use some of the utilities +defined in this module. In addition, a variety of global variables are +defined here for use by all the AFStools modules. Most of these are +private, but a few are semi-public. + +=cut + +use OpenAFS::CMU_copyright; +use OpenAFS::config; +require OpenAFS::afsconf; ## Avoid circular 'use' dependencies +use Exporter; + +$VERSION = ''; +$VERSION = '1.00'; +@ISA = qw(Exporter); +@EXPORT = qw(&AFS_Init + &AFS_Trace + &AFS_SetParm); +@EXPORT_OK = qw(%AFS_Parms + %AFS_Trace + %AFS_Help + %AFScmd + &GetOpts_AFS + &GetOpts_AFS_Help); +%EXPORT_TAGS = (afs_internal => [qw(%AFS_Parms %AFS_Trace %AFScmd %AFS_Help)], + afs_getopts => [qw(&GetOpts_AFS &GetOpts_AFS_Help)] ); + + +=head2 AFS_Init() + +This function does basic initialization of AFStools. It must be called before +any other AFStools function. + +=cut + +sub AFS_Init +{ + my(@dirs, $c, $i, $x); + + $AFS_Parms{'authlvl'} = 1; + $AFS_Parms{'confdir'} = $def_ConfDir; + $AFS_Parms{'cell'} = OpenAFS::afsconf::AFS_conf_localcell(); + + # Search for AFS commands + @dirs = @CmdPath; + foreach $c (@CmdList) + { + $AFScmd{$c} = ''; + foreach $i ($[ .. $#dirs) + { + $x = $dirs[$i]; + if (-x "$x/$c" && ! -d "$x/$c") + { + $AFScmd{$c} = "$x/$c"; + splice(@dirs, $i, 1); # Move this item to the start of the array + unshift(@dirs, $x); + last; + } + } + return "Unable to locate $c!" if (!$AFScmd{$c}); + } + 0; +} + + +=head2 AFS_Trace($subject, $level) + +Sets the tracing level for a particular "subject" to the specified level. +All tracing levels start at 0, and can be set to higher values to get debugging +information from different parts of AFStools. This function is generally +only of use to people debugging or extending AFStools. + +=cut + +$AFS_Help{Trace} = '$subject, $level => void'; +sub AFS_Trace { + my($subject, $level) = @_; + + $AFS_Trace{$subject} = $level; +} + + +=head2 AFS_SetParm($parm, $value) + +Sets the AFStools parameter I<$parm> to I<$value>. AFStools parameters are +used to alter the behaviour of various parts of the system. The following +parameters are currently defined: + +=over 10 + +=item authlvl + +The authentication level to use for commands that talk directly to AFS +servers (bos, vos, pts, etc.). Set to 0 for unauthenticated access (-noauth), +1 to use the user's existing tokens, or 2 to use the AFS service key +(-localauth). + +=item cell + +The default AFS cell in which to work. This is initially the workstation's +local cell. + +=item confdir + +The AFS configuration directory to use. If none is specified, the default +(as defined in OpenAFS::config) will be used. + +=item vostrace + +Set the tracing level used by various B utilities. The default is 0, +which disables any tracing of activity of B commands. A setting of 1 +copies output from all commands except those which are invoked solely to +get information; a setting of 2 additionally uses the "-verbose" command +on any command whose output is copied. If a setting of 3 is used, all +B commands will be invoked with "-verbose", and have their output +copied to stdout. + +=back + +=cut + +$AFS_Help{SetParm} = '$parm, $value => void'; +sub AFS_SetParm { + my($parm, $value) = @_; + + $AFS_Parms{$parm} = $value; +} + + +#: GetOpts_AFS(\@argv, \@optlist) +#: Parse AFS-style options. +#: \@argv is a hard reference to the list of arguments to be parsed. +#: \@optlist is a hard reference to the list of option specifications for valid +#: options; in their default order. Each option specification, in turn, is a +#: hard reference to an associative array containing some of the following +#: elements: +#: name => The name of the argument +#: numargs => Number of arguments (0, 1, or -1 for multiple) +#: required => If nonzero, this argument is required +#: default => Value to give this option if not specified +#: noauto => Don't use this option for unadorned arguments +#: +#: Results are returned in the form of an associative array of options and +#: their values: +#: - Boolean (0-argument) options have a value of 1 if specified. This type +#: of option may not be marked 'required'. +#: - Simple (1-argument) options have a value which is the string given by the +#: user. +#: - Multiple-argument options have a value which is a hard reference to an +#: array of values given by the user. +#: +#: Argument parsing is done in a similar manner to the argument parser used by +#: various AFS utilities. Options have multi-character names, and may not be +#: combined with their arguments or other options. Those options which take +#: arguments use up at least the next argument, regardless of whether it begins +#: with a dash. Options which can take multiple arguments will eat at least +#: one argument, as well as any following argument up to the next option (i.e., +#: the next argument beginning with a dash). An "unadorned" argument will be +#: used by the next argument-taking option. If there are multiple unadorned +#: arguments, they will be used up by successive arguments much in the same +#: way Perl handles list assignment - each one-argument (scalar) option will +#: use one argument; the first multi-argument (list) option will use up any +#: remaining unadorned arguments. +#: +#: On completion, @argv will be left with any unparsed arguments (this can +#: happen if the last option specified is _not_ a multi-argument option, and +#: there are no "defaulted" options). This is considered to be an error +#: condition. +#: +sub GetOpts_AFS_Help { + my($cmd, $optlist) = @_; + my($option, $optname, $desc); + + foreach $option (@$optlist) { + $optname = '-' . $$option{name}; + if ($$option{numargs}) { + $desc = $$option{desc} ? $$option{desc} : $$option{name}; + $desc = " <$desc>"; + $desc .= '+' if ($$option{numargs} < 0); + $optname .= $desc; + } + $optname = "[$optname]" if (!$$option{required}); + $cmd .= " $optname"; + } + $cmd; +} + +sub _which_opt { + my($optname, @options) = @_; + my($o, $which, $n); + + foreach $o (@options) { + next unless ($o =~ /^$optname/); + $n++; + $which = $o; + } + ($n == 1) ? $which : $optname; +} + +sub GetOpts_AFS { + my($argv, $optlist) = @_; + my(@autolist, %opttbl, %result); + my($stop, $key, $value, $diemsg); + + # Initialization: + @autolist = map { + if ($_->{numargs} && !$_->{noauto} && !$stop) { + $stop = 1 if ($_->{numargs} < 0); + ($_->{name}); + } else { + (); + } + } (@$optlist, { name=>'-help', numargs=>0, required=>0 } ); + %opttbl = map { $_->{name} => $_ } @$optlist; + + while (@$argv) { + my($optname, $optkind); + + # Parse the next argument. It can either be an option, or an + # unadorned argument. If the former, shift it off and process it. + # Otherwise, grab the next "automatic" option. If there are no + # more automatic options, we have extra arguments and should return. + if ($argv->[0] =~ /^-(.+)/) { # Got an option! + $optname = $1; + shift(@$argv); + } else { # An unadorned argument + if (@autolist) { + $optname = shift(@autolist); + } else { + $diemsg = join(' ', "Extra arguments:", @$argv) unless ($diemsg); + shift @$argv; + next; + } + } + $optname = &_which_opt($optname, keys %opttbl); + + # Find out how many arguments this thing wants, then remove it from + # the option table and automatic option list. + $optkind = $opttbl{$optname}->{numargs}; + delete $opttbl{$optname}; + @autolist = grep($_ ne $optname, @autolist); + + # Parse arguments (if any), and set the result value + if (!$optkind) { # Boolean! + $result{$optname} = 1; + } elsif ($optkind == 1) { # Single argument + # Shift off a single argument, or signal an error + if (!@$argv) { + $diemsg = "No argument for -$optname" unless ($diemsg); + next; + } + $result{$optname} = shift(@$argv); + } elsif ($optkind < 0) { # Multiple arguments + # Shift off at least one argument, and any additional + # ones that are present. EXCEPT, if there are no more + # explicitly-specified options but there ARE automatic + # options left in our list, then only eat up one. + my($val, @val); + if (!@$argv) { + $diemsg = "No argument for -$optname" unless ($diemsg); + next; + } + $val = shift(@$argv); + push(@val, shift @$argv) while (@$argv && $argv->[0] !~ /^-/); + if (@autolist && !@$argv) { + unshift(@$argv, @val); + @val = ($val); + } else { + unshift(@val, $val); + } + $result{$optname} = [@val]; + } else { + die "Invalid argument spec for -$optname ($optkind)\n"; + } + } + + # Now for a little clean-up + # Set default values for any unspecified option that has them. + # Set an error condition if there are any required options that + # were not specified. + while (($key, $value) = each %opttbl) { + if ($value->{required}) { + $diemsg = "Required option -$key not specified" unless($diemsg); + } + $result{$key} = $value->{default}; + } + if ($diemsg && !$result{help}) { die $diemsg . "\n" } + %result; +} + + +1; + +=head1 VARIABLES + +The following global variables are defined by B. None of these +are exported by default. Those marked "Private" should not be used outside +AFStools; their names, meaning, and even existence may change at any time. + +=over 12 + +=item %AFS_Help - Help info + +This array contains argument lists for all publicly-exported AFStools +functions with names of the form AFS_*. It is intended for programs like +B, which provide a direct interactive interface to AFStools. + +=item %AFS_Parms - Parameter settings [Private] + +This array contains the settings of AFStools parameters set with +B. + +=item %AFS_Trace - Tracing levels [Private] + +This array contains the tracing levels set with B. + +=item %AFScmd - AFS command locations [Private] + +This array contains paths to the various AFS command binaries, for use +by B and possibly other AFStools functions. + +=back + +=head1 COPYRIGHT + +The CMUCS AFStools, including this module are +Copyright (c) 1996, Carnegie Mellon University. All rights reserved. +For use and redistribution information, see CMUCS/CMU_copyright.pm + +=cut diff --git a/src/tests/OpenAFS/vos.pm b/src/tests/OpenAFS/vos.pm new file mode 100644 index 000000000..3f1ae6a6e --- /dev/null +++ b/src/tests/OpenAFS/vos.pm @@ -0,0 +1,803 @@ +# CMUCS AFStools +# Copyright (c) 1996, Carnegie Mellon University +# All rights reserved. +# +# See CMU_copyright.ph for use and distribution information +# +#: * vos.pm - Wrappers around VOS commands (volume maintenance) +#: * This module provides wrappers around the various volserver and VLDB +#: * commands, giving them a nice perl-based interface. Someday, they might +#: * talk to the servers directly instead of using 'vos', but not anytime +#: * soon. +#: + +package OpenAFS::vos; +use OpenAFS::CMU_copyright; +use OpenAFS::util qw(:DEFAULT :afs_internal); +use OpenAFS::wrapper; +use Exporter; + +$VERSION = ''; +$VERSION = '1.00'; +@ISA = qw(Exporter); +@EXPORT = qw(&AFS_vos_create &AFS_vos_listvldb + &AFS_vos_remove &AFS_vos_delentry + &AFS_vos_rename &AFS_vos_syncserv + &AFS_vos_move &AFS_vos_syncvldb + &AFS_vos_examine &AFS_vos_lock + &AFS_vos_addsite &AFS_vos_unlock + &AFS_vos_remsite &AFS_vos_unlockvldb + &AFS_vos_release &AFS_vos_changeaddr + &AFS_vos_backup &AFS_vos_listpart + &AFS_vos_backupsys &AFS_vos_partinfo + &AFS_vos_dump &AFS_vos_listvol + &AFS_vos_restore &AFS_vos_zap + &AFS_vos_status); + +$vos_err_parse = [ 'Error in vos (.*) command', '-(.*)' ]; + + +#: AFS_vos_create($vol, $server, $part, [$quota], [$cell]) +#: Create a volume with name $vol +#: The server name ($server) may be a hostname or IP address +#: The partition may be a partition name (/vicepx), letter (x), or number (24) +#: If specified, use $quota for the initial quota instead of 5000 blocks. +#: If specified, work in $cell instead of the default cell. +#: On success, return the volume ID. +#: +$AFS_Help{vos_create} = '$vol, $server, $part, [$quota], [$cell] => $volid'; +sub AFS_vos_create { + my($vol, $server, $part, $quota, $cell) = @_; + my(@args, $id); + + @args = ('create', '-name', $vol, '-server', $server, '-part', $part); + push(@args, '-maxquota', $quota) if ($quota ne ''); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + ['^Volume (\d+) created on partition \/vicep\S+ of \S+', \$id ], + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + $id; +} + + +#: AFS_vos_remove($vol, $server, $part, [$cell]) +#: Remove the volume $vol from the server and partition specified by $server and +#: $part. If appropriate, also remove the corresponding VLDB entry. +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_remove} = '$vol, $server, $part, [$cell] => Success?'; +sub AFS_vos_remove { + my($vol, $server, $part, $cell) = @_; + my(@args); + + @args = ('remove', '-id', $vol, '-server', $server, '-part', $part); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_rename($old, $new, [$cell]) +#: Rename the volume $old to have the name $new. +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_rename} = '$old, $new, [$cell] => Success?'; +sub AFS_vos_rename { + my($old, $new, $cell) = @_; + my(@args); + + @args = ('rename', '-oldname', $old, '-newname', $new); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_move($vol, $fromsrv, $frompart, $tosrv, $topart, [$cell]) +#: Move the volume specified by $vol. +#: The source location is specified by $fromsrv and $frompart. +#: The destination location is specified by $tosrv and $topart. +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. + +#: +$AFS_Help{vos_move} = '$vol, $fromsrv, $frompart, $tosrv, $topart, [$cell] => Success?'; +sub AFS_vos_move { + my($vol, $fromsrv, $frompart, $tosrv, $topart, $cell) = @_; + my(@args); + + @args = ('move', '-id', $vol, + '-fromserver', $fromsrv, '-frompartition', $frompart, + '-toserver', $tosrv, '-topartition', $topart); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_examine($vol, [$cell]) +#: Examine the volume $vol, and return information about it. +#: If specified, operate in cell $cell instead of the default cell. +#: On success, return an associative array with some or all of the following: +#: - name Name of this volume +#: - id ID of this volume +#: - kind Kind of volume (RW, RO, or BK) +#: - inuse Disk space in use +#: - maxquota Maximum disk usage quota +#: - minquota Minimum disk usage quota (optional) +#: - stamp_create Time when volume was originally created +#: - stamp_update Time volume was last modified +#: - stamp_backup Time backup volume was cloned, or 'Never' +#: - stamp_copy Time this copy of volume was made +#: - backup_flag State of automatic backups: empty or 'disabled' +#: - dayuse Number of accesses in the past day +#: - rwid ID of read-write volume (even if this is RO or BK) +#: - roid ID of read-only volume (even if this is RW or BK) +#: - bkid ID of backup volume (even if this is RW or RO) +#: - rwserv Name of server where read/write volume is +#: - rwpart Name of partition where read/write volume is +#: - rosites Reference to a list of read-only sites. Each site, in turn, +#: is a reference to a two-element list (server, part). +#: +$AFS_Help{vos_examine} = '$vol, [$cell] => %info'; +sub AFS_vos_examine { + my($vol, $cell) = @_; + my(%result, @args, @rosites); + + @args = ('examine', '-id', $vol); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + %result = &wrapper('vos', \@args, + [$vos_err_parse, + ['^(\S+)\s*(\d+)\s*(RW|RO|BK)\s*(\d+)\s*K', 'name', 'id', 'kind', 'inuse'], + ['MaxQuota\s*(\d+)\s*K', 'maxquota' ], + ['MinQuota\s*(\d+)\s*K', 'minquota' ], + ['Creation\s*(.*\S+)', 'stamp_create' ], + ['Last Update\s*(.*\S+)', 'stamp_update' ], + ['Backup\s+([^\d\s].*\S+)', 'stamp_backup' ], + ['Copy\s*(.*\S+)', 'stamp_copy' ], + ['Automatic backups are (disabled) for this volume', 'backup_flag' ], + ['(\d+) accesses in the past day', 'dayuse' ], + ['RWrite\:\s*(\d+)', 'rwid' ], + ['ROnly\:\s*(\d+)', 'roid' ], + ['Backup\:\s*(\d+)', 'bkid' ], + ['server (\S+) partition /vicep(\S+) RW Site', 'rwserv', 'rwpart'], + ['server (\S+) partition /vicep(\S+) RO Site', sub { + push(@rosites, [$_[0], $_[1]]); + }], + ($AFS_Parms{'vostrace'} > 2) ? ([ '', '?']) : () ]); + + $result{'rosites'} = \@rosites if (@rosites); + %result; +} + + + +#: AFS_vos_addsite($vol, $server, $part, [$cell]) +#: Add a replication site for volume $vol +#: The server name ($server) may be a hostname or IP address +#: The partition may be a partition name (/vicepx), letter (x), or number (24) +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_addsite} = '$vol, $server, $part, [$cell] => Success?'; +sub AFS_vos_addsite { + my($vol, $server, $part, $cell) = @_; + my(@args); + + @args = ('addsite', '-id', $vol, '-server', $server, '-part', $part); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_remsite($vol, $server, $part, [$cell]) +#: Remove a replication site for volume $vol +#: The server name ($server) may be a hostname or IP address +#: The partition may be a partition name (/vicepx), letter (x), or number (24) +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_remsite} = '$vol, $server, $part, [$cell] => Success?'; +sub AFS_vos_remsite { + my($vol, $server, $part, $cell) = @_; + my(@args); + + @args = ('remsite', '-id', $vol, '-server', $server, '-part', $part); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_release($vol, [$cell], [$force]) +#: Release the volume $vol. +#: If $force is specified and non-zero, use the "-f" switch. +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_release} = '$vol, [$cell], [$force] => Success?'; +sub AFS_vos_release { + my($vol, $cell, $force) = @_; + my(@args); + + @args = ('release', '-id', $vol); + push(@args, '-f') if ($force); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_backup($vol, [$cell]) +#: Make a backup of the volume $vol. +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_backup} = '$vol, [$cell] => Success?'; +sub AFS_vos_backup { + my($vol, $cell) = @_; + my(@args); + + @args = ('backup', '-id', $vol); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_backupsys([$prefix], [$server, [$part]], [$exclude], [$cell]) +#: Do en masse backups of AFS volumes. +#: If specified, match only volumes whose names begin with $prefix +#: If specified, limit work to the $server and, if given, $part. +#: If $exclude is specified and non-zero, backup only volumes NOT matched. +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_backupsys} = '[$prefix], [$server, [$part]], [$exclude], [$cell] => Success?'; +sub AFS_vos_backupsys { + my($prefix, $server, $part, $exclude, $cell) = @_; + my(@args); + + @args = ('backupsys'); + push(@args, '-prefix', $prefix) if ($prefix); + push(@args, '-server', $server) if ($server); + push(@args, '-partition', $part) if ($server && $part); + push(@args, '-exclude') if ($exclude); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_dump($vol, [$time], [$file], [$cell]) +#: Dump the volume $vol +#: If specified, do an incremental dump since $time instead of a full dump. +#: If specified, dump to $file instead of STDOUT +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_dump} = '$vol, [$time], [$file], [$cell] => Success?'; +sub AFS_vos_dump { + my($vol, $time, $file, $cell) = @_; + my(@args); + + @args = ('dump', '-id', $vol); + push(@args, '-time', ($time ? $time : 0)); + push(@args, '-file', $file) if ($file); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ], + { pass_stdout => !$file }); + 1; +} + + +#: AFS_vos_restore($vol, $server, $part, [$file], [$id], [$owmode], [$cell]) +#: Restore the volume $vol to partition $part on server $server. +#: If specified, restore from $file instead of STDIN +#: If specified, use the volume ID $id +#: If specified, $owmode must be 'abort', 'full', or 'incremental', and +#: indicates what to do if the volume exists. +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_restore} = '$vol, $server, $part, [$file], [$id], [$owmode], [$cell] => Success?'; +sub AFS_vos_restore { + my($vol, $server, $part, $file, $id, $owmode, $cell) = @_; + my(@args); + + @args = ('restore', '-name', $vol, '-server', $server, '-partition', $part); + push(@args, '-file', $file) if ($file); + push(@args, '-id', $id) if ($id); + push(@args, '-overwrite', $owmode) if ($owmode); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_listvldb([$vol], [$server, [$part]], [$locked], [$cell]) +#: Get a list of volumes in the VLDB. +#: If specified, list only the volume $vol +#: If specified, list only volumes on the server $server. +#: If specified with $server, list only volumes on the partition $part. +#: If $locked is specified and nonzero, list only locked VLDB entries +#: If specified, work in $cell instead of the default cell. +#: On success, return an associative array whose keys are names of volumes +#: on the specified server, and each of whose values is an associative +#: array describing the corresponding volume, containing some or all of +#: these elements: +#: - name Name of this volume (same as key) +#: - rwid ID of read-write volume (even if this is RO or BK) +#: - roid ID of read-only volume (even if this is RW or BK) +#: - bkid ID of backup volume (even if this is RW or RO) +#: - locked Empty or LOCKED to indicate VLDB entry is locked +#: - rwserv Name of server where read/write volume is +#: - rwpart Name of partition where read/write volume is +#: - rosites Reference to a list of read-only sites. Each site, in turn, +#: is a reference to a two-element list (server, part). +#: +$AFS_Help{vos_listvldb} = '[$vol], [$server, [$part]], [$locked], [$cell] => %vols'; +sub AFS_vos_listvldb { + my($vol, $server, $part, $locked, $cell) = @_; + my(%finres, %vlist, @rosites); + + @args = ('listvldb'); + push(@args, '-name', $vol) if ($vol); + push(@args, '-server', $server) if ($server); + push(@args, '-partition', $part) if ($part && $server); + push(@args, '-locked') if ($locked); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + %finres = &wrapper('vos', \@args, + [$vos_err_parse, + ['^(VLDB|Total) entries', '.'], + ['^(\S+)', sub { + my(%vinfo) = %OpenAFS::wrapper::result; + + if ($vinfo{name}) { + $vinfo{rosites} = [@rosites] if (@rosites); + $vlist{$vinfo{name}} = \%vinfo; + + @rosites = (); + %OpenAFS::wrapper::result = (); + } + }], + ['^(\S+)', 'name' ], + ['RWrite\:\s*(\d+)', 'rwid' ], + ['ROnly\:\s*(\d+)', 'roid' ], + ['Backup\:\s*(\d+)', 'bkid' ], + ['Volume is currently (LOCKED)', 'locked' ], + ['server (\S+) partition /vicep(\S+) RW Site', 'rwserv', 'rwpart'], + ['server (\S+) partition /vicep(\S+) RO Site', sub { + push(@rosites, [$_[0], $_[1]]); + }], + ($AFS_Parms{'vostrace'} > 2) ? ([ '', '?']) : () ]); + + if ($finres{name}) { + $finres{rosites} = [@rosites] if (@rosites); + $vlist{$finres{name}} = \%finres; + } + %vlist; +} + + + +#: AFS_vos_delentry($vol, [$cell]) +#: Delete the VLDB entry for the volume $vol +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_delentry} = '$vol, [$cell] => Success?'; +sub AFS_vos_delentry { + my($vol, $cell) = @_; + my(@args); + + @args = ('delentry', '-id', $vol); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_syncserv($server, [$part], [$cell], [$force]) +#: Synchronize the server $server with the VLDB +#: If specified, synchronize only partition $part +#: If specified, work in $cell instead of the default cell +#: If $force is specified, force updates to occur +#: On success, return 1. +#: +$AFS_Help{vos_syncserv} = '$server, [$part], [$cell], [$force] => Success?'; +sub AFS_vos_syncserv { + my($server, $part, $cell, $force) = @_; + my(@args); + + @args = ('syncserv', '-server', $server); + push(@args, '-partition', $part) if ($part); + push(@args, '-force') if ($force); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_syncvldb($server, [$part], [$cell], [$force]) +#: Synchronize the VLDB with server $server +#: If specified, synchronize only partition $part +#: If specified, work in $cell instead of the default cell +#: If $force is specified, force updates to occur +#: On success, return 1. +#: +$AFS_Help{vos_syncvldb} = '$server, [$part], [$cell], [$force] => Success?'; +sub AFS_vos_syncvldb { + my($server, $part, $cell, $force) = @_; + my(@args); + + @args = ('syncvldb', '-server', $server); + push(@args, '-partition', $part) if ($part); + push(@args, '-force') if ($force); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_lock($vol, [$cell]) +#: Lock the VLDB entry for volume $vol. +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_lock} = '$vol, [$cell] => Success?'; +sub AFS_vos_lock { + my($vol, $cell) = @_; + my(@args); + + @args = ('lock', '-id', $vol); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_unlock($vol, [$cell]) +#: Unlock the VLDB entry for volume $vol. +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_unlock} = '$vol, [$cell] => Success?'; +sub AFS_vos_unlock { + my($vol, $cell) = @_; + my(@args); + + @args = ('unlock', '-id', $vol); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_unlockvldb([$server, [$part]], [$cell]) +#: Unlock some or all VLDB entries +#: If specified, unlock only entries for volumes on server $server +#: If specified with $server, unlock only entries for volumes on +#: partition $part, instead of entries for volumes on all partitions +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_unlockvldb} = '[$server, [$part]], [$cell] => Success?'; +sub AFS_vos_unlockvldb { + my($server, $part, $cell) = @_; + my(@args); + + @args = ('unlockvldb'); + push(@args, '-server', $server) if ($server); + push(@args, '-partition', $part) if ($server && $part); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_changeaddr($old, $new, [$cell]) +#: Change the IP address of server $old to $new. +#: If specified, work in $cell instead of the default cell. +#: On success, return 1. +#: +$AFS_Help{vos_changeaddr} = '$old, $new, [$cell] => Success?'; +sub AFS_vos_changeaddr { + my($old, $new, $cell) = @_; + my(@args); + + @args = ('changeaddr', '-oldaddr', $old, '-newaddr', $new); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_listpart($server, [$cell]) +#: Retrieve a list of partitions on server $server +#: If specified, work in $cell instead of the default cell. +#: On success, return a list of partition letters +#: +$AFS_Help{vos_listpart} = '$server, [$cell] => @parts'; +sub AFS_vos_listpart { + my($server, $cell) = @_; + my(@args, @parts); + + @args = ('listpart', '-server', $server); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + [ '^(.*\/vicep.*)$', #', + sub { + push(@parts, map { + my($x) = $_; + $x =~ s/^\/vicep//; + $x; + } split(' ', $_[0])); + }], + ($AFS_Parms{'vostrace'} > 2) ? ([ '', '?']) : () ]); + @parts; +} + + +#: AFS_vos_partinfo($server, [$part], [$cell]) +#: Get information about partitions on server $server. +#: If specified, only get info about partition $part. +#: If specified, work in $cell instead of the default cell. +#: On success, return an associative array whose keys are partition letters, +#: and each of whose values is a reference to a 2-element list, consisting +#: of the total size of the partition and the amount of space used. +#: +$AFS_Help{vos_partinfo} = '$server, [$part], [$cell] => %info'; +sub AFS_vos_partinfo { + my($server, $part, $cell) = @_; + my(@args, %parts); + + @args = ('partinfo', '-server', $server); + push(@args, '-partition', $part) if ($part); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + [ '^Free space on partition /vicep(.+)\: (\d+) K blocks out of total (\d+)', + sub { + $parts{$_[0]} = [ $_[1], $_[2] ]; + }], + ($AFS_Parms{'vostrace'} > 2) ? ([ '', '?']) : () ]); + %parts; +} + + +#: AFS_vos_listvol($server, [$part], [$cell]) +#: Get a list of volumes on the server $server. +#: If specified, list only volumes on the partition $part. +#: If specified, work in $cell instead of the default cell. +#: On success, return an associative array whose keys are names of volumes +#: on the specified server, and each of whose values is an associative +#: array describing the corresponding volume, containing some or all of +#: these elements: +#: - name Name of this volume (same as key) +#: - id ID of this volume +#: - kind Kind of volume (RW, RO, or BK) +#: - inuse Disk space in use +#: - maxquota Maximum disk usage quota +#: - minquota Minimum disk usage quota (optional) +#: - stamp_create Time when volume was originally created +#: - stamp_update Time volume was last modified +#: - stamp_backup Time backup volume was cloned, or 'Never' +#: - stamp_copy Time this copy of volume was made +#: - backup_flag State of automatic backups: empty or 'disabled' +#: - dayuse Number of accesses in the past day +#: - serv Server where this volume is located +#: - part Partition where this volume is located +#: +$AFS_Help{vos_listvol} = '$server, [$part], [$cell] => %vols'; +sub AFS_vos_listvol { + my($server, $part, $cell) = @_; + my(%finres, %vlist); + + @args = ('listvol', '-server', $server, '-long'); + push(@args, '-partition', $part) if ($part); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + %finres = &wrapper('vos', \@args, + [$vos_err_parse, + ['^\S+\s*\d+\s*(RW|RO|BK)', sub { + my(%vinfo) = %OpenAFS::wrapper::result; + + if ($vinfo{name}) { + $vlist{$vinfo{name}} = \%vinfo; + %OpenAFS::wrapper::result = (); + } + }], + ['^(\S+)\s*(\d+)\s*(RW|RO|BK)\s*(\d+)\s*K', 'name', 'id', 'kind', 'inuse'], + ['(\S+)\s*\/vicep(\S+)\:', 'serv', 'part' ], + ['MaxQuota\s*(\d+)\s*K', 'maxquota' ], + ['MinQuota\s*(\d+)\s*K', 'minquota' ], + ['Creation\s*(.*\S+)', 'stamp_create' ], + ['Last Update\s*(.*\S+)', 'stamp_update' ], + ['Backup\s+([^\d\s].*\S+)', 'stamp_backup' ], + ['Copy\s*(.*\S+)', 'stamp_copy' ], + ['Automatic backups are (disabled) for this volume', 'backup_flag' ], + ['(\d+) accesses in the past day', 'dayuse' ], + ($AFS_Parms{'vostrace'} > 2) ? ([ '', '?']) : () ]); + + if ($finres{name}) { + $vlist{$finres{name}} = \%finres; + } + %vlist; +} + +#: AFS_vos_zap($vol, $server, $part, [$cell], [$force]) +#: Remove the volume $vol from the server and partition specified by $server and +#: $part. Don't bother messing with the VLDB. +#: If specified, work in $cell instead of the default cell. +#: If $force is specified, force the zap to happen +#: On success, return 1. +#: +$AFS_Help{vos_zap} = '$vol, $server, $part, [$cell], [$force] => Success?'; +sub AFS_vos_zap { + my($vol, $server, $part, $cell, $force) = @_; + my(@args); + + @args = ('zap', '-id', $vol, '-server', $server, '-part', $part); + push(@args, '-force') if ($force); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); + 1; +} + + +#: AFS_vos_status($server, [$cell]) +#: Get information about outstanding transactions on $server +#: If specified, work in $cell instead of the default cell +#: On success, return a list of transactions, each of which is a reference +#: to an associative array containing some or all of these elements: +#: - transid Transaction ID +#: - stamp_create Time the transaction was created +#: - volid Volume ID +#: - part Partition letter +#: - action Action or procedure +#: - flags Volume attach flags +#: If there are no transactions, the list will be empty. +#: +$AFS_Help{vos_status} = '$server, [$cell] => @trans'; +sub AFS_vos_status { + my($server, $cell) = @_; + my(@trlist); + + @args = ('status', '-server', $server); + push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); + push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); + push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 2); + push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); + &wrapper('vos', \@args, + [$vos_err_parse, + ['^(\-)', sub { + my(%trinfo) = %OpenAFS::wrapper::result; + + if ($trinfo{transid}) { + push(@trlist, \%trinfo); + %OpenAFS::wrapper::result = (); + } + }], + ['^transaction\:\s*(\d+)\s*created: (.*\S+)', 'transid', 'stamp_create'], + ['^attachFlags:\s*(.*\S+)', 'flags'], + ['^volume:\s*(\d+)\s*partition\: \/vicep(\S+)\s*procedure\:\s*(\S+)', + 'volid', 'part', 'action'], + ($AFS_Parms{'vostrace'} > 2) ? ([ '', '?']) : () ]); + + @trlist; +} + +1; diff --git a/src/tests/OpenAFS/wrapper.pm b/src/tests/OpenAFS/wrapper.pm new file mode 100644 index 000000000..4e4931f22 --- /dev/null +++ b/src/tests/OpenAFS/wrapper.pm @@ -0,0 +1,729 @@ +# CMUCS AFStools +# Copyright (c) 1996, 2001 Carnegie Mellon University +# All rights reserved. +# +# See CMU_copyright.ph for use and distribution information + +package OpenAFS::wrapper; + +=head1 NAME + +OpenAFS::wrapper - AFS command wrapper + +=head1 SYNOPSIS + + use OpenAFS::wrapper; + %result = &wrapper($cmd, \@args, \@pspec, \%options); + +=head1 DESCRIPTION + +This module provides a generic wrapper for calling an external program and +parsing its output. It is primarily intended for use by AFStools for calling +AFS commands, but is general enough to be used for running just about any +utility program. The wrapper is implemented by a single function, +B, which takes several arguments: + +=over 4 + +=item $cmd + +The command to run. This can be a full path, or it can be a simple command +name, in which case B will find the binary on its internal path. + +=item \@args + +A reference to the list of arguments to be passed to the command. Each +element of the list is passed as a single argument, as in B. + +=item \@pspec + +A reference to the list describing how to parse the command's output. +See below for details. + +=item \%options + +A reference to a table of command execution and parsing options. + +=back + +On success, B returns an associative array of data gathered +from the command's output. The exact contents of this array are +caller-defined, and depend on the parsing instructions given. On failure, +an exception will be thrown (using B), describing the reason for the +failure. + +The I<%options> table may be used to pass any or all of the following +options into B, describing how the command should be executed +and its output parsed: + +=over 4 + +=item pass_stderr + +If specified and nonzero, the command's stderr will be passed directly +to the calling program's, instead of being parsed. This is useful when +we want to process the command's output, but let the user see any +diagnostic output or error messages. + +=item pass_stdout + +If specified and nonzero, the command's stdout will be passed directly +to the calling program's, instead of being parsed. This is useful when +the command being run produces diagnostic or error messages on stderr +that we want to parse, but provides bulk data on stdout that we don't +want to touch (e.g. B when the output file is stdout). + +=item path + +If specified, the path to be used for the program to execute, instead of +deriving it from the command name. This is useful when we want the +command's argv[0] (which is always I<$cmd}) to be different from the +path to the program. + +=item errors_last + +If specified and nonzero, the built-in instructions for catching errors +from the command will be added to the end of the instructions in @pspec +instead of to the beginning. + +=back + +=head1 PARSING COMMAND OUTPUT + +The I<@pspec> list describes how to parse command output. Each element +of the list acts like an "instruction" describing how to parse the command's +output. As each line of output is received from the program, the parsing +instructions are run over that line in order. This process continues for +every line of output until the program terminates, or the process is +aborted early by flow-control operators. + +Each parsing instruction is a reference to a list, which consists of a +regular expression and a list of "actions". As a line of output is +processed, it is compared to each instruction's regexp in turn. Whenever +a match is found, the actions associated with that instruction are taken, +in order. Each instruction's regexp may contain one or more parenthesized +subexpressions; generally, each "action" uses up one subexpression, but there +are some exceptions. Due to the current design of B, each regexp +must have at least one subexpression, even if it is not used. + +The acceptable actions are listed below, each followed by a number in brackets +indicating how many subexpressions are "used" by this action. It is an error +if there are not enough subexpressions left to satisfy an action. In the +following descriptions, I<$action> is the action itself (typically a string or +reference), I<$value> is the value of the subexpression that will be used, and +I<%result> is the result table that will be returned by B when the +command completes. + +=over 4 + +=item string [1] + +Sets $result{$action} to $value. Note that several specific strings have +special meaning, and more may be added in the future. To ensure compatibility +with future versions of B, use only valid Perl identifiers as +"string" actions. + +=item scalar ref [1] + +Sets $$action to $value. + +=item list ref [*] + +Pushes the remaining subexpression values onto @$action. This action uses +all remaining subexpression values. + +=item hash ref [2] + +Sets $$action{$value0} to $value1. + +=item code ref [*] + +Calls the referenced function, with all remaining subexpression values as +its arguments. Any values returned by the function will be used to refill +the (now empty) subexpression value list, and thus may be used as arguments +by subsequent actions. If only a few values are required, use a function +like this: + + sub usetwo { # uses two values and preserves the rest + my($val1, $val2, @rest) = @_; + + print STDOUT "Got $val1, $val2\n"; + @rest; + } + +=item '.' [0] + +End processing for this line of output, ignoring any remaining instructions. +Remaining actions in this instruction will be processed. + +=item '+n' [0] + +Skip the next I instructions. This, along with the '.' action, can be +used to build simple flow-control constructs based on the contents of +lines of output. + +=item '-x' [0..1] + +Signal an error after this instruction. Remaining actions in this instruction +will be processed, but no further instructions will be processed for this +line, and no further lines of output will be processed. If I is given, +it will be used as a regexp to match against the B line of output, +and the first parenthesized subexpression resulting from that match will be +used as the error string. Otherwise, one subexpression from the current +line will be used up as the error string. + +=item '?' [1] + +Prints $value to STDOUT. + +=back + +=cut + +use OpenAFS::CMU_copyright; +use OpenAFS::util qw(:DEFAULT :afs_internal); +use Exporter; +use Symbol; + +$VERSION = ''; +$VERSION = '1.00'; +@ISA = qw(Exporter); +@EXPORT = qw(&wrapper); +@EXPORT_OK = qw(&wrapper &fast_wrapper); + +sub wrapper { + my($cmd, $args, $instrs, $options) = @_; + my($prevline, $pid, $exception); + my(@instrs, $instr, $action, @values, $path); + local(%result); + my(@werrinstrs) = ([ '^(wrapper\:.*)', '-' ]); + my(@cerrinstrs) = ([ '^(' . $cmd . '\:.*)', '-' ], + [ '^(' . $path . '\:.*)', '-' ]); + + if ($options->{errors_last}) { + @instrs = (@werrinstrs, @$instrs, @cerrinstrs); + } else { + @instrs = (@werrinstrs, @cerrinstrs, @$instrs); + } + + if ($options->{path}) { + $path = $options->{path}; + } elsif ($cmd =~ /^\//) { + $path = $cmd; + } else { + $path = $AFScmd{$cmd}; + } + + if ($AFS_Trace{wrapper}) { + print STDERR "Instructions:\n"; + foreach $instr (@$instrs) { + print STDERR " /", $instr->[0], "/\n"; + if ($AFS_Trace{wrapper} > 2) { + my(@actions) = @$instr; + shift(@actions); + print " => ", + join(', ', map { ref($_) ? "<" . ref($_) . " reference>" + : $_ } @actions), + "\n"; + } + } + } + + ## Start the child + if ($options->{pass_stdout}) { + open(REALSTDOUT, ">&STDOUT"); + } + $pid = open(AFSCMD, "-|"); + if (!defined($pid)) { + die "wrapper: Fork failed for $cmd: $!\n"; + } + + ## Run the appropriate program + if (!$pid) { + + if ($AFS_Trace{wrapper} > 1) { + print STDERR "Command: $path ", join(' ', @$args), "\n"; + } + + open(STDERR, ">&STDOUT") if (!$options{pass_stderr}); + if ($options{pass_stdout}) { + open(STDOUT, ">&REALSTDOUT"); + close(REALSTDOUT); + } + + { exec($path $cmd, @$args); } + # Need to be careful here - we might be doing "vos dump" to STDOUT + if ($options{pass_stdout}) { + print STDERR "wrapper: Exec failed for $cmd: $!\n"; + } else { + print STDOUT "wrapper: Exec failed for $cmd: $!\n"; + } + exit(127); + } + if ($options{pass_stdout}) { + close(REALSTDOUT); + } + + ## Now, parse the output + line: + while () { + my($skip) = 0; + + print STDERR $_ if ($AFS_Trace{wrapper} > 3); + chop; + + instr: + foreach $instr (@instrs) { + my($dot, $action, @actions); + + if ($skip) { + $skip--; + next instr; + } + $dot = 0; + if ($instr->[0]) { + @values = ($_ =~ $instr->[0]); + next instr if (!@values); + } else { + @values = (); + } + + act: + @actions = @$instr; + shift(@actions); + foreach $action (@actions) { + if (ref($action) eq 'SCALAR') { + if (@values) { + $$action = shift(@values); + } else { + last act; + } + } elsif (ref($action) eq 'ARRAY') { + push(@$action, @values); + @values = (); + } elsif (ref($action) eq 'HASH') { + if (@values > 1) { + $$action{$values[0]} = $values[1]; + shift(@values); shift(@values); + } elsif (@values) { + $$action{shift @values} = ''; + last act; + } else { + last act; + } + } elsif (ref($action) eq 'CODE') { + @values = &$action(@values); + } elsif (ref($action)) { + $exception = "Unknown reference to " . ref($action) + . "in parse instructions"; + last line; + } else { ## Must be a string! + if ($action eq '.') { + $dot = 1; + } elsif ($action =~ /\+(\d+)/) { + $skip = $1; + } elsif ($action =~ /-(.*)/) { + my($pat) = $1; + + if ($pat && $prevline) { + ($exception) = ($prevline =~ $pat); + } elsif (@values) { + $exception = shift(@values); + } else { + $exception = $_; + } + } elsif ($action eq '?') { + print STDOUT (@values ? shift(@values) : $_), "\n"; + } elsif (@values) { + $result{$action} = shift(@values); + } else { + last act; + } + } + } + + last line if ($exception); + last instr if ($dot); + } + $prevline = $_; + } + close(AFSCMD); + $exception .= "\n" if ($exception && $exception !~ /\n$/); + die $exception if ($exception); + %result; +} + + +## Generate code for a fast wrapper (see example below) +sub _fastwrap_gen { + my($instrs, $refs) = @_; + my($SRC, $N, $N1, $X, $instr, $pattern, @actions, $action); + + $N = $X = 0; + $N1 = 1; + + $SRC = <<'#####'; +sub { + my($FD, $refs) = @_; + my($prevline, @values, $skip, $exception); + + line: while (<$FD>) { +##### + + $SRC .= " print STDERR \$_;\n" if ($AFS_Trace{'wrapper'} > 3); + $SRC .= " chop;\n"; + + foreach $instr (@$instrs) { + ($pattern, @actions) = (@$instr); + $SRC .= ($pattern ? <<"#####" : <<"#####"); + + instr_$N: + die \$exception if \$exception; + if (\$skip) { \$skip-- } else { + \@values = (\$_ =~ /$pattern/); + if (\@values) { +##### + + instr_$N: + die \$exception if \$exception; + if (\$skip) { \$skip-- } else { + \@values = (); + if (1) { +##### + + foreach $action (@actions) { + if (ref($action) eq 'SCALAR') { + $refs[++$X] = $action; + $SRC .= <<"#####"; + + if (\@values) { \${\$refs[$X]} = shift (\@values) } + else { goto instr_$N1 } +##### + + } elsif (ref($action) eq 'ARRAY') { + $refs[++$X] = $action; + $SRC .= <<"#####"; + + push(\@{\$refs[$X]}, \@values); + \@values = (); +##### + + } elsif (ref($action) eq 'HASH') { + $refs[++$X] = $action; + $SRC .= <<"#####"; + + if (\@values > 1) { + \$refs[$X]{\$values[0]} = shift(\$values[1]); + shift(\@values); shift(\@values); + } elsif (\@values) { + \$refs[$X]{shift(\@values)} = ''; + goto instr_$N1; + } else { + goto instr_$N1; + } +##### + + } elsif (ref($action) eq 'CODE') { + $refs[++$X] = $action; + $SRC .= "\n \@values = \$refs[$X]->(\@values);\n"; + + } elsif (ref($action)) { + die "Unknown reference to " . ref($action) . "in parse instructions\n"; + + } elsif ($action eq '.') { + $SRC .= "\n next line;\n"; + + } elsif ($action eq '?') { + $SRC .= <<"#####"; + + if (\@values) { print STDOUT shift(\@values), "\\n" } + else { print STDOUT \$_, "\\n" } +##### + + } elsif ($action =~ /\+(\d+)/) { + $SRC .= "\n \$skip = $1;\n"; + + } elsif ($action =~ /-(.*)/) { + $SRC .= $1 ? <<"#####" : <<"#####"; + + if (\$prevline) { (\$exception) = (\$prevline =~ /$1/) } + elsif (\@values) { \$exception = shift(\@values) } + else { \$exception = \$_ } +##### + + if (\@values) { \$exception = shift(\@values) } + else { \$exception = \$_ } +##### + + } else { + $SRC .= <<"#####"; + + if (\@values) { \$result{"\Q$action\E"} = shift(\@values) } + else { goto instr_$N1 } +##### + } + } + + $N++; $N1++; + $SRC .= <<'#####'; + } + } +##### + } + + $SRC .= <<'#####'; + } continue { + die $exception if $exception; + $prevline = $_; + } +} +##### + + $SRC; +} + +####################### Example code ####################### +# sub { +# my($FD, $refs) = @_; +# my($prevline, @values, $skip, $exception); +# +# line: while (<$FD>) { +# print STDERR $_; ## if ($AFS_Trace{'wrapper'} > 3); +# chop; +# +# ## Following block repeated for each instruction +# instr_N: +# die $exception if $exception; +# if ($skip) { $skip-- } else { +# @values = ($_ =~ /## pattern ##/); ## () if no pattern +# if (@values) { ## 1 if no pattern +# ## For each action, include one of the following blocks: +# +# ## SCALAR ref +# if (@values) { ${$refs[X]} = shift (@values) } +# else { goto instr_N+1 } +# +# ## ARRAY ref +# push(@{$refs[X]}, @values); +# @values = (); +# +# ## HASH ref +# if (@values > 1) { +# $refs[X]{shift(@values)} = shift(@values); +# } elsif (@values) { +# $refs[X]{shift(@values)} = ''; +# goto instr_N+1; +# } else { +# goto instr_N+1; +# } +# +# ## CODE ref +# @values = $refs[X]->(@values); +# +# ## string '.' +# next line; +# +# ## string '?' +# if (@values) { print STDOUT shift(@values), "\n" } +# else { print STDOUT $_, "\n" } +# +# ## string '+DDD' +# $skip = DDD; +# +# ## string '-XXX' +# if ($prevline) { ($exception) = ($prefline =~ /XXX/) } +# elsif (@values) { $exception = shift(@values) } +# else { $exception = $_ } +# +# ## string '-' +# if (@values) { $exception = shift(@values) } +# else { $exception = $_ } +# +# ## anything else +# if (@values) { $result{XXX} = shift(@values) } +# else { goto instr_N+1 } +# } +# } +# +# } continue { +# die $exception if $exception; +# $prevline = $_; +# } +# } +############################################################ + + +## The following does exactly the same thing as wrapper(), +## but should be considerably faster. Instead of interpreting +## parsing instructions, it translates them into perl code, +## which is then compiled into the interpreter. The chief +## benefit to this approach is that we no longer compile +## one RE per instruction per line of input. + +sub fast_wrapper { + my($cmd, $args, $instrs, $options) = @_; + my(@instrs, $SRC, $CODE, $path, $pid, $refs, $FD, $exception); + local(%result); + my(@werrinstrs) = ([ '^(wrapper\:.*)', '-' ]); + my(@cerrinstrs) = ([ '^(' . $cmd . '\:.*)', '-' ], + [ '^(' . $path . '\:.*)', '-' ]); + + $FD = gensym; + $refs = []; + if ($options->{errors_last}) { + @instrs = (@werrinstrs, @$instrs, @cerrinstrs); + } else { + @instrs = (@werrinstrs, @cerrinstrs, @$instrs); + } + $SRC = _fastwrap_gen(\@instrs, $refs); + $CODE = eval $SRC; + + if ($options->{path}) { + $path = $options->{path}; + } elsif ($cmd =~ /^\//) { + $path = $cmd; + } else { + $path = $AFScmd{$cmd}; + } + + if ($AFS_Trace{'wrapper'}) { + print STDERR "Instructions:\n"; + foreach $instr (@$instrs) { + print STDERR " /", $instr->[0], "/\n"; + if ($AFS_Trace{'wrapper'} > 2) { + my(@actions) = @$instr; + shift(@actions); + print " => ", + join(', ', map { ref($_) ? "<" . ref($_) . " reference>" + : $_ } @actions), + "\n"; + } + } + } + + if ($AFS_Trace{'wrapper'} > 2) { print STDERR "Input parse code:\n$SRC\n" } + + ## Start the child + if ($options->{pass_stdout}) { + open(REALSTDOUT, ">&STDOUT"); + } + $pid = open($FD, "-|"); + if (!defined($pid)) { + die "wrapper: Fork failed for $cmd: $!\n"; + } + + ## Run the appropriate program + if (!$pid) { + if ($AFS_Trace{'wrapper'} > 1) { + print STDERR "Command: $path ", join(' ', @$args), "\n"; + } + + open(STDERR, ">&STDOUT") if (!$options{pass_stderr}); + if ($options{pass_stdout}) { + open(STDOUT, ">&REALSTDOUT"); + close(REALSTDOUT); + } + + { exec($path $cmd, @$args) } + # Need to be careful here - we might be doing "vos dump" to STDOUT + if ($options{pass_stdout}) { + print STDERR "wrapper: Exec failed for $cmd: $!\n"; + } else { + print STDOUT "wrapper: Exec failed for $cmd: $!\n"; + } + exit(127); + } + if ($options{pass_stdout}) { + close(REALSTDOUT); + } + + ## Now, parse the output + eval { $CODE->($FD, $refs) }; + $exception = $@; + + close($FD); + + $exception .= "\n" if ($exception && $exception !~ /\n$/); + die $exception if ($exception); + %result; +} + + +1; + +=head1 EXAMPLES + +The following set of instructions is used by B to detect errors +issued by the command, or by the child process spawned to invoke the command. +I<$cmd> is the name of the command to run, and I<$path> is the path to the +binary actually invoked. + + [ '^(wrapper\:.*)', '-' ] + [ '^(' . $cmd . '\:.*)', '-' ] + [ '^(' . $path . '\:.*)', '-' ] + +The following instruction is added by the B module to catch errors +generated by B commands, which often take the form of a generic error +message (Error in vos XXX command), with a description of the specific problem +on the preceeding line: + + [ 'Error in vos (.*) command', '-(.*)' ] + +If the AFStools parameter I is nonzero, the following instruction +is added to force all lines of output to be copied to STDOUT. Note that this +is different from specifying the I option, which would pass the +command's STDOUT directly to ours without parsing it. + + [ '', '?' ] + +B uses the following instructions to parse the +output of "vos listvldb". This is a fairly complex example, which illustrates +many of the features of B. + + 1 ['^(VLDB|Total) entries', '.'] + 2 ['^(\S+)', sub { + my(%vinfo) = %OpenAFS::wrapper::result; + if ($vinfo{name}) { + $vinfo{rosites} = [@rosites] if (@rosites); + $vlist{$vinfo{name}} = \%vinfo; + @rosites = (); + %OpenAFS::wrapper::result = (); + } + }], + 3 ['^(\S+)', 'name' ], + 4 ['RWrite\:\s*(\d+)', 'rwid' ], + 5 ['ROnly\:\s*(\d+)', 'roid' ], + 6 ['Backup\:\s*(\d+)', 'bkid' ], + 7 ['Volume is currently (LOCKED)', 'locked' ], + 8 ['server (\S+) partition /vicep(\S+) RW Site', 'rwserv', 'rwpart'], + 9 ['server (\S+) partition /vicep(\S+) RO Site', sub { + push(@rosites, [$_[0], $_[1]]); + }], + +Instruction 1 matchees the header and trailer lines printed out by B, and +terminates processing of those lines before instructions 2 and 3 have a chance +to match it. This is a simple example of a conditional - the next two +instructions are used only if this one doesn't match. If we wanted to consider +additional instructions even on lines that do match this one, we could place +them above this one, or use '+2' instead of '.', which would skip only the next +two instructions and allow remaining ones to be processed. + +Instruction 2 matches the first line printed for each volume, stores away any +information that has been collected about the previous volume, and prepares for +the new one. Besides being a good example of use of a code reference as an +action, this instruction also takes advantage of the fact that B's +%result array is a dynamically-scoped variable, and so can be modified by code +referenced in parsing instructions. + +The remaining instructions are fairly simple. Instructions 3 through 8 use +simple strings to add information about the volume to %result. Instruction 9 +is a bit more complicated; it uses a function to add a server/partition pair +to the current volume's list of RO sites. + +=head1 COPYRIGHT + +The CMUCS AFStools, including this module are +Copyright (c) 1996, 2001 Carnegie Mellon University. All rights reserved. +For use and redistribution information, see CMUCS/CMU_copyright.pm + +=cut diff --git a/src/tests/afsconf.pm b/src/tests/afsconf.pm deleted file mode 100644 index 86db4605d..000000000 --- a/src/tests/afsconf.pm +++ /dev/null @@ -1,234 +0,0 @@ -# CMUCS AFStools -# Copyright (c) 1996, Carnegie Mellon University -# All rights reserved. -# -# See CMUCS/CMU_copyright.pm for use and distribution information - -package OpenAFS::afsconf; - -=head1 NAME - -OpenAFS::afsconf - Access to AFS config info - -=head1 SYNOPSIS - - use OpenAFS::afsconf; - - $cell = AFS_conf_localcell(); - $cell = AFS_conf_canoncell($cellname); - @servers = AFS_conf_cellservers($cellname); - @cells = AFS_conf_listcells(); - %info = AFS_conf_cacheinfo(); - -=head1 DESCRIPTION - -This module provides access to information about the local workstation's -AFS configuration. This includes information like the name of the -local cell, where AFS is mounted, and access to information in the -F. All information returned by this module is based on the -configuration files, and does not necessarily reflect changes made -on the afsd command line or using B commands. - -=cut - -use OpenAFS::CMU_copyright; -use OpenAFS::config; -use OpenAFS::util qw(:DEFAULT :afs_internal); -use Exporter; - -$VERSION = ''; -$VERSION = '1.00'; -@ISA = qw(Exporter); -@EXPORT = qw(&AFS_conf_localcell - &AFS_conf_canoncell - &AFS_conf_listcells - &AFS_conf_cellservers - &AFS_conf_cacheinfo); - - -# _confpath($file) - Return path to a configuration file -sub _confpath { - my($file) = @_; - - if ($conf_paths{$file}) { - $conf_paths{$file}; - } elsif ($AFS_Parms{confdir} && -r "$AFS_Parms{confdir}/$file") { - $conf_paths{$file} = "$AFS_Parms{confdir}/$file"; - } elsif (-r "$def_ConfDir/$file") { - $conf_paths{$file} = "$def_ConfDir/$file"; - } else { - die "Unable to locate $file\n"; - } -} - -=head2 AFS_conf_localcell() - -Return the canonical name of the local cell. This depends on the contents -of the F file in the AFS configuration directory. - -=cut - -$AFS_Help{conf_localcell} = '=> $lclcell'; -sub AFS_conf_localcell { - my($path) = _confpath(ThisCell); - my($result); - - return '' if (!$path); - if (open(THISCELL, $path)) { - chomp($result = ); - close(THISCELL); - $result; - } else { - die "Unable to open $path: $!\n"; - } -} - -=head2 AFS_conf_canoncell($cellname) - -Return the canonical name of the specified cell, as found in F. -I<$cellname> may be any unique prefix of a cell name, as with various AFS -commands that take cell names as arguments. - -=head2 AFS_conf_cellservers($cellname) - -Return a list of servers in the specified cell. As with B, -I<$cellname> may be any unique prefix of a cell name. The resulting list -contains server hostnames, as found in F. - -=cut - -$AFS_Help{conf_canoncell} = '$cellname => $canon'; -$AFS_Help{conf_cellservers} = '$cellname => @servers'; - -sub AFS_conf_canoncell { &_findcell($_[0], 0); } -sub AFS_conf_cellservers { &_findcell($_[0], 1); } - -sub _findcell { - my($cellname, $doservers) = @_; - my($path, $found, @servers, $looking); - - return $canon_name{$cellname} if (!$doservers && $canon_name{$cellname}); - $path = _confpath(CellServDB) || die "Unable to locate CellServDB\n"; - - if (open(CELLSERVDB, $path)) { - my($cellpat) = $cellname; - $cellpat =~ s/(\W)/\\$1/g; - while () { - $looking = 0 if (/^\>/); - if (/^\>$cellpat/) { - if ($found) { - close(CELLSERVDB); - die "Cell name $cellname is not unique\n"; - } else { - chop($found = $_); - $found =~ s/^\>(\S+).*/$1/; - $looking = 1 if ($doservers); - } - } elsif ($looking && (/^[\.\d]+\s*\#\s*(.*\S+)/ || /^([\.\d]+)/)) { - push(@servers, $1); - } - } - close(CELLSERVDB); - if ($found) { - $canon_name{$cellname} = $found; - $doservers ? @servers : ($found); - } else { - die "Cell $cellname not in CellServDB\n"; - } - } else { - die "Unable to open $path: $!\n"; - } -} - -=head2 AFS_conf_listcells() - -Return a list of canonical names (as found in F) of all -known AFS cells. - -=cut - -$AFS_Help{conf_listcells} = '=> @cells'; -sub AFS_conf_listcells { - my($path, @cells); - - $path = _confpath(CellServDB) || die "Unable to locate CellServDB!\n"; - - if (open(CELLSERVDB, $path)) { - while () { - if (/^\>(\S+)/) { - push(@cells, $1); - } - } - close(CELLSERVDB); - @cells; - } else { - die "Unable to open $path: $!\n"; - } -} - -=head2 AFS_conf_cacheinfo() - -Return a table of information about the local workstation's cache -configuration. This table may contain any or all of the following elements: - -=over 14 - -=item afsroot - -Mount point for the AFS root volume - -=item cachedir - -Location of the AFS cache directory - -=item cachesize - -AFS cache size - -=item hardcachesize - -Hard limit on AFS cache size (if specified; probably Mach-specific) - -=item translator - -Name of AFS/NFS translator server (if set) - -=back - -=cut - -$AFS_Help{conf_cacheinfo} = '=> %info'; -sub AFS_conf_cacheinfo { - my($path) = _confpath('cacheinfo'); - my(%result, $line, $hcs); - - if ($path) { - if (open(CACHEINFO, $path)) { - chop($line = ); - close(CACHEINFO); - (@result{'afsroot', 'cachedir', 'cachesize'} , $hcs) = split(/:/, $line); - $result{'hardcachesize'} = $hcs if ($hcs); - } else { - die "Unable to open $path: $!\n"; - } - } - if ($ENV{'AFSSERVER'}) { - $result{'translator'} = $ENV{'AFSSERVER'}; - } elsif (open(SRVFILE, "$ENV{HOME}/.AFSSERVER") - || open(SRVFILE, "/.AFSSERVER")) { - $result{'translator'} = ; - close(SRVFILE); - } - %result; -} - - -1; - -=head1 COPYRIGHT - -The CMUCS AFStools, including this module are -Copyright (c) 1996, Carnegie Mellon University. All rights reserved. -For use and redistribution information, see CMUCS/CMU_copyright.pm - -=cut diff --git a/src/tests/afscp.c b/src/tests/afscp.c index 4bf5ce2e9..6cb8931ed 100644 --- a/src/tests/afscp.c +++ b/src/tests/afscp.c @@ -21,7 +21,7 @@ #include /*#include */ -#include +#include struct VenusFid { afs_int32 Cell; diff --git a/src/tests/bos.pm b/src/tests/bos.pm deleted file mode 100644 index 9d857928b..000000000 --- a/src/tests/bos.pm +++ /dev/null @@ -1,679 +0,0 @@ -# CMUCS AFStools -# Copyright (c) 1996, Carnegie Mellon University -# All rights reserved. -# -# See CMU_copyright.ph for use and distribution information -# -#: * bos.pm - Wrappers around BOS commands (basic overseer server) -#: * This module provides wrappers around the various bosserver -#: * commands, giving them a nice perl-based interface. Someday, they might -#: * talk to the servers directly instead of using 'bos', but not anytime -#: * soon. -#: - -package OpenAFS::bos; -use OpenAFS::CMU_copyright; -use OpenAFS::util qw(:DEFAULT :afs_internal); -use OpenAFS::wrapper; -use Exporter; - -$VERSION = ''; -$VERSION = '1.00'; -@ISA = qw(Exporter); -@EXPORT = qw(&AFS_bos_create &AFS_bos_addhost - &AFS_bos_addkey &AFS_bos_adduser - &AFS_bos_delete &AFS_bos_exec - &AFS_bos_getdate &AFS_bos_getlog - &AFS_bos_getrestart &AFS_bos_install - &AFS_bos_listhosts &AFS_bos_listkeys - &AFS_bos_listusers &AFS_bos_prune - &AFS_bos_removehost &AFS_bos_removekey - &AFS_bos_removeuser &AFS_bos_restart - &AFS_bos_salvage &AFS_bos_setauth - &AFS_bos_setcellname &AFS_bos_setrestart - &AFS_bos_shutdown &AFS_bos_start - &AFS_bos_startup &AFS_bos_status - &AFS_bos_stop &AFS_bos_uninstall); - -#: AFS_bos_addhost($server, $host, [$clone], [$cell]) -#: Add a new database server host named $host to the database -#: on $server. -#: If $clone is specified, create an entry for a clone server. -#: On success, return 1. -#: -$AFS_Help{bos_addhost} = '$server, $host, [$clone], [$cell] => Success?'; -sub AFS_bos_addhost { - my($server, $host, $clone, $cell) = @_; - my(@args); - - @args = ('addhost', '-server', $server, '-host', $host); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-clone') if ($clone); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_addkey($server, $key, $kvno, [$cell]) -#: Add a key $key with key version number $kvno on server $server -#: On success, return 1. -#: -$AFS_Help{bos_addkey} = '$server, $key, $kvno, [$cell] => Success?'; -sub AFS_bos_addkey { - my($server, $key, $kvno, $cell) = @_; - my(@args); - - @args = ('addkey', '-server', $server, '-key', $key, '-kvno', $kvno); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_adduser($server, \@user, [$cell]) -#: Add users specified in @users to bosserver superuser list on $server. -#: On success, return 1. -#: -$AFS_Help{bos_adduser} = '$server, \@user, [$cell] => Success?'; -sub AFS_bos_adduser { - my($server, $user, $cell) = @_; - my(@args); - - @args = ('adduser', '-server', $server, '-user', @$user); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_create($server, $instance, $type, \@cmd, [$cell]) -#: Create a bnode with name $instance -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{bos_create} = '$server, $instance, $type, \@cmd, [$cell] => Success?'; -sub AFS_bos_create { - my($server, $instance, $type, $cmd, $cell) = @_; - my(@args); - - @args = ('create', '-server', $server, '-instance', $instance, '-type', - $type, '-cmd', @$cmd); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_delete($server, $instance, [$cell]) -#: Delete a bnode with name $instance -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{bos_delete} = '$server, $instance, [$cell] => Success?'; -sub AFS_bos_delete { - my($server, $instance, $cell) = @_; - my(@args); - - @args = ('delete', '-server', $server, '-instance', $instance); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_exec($server, $cmd, [$cell]) -#: Exec a process on server $server -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{bos_exec} = '$server, $cmd, [$cell] => Success?'; -sub AFS_bos_exec { - my($server, $cmd, $cell) = @_; - my(@args); - - @args = ('exec', '-server', $server, '-cmd', $cmd); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_getdate($server, $file, [$cell]) -#: Get the date for file $file from server $server -#: On success, return ($exedate, $bakdate, $olddate). -#: -$AFS_Help{bos_getdate} = '$server, $file, [$cell] => ($exedate, $bakdate, $olddate)'; -sub AFS_bos_getdate { - my($server, $file, $cell) = @_; - my(@args, $exedate, $bakdate, $olddate); - - @args = ('getdate', '-server', $server, '-file', $file); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args, - [[ 'dated (.*), (no )?\.BAK', \$exedate], - [ '\.BAK file dated (.*), (no )?\.OLD', \$bakdate], - [ '\.OLD file dated (.*)\.', \$olddate]]); - ($exedate, $bakdate, $olddate); -} - -#: AFS_bos_getlog($server, $file, [$cell]) -#: Get log named $file from server $server -#: On success, return 1. -#: -$AFS_Help{bos_getlog} = '$server, $file, [$cell] => Success?'; -sub AFS_bos_getlog { - my($server, $file, $cell) = @_; - my(@args); - - @args = ('getlog', '-server', $server, '-file', $file); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args, - [[ '^Fetching log file .*', '.']], { pass_stdout }); - 1; -} - -#: AFS_bos_getrestart($server, [$cell]) -#: Get the restart time for server $server -#: On success, return ($genrestart, $binrestart). -#: -$AFS_Help{bos_getrestart} = '$server, [$cell] => ($genrestart, $binrestart)'; -sub AFS_bos_getrestart { - my($server, $cell) = @_; - my(@args, $genrestart, $binrestart); - - @args = ('getrestart', '-server', $server); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args, - [[ '^Server .* restarts at\s*(.*\S+)', \$genrestart], - [ '^Server .* restarts for new binaries at\s*(.*\S+)', \$binrestart]]); - ($genrestart, $binrestart); -} - -#: AFS_bos_install($server, \@files, [$dir], [$cell]) -#: Install files in \@files on server $server in directory $dir -#: or the default directory. -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{bos_install} = '$server, \@files, [$dir], [$cell] => Success?'; -sub AFS_bos_install { - my($server, $files, $dir, $cell) = @_; - my(@args, $file); - - @args = ('install', '-server', $server, '-file', @$files); - push(@args, '-dir', $dir) if ($dir); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args, [[ 'bos: installed file .*', '.' ]], - { 'errors_last' => 1 }); - 1; -} - -#: AFS_bos_listhosts($server, [$cell]) -#: Get host list on server $server. -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, an array of hosts with the first entry being the cellname. -#: -$AFS_Help{bos_listhosts} = '$server, [$cell] => @ret'; -sub AFS_bos_listhosts { - my($server, $cell) = @_; - my(@args, @ret); - - @args = ('listhosts', '-server', $server); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args, - [[ '^Cell name is (.*)', sub { - push(@ret, $_[0]); - } ], - [ 'Host \S+ is (\S+)', sub { - push(@ret, $_[0]); - } ] - ]); - @ret; -} - -#: AFS_bos_listkeys($server, [$showkey], [$cell]) -#: Get key list on server $server. -#: The server name ($server) may be a hostname or IP address -#: If specified, $showkey indicates keys and not checksums should be shown. -#: If specified, work in $cell instead of the default cell. -#: On success, an array of hosts with the first entry being the cellname. -#: -$AFS_Help{bos_listkeys} = '$server, [$showkey], [$cell] => %ret'; -sub AFS_bos_listkeys { - my($server, $showkey, $cell) = @_; - my(@args, %ret); - - @args = ('listkeys', '-server', $server); - push(@args, '-showkey') if ($showkey); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - %ret = &wrapper('bos', \@args, - [[ '^key (\d+) has cksum (\d+)', sub { - my(%ret) = %OpenAFS::wrapper::result; - $ret{$_[0]} = $_[1]; - %OpenAFS::wrapper::result = %ret; - } ], - [ '^key (\d+) is \'(\S+)\'', sub { - my(%ret) = %OpenAFS::wrapper::result; - $ret{$_[0]} = $_[1]; - %OpenAFS::wrapper::result = %ret; - } ], - [ '^Keys last changed on\s*(.*\S+)', sub { - my(%ret) = %OpenAFS::wrapper::result; - $ret{'date'} = $_[0]; - %OpenAFS::wrapper::result = %ret; - } ], - [ 'All done.', '.']]); - %ret; -} - -#: AFS_bos_listusers($server, [$cell]) -#: Get superuser list on server $server. -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, an array of users. -#: -$AFS_Help{bos_listusers} = '$server, [$cell] => @ret'; -sub AFS_bos_listusers { - my($server, $cell) = @_; - my(@args, @ret); - - @args = ('listusers', '-server', $server); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args, [[ '^SUsers are: (\S+)', sub { - push(@ret, split(' ',$_[0])); - } ]]); - @ret; -} - -#: AFS_bos_prune($server, [$bak], [$old], [$core], [$all], [$cell]) -#: Prune files on server $server -#: If $bak is specified, remove .BAK files -#: If $old is specified, remove .OLD files -#: If $core is specified, remove core files -#: If $all is specified, remove all junk files -#: On success, return 1. -#: -$AFS_Help{bos_prune} = '$server, [$bak], [$old], [$core], [$all], [$cell] => Success?'; -sub AFS_bos_prune { - my($server, $bak, $old, $core, $all, $cell) = @_; - my(@args); - - @args = ('prune', '-server', $server, '-bak', $bak, '-old', $old, '-core', $core, '-all', $all); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-bak') if ($bak); - push(@args, '-old') if ($old); - push(@args, '-core') if ($core); - push(@args, '-all') if ($all); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_removehost($server, $host, [$cell]) -#: Remove a new database server host named $host from the database -#: on $server. -#: On success, return 1. -#: -$AFS_Help{bos_removehost} = '$server, $host, [$cell] => Success?'; -sub AFS_bos_removehost { - my($server, $host, $cell) = @_; - my(@args); - - @args = ('removehost', '-server', $server, '-host', $host); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_removekey($server, $kvno, [$cell]) -#: Remove a key with key version number $kvno on server $server -#: On success, return 1. -#: -$AFS_Help{bos_removekey} = '$server, $kvno, [$cell] => Success?'; -sub AFS_bos_removekey { - my($server, $kvno, $cell) = @_; - my(@args); - - @args = ('removekey', '-server', $server, '-kvno', $kvno); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_removeuser($server, \@user, [$cell]) -#: Remove users specified in @users to bosserver superuser list on $server. -#: On success, return 1. -#: -$AFS_Help{bos_removeuser} = '$server, \@user, [$cell] => Success?'; -sub AFS_bos_removeuser { - my($server, $user, $cell) = @_; - my(@args); - - @args = ('removeuser', '-server', $server, '-user', @$user); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_restart($server, [\@inst], [$bosserver], [$all], [$cell]) -#: Restart bosserver instances specified in \@inst, or if $all is -#: specified, all instances. -#: If $bosserver is specified, restart the bosserver. -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{bos_restart} = '$server, [\@inst], [$bosserver], [$all], [$cell] => Success?'; -sub AFS_bos_restart { - my($server, $inst, $bosserver, $all, $cell) = @_; - my(@args); - - @args = ('restart', '-server', $server); - push(@args, '-instance', @$inst) if ($inst); - push(@args, '-bosserver') if ($bosserver); - push(@args, '-all') if ($all); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_salvage($server, [$partition], [$volume], [$file], [$all], [$showlog], [$parallel], [$tmpdir], [$orphans], [$cell]) -#: Invoke the salvager, providing a partition $partition if specified, and -#: further a volume id $volume if specified. -#: If specified, $file is a file to write the salvager output into. -#: If specified, $all indicates all partitions should be salvaged. -#: If specified, $showlog indicates the log should be displayed on completion. -#: If specified, $parallel indicates the number salvagers that should be run -#: in parallel. -#: If specified, $tmpdir indicates a directory in which to store temporary -#: files. -#: If specified, $orphans indicates how to handle orphans in a volume -#: (valid options are ignore, remove and attach). -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{bos_salvage} = '$server, [$partition], [$volume], [$file], [$all], [$showlog], [$parallel], [$tmpdir], [$orphans], [$cell] => Success?'; -sub AFS_bos_salvage { - my($server, $partition, $volume, $file, $all, $showlog, $parallel, $tmpdir, $orphans, $cell) = @_; - my(@args); - - @args = ('salvage', '-server', $server); - push(@args, '-partition', $partition)if ($partition); - push(@args, '-volume', $volume) if ($volume); - push(@args, '-file', $file) if ($file); - push(@args, '-all') if ($all); - push(@args, '-showlog') if ($showlog); - push(@args, '-parallel', $parallel) if ($parallel); - push(@args, '-tmpdir', $tmpdir) if ($tmpdir); - push(@args, '-orphans', $orphans)if ($orphans); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args, [['bos: shutting down fs.', '.'], - ['Starting salvage.', '.'], - ['bos: waiting for salvage to complete.', '.'], - ['bos: salvage completed', '.'], - ['bos: restarting fs.', '.']], - { 'errors_last' => 1 }); - 1; -} - -#: AFS_bos_setauth($server, $authrequired, [$cell]) -#: Set the authentication required flag for server $server to -#: $authrequired. -#: On success, return 1. -#: -$AFS_Help{bos_setauth} = '$server, $authrequired, [$cell] => Success?'; -sub AFS_bos_setauth { - my($server, $authrequired, $cell) = @_; - my(@args); - - @args = ('setauth', '-server', $server, '-authrequired', $authrequired); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_setcellname($server, $name, [$cell]) -#: Set the cellname for server $server to $name -#: On success, return 1. -#: -$AFS_Help{bos_setcellname} = '$server, $name, [$cell] => Success?'; -sub AFS_bos_setcellname { - my($server, $name, $cell) = @_; - my(@args); - - @args = ('setcellname', '-server', $server, '-name', $name); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_setrestart($server, $time, [$general], [$newbinary], [$cell]) -#: Set the restart time for server $server to $time -#: If specified, $general indicates only the general restart time should be -#: set. -#: If specified, $newbinary indicates only the binary restart time should be -#: set. -#: On success, return 1. -#: -$AFS_Help{bos_setrestart} = '$server, $time, [$general], [$newbinary], [$cell] => Success?'; -sub AFS_bos_setrestart { - my($server, $time, $general, $newbinary, $cell) = @_; - my(@args); - - @args = ('setrestart', '-server', $server, '-time', $time); - push(@args, '-general') if ($general); - push(@args, '-newbinary') if ($newbinary); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_shutdown($server, [\@inst], [$wait], [$cell]) -#: Stop all bosserver instances or if \@inst is specified, -#: only those in \@inst on server $server -#: waiting for them to stop if $wait is specified. -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{bos_shutdown} = '$server, [\@inst], [$wait], [$cell] => Success?'; -sub AFS_bos_shutdown { - my($server, $inst, $wait, $cell) = @_; - my(@args); - - @args = ('shutdown', '-server', $server); - push(@args, '-instance', @$inst) if ($inst); - push(@args, '-wait') if ($wait); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_start($server, \@inst, [$cell]) -#: Start bosserver instances in \@inst on server $server . -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{bos_start} = '$server, \@inst, [$cell] => Success?'; -sub AFS_bos_start { - my($server, $inst, $cell) = @_; - my(@args); - - @args = ('start', '-server', $server, '-instance', @$inst); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_startup($server, [\@inst], [$cell]) -#: Start all bosserver instances or if \@inst is specified, only -#: those in \@inst on server $server . -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{bos_startup} = '$server, [\@inst], [$cell] => Success?'; -sub AFS_bos_startup { - my($server, $inst, $cell) = @_; - my(@args); - - @args = ('startup', '-server', $server); - push(@args, '-instance', @$inst) if ($inst); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_status($server, [\@bnodes], [$cell]) -#: Get status for the specified bnodes on $server, or for all bnodes -#: if none are given. -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, return an associative array whose keys are the names -#: of bnodes on the specified server, and each of whose values is -#: an associative array describing the status of the corresponding -#: bnode, containing some or all of the following elements: -#: - name Name of this bnode (same as key) -#: - type Type of bnode (simple, cron, fs) -#: - status Basic status -#: - aux_status Auxillary status string, for bnode types that provide it -#: - num_starts Number of process starts -#: - last_start Time of last process start -#: - last_exit Time of last exit -#: - last_error Time of last error exit -#: - error_code Exit code from last error exit -#: - error_signal Signal from last error exit -#: - commands Ref to list of commands -#: -$AFS_Help{bos_status} = '$server, [\@bnodes], [$cell] => %bnodes'; -sub AFS_bos_status { - my($server, $bnodes, $cell) = @_; - my(@args, %finres, %blist, @cmds); - - @args = ('status', '-server', $server, '-long'); - push(@args, '-instance', @$bnodes) if ($bnodes); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - %finres = &wrapper('bos', \@args, - [['^(Instance)', sub { - my(%binfo) = %OpenAFS::wrapper::result; - - if ($binfo{name}) { - $binfo{commands} = [@cmds] if (@cmds); - $blist{$binfo{name}} = \%binfo; - - @cmds = (); - %OpenAFS::wrapper::result = (); - } - }], - ['^Instance (.*), \(type is (\S+)\)\s*(.*)', 'name', 'type', 'status' ], - ['Auxilliary status is: (.*)\.', 'aux_status' ], - ['Process last started at (.*) \((\d+) proc starts\)', 'last_start', 'num_starts' ], - ['Last exit at (.*\S+)', 'last_exit' ], - ['Last error exit at (.*),', 'last_error' ], - ['by exiting with code (\d+)', 'error_code' ], - ['due to signal (\d+)', 'error_signal' ], - [q/Command \d+ is '(.*)'/, sub { push(@cmds, $_[0]) }], - ]); - if ($finres{name}) { - $finres{commands} = [@cmds] if (@cmds); - $blist{$finres{name}} = \%finres; - } - %blist; -} - -#: AFS_bos_stop($server, \@inst, [$wait], [$cell]) -#: Stop bosserver instances in \@inst on server $server -#: waiting for them to stop if $wait is specified. -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{bos_stop} = '$server, \@inst, [$wait], [$cell] => Success?'; -sub AFS_bos_stop { - my($server, $inst, $wait, $cell) = @_; - my(@args); - - @args = ('stop', '-server', $server, '-instance', @$inst); - push(@args, '-wait') if ($wait); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args); - 1; -} - -#: AFS_bos_uninstall($server, \@files, [$dir], [$cell]) -#: Uninstall files in \@files on server $server in directory $dir -#: or the default directory. -#: The server name ($server) may be a hostname or IP address -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{bos_uninstall} = '$server, \@files, [$dir], [$cell] => Success?'; -sub AFS_bos_uninstall { - my($server, $files, $dir, $cell) = @_; - my(@args); - - @args = ('uninstall', '-server', $server, '-file', @$files); - push(@args, '-dir', $dir) if ($dir); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('bos', \@args, [[ '^bos: uninstalled file .*', '.' ]], - { 'errors_last' => 1 }); - 1; -} - -1; diff --git a/src/tests/config.pm b/src/tests/config.pm deleted file mode 100644 index 0de0a54e1..000000000 --- a/src/tests/config.pm +++ /dev/null @@ -1,125 +0,0 @@ -# CMUCS AFStools -# Copyright (c) 1996, Carnegie Mellon University -# All rights reserved. -# -# See CMU_copyright.pm for use and distribution information - -package OpenAFS::config; - -=head1 NAME - -OpenAFS::config - AFStools configuration - -=head1 SYNOPSIS - - use OpenAFS::config; - -=head1 DESCRIPTION - -This module contains various AFStools configuration variables which are used -by the other AFStools modules. These describe how AFStools should act in a -particular installation, and are mostly pretty mundane. All of the defaults -here are pretty reasonable, so you shouldn't have to change anything unless -your site is particularly exotic. - -Note that this file only describes how a particular B of AFStools -should act, not how it should act upon a particular B. Since the cell -AFStools is running in is not necessarily the same as the cell on which it -is acting, most configuration that is really per-cell should be located in a -cell-specific module. - -This module should only be used by other parts of AFStools. As such, the -variables described here are not normally visible to user programs, and this -file is mostly of interest to administrators who are installing AFStools. - -=over 4 - -=cut - -use OpenAFS::CMU_copyright; -use OpenAFS::Dirpath; -use Exporter; - -$VERSION = ''; -$VERSION = '1.00'; -@ISA = qw(Exporter); -@EXPORT = qw($def_ConfDir - @CmdList - @CmdPath - $err_table_dir - ); - -# The following configuration variables are defined here. Mention them -# all an extra time, to suppress annoying warnings. Doesn't perl have -# a way of doing this??? -@x = (); -@x = ($def_ConfDir, @CmdList, @CmdPath); - -=item $def_ConfDir - Default configuration directory - -This is the default AFS configuration directory, where files like ThisCell, -CellServDB, and so on are found. If the AFStools parameter I is -set, it will generally be searched before this directory. Normally, this -should be set to F and not changed, as that path is hardwired -into AFS. However, it might be necessary to modify this if your site uses -an exotic locally-compiled version of AFS. - -=cut - -$def_ConfDir = "$openafsdirpath->{'viceetcdir'}"; -#$def_ConfDir = "/usr/vice/etc"; - - -=item @CmdList - List of AFS commands - -This is a list of AFS commands that the AFStools package might want to invoke -using B. Don't remove anything from this list if you -know what's good for you. It's OK to add things, though, if you think you -might use the wrapper features for something. - -=cut - -@CmdList = ('fs', 'pts', 'vos', 'bos', 'kas', 'krbkas', 'sys'); - - -=item @CmdPath - Path to search for AFS commands - -This is the list of directories where B will look for -AFS commands. For AFStools to work properly, every command listed in -I<@OpenAFS::config::CmdList> must appear in one of these directories. The default -should be sufficient for most sites; we deal with Transarc's reccommendations -as well as common practice. Note that on machines for which /usr/afs/bin -exists (typically, AFS fileservers), that directory is first. This is probably -what you want... - -=cut - -@CmdPath = (split(/:/, $ENV{PATH}), - "$openafsdirpath->{'afssrvbindir'}", # For servers - '/usr/local/bin', # Many sites put AFS in /usr/local - '/usr/local/etc', - '/usr/afsws/bin', # For people who use Transarc's - '/usr/afsws/etc'); # silly reccommendations - -=item $err_table_dir - Error table directory - -This is the location of error tables used by the errcode and errstr -routines in OpenAFS::errtrans. Each file in this directory should be a -com_err error table (in source form), and should be named the same -as the com_err error package contained within. - -=cut - -$err_table_dir = '/usr/local/lib/errtbl'; - -1; - -=back - -=head1 COPYRIGHT - -The CMUCS AFStools, including this module are -Copyright (c) 1996, Carnegie Mellon University. All rights reserved. -For use and redistribution information, see CMUCS/CMU_copyright.pm - -=cut diff --git a/src/tests/errtrans.pm b/src/tests/errtrans.pm deleted file mode 100644 index 48cf96ae3..000000000 --- a/src/tests/errtrans.pm +++ /dev/null @@ -1,310 +0,0 @@ -# CMUCS AFStools -# Copyright (c) 1996, Carnegie Mellon University -# All rights reserved. -# -# See CMUCS/CMU_copyright.pm for use and distribution information - -package OpenAFS::errtrans; - -=head1 NAME - -OpenAFS::errtrans - com_err error translation - -=head1 SYNOPSIS - - use OpenAFS::errtrans - $code = errcode($name); - $code = errcode($pkg, $err); - $string = errstr($code, [$volerrs]); - -=head1 DESCRIPTION - -This module translates "common" error codes such as those produced -by MIT's com_err package, and used extensively in AFS. It also knows -how to translate system error codes, negative error codes used by Rx, -and a few "special" error codes used by AFS's volume package. - -In order to work, these routines depend on the existence of error -table files in $err_table_dir, which is usually /usr/local/lib/errtbl. -Each file should be named after a com_err error package, and contain -the definition for that package. - -Note that the AFS version of com_err translates package names to uppercase -before generating error codes, so a table which claims to define the 'pt' -package actually defines the 'PT' package when compiled by AFS's compile_et. -Tables that are normally fed to AFS's compile_et should be installed using -the _uppercase_ version of the package name. - -The error tables used in AFS are part of copyrighted AFS source code, and -are not included with this package. However, I have included a utility -(gen_et) which can generate error tables from the .h files normally -produced by compile_et, and Transarc provides many of these header files -with binary AFS distributions (in .../include/afs). See the gen_et -program for more details. - -=cut - -use OpenAFS::CMU_copyright; -use OpenAFS::util qw(:DEFAULT :afs_internal); -use OpenAFS::config qw($err_table_dir); -use Symbol; -use Exporter; -use POSIX; - -$VERSION = ''; -$VERSION = '1.00'; -@ISA = qw(Exporter); -@EXPORT = qw(&errcode &errstr); - - -@NumToChar = ('', 'A'..'Z', 'a'..'z', '0'..'9', '_'); -%CharToNum = map(($NumToChar[$_], $_), (1 .. $#NumToChar)); - -%Vol_Codes = ( VSALVAGE => 101, - VNOVNODE => 102, - VNOVOL => 103, - VVOLEXISTS => 104, - VNOSERVICE => 105, - VOFFLINE => 106, - VONLINE => 107, - VDISKFULL => 108, - VOVERQUOTA => 109, - VBUSY => 110, - VMOVED => 111 - ); -%Vol_Desc = ( 101 => "volume needs to be salvaged", - 102 => "no such entry (vnode)", - 103 => "volume does not exist / did not salvage", - 104 => "volume already exists", - 105 => "volume out of service", - 106 => "volume offline (utility running)", - 107 => "volume already online", - 108 => "unknown volume error 108", - 109 => "unknown volume error 109", - 110 => "volume temporarily busy", - 111 => "volume moved" - ); -%Rx_Codes = ( RX_CALL_DEAD => -1, - RX_INVALID_OPERATION => -2, - RX_CALL_TIMEOUT => -3, - RX_EOF => -4, - RX_PROTOCOL_ERROR => -5, - RX_USER_ABORT => -6, - RX_ADDRINUSE => -7, - RX_MSGSIZE => -8, - RXGEN_CC_MARSHAL => -450, - RXGEN_CC_UNMARSHAL => -451, - RXGEN_SS_MARSHAL => -452, - RXGEN_SS_UNMARSHAL => -453, - RXGEN_DECODE => -454, - RXGEN_OPCODE => -455, - RXGEN_SS_XDRFREE => -456, - RXGEN_CC_XDRFREE => -457 - ); -%Rx_Desc = ( -1 => "server or network not responding", - -2 => "invalid RPC (Rx) operation", - -3 => "server not responding promptly", - -4 => "Rx unexpected EOF", - -5 => "Rx protocol error", - -6 => "Rx user abort", - -7 => "port address already in use", - -8 => "Rx message size incorrect", - -450 => "Rx client: XDR marshall failed", - -451 => "Rx client: XDR unmarshall failed", - -452 => "Rx server: XDR marshall failed", - -453 => "Rx server: XDR unmarshall failed", - -454 => "Rx: Decode failed", - -455 => "Rx: Invalid RPC opcode", - -456 => "Rx server: XDR free failed", - -457 => "Rx client: XDR free failed", - map(($_ => "RPC interface mismatch ($_)"), (-499 .. -458)), - -999 => "Unknown error" - ); - - -sub _tbl_to_num { - my(@tbl) = split(//, $_[0]); - my($n); - - @tbl = @tbl[0..3] if (@tbl > 4); - foreach (@tbl) { $n = ($n << 6) + $CharToNum{$_} } - $n << 8; -} - - -sub _num_to_tbl { - my($n) = $_[0] >> 8; - my($tbl); - - while ($n) { - $tbl = @NumToChar[$n & 0x3f] . $tbl; - $n >>= 6; - } - $tbl; -} - - -sub _load_system_errors { - my($file) = @_; - my($fh) = &gensym(); - - return if ($did_include{$file}); -# print "Loading $file...\n"; - $did_include{$file} = 'yes'; - if (open($fh, "/usr/include/$file")) { - while (<$fh>) { - if (/^\#define\s*(E\w+)\s*(\d+)/) { - $Codes{$1} = $2; - } elsif (/^\#include\s*\"([^"]+)\"/ - || /^\#include\s*\<([^>]+)\>/) { - &_load_system_errors($1); - } - } - close($fh); - } -} - - -# Load an error table into memory -sub _load_error_table { - my($pkg) = @_; - my($fh, @words, $curval, $tval, $nval); - my($tid, $tfn, $code, $val, $desc); - - return if ($Have_Table{$pkg}); - # Read in the input file, and split it into words - $fh = &gensym(); - return unless open($fh, "$err_table_dir/$pkg"); -# print "Loading $pkg...\n"; - line: while (<$fh>) { - s/^\s*//; # Strip leading whitespace - while ($_) { - next line if (/^#/); - if (/^(error_table|et)\s*/) { push(@words, 'et'); $_ = $' } - elsif (/^(error_code|ec)\s*/) { push(@words, 'ec'); $_ = $' } - elsif (/^end\s*/) { push(@words, 'end'); $_ = $' } - elsif (/^(\w+)\s*/) { push(@words, $1); $_ = $' } - elsif (/^\"([^"]*)\"\s*/) { push(@words, $1); $_ = $' } - elsif (/^([,=])\s*/) { push(@words, $1); $_ = $' } - else { close($fh); return } - } - } - close($fh); - - # Parse the table header - $_ = shift(@words); return unless ($_ eq 'et'); - if ($words[1] eq 'ec') { $tid = shift(@words) } - elsif ($words[2] eq 'ec') { ($tfn, $tid) = splice(@words, 0, 2) } - else { return; } - if ($tid ne $pkg) { - $Have_Table{$tid} = 'yes'; - $_ = $tid; - $_ =~ tr/a-z/A-Z/; - $tid = $_ if ($_ eq $pkg); - } - $tval = &_tbl_to_num($tid); - $Have_Table{$pkg} = 'yes'; -# print "Package $pkg: table-id = $tid, table-fun = $tfn, base = $tval\n"; - - while (@words) { - $_ = shift(@words); return unless ($_ eq 'ec'); - $code = shift(@words); - $_ = shift(@words); - if ($_ eq '=') { - $val = shift(@words); - $_ = shift(@words); - } else { - $val = $curval; - } - return unless ($_ eq ','); - $desc = shift(@words); - $nval = $tval + $val; - $curval = $val + 1; - $Desc{$nval} = $desc; - $Codes{$code} = $nval; -# print " code $code: value = $nval ($tval + $val), desc = \"$desc\"\n"; - } -} - -=head2 errcode($name) - -Returns the numeric error code corresponding to the specified error -name. This routine knows about names of system errors, a few special -Rx and volume-package errors, and any errors defined in installed -error tables. If the specified error code is not found, returns -999. - -=head2 errcode($pkg, $code) - -Shifts $code into the specified error package, and returns the -resulting com_err code. This can be used to generate error codes -for _any_ valid com_err package. - -=cut - -sub errcode { - if (@_ > 1) { - my($pkg, $code) = @_; - &_tbl_to_num($pkg) + $code; - } else { - my($name) = @_; - my($dir, @tbls, $code); - - &_load_system_errors("errno.h"); - if ($Vol_Codes{$name}) { $Vol_Codes{$name} } - elsif ($Rx_Codes{$name}) { $Rx_Codes{$name} } - elsif ($Codes{$name}) { $Codes{$name} } - else { - if ($name =~ /^E/) { # Might be a POSIX error constant - $! = 0; - $code = &POSIX::constant($name, 0); - if (!$!) { return $code; } - } - $dir = &gensym(); - if (opendir($dir, $err_table_dir)) { - @tbls = grep(!/^\.?\.$/, readdir($dir)); - close($dir); - foreach (@tbls) { &_load_error_table($_) } - } - $Codes{$name} ? $Codes{$name} : -999; - } - } -} - - -=head2 errstr($code, [$volerrs]) - -Returns the error string corresponding to a specified com_err, Rx, -or system error code. If $volerrs is specified and non-zero, then -volume-package errors are considered before system errors with the -same values. - -=cut - -sub errstr { - my($code, $volerrs) = @_; - my($pkg, $sub); - - if ($Rx_Desc{$code}) { return $Rx_Desc{$code} } - if ($volerrs && $Vol_Desc{$code}) { return $Vol_Desc{$code} } - $sub = $code & 0xff; - $pkg = &_num_to_tbl($code); - if ($pkg eq '') { - $! = $sub + 0; - $_ = $! . ''; - if (/^(Error )?\d+$/) { $Vol_Desc{$sub} ? $Vol_Desc{$sub} : "Error $sub" } - else { $_ } - } else { - &_load_error_table($pkg); - $Desc{$code} ? $Desc{$code} : "Unknown code $pkg $sub ($code)"; - } -} - -1; - -=head1 COPYRIGHT - -The CMUCS AFStools, including this module are -Copyright (c) 1996, Carnegie Mellon University. All rights reserved. -For use and redistribution information, see CMUCS/CMU_copyright.pm - -=cut diff --git a/src/tests/fs.pm b/src/tests/fs.pm deleted file mode 100644 index 40932377a..000000000 --- a/src/tests/fs.pm +++ /dev/null @@ -1,817 +0,0 @@ -# CMUCS AFStools -# Copyright (c) 1996, 2001 Carnegie Mellon University -# All rights reserved. -# -# See CMU_copyright.ph for use and distribution information -# -#: * fs.pm - Wrappers around the FS commands (fileserver/cache manager) -#: * This module provides wrappers around the various FS commands, which -#: * perform fileserver and cache manager control operations. Right now, -#: * these are nothing more than wrappers around 'fs'; someday, we might -#: * talk to the cache manager directly, but not anytime soon. -#: - -package OpenAFS::fs; -use OpenAFS::CMU_copyright; -use OpenAFS::util qw(:DEFAULT :afs_internal); -use OpenAFS::wrapper; -use Exporter; - -$VERSION = ''; -$VERSION = '1.00'; -@ISA = qw(Exporter); -@EXPORT = qw(&AFS_fs_getacl &AFS_fs_setacl - &AFS_fs_cleanacl &AFS_fs_getquota - &AFS_fs_setquota &AFS_fs_whereis - &AFS_fs_examine &AFS_fs_setvol - &AFS_fs_getmount &AFS_fs_mkmount - &AFS_fs_rmmount &AFS_fs_checkvolumes - &AFS_fs_flush &AFS_fs_flushmount - &AFS_fs_flushvolume &AFS_fs_messages - &AFS_fs_newcell &AFS_fs_rxstatpeer - &AFS_fs_rxstatproc &AFS_fs_setcachesize - &AFS_fs_setcell &AFS_fs_setcrypt - &AFS_fs_setclientaddrs &AFS_fs_copyacl - &AFS_fs_storebehind &AFS_fs_setserverprefs - &AFS_fs_checkservers &AFS_fs_checkservers_interval - &AFS_fs_exportafs &AFS_fs_getcacheparms - &AFS_fs_getcellstatus &AFS_fs_getclientaddrs - &AFS_fs_getcrypt &AFS_fs_getserverprefs - &AFS_fs_listcells &AFS_fs_setmonitor - &AFS_fs_getmonitor &AFS_fs_getsysname - &AFS_fs_setsysname &AFS_fs_whichcell - &AFS_fs_wscell); - -#: ACL-management functions: -#: AFS access control lists are represented as a Perl list (or usually, a -#: reference to such a list). Each element in such a list corresponds to -#: a single access control entry, and is a reference to a 2-element list -#: consisting of a PTS entity (name or ID), and a set of rights. The -#: rights are expressed in the usual publically-visible AFS notation, as -#: a string of characters drawn from the class [rlidwkaABCDEFGH]. No -#: rights are denoted by the empty string; such an ACE will never returned -#: by this library, but may be used as an argument to remove a particular -#: ACE from a directory's ACL. -#: -#: One might be inclined to ask why we chose this representation, instead of -#: using an associative array, as might seem obvious. The answer is that -#: doing so would have implied a nonambiguity that isn't there. Suppose you -#: have an ACL %x, and want to know if there is an entry for user $U on that -#: list. You might think you could do this by looking at $x{$U}. The -#: problem here is that two values for $U (one numeric and one not) refer to -#: the same PTS entity, even though they would reference different elements -#: in such an ACL. So, we instead chose a representation that wasn't a hash, -#: so people wouldn't try to do hash-like things to it. If you really want -#: to be able to do hash-like operations, you should turn the list-form ACL -#: into a hash table, and be sure to do name-to-number translation on all the -#: keys as you go. -#: -#: AFS_fs_getacl($path) -#: Get the ACL on a specified path. -#: On success, return a list of two references to ACLs; the first is the -#: positive ACL for the specified path, and the second is the negative ACL. -#: -$AFS_Help{fs_getacl} = '$path => (\@posacl, \@negacl)'; -sub AFS_fs_getacl { - my($path) = @_; - my(@args, @posacl, @negacl, $neg); - - @args = ('listacl', '-path', $path); - &wrapper('fs', \@args, - [ - [ '^(Normal|Negative) rights\:', sub { - $neg = ($_[0] eq 'Negative'); - }], - [ '^ (.*) (\S+)$', sub { #',{ - if ($neg) { - push(@negacl, [@_]); - } else { - push(@posacl, [@_]); - } - }]]); - (\@posacl, \@negacl); -} - -#: AFS_fs_setacl(\@paths, \@posacl, \@negacl, [$clear]) -#: Set the ACL on a specified path. Like the 'fs setacl' command, this -#: function normally only changes ACEs that are mentioned in one of the two -#: argument lists. If a given ACE already exists, it is changed; if not, it -#: is added. To delete a single ACE, specify the word 'none' or the empty -#: string in the rights field. ACEs that already exist but are not mentioned -#: are left untouched, unless $clear is specified. In that case, all -#: existing ACE's (both positive and negative) are deleted. -$AFS_Help{fs_setacl} = '\@paths, \@posacl, \@negacl, [$clear] => Success?'; -sub AFS_fs_setacl { - my($paths, $posacl, $negacl, $clear) = @_; - my($ace, $U, $access); - - if (@$posacl) { - @args = ('setacl', '-dir', @$paths); - push(@args, '-clear') if ($clear); - push(@args, '-acl'); - foreach $e (@$posacl) { - ($U, $access) = @$e; - $access = 'none' if ($access eq ''); - push(@args, $U, $access); - } - &wrapper('fs', \@args); - } - if (@$negacl) { - @args = ('setacl', '-dir', @$paths, '-negative'); - push(@args, '-clear') if ($clear && !@$posacl); - push(@args, '-acl'); - foreach $e (@$negacl) { - ($U, $access) = @$e; - $access = 'none' if ($access eq ''); - push(@args, $U, $access); - } - &wrapper('fs', \@args); - } - if ($clear && !@$posacl && !@$negacl) { - @args = ('setacl', '-dir', @$paths, - '-acl', 'system:anyuser', 'none', '-clear'); - &wrapper('fs', \@args); - } - 1; -} - -#: AFS_fs_cleanacl(\@paths) -#: Clean the ACL on the specified path, removing any ACEs which refer to PTS -#: entities that no longer exist. All the work is done by 'fs'. -#: -$AFS_Help{'fs_cleanacl'} = '\@paths => Success?'; -sub AFS_fs_cleanacl { - my($paths) = @_; - my(@args); - - @args = ('cleanacl', '-path', @$paths); - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_getquota($path) [listquota] -#: Get the quota on the specified path. -#: On success, returns the quota. -#: -$AFS_Help{'fs_getquota'} = '$path => $quota'; -sub AFS_fs_getquota { - my($path) = @_; - my(@args, $quota); - - @args = ('listquota', '-path', $path); - &wrapper('fs', \@args, - [[ '^\S+\s+(\d+)\s+\d+\s+\d+\%', \$quota ]]); - $quota; -} - -#: AFS_fs_setquota($path, $quota) [setquota] -#: Set the quota on the specified path to $quota. If $quota is -#: given as 0, there will be no limit to the volume's size. -#: On success, return 1 -#: -$AFS_Help{'fs_setquota'} = '$path, $quota => Success?'; -sub AFS_fs_setquota { - my($path, $quota) = @_; - my(@args); - - @args = ('setquota', '-path', $path, '-max', $quota); - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_whereis($path) [whereis, whichcell] -#: Locate the fileserver housing the specified path, and the cell in which it -#: is located. -#: On success, returns a list of 2 or more elements. The first element is the -#: name of the cell in which the volume is located. The remaining elements -#: the names of servers housing the volume; for a replicated volume, there may -#: (should) be more than one such server. -#: -$AFS_Help{'fs_whereis'} = '$path => ($cell, @servers)'; -sub AFS_fs_whereis { - my($path) = @_; - my(@args, $cell, @servers); - - @args = ('whichcell', '-path', $path); - &wrapper('fs', \@args, - [[ "lives in cell \'(.*)\'", \$cell ]]); - - @args = ('whereis', '-path', $path); - &wrapper('fs', \@args, - [[ 'is on host(s?)\s*(.*)', sub { - @servers = split(' ', $_[1]); - }]]); - ($cell, @servers); -} - -#: AFS_fs_examine($path) -#: Get information about the volume containing the specified path. -#: On success, return an associative array containing some or all -#: of the following elements: -#: - vol_name -#: - vol_id -#: - quota_max -#: - quota_used -#: - quota_pctused -#: - part_size -#: - part_avail -#: - part_used -#: - part_pctused -#: -$AFS_Help{'fs_examine'} = '$path => %info'; -sub AFS_fs_examine { - my($path) = @_; - my(@args, %info); - - @args = ('examine', '-path', $path); - %info = &wrapper('fs', \@args, - [[ 'vid = (\d+) named (\S+)', 'vol_id', 'vol_name' ], - [ 'disk quota is (\d+|unlimited)', 'quota_max' ], - [ 'blocks used are (\d+)', 'quota_used' ], - [ '(\d+) blocks available out of (\d+)', - 'part_avail', 'part_size']]); - if ($info{'quota_max'} eq 'unlimited') { - $info{'quota_max'} = 0; - $info{'quota_pctused'} = 0; - } else { - $info{'quota_pctused'} = ($info{'quota_used'} / $info{'quota_max'}) * 100; - $info{'quota_pctused'} =~ s/\..*//; - } - $info{'part_used'} = $info{'part_size'} - $info{'part_avail'}; - $info{'part_pctused'} = ($info{'part_used'} / $info{'part_size'}) * 100; - $info{'part_pctused'} =~ s/\..*//; - %info; -} - -#: AFS_fs_setvol($path, [$maxquota], [$motd]) -#: Set information about the volume containing the specified path. -#: On success, return 1. -$AFS_Help{'fs_setvol'} = '$path, [$maxquota], [$motd] => Success?'; -sub AFS_fs_setvol { - my($path, $maxquota, $motd) = @_; - my(@args); - - @args = ('setvol', '-path', $path); - push(@args, '-max', $maxquota) if ($maxquota || $maxquota eq '0'); - push(@args, '-motd', $motd) if ($motd); - &wrapper('fs', \@args); - 1; -} - - -#: AFS_fs_getmount($path) -#: Get the contents of the specified AFS mount point. -#: On success, return the contents of the specified mount point. -#: If the specified path is not a mount point, return the empty string. -$AFS_Help{'fs_getmount'} = '$path => $vol'; -sub AFS_fs_getmount { - my($path) = @_; - my(@args, $vol); - - @args = ('lsmount', '-dir', $path); - &wrapper('fs', \@args, - [[ "mount point for volume '(.+)'", \$vol ]]); - $vol; -} - - -#: AFS_fs_mkmount($path, $vol, [$cell], [$rwmount], [$fast]) -#: Create an AFS mount point at $path, leading to the volume $vol. -#: If $cell is specified, create a cellular mount point to that cell. -#: If $rwmount is specified and nonzero, create a read-write mount point. -#: If $fast is specified and nonzero, don't check to see if the volume exists. -#: On success, return 1. -$AFS_Help{'fs_mkmount'} = '$path, $vol, [$cell], [$rwmount], [$fast] => Success?'; -sub AFS_fs_mkmount { - my($path, $vol, $cell, $rwmount, $fast) = @_; - my(@args); - - @args = ('mkmount', '-dir', $path, '-vol', $vol); - push(@args, '-cell', $cell) if ($cell); - push(@args, '-rw') if ($rwmount); - push(@args, '-fast') if ($fast); - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_rmmount($path) [rmmount] -#: Remove an AFS mount point at $path -#: On success, return 1 -$AFS_Help{'fs_rmmount'} = '$path => Success?'; -sub AFS_fs_rmmount { - my($path) = @_; - my(@args); - - @args = ('rmmount', '-dir', $path); - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_checkvolumes() -#: Check/update volume ID cache -#: On success, return 1 -$AFS_Help{'fs_checkvolumes'} = '=> Success?'; -sub AFS_fs_checkvolumes { - my(@args); - - @args = ('checkvolumes'); - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_flush(\@paths) -#: Flush files named by @paths from the cache -#: On success, return 1 -$AFS_Help{'fs_flush'} = '\@paths => Success?'; -sub AFS_fs_flush { - my($paths) = @_; - my(@args); - - @args = ('flush'); - push(@args, '-path', @$paths) if $paths; - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_flushmount(\@paths) -#: Flush mount points named by @paths from the cache -#: On success, return 1 -$AFS_Help{'fs_flushmount'} = '\@paths => Success?'; -sub AFS_fs_flushmount { - my($paths) = @_; - my(@args); - - @args = ('flushmount'); - push(@args, '-path', @$paths) if $paths; - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_flushvolume(\@paths) -#: Flush volumes containing @paths from the cache -#: On success, return 1 -$AFS_Help{'fs_flushvolume'} = '\@paths => Success?'; -sub AFS_fs_flushvolume { - my($paths) = @_; - my(@args); - - @args = ('flushvolume'); - push(@args, '-path', @$paths) if $paths; - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_messages($mode) -#: Set cache manager message mode -#: Valid modes are 'user', 'console', 'all', 'none' -#: On success, return 1 -$AFS_Help{'fs_messages'} = '$mode => Success?'; -sub AFS_fs_messages { - my($mode) = @_; - my(@args); - - @args = ('messages', '-show', $mode); - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_newcell($cell, \@dbservers, [$linkedcell]) -#: Add a new cell to the cache manager's list, or updating an existing cell -#: On success, return 1 -$AFS_Help{'fs_newcell'} = '$cell, \@dbservers, [$linkedcell] => Success?'; -sub AFS_fs_newcell { - my($cell, $dbservers, $linkedcell) = @_; - my(@args); - - @args = ('newcell', '-name', $cell, '-servers', @$dbservers); - push(@args, '-linkedcell', $linkedcell) if $linkedcell; - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_rxstatpeer($enable, [$clear]) -#: Control per-peer Rx statistics: -#: - if $enable is 1, enable stats -#: - if $enable is 0, disable stats -#: - if $clear is 1, clear stats -#: On success, return 1 -$AFS_Help{'fs_rxstatpeer'} = '$enable, [$clear] => Success?'; -sub AFS_fs_rxstatpeer { - my($enable, $clear) = @_; - my(@args); - - @args = ('rxstatpeer'); - push(@args, '-enable') if $enable; - push(@args, '-disable') if defined($enable) && !$enable; - push(@args, '-clear') if $clear; - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_rxstatproc($enable, [$clear]) -#: Control per-process Rx statistics: -#: - if $enable is 1, enable stats -#: - if $enable is 0, disable stats -#: - if $clear is 1, clear stats -#: On success, return 1 -$AFS_Help{'fs_rxstatproc'} = '$enable, [$clear] => Success?'; -sub AFS_fs_rxstatproc { - my($enable, $clear) = @_; - my(@args); - - @args = ('rxstatproc'); - push(@args, '-enable') if $enable; - push(@args, '-disable') if defined($enable) && !$enable; - push(@args, '-clear') if $clear; - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_setcachesize($size) -#: Set the cache size to $size K -#: On success, return 1 -$AFS_Help{'fs_setcachesize'} = '$size => Success?'; -sub AFS_fs_setcachesize { - my($size) = @_; - my(@args); - - @args = ('setcachesize', '-blocks', $size); - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_setcell(\@cells, $suid) -#: Set cell control bits for @cells -#: - if $suid is 1, enable suid programs -#: - if $suid is 0, disable suid programs -#: On success, return 1 -$AFS_Help{'fs_setcell'} = '\@cells, [$suid] => Success?'; -sub AFS_fs_setcell { - my($cells, $suid) = @_; - my(@args); - - @args = ('setcell', '-cell', @$cells); - push(@args, '-suid') if $suid; - push(@args, '-nosuid') if defined($suid) && !$suid; - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_setcrypt($enable) -#: Control cache manager encryption -#: - if $enable is 1, enable encrypted connections -#: - if $enable is 0, disable encrypted connections -#: On success, return 1 -$AFS_Help{'fs_setcrypt'} = '$enable => Success?'; -sub AFS_fs_setcrypt { - my($enable) = @_; - my(@args); - - @args = ('setcrypt', '-crypt', $enable ? 'on' : 'off'); - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_setclientaddrs(\@addrs) -#: Set client network interface addresses -#: On success, return 1 -$AFS_Help{'fs_setclientaddrs'} = '\@addrs => Success?'; -sub AFS_fs_setclientaddrs { - my($addrs) = @_; - my(@args); - - @args = ('setclientaddrs'); - push(@args, '-address', @$addrs) if $addrs; - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_copyacl($from, \@to, [$clear]) -#: Copy the access control list on $from to each directory named in @to. -#: If $clear is specified and nonzero, the target ACL's are cleared first -#: On success, return 1 -$AFS_Help{'fs_copyacl'} = '$from, \@to, [$clear] => Success?'; -sub AFS_fs_copyacl { - my($from, $to, $clear) = @_; - my(@args); - - @args = ('copyacl', '-fromdir', $from, '-todir', @$to); - push(@args, '-clear') if $clear; - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_storebehind(\@paths, [$size], [$def]) -#: Set amount of date to store after file close -#: If $size is specified, the size for each file in @paths is set to $size. -#: If $default is specified, the default size is set to $default. -#: Returns the new or current default value, and a hash mapping filenames -#: to their storebehind sizes. A hash entry whose value is undef indicates -#: that the corresponding file will use the default size. -$AFS_Help{'fs_storebehind'} = '\@paths, [$size], [$def] => ($def, \%sizes)'; -sub AFS_fs_storebehind { - my($paths, $size, $def) = @_; - my(@args, %sizes, $ndef); - - @args = ('storebehind', '-verbose'); - push(@args, '-kbytes', $size) if defined($size); - push(@args, '-files', @$paths) if $paths && @$paths; - push(@args, '-allfiles', $def) if defined($def); - &wrapper('fs', \@args, [ - ['^Will store up to (\d+) kbytes of (.*) asynchronously', - sub { $sizes{$_[1]} = $_[0] }], - ['^Will store (.*) according to default', - sub { $sizes{$_[0]} = undef }], - ['^Default store asynchrony is (\d+) kbytes', \$ndef], - ]); - ($ndef, \%sizes); -} - -#: AFS_fs_setserverprefs(\%fsprefs, \%vlprefs) -#: Set fileserver and/or VLDB server preference ranks -#: Each of %fsprefs and %vlprefs maps server names to the rank to be -#: assigned to the specified servers. -#: On success, return 1. -$AFS_Help{'fs_setserverprefs'} = '\%fsprefs, \%vlprefs => Success?'; -sub AFS_fs_setserverprefs { - my($fsprefs, $vlprefs) = @_; - my(@args, $srv); - - @args = ('setserverprefs'); - if ($fsprefs && %$fsprefs) { - push(@args, '-servers'); - foreach $srv (keys %$fsprefs) { - push(@args, $srv, $$fsprefs{$srv}); - } - } - if ($vlprefs && %$vlprefs) { - push(@args, '-vlservers'); - foreach $srv (keys %$vlprefs) { - push(@args, $srv, $$vlprefs{$srv}); - } - } - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_checkservers([$fast], [$allcells], [$cell]) -#: Check to see what fileservers are down -#: If $cell is specified, fileservers in the specified cell are checked -#: If $allcells is specified and nonzero, fileservers in all cells are checked -#: If $fast is specified and nonzero, don't probe servers -$AFS_Help{'fs_checkservers'} = '[$fast], [$allcells], [$cell] => @down'; -sub AFS_fs_checkservers { - my($fast, $allcells, $cell) = @_; - my(@args, @down); - - @args = ('checkservers'); - push(@args, '-all') if $allcells; - push(@args, '-fast') if $fast; - push(@args, '-cell', $cell) if $cell; - &wrapper('fs', \@args, [ - ['^These servers unavailable due to network or server problems: (.*)\.', - sub { push(@down, split(' ', $_[0])) }], - ]); - @down; -} - -#: AFS_fs_checkservers_interval([$interval]) -#: Get and/or set the down server check interval -#: If $interval is specified and nonzero, it is set as the new interval -#: On success, returns the old interval in seconds -$AFS_Help{'fs_checkservers_interval'} = '$interval => $oldinterval'; -sub AFS_fs_checkservers_interval { - my($interval) = @_; - my(@args, $oldinterval); - - @args = ('checkservers', '-interval', $interval); - &wrapper('fs', \@args, [ - ['^The new down server probe interval \((\d+) secs\)', \$oldinterval], - ['^The current down server probe interval is (\d+) secs', \$oldinterval], - ]); - $oldinterval; -} - -#: AFS_fs_exportafs($type, \%options); -#: Get and/or modify protocol translator settings -#: $type is the translator type, which must be 'nfs' -#: %options specifies the options to be set. Each key is the name of an -#: option, which is enabled if the value is 1, and disabled if the value -#: is 0. The following options are supported: -#: start Enable exporting of AFS -#: convert Copy AFS owner mode bits to UNIX group/other mode bits -#: uidcheck Strict UID checking -#: submounts Permit mounts of /afs subdirectories -#: On success, returns an associative array %modes, which is of the same -#: form, indicating which options are enabled. -$AFS_Help{'fs_exportafs'} = '$type, \%options => %modes'; -sub AFS_fs_exportafs { - my($type, $options) = @_; - my(@args, %modes); - - @args = ('exportafs', '-type', $type); - foreach (qw(start convert uidcheck submounts)) { - push(@args, "-$_", $$options{$_} ? 'on' : 'off') if exists($$options{$_}); - } - - &wrapper('fs', \@args, [ - ['translator is disabled', sub { $modes{'start'} = 0 }], - ['translator is enabled', sub { $modes{'start'} = 1 }], - ['strict unix', sub { $modes{'convert'} = 0 }], - ['convert owner', sub { $modes{'convert'} = 1 }], - [q/no 'passwd sync'/, sub { $modes{'uidcheck'} = 0 }], - [q/strict 'passwd sync'/, sub { $modes{'uidcheck'} = 1 }], - ['Only mounts', sub { $modes{'submounts'} = 0 }], - ['Allow mounts', sub { $modes{'submounts'} = 1 }], - ]); - %modes; -} - - -#: AFS_fs_getcacheparms() -#: Returns the size of the cache, and the amount of cache space used. -#: Sizes are returned in 1K blocks. -$AFS_Help{'fs_getcacheparms'} = 'void => ($size, $used)'; -sub AFS_fs_getcacheparms { - my(@args, $size, $used); - - @args = ('getcacheparms'); - &wrapper('fs', \@args, [ - [q/AFS using (\d+) of the cache's available (\d+) 1K byte blocks/, - \$used, \$size], - ]); - ($size, $used); -} - -#: AFS_fs_getcellstatus(\@cells) -#: Get cell control bits for cells listed in @cells. -#: On success, returns a hash mapping cells to their status; keys are -#: cell names, and values are 1 if SUID programs are permitted for that -#: cell, and 0 if not. -$AFS_Help{'fs_getcellstatus'} = '\@cells => %status'; -sub AFS_fs_getcellstatus { - my($cells) = @_; - my(@args, %status); - - @args = ('getcellstatus', '-cell', @$cells); - &wrapper('fs', \@args, [ - ['Cell (.*) status: setuid allowed', sub { $status{$_[0]} = 1 }], - ['Cell (.*) status: no setuid allowed', sub { $status{$_[0]} = 0 }], - ]); - %status; -} - -#: AFS_fs_getclientaddrs -#: Returns a list of the client interface addresses -$AFS_Help{'fs_getclientaddrs'} = 'void => @addrs'; -sub AFS_fs_getclientaddrs { - my(@args, @addrs); - - @args = ('getclientaddrs'); - &wrapper('fs', \@args, [ - ['^(\d+\.\d+\.\d+\.\d+)', \@addrs ] - ]); - @addrs; -} - -#: AFS_fs_getcrypt -#: Returns the cache manager encryption flag -$AFS_Help{'fs_getcrypt'} = 'void => $crypt'; -sub AFS_fs_getcrypt { - my(@args, $crypt); - - @args = ('getcrypt'); - &wrapper('fs', \@args, [ - ['^Security level is currently clear', sub { $crypt = 0 }], - ['^Security level is currently crypt', sub { $crypt = 1 }], - ]); - $crypt; -} - -#: AFS_fs_getserverprefs([$vlservers], [$numeric]) -#: Get fileserver or vlserver preference ranks -#: If $vlservers is specified and nonzero, VLDB server ranks -#: are retrieved; otherwise fileserver ranks are retrieved. -#: If $numeric is specified and nonzero, servers are identified -#: by IP address instead of by hostname. -#: Returns a hash whose keys are server names or IP addresses, and -#: whose values are the ranks of those servers. -$AFS_Help{'fs_getserverprefs'} = '[$vlservers], [$numeric] => %prefs'; -sub AFS_fs_getserverprefs { - my($vlservers, $numeric) = @_; - my(@args, %prefs); - - @args = ('getserverprefs'); - push(@args, '-numeric') if $numeric; - push(@args, '-vlservers') if $vlservers; - &wrapper('fs', \@args, [ - ['^(\S+)\s*(\d+)', \%prefs], - ]); - %prefs; -} - -#: AFS_fs_listcells([$numeric') -#: Get a list of cells known to the cache manager, and the VLDB -#: servers for each cell. -#: If $numeric is specified and nonzero, VLDB servers are identified -#: by IP address instead of by hostname. -#: Returns a hash where each key is a cell name, and each value is -#: a list of VLDB servers for the corresponding cell. -$AFS_Help{'fs_listcells'} = '[$numeric] => %cells'; -sub AFS_fs_listcells { - my($numeric) = @_; - my(@args, %cells); - - @args = ('listcells'); - push(@args, '-numeric') if $numeric; - &wrapper('fs', \@args, [ - ['^Cell (\S+) on hosts (.*)\.', - sub { $cells{$_[0]} = [ split(' ', $_[1]) ] }], - ]); - %cells; -} - -#: AFS_fs_setmonitor($server) -#: Set the cache manager monitor host to $server. -#: If $server is 'off' or undefined, monitoring is disabled. -#: On success, return 1. -$AFS_Help{'fs_setmonitor'} = '$server => Success?'; -sub AFS_fs_setmonitor { - my($server) = @_; - my(@args); - - @args = ('monitor', '-server', defined($server) ? $server : 'off'); - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_getmonitor -#: Return the cache manager monitor host, or undef if monitoring is disabled. -$AFS_Help{'fs_getmonitor'} = 'void => $server'; -sub AFS_fs_getmonitor { - my(@args, $server); - - @args = ('monitor'); - &wrapper('fs', \@args, [ - ['Using host (.*) for monitor services\.', \$server], - ]); - $server; -} - -#: AFS_fs_getsysname -#: Returns the current list of system type names -$AFS_Help{'fs_getsysname'} = 'void => @sys'; -sub AFS_fs_getsysname { - my(@args, @sys); - - @args = ('sysname'); - &wrapper('fs', \@args, [ - [q/Current sysname is '(.*)'/, \@sys], - [q/Current sysname list is '(.*)'/, - sub { push(@sys, split(q/' '/, $_[0])) }], - ]); - @sys; -} - -#: AFS_fs_setsysname(\@sys) -#: Sets the system type list to @sys -#: On success, return 1. -$AFS_Help{'fs_setsysname'} = '$server => Success?'; -sub AFS_fs_setsysname { - my($sys) = @_; - my(@args); - - @args = ('sysname', '-newsys', @$sys); - &wrapper('fs', \@args); - 1; -} - -#: AFS_fs_whichcell(\@paths) -#: Get the cells containing the specified paths -#: Returns a hash in which each key is a pathname, and each value -#: is the name of the cell which contains the corresponding file. -$AFS_Help{'fs_whichcell'} = '\@paths => %where'; -sub AFS_fs_whichcell { - my($paths) = @_; - my(@args, %where); - - @args = ('whichcell', '-path', @$paths); - &wrapper('fs', \@args, [ - [q/^File (.*) lives in cell '(.*)'/, \%where], - ]); - %where; -} - -#: AFS_fs_wscell -#: Returns the name of the workstation's home cell -$AFS_Help{'fs_wscell'} = 'void => $cell'; -sub AFS_fs_wscell { - my(@args, $cell); - - @args = ('wscell'); - &wrapper('fs', \@args, [ - [q/^This workstation belongs to cell '(.*)'/, \$cell], - ]); - $cell; -} - diff --git a/src/tests/kas.pm b/src/tests/kas.pm deleted file mode 100644 index 376f62a9a..000000000 --- a/src/tests/kas.pm +++ /dev/null @@ -1,325 +0,0 @@ -# CMUCS AFStools -# Copyright (c) 1996, Carnegie Mellon University -# All rights reserved. -# -# See CMU_copyright.ph for use and distribution information -# -#: * kas.pm - Wrappers around KAS commands (authentication maintenance) -#: * This module provides wrappers around the various kaserver commands -#: * giving them a nice perl-based interface. At present, this module -#: * requires a special 'krbkas' which uses existing Kerberos tickets -#: * which the caller must have already required (using 'kaslog'). -#: - -package OpenAFS::kas; -use OpenAFS::CMU_copyright; -use OpenAFS::util qw(:DEFAULT :afs_internal); -use OpenAFS::wrapper; -use POSIX (); -use Exporter; - -$VERSION = ''; -$VERSION = '1.00'; -@ISA = qw(Exporter); -@EXPORT = qw(&AFS_kas_create &AFS_kas_setf - &AFS_kas_delete &AFS_kas_setkey - &AFS_kas_examine &AFS_kas_setpw - &AFS_kas_randomkey &AFS_kas_stringtokey - &AFS_kas_list); - -# Instructions to parse kas error messages -@kas_err_parse = ( [ ' : \[.*\] (.*), wait one second$', '.' ], - [ ' : \[.*\] (.*) \(retrying\)$', '.' ], - [ ' : \[.*\] (.*)', '-' ]); - -# Instructions to parse attributes of an entry -@kas_entry_parse = ( - [ '^User data for (.*) \((.*)\)$', 'princ', 'flags', '.' ], - [ '^User data for (.*)', 'princ' ], - [ 'key \((\d+)\) cksum is (\d+),', 'kvno', 'cksum' ], - [ 'last cpw: (.*)', \&parsestamp, 'stamp_cpw' ], - [ 'password will (never) expire', 'stamp_pwexp' ], - [ 'password will expire: ([^\.]*)', \&parsestamp, 'stamp_pwexp' ], - [ 'An (unlimited) number of', 'max_badauth' ], - [ '(\d+) consecutive unsuccessful', 'max_badauth' ], - [ 'for this user is ([\d\.]+) minutes', 'locktime' ], - [ 'for this user is (not limited)', 'locktime' ], - [ 'User is locked (forever)', 'locked' ], - [ 'User is locked until (.*)', \&parsestamp, 'locked' ], - [ 'entry (never) expires', 'stamp_expire' ], - [ 'entry expires on ([^\.]*)\.', \&parsestamp, 'stamp_expire' ], - [ 'Max ticket lifetime (.*) hours', 'maxlife' ], - [ 'Last mod on (.*) by', \&parsestamp, 'stamp_update' ], - [ 'Last mod on .* by (.*)', 'last_writer' ]); - - -@Months = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', - 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); -%Months = map(($Months[$_] => $_), 0..11); - -# Parse a timestamp -sub parsestamp { - my($stamp) = @_; - my($MM, $DD, $YYYY, $hh, $mm, $ss); - - if ($stamp =~ /^\S+ (\S+) (\d+) (\d+):(\d+):(\d+) (\d+)/) { - ($MM, $DD, $hh, $mm, $ss, $YYYY) = ($1, $2, $3, $4, $5, $6); - $YYYY -= 1900; - $MM = $Months{$MM}; - if (defined($MM)) { - $stamp = POSIX::mktime($ss, $mm, $hh, $DD, $MM, $YYYY); - } - } - $stamp; -} - - -# Turn an 8-byte key into a string we can give to kas -sub stringize_key { - my($key) = @_; - my(@chars) = unpack('CCCCCCCC', $key); - - sprintf("\\%03o" x 8, @chars); -} - - -# Turn a string into an 8-byte DES key -sub unstringize_key { - my($string) = @_; - my($char, $key); - - while ($string ne '') { - if ($string =~ /^\\(\d\d\d)/) { - $char = $1; - $string = $'; - $key .= chr(oct($char)); - } else { - $key .= substr($string, 0, 1); - $string =~ s/^.//; - } - } - $key; -} - - -#: AFS_kas_create($princ, $initpass, [$cell]) -#: Create a principal with name $princ, and initial password $initpass -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{kas_create} = '$princ, $initpass, [$cell] => Success?'; -sub AFS_kas_create { - my($print, $initpass, $cell) = @_; - my(@args, $id); - - @args = ('create', '-name', $princ, '-initial_password', $initpass); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('krbkas', \@args, [ @kas_err_parse ]); - 1; -} - - -#: AFS_kas_delete($princ, [$cell]) -#: Delete the principal $princ. -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{kas_delete} = '$princ, [$cell] => Success?'; -sub AFS_kas_delete { - my($princ, $cell) = @_; - my(@args); - - @args = ('delete', '-name', $princ); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('krbkas', \@args, [ @kas_err_parse ]); - 1; -} - - -#: AFS_kas_examine($princ, [$cell]) -#: Examine the prinicpal $princ, and return information about it. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return an associative array with some or all of the following: -#: - princ Name of this principal -#: - kvno Key version number -#: - cksum Key checksum -#: - maxlife Maximum ticket lifetime (in hours) -#: - stamp_expire Time this principal expires, or 'never' -#: - stamp_pwexp Time this principal's password expires, or 'never' -#: - stamp_cpw Time this principal's password was last changed -#: - stamp_update Time this princiapl was last modified -#: - last_writer Administrator who last modified this principal -#: - max_badauth Maximum number of bad auth attempts, or 'unlimited' -#: - locktime Penalty time for bad auth (in minutes), or 'not limited' -#: - locked Set and non-empty if account is locked -#: - expired Set and non-empty if account is expired -#: - flags Reference to a list of flags -#: -$AFS_Help{kas_examine} = '$princ, [$cell] => %info'; -sub AFS_kas_examine { - my($vol, $cell) = @_; - my(%result, @args, $flags); - - @args = ('examine', '-name', $princ); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - %result = &wrapper('krbkas', \@args, [ @kas_err_parse, @kas_entry_parse ]); - - if ($result{flags}) { - $result{expired} = 1 if ($result{flags} =~ /expired/); - $result{flags} = [ split(/\+/, $result{flags}) ]; - } - %result; -} - - -#: AFS_kas_list([$cell]) -#: Get a list of principals in the kaserver database -#: If specified, work in $cell instead of the default cell. -#: On success, return an associative array whose keys are names of kaserver -#: principals, and each of whose values is an associative array describing -#: the corresponding principal, containing some or all of the same elements -#: that may be returned by AFS_kas_examine -#: -$AFS_Help{kas_list} = '[$cell] => %princs'; -sub AFS_kas_list { - my($cell) = @_; - my(@args, %finres, %plist); - - @args = ('list', '-long'); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - %finres = &wrapper('krbkas', \@args, - [ @kas_err_parse, - [ '^User data for (.*)', sub { - my(%pinfo) = %OpenAFS::wrapper::result; - - if ($pinfo{name}) { - $plist{$pinfo{name}} = \%pinfo; - %OpenAFS::wrapper::result = (); - } - }], - @kas_entry_parse ]); - - if ($finres{name}) { - $plist{$finres{name}} = \%finres; - } - %plist; -} - - -#: AFS_kas_setf($princ, \%attrs, [$cell]) -#: Change the attributes of the principal $princ. -#: If specified, operate in cell $cell instead of the default cell. -#: The associative array %attrs specifies the attributes to change and -#: their new values. Any of the following attributes may be changed: -#: - flags Entry flags -#: - expire Expiration time (mm/dd/yy) -#: - lifetime Maximum ticket lifetime (seconds) -#: - pwexpires Maximum password lifetime (days) -#: - reuse Permit password reuse (yes/no) -#: - attempts Maximum failed authentication attempts -#: - locktime Authentication failure penalty (minutes or hh:mm) -#: -#: On success, return 1. -#: -$AFS_Help{kas_setf} = '$princ, \%attrs, [$cell] => Success?'; -sub AFS_kas_setf { - my($princ, $attrs, $cell) = @_; - my(%result, @args); - - @args = ('setfields', '-name', $princ); - push(@args, '-flags', $$attrs{flags}) if ($$attrs{flags}); - push(@args, '-expiration', $$attrs{expire}) if ($$attrs{expire}); - push(@args, '-lifetime', $$attrs{lifetime}) if ($$attrs{lifetime}); - push(@args, '-pwexpires', $$attrs{pwexpires}) if ($$attrs{pwexpires}); - push(@args, '-reuse', $$attrs{reuse}) if ($$attrs{reuse}); - push(@args, '-attempts', $$attrs{attempts}) if ($$attrs{attempts}); - push(@args, '-locktime', $$attrs{locktime}) if ($$attrs{locktime}); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('krbkas', \@args, [ @kas_err_parse ]); - 1; -} - - -#: AFS_kas_setkey($princ, $key, [$kvno], [$cell]) -#: Change the key of principal $princ to the specified value. -#: $key is the 8-byte DES key to use for this principal. -#: If specified, set the key version number to $kvno. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{kas_setkey} = '$princ, $key, [$kvno], [$cell] => Success?'; -sub AFS_kas_setkey { - my($princ, $key, $kvno, $cell) = @_; - my(@args); - - @args = ('setkey', '-name', $princ, '-new_key', &stringize_key($key)); - push(@args, '-kvno', $kvno) if (defined($kvno)); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('krbkas', \@args, [ @kas_err_parse ]); - 1; -} - - -#: AFS_kas_setpw($princ, $password, [$kvno], [$cell]) -#: Change the key of principal $princ to the specified value. -#: $password is the new password to use. -#: If specified, set the key version number to $kvno. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{kas_setpw} = '$princ, $password, [$kvno], [$cell] => Success?'; -sub AFS_kas_setpw { - my($princ, $password, $kvno, $cell) = @_; - my(@args); - - @args = ('setpasswd', '-name', $princ, '-new_password', $password); - push(@args, '-kvno', $kvno) if (defined($kvno)); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('krbkas', \@args, [ @kas_err_parse ]); - 1; -} - - -#: AFS_kas_stringtokey($string, [$cell]) -#: Convert the specified string to a DES key -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return the resulting key -$AFS_Help{kas_stringtokey} = '$string, [$cell] => $key'; -sub AFS_kas_stringtokey { - my($string, $cell) = @_; - my(@args, $key); - - @args = ('stringtokey', '-string', $string); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('krbkas', \@args, - [ @kas_err_parse, - [ q/^Converting .* in realm .* yields key='(.*)'.$/, \$key ]]); - &unstringize_key($key); -} - - -#: AFS_kas_randomkey([$cell]) -#: Ask the kaserver to generate a random DES key -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return the resulting key -$AFS_Help{kas_randomkey} = '[$cell] => $key'; -sub AFS_kas_randomkey { - my($cell) = @_; - my(@args, $key); - - @args = ('getrandomkey'); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('krbkas', \@args, - [ @kas_err_parse, - [ '^Key: (\S+)', \$key ]]); - &unstringize_key($key); -} - -1; diff --git a/src/tests/make-page.c b/src/tests/make-page.c index 7a8ff6be1..9a042997d 100644 --- a/src/tests/make-page.c +++ b/src/tests/make-page.c @@ -43,6 +43,7 @@ #include #include #include +#include #include diff --git a/src/tests/pts.pm b/src/tests/pts.pm deleted file mode 100644 index 715b5e1dd..000000000 --- a/src/tests/pts.pm +++ /dev/null @@ -1,306 +0,0 @@ -# CMUCS AFStools -# Copyright (c) 1996, Carnegie Mellon University -# All rights reserved. -# -# See CMU_copyright.ph for use and distribution information -# -#: * pts.pm - Wrappers around PTS commands (user/group maintenance) -#: * This module provides wrappers around the various PTS commands, giving -#: * them a nice perl-based interface. Someday, they might talk to the -#: * ptserver directly instead of using 'pts', but not anytime soon. -#: - -package OpenAFS::pts; -use OpenAFS::CMU_copyright; -use OpenAFS::util qw(:DEFAULT :afs_internal); -use OpenAFS::wrapper; -use Exporter; - -$VERSION = ''; -$VERSION = '1.00'; -@ISA = qw(Exporter); -@EXPORT = qw(&AFS_pts_createuser &AFS_pts_listmax - &AFS_pts_creategroup &AFS_pts_setmax - &AFS_pts_delete &AFS_pts_add - &AFS_pts_rename &AFS_pts_remove - &AFS_pts_examine &AFS_pts_members - &AFS_pts_chown &AFS_pts_listown - &AFS_pts_setf); - - -#: AFS_pts_createuser($user, [$id], [$cell]) -#: Create a PTS user with $user as its name. -#: If specified, use $id as the PTS id; otherwise, AFS picks one. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return the PTS id of the newly-created user. -#: -$AFS_Help{pts_createuser} = '$user, [$id], [$cell] => $uid'; -sub AFS_pts_createuser { - my($user, $id, $cell) = @_; - my(@args, $uid); - - @args = ('createuser', '-name', $user); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - push(@args, '-id', $id) if ($id); - &wrapper('pts', \@args, [[ '^User .* has id (\d+)', \$uid ]]); - $uid; -} - - -#: AFS_pts_creategroup($group, [$id], [$owner], [$cell]) -#: Create a PTS group with $group as its name. -#: If specified, use $id as the PTS id; otherwise, AFS picks one. -#: If specified, use $owner as the owner, instead of the current user. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return the PTS id of the newly-created group. -#: -$AFS_Help{pts_creategroup} = '$group, [$id], [$owner], [$cell] => $gid'; -sub AFS_pts_creategroup { - my($group, $id, $owner, $cell) = @_; - my(@args, $uid); - - @args = ('creategroup', '-name', $group); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - push(@args, '-id', $id) if ($id); - push(@args, '-owner', $owner) if ($owner); - &wrapper('pts', \@args, [[ '^group .* has id (\-\d+)', \$uid ]]); - $uid; -} - - -#: AFS_pts_delete(\@objs, [$cell]) -#: Attempt to destroy PTS objects listed in @objs. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return 1. -#: If multiple objects are specified and only some are destroyed, some -#: operations may be left untried. -#: -$AFS_Help{pts_delete} = '\@objs, [$cell] => Success?'; -sub AFS_pts_delete { - my($objs, $cell) = @_; - my(@args); - - @args = ('delete', '-nameorid', @$objs); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('pts', \@args); - 1; -} - - -#: AFS_pts_rename($old, $new, [$cell]) -#: Rename the PTS object $old to have the name $new. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{pts_rename} = '$old, $new, [$cell] => Success?'; -sub AFS_pts_rename { - my($old, $new, $cell) = @_; - my(@args); - - @args = ('rename', '-oldname', $old, '-newname', $new); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('pts', \@args); - 1; -} - - -#: AFS_pts_examine($obj, [$cell]) -#: Examine the PTS object $obj, and return information about it. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return an associative array with some or all of the following: -#: - name Name of this object -#: - id ID of this object -#: - owner Name or ID of owner -#: - creator Name or ID of creator -#: - mem_count Number of members (group) or memberships (user) -#: - flags Privacy/access flags (as a string) -#: - group_quota Remaining group quota -#: -$AFS_Help{pts_examine} = '$obj, [$cell] => %info'; -sub AFS_pts_examine { - my($obj, $cell) = @_; - my(@args); - - @args = ('examine', '-nameorid', $obj); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('pts', \@args, - [[ '^Name\: (.*)\, id\: ([\-0-9]+)\, owner\: (.*)\, creator\: (.*)\,$', #', - 'name', 'id', 'owner', 'creator' ], - [ '^ membership\: (\d+)\, flags\: (.....)\, group quota\: (\d+)\.$', #', - 'mem_count', 'flags', 'group_quota' ] - ]); -} - - -#: AFS_pts_chown($obj, $owner, [$cell]) -#: Change the owner of the PTS object $obj to be $owner. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{pts_chown} = '$obj, $owner, [$cell] => Success?'; -sub AFS_pts_chown { - my($obj, $owner, $cell) = @_; - my(@args); - - @args = ('chown', '-name', $obj, '-owner', $owner); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('pts', \@args); - 1; -} - - -#: AFS_pts_setf($obj, [$access], [$gquota], [$cell]) -#: Change the access flags and/or group quota for the PTS object $obj. -#: If specified, $access specifies the new access flags in the standard 'SOMAR' -#: format; individual flags may be specified as '.' to keep the current value. -#: If specified, $gquota specifies the new group quota. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{pts_setf} = '$obj, [$access], [$gquota], [$cell] => Success?'; -sub AFS_pts_setf { - my($obj, $access, $gquota, $cell) = @_; - my(%result, @args); - - @args = ('setfields', '-nameorid', $obj); - push(@args, '-groupquota', $gquota) if ($gquota ne ''); - if ($access) { - my(@old, @new, $i); - # Ensure access is 5 characters - if (length($access) < 5) { - $access .= ('.' x (5 - length($access))); - } elsif (length($access) > 5) { - substr($access, 5) = ''; - } - - %result = &AFS_pts_examine($obj, $cell); - - @old = split(//, $result{'flags'}); - @new = split(//, $access); - foreach $i (0 .. 4) { - $new[$i] = $old[$i] if ($new[$i] eq '.'); - } - $access = join('', @new); - if ($access ne $result{'flags'}) { - push(@args, '-access', $access); - } - } - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('pts', \@args); - 1; -} - - -#: AFS_pts_listmax([$cell]) -#: Fetch the maximum assigned group and user ID. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, returns (maxuid, maxgid) -#: -$AFS_Help{pts_listmax} = '[$cell] => ($maxuid, $maxgid)'; -sub AFS_pts_listmax { - my($cell) = @_; - my(@args, $uid, $gid); - - @args = ('listmax'); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('pts', \@args, - [[ '^Max user id is (\d+) and max group id is (\-\d+).', - \$uid, \$gid ]]); - ($uid, $gid); -} - - -#: AFS_pts_setmax([$maxuser], [$maxgroup], [$cell]) -#: Set the maximum assigned group and/or user ID. -#: If specified, $maxuser is the new maximum user ID -#: If specified, $maxgroup is the new maximum group ID -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{pts_setmax} = '[$maxuser], [$maxgroup], [$cell] => Success?'; -sub AFS_pts_setmax { - my($maxuser, $maxgroup, $cell) = @_; - my(@args); - - @args = ('setmax'); - push(@args, '-group', $maxgroup) if ($maxgroup); - push(@args, '-user', $maxuser) if ($maxuser); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('pts', \@args); - 1; -} - -#: AFS_pts_add(\@users, \@groups, [$cell]) -#: Add users specified in @users to groups specified in @groups. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return 1. -#: If multiple users and/or groups are specified and only some memberships -#: are added, some operations may be left untried. -#: -$AFS_Help{pts_add} = '\@users, \@groups, [$cell] => Success?'; -sub AFS_pts_add { - my($users, $groups, $cell) = @_; - my(@args); - - @args = ('adduser', '-user', @$users, '-group', @$groups); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('pts', \@args); - 1; -} - - -#: AFS_pts_remove(\@users, \@groups, [$cell]) -#: Remove users specified in @users from groups specified in @groups. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return 1. -#: If multiple users and/or groups are specified and only some memberships -#: are removed, some operations may be left untried. -#: -$AFS_Help{pts_remove} = '\@users, \@groups, [$cell] => Success?'; -sub AFS_pts_remove { - my($users, $groups, $cell) = @_; - my(@args); - - @args = ('removeuser', '-user', @$users, '-group', @$groups); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('pts', \@args); - 1; -} - - -#: AFS_pts_members($obj, [$cell]) -#: If $obj specifies a group, retrieve a list of its members. -#: If $obj specifies a user, retrieve a list of groups to which it belongs. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return the resulting list. -#: -$AFS_Help{pts_members} = '$obj, [$cell] => @members'; -sub AFS_pts_members { - my($obj, $cell) = @_; - my(@args, @grouplist); - - @args = ('membership', '-nameorid', $obj); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('pts', \@args, [[ '^ (.*)', \@grouplist ]]); - @grouplist; -} - - -#: AFS_pts_listown($owner, [$cell]) -#: Retrieve a list of PTS groups owned by the PTS object $obj. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return the resulting list. -#: -$AFS_Help{pts_listown} = '$owner, [$cell] => @owned'; -sub AFS_pts_listown { - my($owner, $cell) = @_; - my(@args, @grouplist); - - @args = ('listowned', '-nameorid', $owner); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('pts', \@args, [[ '^ (.*)', \@grouplist ]]); - @grouplist; -} - - -1; diff --git a/src/tests/rename-under-feet.c b/src/tests/rename-under-feet.c index 83cb187f6..79e359a1b 100644 --- a/src/tests/rename-under-feet.c +++ b/src/tests/rename-under-feet.c @@ -39,6 +39,7 @@ #include #include #include +#include #include #include diff --git a/src/tests/util.pm b/src/tests/util.pm deleted file mode 100644 index ec1c52af6..000000000 --- a/src/tests/util.pm +++ /dev/null @@ -1,356 +0,0 @@ -# CMUCS AFStools -# Copyright (c) 1996, Carnegie Mellon University -# All rights reserved. -# -# See CMUCS/CMU_copyright.ph for use and distribution information - -package OpenAFS::util; - -=head1 NAME - -OpenAFS::util - General AFS utilities - -=head1 SYNOPSIS - - use OpenAFS::util; - - AFS_Init(); - AFS_Trace($subject, $level); - AFS_SetParm($parm, $value); - - use OpenAFS::util qw(GetOpts_AFS); - %options = GetOpts_AFS(\@argv, \@optlist); - -=head1 DESCRIPTION - -This module defines a variety of AFS-related utility functions. Virtually -every application that uses AFStools will need to use some of the utilities -defined in this module. In addition, a variety of global variables are -defined here for use by all the AFStools modules. Most of these are -private, but a few are semi-public. - -=cut - -use OpenAFS::CMU_copyright; -use OpenAFS::config; -require OpenAFS::afsconf; ## Avoid circular 'use' dependencies -use Exporter; - -$VERSION = ''; -$VERSION = '1.00'; -@ISA = qw(Exporter); -@EXPORT = qw(&AFS_Init - &AFS_Trace - &AFS_SetParm); -@EXPORT_OK = qw(%AFS_Parms - %AFS_Trace - %AFS_Help - %AFScmd - &GetOpts_AFS - &GetOpts_AFS_Help); -%EXPORT_TAGS = (afs_internal => [qw(%AFS_Parms %AFS_Trace %AFScmd %AFS_Help)], - afs_getopts => [qw(&GetOpts_AFS &GetOpts_AFS_Help)] ); - - -=head2 AFS_Init() - -This function does basic initialization of AFStools. It must be called before -any other AFStools function. - -=cut - -sub AFS_Init -{ - my(@dirs, $c, $i, $x); - - $AFS_Parms{'authlvl'} = 1; - $AFS_Parms{'confdir'} = $def_ConfDir; - $AFS_Parms{'cell'} = OpenAFS::afsconf::AFS_conf_localcell(); - - # Search for AFS commands - @dirs = @CmdPath; - foreach $c (@CmdList) - { - $AFScmd{$c} = ''; - foreach $i ($[ .. $#dirs) - { - $x = $dirs[$i]; - if (-x "$x/$c" && ! -d "$x/$c") - { - $AFScmd{$c} = "$x/$c"; - splice(@dirs, $i, 1); # Move this item to the start of the array - unshift(@dirs, $x); - last; - } - } - return "Unable to locate $c!" if (!$AFScmd{$c}); - } - 0; -} - - -=head2 AFS_Trace($subject, $level) - -Sets the tracing level for a particular "subject" to the specified level. -All tracing levels start at 0, and can be set to higher values to get debugging -information from different parts of AFStools. This function is generally -only of use to people debugging or extending AFStools. - -=cut - -$AFS_Help{Trace} = '$subject, $level => void'; -sub AFS_Trace { - my($subject, $level) = @_; - - $AFS_Trace{$subject} = $level; -} - - -=head2 AFS_SetParm($parm, $value) - -Sets the AFStools parameter I<$parm> to I<$value>. AFStools parameters are -used to alter the behaviour of various parts of the system. The following -parameters are currently defined: - -=over 10 - -=item authlvl - -The authentication level to use for commands that talk directly to AFS -servers (bos, vos, pts, etc.). Set to 0 for unauthenticated access (-noauth), -1 to use the user's existing tokens, or 2 to use the AFS service key -(-localauth). - -=item cell - -The default AFS cell in which to work. This is initially the workstation's -local cell. - -=item confdir - -The AFS configuration directory to use. If none is specified, the default -(as defined in OpenAFS::config) will be used. - -=item vostrace - -Set the tracing level used by various B utilities. The default is 0, -which disables any tracing of activity of B commands. A setting of 1 -copies output from all commands except those which are invoked solely to -get information; a setting of 2 additionally uses the "-verbose" command -on any command whose output is copied. If a setting of 3 is used, all -B commands will be invoked with "-verbose", and have their output -copied to stdout. - -=back - -=cut - -$AFS_Help{SetParm} = '$parm, $value => void'; -sub AFS_SetParm { - my($parm, $value) = @_; - - $AFS_Parms{$parm} = $value; -} - - -#: GetOpts_AFS(\@argv, \@optlist) -#: Parse AFS-style options. -#: \@argv is a hard reference to the list of arguments to be parsed. -#: \@optlist is a hard reference to the list of option specifications for valid -#: options; in their default order. Each option specification, in turn, is a -#: hard reference to an associative array containing some of the following -#: elements: -#: name => The name of the argument -#: numargs => Number of arguments (0, 1, or -1 for multiple) -#: required => If nonzero, this argument is required -#: default => Value to give this option if not specified -#: noauto => Don't use this option for unadorned arguments -#: -#: Results are returned in the form of an associative array of options and -#: their values: -#: - Boolean (0-argument) options have a value of 1 if specified. This type -#: of option may not be marked 'required'. -#: - Simple (1-argument) options have a value which is the string given by the -#: user. -#: - Multiple-argument options have a value which is a hard reference to an -#: array of values given by the user. -#: -#: Argument parsing is done in a similar manner to the argument parser used by -#: various AFS utilities. Options have multi-character names, and may not be -#: combined with their arguments or other options. Those options which take -#: arguments use up at least the next argument, regardless of whether it begins -#: with a dash. Options which can take multiple arguments will eat at least -#: one argument, as well as any following argument up to the next option (i.e., -#: the next argument beginning with a dash). An "unadorned" argument will be -#: used by the next argument-taking option. If there are multiple unadorned -#: arguments, they will be used up by successive arguments much in the same -#: way Perl handles list assignment - each one-argument (scalar) option will -#: use one argument; the first multi-argument (list) option will use up any -#: remaining unadorned arguments. -#: -#: On completion, @argv will be left with any unparsed arguments (this can -#: happen if the last option specified is _not_ a multi-argument option, and -#: there are no "defaulted" options). This is considered to be an error -#: condition. -#: -sub GetOpts_AFS_Help { - my($cmd, $optlist) = @_; - my($option, $optname, $desc); - - foreach $option (@$optlist) { - $optname = '-' . $$option{name}; - if ($$option{numargs}) { - $desc = $$option{desc} ? $$option{desc} : $$option{name}; - $desc = " <$desc>"; - $desc .= '+' if ($$option{numargs} < 0); - $optname .= $desc; - } - $optname = "[$optname]" if (!$$option{required}); - $cmd .= " $optname"; - } - $cmd; -} - -sub _which_opt { - my($optname, @options) = @_; - my($o, $which, $n); - - foreach $o (@options) { - next unless ($o =~ /^$optname/); - $n++; - $which = $o; - } - ($n == 1) ? $which : $optname; -} - -sub GetOpts_AFS { - my($argv, $optlist) = @_; - my(@autolist, %opttbl, %result); - my($stop, $key, $value, $diemsg); - - # Initialization: - @autolist = map { - if ($_->{numargs} && !$_->{noauto} && !$stop) { - $stop = 1 if ($_->{numargs} < 0); - ($_->{name}); - } else { - (); - } - } (@$optlist, { name=>'-help', numargs=>0, required=>0 } ); - %opttbl = map { $_->{name} => $_ } @$optlist; - - while (@$argv) { - my($optname, $optkind); - - # Parse the next argument. It can either be an option, or an - # unadorned argument. If the former, shift it off and process it. - # Otherwise, grab the next "automatic" option. If there are no - # more automatic options, we have extra arguments and should return. - if ($argv->[0] =~ /^-(.+)/) { # Got an option! - $optname = $1; - shift(@$argv); - } else { # An unadorned argument - if (@autolist) { - $optname = shift(@autolist); - } else { - $diemsg = join(' ', "Extra arguments:", @$argv) unless ($diemsg); - shift @$argv; - next; - } - } - $optname = &_which_opt($optname, keys %opttbl); - - # Find out how many arguments this thing wants, then remove it from - # the option table and automatic option list. - $optkind = $opttbl{$optname}->{numargs}; - delete $opttbl{$optname}; - @autolist = grep($_ ne $optname, @autolist); - - # Parse arguments (if any), and set the result value - if (!$optkind) { # Boolean! - $result{$optname} = 1; - } elsif ($optkind == 1) { # Single argument - # Shift off a single argument, or signal an error - if (!@$argv) { - $diemsg = "No argument for -$optname" unless ($diemsg); - next; - } - $result{$optname} = shift(@$argv); - } elsif ($optkind < 0) { # Multiple arguments - # Shift off at least one argument, and any additional - # ones that are present. EXCEPT, if there are no more - # explicitly-specified options but there ARE automatic - # options left in our list, then only eat up one. - my($val, @val); - if (!@$argv) { - $diemsg = "No argument for -$optname" unless ($diemsg); - next; - } - $val = shift(@$argv); - push(@val, shift @$argv) while (@$argv && $argv->[0] !~ /^-/); - if (@autolist && !@$argv) { - unshift(@$argv, @val); - @val = ($val); - } else { - unshift(@val, $val); - } - $result{$optname} = [@val]; - } else { - die "Invalid argument spec for -$optname ($optkind)\n"; - } - } - - # Now for a little clean-up - # Set default values for any unspecified option that has them. - # Set an error condition if there are any required options that - # were not specified. - while (($key, $value) = each %opttbl) { - if ($value->{required}) { - $diemsg = "Required option -$key not specified" unless($diemsg); - } - $result{$key} = $value->{default}; - } - if ($diemsg && !$result{help}) { die $diemsg . "\n" } - %result; -} - - -1; - -=head1 VARIABLES - -The following global variables are defined by B. None of these -are exported by default. Those marked "Private" should not be used outside -AFStools; their names, meaning, and even existence may change at any time. - -=over 12 - -=item %AFS_Help - Help info - -This array contains argument lists for all publicly-exported AFStools -functions with names of the form AFS_*. It is intended for programs like -B, which provide a direct interactive interface to AFStools. - -=item %AFS_Parms - Parameter settings [Private] - -This array contains the settings of AFStools parameters set with -B. - -=item %AFS_Trace - Tracing levels [Private] - -This array contains the tracing levels set with B. - -=item %AFScmd - AFS command locations [Private] - -This array contains paths to the various AFS command binaries, for use -by B and possibly other AFStools functions. - -=back - -=head1 COPYRIGHT - -The CMUCS AFStools, including this module are -Copyright (c) 1996, Carnegie Mellon University. All rights reserved. -For use and redistribution information, see CMUCS/CMU_copyright.pm - -=cut diff --git a/src/tests/vos.pm b/src/tests/vos.pm deleted file mode 100644 index 3f1ae6a6e..000000000 --- a/src/tests/vos.pm +++ /dev/null @@ -1,803 +0,0 @@ -# CMUCS AFStools -# Copyright (c) 1996, Carnegie Mellon University -# All rights reserved. -# -# See CMU_copyright.ph for use and distribution information -# -#: * vos.pm - Wrappers around VOS commands (volume maintenance) -#: * This module provides wrappers around the various volserver and VLDB -#: * commands, giving them a nice perl-based interface. Someday, they might -#: * talk to the servers directly instead of using 'vos', but not anytime -#: * soon. -#: - -package OpenAFS::vos; -use OpenAFS::CMU_copyright; -use OpenAFS::util qw(:DEFAULT :afs_internal); -use OpenAFS::wrapper; -use Exporter; - -$VERSION = ''; -$VERSION = '1.00'; -@ISA = qw(Exporter); -@EXPORT = qw(&AFS_vos_create &AFS_vos_listvldb - &AFS_vos_remove &AFS_vos_delentry - &AFS_vos_rename &AFS_vos_syncserv - &AFS_vos_move &AFS_vos_syncvldb - &AFS_vos_examine &AFS_vos_lock - &AFS_vos_addsite &AFS_vos_unlock - &AFS_vos_remsite &AFS_vos_unlockvldb - &AFS_vos_release &AFS_vos_changeaddr - &AFS_vos_backup &AFS_vos_listpart - &AFS_vos_backupsys &AFS_vos_partinfo - &AFS_vos_dump &AFS_vos_listvol - &AFS_vos_restore &AFS_vos_zap - &AFS_vos_status); - -$vos_err_parse = [ 'Error in vos (.*) command', '-(.*)' ]; - - -#: AFS_vos_create($vol, $server, $part, [$quota], [$cell]) -#: Create a volume with name $vol -#: The server name ($server) may be a hostname or IP address -#: The partition may be a partition name (/vicepx), letter (x), or number (24) -#: If specified, use $quota for the initial quota instead of 5000 blocks. -#: If specified, work in $cell instead of the default cell. -#: On success, return the volume ID. -#: -$AFS_Help{vos_create} = '$vol, $server, $part, [$quota], [$cell] => $volid'; -sub AFS_vos_create { - my($vol, $server, $part, $quota, $cell) = @_; - my(@args, $id); - - @args = ('create', '-name', $vol, '-server', $server, '-part', $part); - push(@args, '-maxquota', $quota) if ($quota ne ''); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - ['^Volume (\d+) created on partition \/vicep\S+ of \S+', \$id ], - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - $id; -} - - -#: AFS_vos_remove($vol, $server, $part, [$cell]) -#: Remove the volume $vol from the server and partition specified by $server and -#: $part. If appropriate, also remove the corresponding VLDB entry. -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_remove} = '$vol, $server, $part, [$cell] => Success?'; -sub AFS_vos_remove { - my($vol, $server, $part, $cell) = @_; - my(@args); - - @args = ('remove', '-id', $vol, '-server', $server, '-part', $part); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_rename($old, $new, [$cell]) -#: Rename the volume $old to have the name $new. -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_rename} = '$old, $new, [$cell] => Success?'; -sub AFS_vos_rename { - my($old, $new, $cell) = @_; - my(@args); - - @args = ('rename', '-oldname', $old, '-newname', $new); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_move($vol, $fromsrv, $frompart, $tosrv, $topart, [$cell]) -#: Move the volume specified by $vol. -#: The source location is specified by $fromsrv and $frompart. -#: The destination location is specified by $tosrv and $topart. -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. - -#: -$AFS_Help{vos_move} = '$vol, $fromsrv, $frompart, $tosrv, $topart, [$cell] => Success?'; -sub AFS_vos_move { - my($vol, $fromsrv, $frompart, $tosrv, $topart, $cell) = @_; - my(@args); - - @args = ('move', '-id', $vol, - '-fromserver', $fromsrv, '-frompartition', $frompart, - '-toserver', $tosrv, '-topartition', $topart); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_examine($vol, [$cell]) -#: Examine the volume $vol, and return information about it. -#: If specified, operate in cell $cell instead of the default cell. -#: On success, return an associative array with some or all of the following: -#: - name Name of this volume -#: - id ID of this volume -#: - kind Kind of volume (RW, RO, or BK) -#: - inuse Disk space in use -#: - maxquota Maximum disk usage quota -#: - minquota Minimum disk usage quota (optional) -#: - stamp_create Time when volume was originally created -#: - stamp_update Time volume was last modified -#: - stamp_backup Time backup volume was cloned, or 'Never' -#: - stamp_copy Time this copy of volume was made -#: - backup_flag State of automatic backups: empty or 'disabled' -#: - dayuse Number of accesses in the past day -#: - rwid ID of read-write volume (even if this is RO or BK) -#: - roid ID of read-only volume (even if this is RW or BK) -#: - bkid ID of backup volume (even if this is RW or RO) -#: - rwserv Name of server where read/write volume is -#: - rwpart Name of partition where read/write volume is -#: - rosites Reference to a list of read-only sites. Each site, in turn, -#: is a reference to a two-element list (server, part). -#: -$AFS_Help{vos_examine} = '$vol, [$cell] => %info'; -sub AFS_vos_examine { - my($vol, $cell) = @_; - my(%result, @args, @rosites); - - @args = ('examine', '-id', $vol); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - %result = &wrapper('vos', \@args, - [$vos_err_parse, - ['^(\S+)\s*(\d+)\s*(RW|RO|BK)\s*(\d+)\s*K', 'name', 'id', 'kind', 'inuse'], - ['MaxQuota\s*(\d+)\s*K', 'maxquota' ], - ['MinQuota\s*(\d+)\s*K', 'minquota' ], - ['Creation\s*(.*\S+)', 'stamp_create' ], - ['Last Update\s*(.*\S+)', 'stamp_update' ], - ['Backup\s+([^\d\s].*\S+)', 'stamp_backup' ], - ['Copy\s*(.*\S+)', 'stamp_copy' ], - ['Automatic backups are (disabled) for this volume', 'backup_flag' ], - ['(\d+) accesses in the past day', 'dayuse' ], - ['RWrite\:\s*(\d+)', 'rwid' ], - ['ROnly\:\s*(\d+)', 'roid' ], - ['Backup\:\s*(\d+)', 'bkid' ], - ['server (\S+) partition /vicep(\S+) RW Site', 'rwserv', 'rwpart'], - ['server (\S+) partition /vicep(\S+) RO Site', sub { - push(@rosites, [$_[0], $_[1]]); - }], - ($AFS_Parms{'vostrace'} > 2) ? ([ '', '?']) : () ]); - - $result{'rosites'} = \@rosites if (@rosites); - %result; -} - - - -#: AFS_vos_addsite($vol, $server, $part, [$cell]) -#: Add a replication site for volume $vol -#: The server name ($server) may be a hostname or IP address -#: The partition may be a partition name (/vicepx), letter (x), or number (24) -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_addsite} = '$vol, $server, $part, [$cell] => Success?'; -sub AFS_vos_addsite { - my($vol, $server, $part, $cell) = @_; - my(@args); - - @args = ('addsite', '-id', $vol, '-server', $server, '-part', $part); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_remsite($vol, $server, $part, [$cell]) -#: Remove a replication site for volume $vol -#: The server name ($server) may be a hostname or IP address -#: The partition may be a partition name (/vicepx), letter (x), or number (24) -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_remsite} = '$vol, $server, $part, [$cell] => Success?'; -sub AFS_vos_remsite { - my($vol, $server, $part, $cell) = @_; - my(@args); - - @args = ('remsite', '-id', $vol, '-server', $server, '-part', $part); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_release($vol, [$cell], [$force]) -#: Release the volume $vol. -#: If $force is specified and non-zero, use the "-f" switch. -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_release} = '$vol, [$cell], [$force] => Success?'; -sub AFS_vos_release { - my($vol, $cell, $force) = @_; - my(@args); - - @args = ('release', '-id', $vol); - push(@args, '-f') if ($force); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_backup($vol, [$cell]) -#: Make a backup of the volume $vol. -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_backup} = '$vol, [$cell] => Success?'; -sub AFS_vos_backup { - my($vol, $cell) = @_; - my(@args); - - @args = ('backup', '-id', $vol); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_backupsys([$prefix], [$server, [$part]], [$exclude], [$cell]) -#: Do en masse backups of AFS volumes. -#: If specified, match only volumes whose names begin with $prefix -#: If specified, limit work to the $server and, if given, $part. -#: If $exclude is specified and non-zero, backup only volumes NOT matched. -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_backupsys} = '[$prefix], [$server, [$part]], [$exclude], [$cell] => Success?'; -sub AFS_vos_backupsys { - my($prefix, $server, $part, $exclude, $cell) = @_; - my(@args); - - @args = ('backupsys'); - push(@args, '-prefix', $prefix) if ($prefix); - push(@args, '-server', $server) if ($server); - push(@args, '-partition', $part) if ($server && $part); - push(@args, '-exclude') if ($exclude); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_dump($vol, [$time], [$file], [$cell]) -#: Dump the volume $vol -#: If specified, do an incremental dump since $time instead of a full dump. -#: If specified, dump to $file instead of STDOUT -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_dump} = '$vol, [$time], [$file], [$cell] => Success?'; -sub AFS_vos_dump { - my($vol, $time, $file, $cell) = @_; - my(@args); - - @args = ('dump', '-id', $vol); - push(@args, '-time', ($time ? $time : 0)); - push(@args, '-file', $file) if ($file); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ], - { pass_stdout => !$file }); - 1; -} - - -#: AFS_vos_restore($vol, $server, $part, [$file], [$id], [$owmode], [$cell]) -#: Restore the volume $vol to partition $part on server $server. -#: If specified, restore from $file instead of STDIN -#: If specified, use the volume ID $id -#: If specified, $owmode must be 'abort', 'full', or 'incremental', and -#: indicates what to do if the volume exists. -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_restore} = '$vol, $server, $part, [$file], [$id], [$owmode], [$cell] => Success?'; -sub AFS_vos_restore { - my($vol, $server, $part, $file, $id, $owmode, $cell) = @_; - my(@args); - - @args = ('restore', '-name', $vol, '-server', $server, '-partition', $part); - push(@args, '-file', $file) if ($file); - push(@args, '-id', $id) if ($id); - push(@args, '-overwrite', $owmode) if ($owmode); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_listvldb([$vol], [$server, [$part]], [$locked], [$cell]) -#: Get a list of volumes in the VLDB. -#: If specified, list only the volume $vol -#: If specified, list only volumes on the server $server. -#: If specified with $server, list only volumes on the partition $part. -#: If $locked is specified and nonzero, list only locked VLDB entries -#: If specified, work in $cell instead of the default cell. -#: On success, return an associative array whose keys are names of volumes -#: on the specified server, and each of whose values is an associative -#: array describing the corresponding volume, containing some or all of -#: these elements: -#: - name Name of this volume (same as key) -#: - rwid ID of read-write volume (even if this is RO or BK) -#: - roid ID of read-only volume (even if this is RW or BK) -#: - bkid ID of backup volume (even if this is RW or RO) -#: - locked Empty or LOCKED to indicate VLDB entry is locked -#: - rwserv Name of server where read/write volume is -#: - rwpart Name of partition where read/write volume is -#: - rosites Reference to a list of read-only sites. Each site, in turn, -#: is a reference to a two-element list (server, part). -#: -$AFS_Help{vos_listvldb} = '[$vol], [$server, [$part]], [$locked], [$cell] => %vols'; -sub AFS_vos_listvldb { - my($vol, $server, $part, $locked, $cell) = @_; - my(%finres, %vlist, @rosites); - - @args = ('listvldb'); - push(@args, '-name', $vol) if ($vol); - push(@args, '-server', $server) if ($server); - push(@args, '-partition', $part) if ($part && $server); - push(@args, '-locked') if ($locked); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - %finres = &wrapper('vos', \@args, - [$vos_err_parse, - ['^(VLDB|Total) entries', '.'], - ['^(\S+)', sub { - my(%vinfo) = %OpenAFS::wrapper::result; - - if ($vinfo{name}) { - $vinfo{rosites} = [@rosites] if (@rosites); - $vlist{$vinfo{name}} = \%vinfo; - - @rosites = (); - %OpenAFS::wrapper::result = (); - } - }], - ['^(\S+)', 'name' ], - ['RWrite\:\s*(\d+)', 'rwid' ], - ['ROnly\:\s*(\d+)', 'roid' ], - ['Backup\:\s*(\d+)', 'bkid' ], - ['Volume is currently (LOCKED)', 'locked' ], - ['server (\S+) partition /vicep(\S+) RW Site', 'rwserv', 'rwpart'], - ['server (\S+) partition /vicep(\S+) RO Site', sub { - push(@rosites, [$_[0], $_[1]]); - }], - ($AFS_Parms{'vostrace'} > 2) ? ([ '', '?']) : () ]); - - if ($finres{name}) { - $finres{rosites} = [@rosites] if (@rosites); - $vlist{$finres{name}} = \%finres; - } - %vlist; -} - - - -#: AFS_vos_delentry($vol, [$cell]) -#: Delete the VLDB entry for the volume $vol -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_delentry} = '$vol, [$cell] => Success?'; -sub AFS_vos_delentry { - my($vol, $cell) = @_; - my(@args); - - @args = ('delentry', '-id', $vol); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_syncserv($server, [$part], [$cell], [$force]) -#: Synchronize the server $server with the VLDB -#: If specified, synchronize only partition $part -#: If specified, work in $cell instead of the default cell -#: If $force is specified, force updates to occur -#: On success, return 1. -#: -$AFS_Help{vos_syncserv} = '$server, [$part], [$cell], [$force] => Success?'; -sub AFS_vos_syncserv { - my($server, $part, $cell, $force) = @_; - my(@args); - - @args = ('syncserv', '-server', $server); - push(@args, '-partition', $part) if ($part); - push(@args, '-force') if ($force); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_syncvldb($server, [$part], [$cell], [$force]) -#: Synchronize the VLDB with server $server -#: If specified, synchronize only partition $part -#: If specified, work in $cell instead of the default cell -#: If $force is specified, force updates to occur -#: On success, return 1. -#: -$AFS_Help{vos_syncvldb} = '$server, [$part], [$cell], [$force] => Success?'; -sub AFS_vos_syncvldb { - my($server, $part, $cell, $force) = @_; - my(@args); - - @args = ('syncvldb', '-server', $server); - push(@args, '-partition', $part) if ($part); - push(@args, '-force') if ($force); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_lock($vol, [$cell]) -#: Lock the VLDB entry for volume $vol. -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_lock} = '$vol, [$cell] => Success?'; -sub AFS_vos_lock { - my($vol, $cell) = @_; - my(@args); - - @args = ('lock', '-id', $vol); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_unlock($vol, [$cell]) -#: Unlock the VLDB entry for volume $vol. -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_unlock} = '$vol, [$cell] => Success?'; -sub AFS_vos_unlock { - my($vol, $cell) = @_; - my(@args); - - @args = ('unlock', '-id', $vol); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_unlockvldb([$server, [$part]], [$cell]) -#: Unlock some or all VLDB entries -#: If specified, unlock only entries for volumes on server $server -#: If specified with $server, unlock only entries for volumes on -#: partition $part, instead of entries for volumes on all partitions -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_unlockvldb} = '[$server, [$part]], [$cell] => Success?'; -sub AFS_vos_unlockvldb { - my($server, $part, $cell) = @_; - my(@args); - - @args = ('unlockvldb'); - push(@args, '-server', $server) if ($server); - push(@args, '-partition', $part) if ($server && $part); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_changeaddr($old, $new, [$cell]) -#: Change the IP address of server $old to $new. -#: If specified, work in $cell instead of the default cell. -#: On success, return 1. -#: -$AFS_Help{vos_changeaddr} = '$old, $new, [$cell] => Success?'; -sub AFS_vos_changeaddr { - my($old, $new, $cell) = @_; - my(@args); - - @args = ('changeaddr', '-oldaddr', $old, '-newaddr', $new); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_listpart($server, [$cell]) -#: Retrieve a list of partitions on server $server -#: If specified, work in $cell instead of the default cell. -#: On success, return a list of partition letters -#: -$AFS_Help{vos_listpart} = '$server, [$cell] => @parts'; -sub AFS_vos_listpart { - my($server, $cell) = @_; - my(@args, @parts); - - @args = ('listpart', '-server', $server); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - [ '^(.*\/vicep.*)$', #', - sub { - push(@parts, map { - my($x) = $_; - $x =~ s/^\/vicep//; - $x; - } split(' ', $_[0])); - }], - ($AFS_Parms{'vostrace'} > 2) ? ([ '', '?']) : () ]); - @parts; -} - - -#: AFS_vos_partinfo($server, [$part], [$cell]) -#: Get information about partitions on server $server. -#: If specified, only get info about partition $part. -#: If specified, work in $cell instead of the default cell. -#: On success, return an associative array whose keys are partition letters, -#: and each of whose values is a reference to a 2-element list, consisting -#: of the total size of the partition and the amount of space used. -#: -$AFS_Help{vos_partinfo} = '$server, [$part], [$cell] => %info'; -sub AFS_vos_partinfo { - my($server, $part, $cell) = @_; - my(@args, %parts); - - @args = ('partinfo', '-server', $server); - push(@args, '-partition', $part) if ($part); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - [ '^Free space on partition /vicep(.+)\: (\d+) K blocks out of total (\d+)', - sub { - $parts{$_[0]} = [ $_[1], $_[2] ]; - }], - ($AFS_Parms{'vostrace'} > 2) ? ([ '', '?']) : () ]); - %parts; -} - - -#: AFS_vos_listvol($server, [$part], [$cell]) -#: Get a list of volumes on the server $server. -#: If specified, list only volumes on the partition $part. -#: If specified, work in $cell instead of the default cell. -#: On success, return an associative array whose keys are names of volumes -#: on the specified server, and each of whose values is an associative -#: array describing the corresponding volume, containing some or all of -#: these elements: -#: - name Name of this volume (same as key) -#: - id ID of this volume -#: - kind Kind of volume (RW, RO, or BK) -#: - inuse Disk space in use -#: - maxquota Maximum disk usage quota -#: - minquota Minimum disk usage quota (optional) -#: - stamp_create Time when volume was originally created -#: - stamp_update Time volume was last modified -#: - stamp_backup Time backup volume was cloned, or 'Never' -#: - stamp_copy Time this copy of volume was made -#: - backup_flag State of automatic backups: empty or 'disabled' -#: - dayuse Number of accesses in the past day -#: - serv Server where this volume is located -#: - part Partition where this volume is located -#: -$AFS_Help{vos_listvol} = '$server, [$part], [$cell] => %vols'; -sub AFS_vos_listvol { - my($server, $part, $cell) = @_; - my(%finres, %vlist); - - @args = ('listvol', '-server', $server, '-long'); - push(@args, '-partition', $part) if ($part); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - %finres = &wrapper('vos', \@args, - [$vos_err_parse, - ['^\S+\s*\d+\s*(RW|RO|BK)', sub { - my(%vinfo) = %OpenAFS::wrapper::result; - - if ($vinfo{name}) { - $vlist{$vinfo{name}} = \%vinfo; - %OpenAFS::wrapper::result = (); - } - }], - ['^(\S+)\s*(\d+)\s*(RW|RO|BK)\s*(\d+)\s*K', 'name', 'id', 'kind', 'inuse'], - ['(\S+)\s*\/vicep(\S+)\:', 'serv', 'part' ], - ['MaxQuota\s*(\d+)\s*K', 'maxquota' ], - ['MinQuota\s*(\d+)\s*K', 'minquota' ], - ['Creation\s*(.*\S+)', 'stamp_create' ], - ['Last Update\s*(.*\S+)', 'stamp_update' ], - ['Backup\s+([^\d\s].*\S+)', 'stamp_backup' ], - ['Copy\s*(.*\S+)', 'stamp_copy' ], - ['Automatic backups are (disabled) for this volume', 'backup_flag' ], - ['(\d+) accesses in the past day', 'dayuse' ], - ($AFS_Parms{'vostrace'} > 2) ? ([ '', '?']) : () ]); - - if ($finres{name}) { - $vlist{$finres{name}} = \%finres; - } - %vlist; -} - -#: AFS_vos_zap($vol, $server, $part, [$cell], [$force]) -#: Remove the volume $vol from the server and partition specified by $server and -#: $part. Don't bother messing with the VLDB. -#: If specified, work in $cell instead of the default cell. -#: If $force is specified, force the zap to happen -#: On success, return 1. -#: -$AFS_Help{vos_zap} = '$vol, $server, $part, [$cell], [$force] => Success?'; -sub AFS_vos_zap { - my($vol, $server, $part, $cell, $force) = @_; - my(@args); - - @args = ('zap', '-id', $vol, '-server', $server, '-part', $part); - push(@args, '-force') if ($force); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 1); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - $AFS_Parms{'vostrace'} ? ([ '', '?']) : () ]); - 1; -} - - -#: AFS_vos_status($server, [$cell]) -#: Get information about outstanding transactions on $server -#: If specified, work in $cell instead of the default cell -#: On success, return a list of transactions, each of which is a reference -#: to an associative array containing some or all of these elements: -#: - transid Transaction ID -#: - stamp_create Time the transaction was created -#: - volid Volume ID -#: - part Partition letter -#: - action Action or procedure -#: - flags Volume attach flags -#: If there are no transactions, the list will be empty. -#: -$AFS_Help{vos_status} = '$server, [$cell] => @trans'; -sub AFS_vos_status { - my($server, $cell) = @_; - my(@trlist); - - @args = ('status', '-server', $server); - push(@args, '-noauth') if ($AFS_Parms{'authlvl'} == 0); - push(@args, '-localauth') if ($AFS_Parms{'authlvl'} == 2); - push(@args, '-verbose') if ($AFS_Parms{'vostrace'} > 2); - push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'}); - &wrapper('vos', \@args, - [$vos_err_parse, - ['^(\-)', sub { - my(%trinfo) = %OpenAFS::wrapper::result; - - if ($trinfo{transid}) { - push(@trlist, \%trinfo); - %OpenAFS::wrapper::result = (); - } - }], - ['^transaction\:\s*(\d+)\s*created: (.*\S+)', 'transid', 'stamp_create'], - ['^attachFlags:\s*(.*\S+)', 'flags'], - ['^volume:\s*(\d+)\s*partition\: \/vicep(\S+)\s*procedure\:\s*(\S+)', - 'volid', 'part', 'action'], - ($AFS_Parms{'vostrace'} > 2) ? ([ '', '?']) : () ]); - - @trlist; -} - -1; diff --git a/src/tests/wrapper.pm b/src/tests/wrapper.pm deleted file mode 100644 index 4e4931f22..000000000 --- a/src/tests/wrapper.pm +++ /dev/null @@ -1,729 +0,0 @@ -# CMUCS AFStools -# Copyright (c) 1996, 2001 Carnegie Mellon University -# All rights reserved. -# -# See CMU_copyright.ph for use and distribution information - -package OpenAFS::wrapper; - -=head1 NAME - -OpenAFS::wrapper - AFS command wrapper - -=head1 SYNOPSIS - - use OpenAFS::wrapper; - %result = &wrapper($cmd, \@args, \@pspec, \%options); - -=head1 DESCRIPTION - -This module provides a generic wrapper for calling an external program and -parsing its output. It is primarily intended for use by AFStools for calling -AFS commands, but is general enough to be used for running just about any -utility program. The wrapper is implemented by a single function, -B, which takes several arguments: - -=over 4 - -=item $cmd - -The command to run. This can be a full path, or it can be a simple command -name, in which case B will find the binary on its internal path. - -=item \@args - -A reference to the list of arguments to be passed to the command. Each -element of the list is passed as a single argument, as in B. - -=item \@pspec - -A reference to the list describing how to parse the command's output. -See below for details. - -=item \%options - -A reference to a table of command execution and parsing options. - -=back - -On success, B returns an associative array of data gathered -from the command's output. The exact contents of this array are -caller-defined, and depend on the parsing instructions given. On failure, -an exception will be thrown (using B), describing the reason for the -failure. - -The I<%options> table may be used to pass any or all of the following -options into B, describing how the command should be executed -and its output parsed: - -=over 4 - -=item pass_stderr - -If specified and nonzero, the command's stderr will be passed directly -to the calling program's, instead of being parsed. This is useful when -we want to process the command's output, but let the user see any -diagnostic output or error messages. - -=item pass_stdout - -If specified and nonzero, the command's stdout will be passed directly -to the calling program's, instead of being parsed. This is useful when -the command being run produces diagnostic or error messages on stderr -that we want to parse, but provides bulk data on stdout that we don't -want to touch (e.g. B when the output file is stdout). - -=item path - -If specified, the path to be used for the program to execute, instead of -deriving it from the command name. This is useful when we want the -command's argv[0] (which is always I<$cmd}) to be different from the -path to the program. - -=item errors_last - -If specified and nonzero, the built-in instructions for catching errors -from the command will be added to the end of the instructions in @pspec -instead of to the beginning. - -=back - -=head1 PARSING COMMAND OUTPUT - -The I<@pspec> list describes how to parse command output. Each element -of the list acts like an "instruction" describing how to parse the command's -output. As each line of output is received from the program, the parsing -instructions are run over that line in order. This process continues for -every line of output until the program terminates, or the process is -aborted early by flow-control operators. - -Each parsing instruction is a reference to a list, which consists of a -regular expression and a list of "actions". As a line of output is -processed, it is compared to each instruction's regexp in turn. Whenever -a match is found, the actions associated with that instruction are taken, -in order. Each instruction's regexp may contain one or more parenthesized -subexpressions; generally, each "action" uses up one subexpression, but there -are some exceptions. Due to the current design of B, each regexp -must have at least one subexpression, even if it is not used. - -The acceptable actions are listed below, each followed by a number in brackets -indicating how many subexpressions are "used" by this action. It is an error -if there are not enough subexpressions left to satisfy an action. In the -following descriptions, I<$action> is the action itself (typically a string or -reference), I<$value> is the value of the subexpression that will be used, and -I<%result> is the result table that will be returned by B when the -command completes. - -=over 4 - -=item string [1] - -Sets $result{$action} to $value. Note that several specific strings have -special meaning, and more may be added in the future. To ensure compatibility -with future versions of B, use only valid Perl identifiers as -"string" actions. - -=item scalar ref [1] - -Sets $$action to $value. - -=item list ref [*] - -Pushes the remaining subexpression values onto @$action. This action uses -all remaining subexpression values. - -=item hash ref [2] - -Sets $$action{$value0} to $value1. - -=item code ref [*] - -Calls the referenced function, with all remaining subexpression values as -its arguments. Any values returned by the function will be used to refill -the (now empty) subexpression value list, and thus may be used as arguments -by subsequent actions. If only a few values are required, use a function -like this: - - sub usetwo { # uses two values and preserves the rest - my($val1, $val2, @rest) = @_; - - print STDOUT "Got $val1, $val2\n"; - @rest; - } - -=item '.' [0] - -End processing for this line of output, ignoring any remaining instructions. -Remaining actions in this instruction will be processed. - -=item '+n' [0] - -Skip the next I instructions. This, along with the '.' action, can be -used to build simple flow-control constructs based on the contents of -lines of output. - -=item '-x' [0..1] - -Signal an error after this instruction. Remaining actions in this instruction -will be processed, but no further instructions will be processed for this -line, and no further lines of output will be processed. If I is given, -it will be used as a regexp to match against the B line of output, -and the first parenthesized subexpression resulting from that match will be -used as the error string. Otherwise, one subexpression from the current -line will be used up as the error string. - -=item '?' [1] - -Prints $value to STDOUT. - -=back - -=cut - -use OpenAFS::CMU_copyright; -use OpenAFS::util qw(:DEFAULT :afs_internal); -use Exporter; -use Symbol; - -$VERSION = ''; -$VERSION = '1.00'; -@ISA = qw(Exporter); -@EXPORT = qw(&wrapper); -@EXPORT_OK = qw(&wrapper &fast_wrapper); - -sub wrapper { - my($cmd, $args, $instrs, $options) = @_; - my($prevline, $pid, $exception); - my(@instrs, $instr, $action, @values, $path); - local(%result); - my(@werrinstrs) = ([ '^(wrapper\:.*)', '-' ]); - my(@cerrinstrs) = ([ '^(' . $cmd . '\:.*)', '-' ], - [ '^(' . $path . '\:.*)', '-' ]); - - if ($options->{errors_last}) { - @instrs = (@werrinstrs, @$instrs, @cerrinstrs); - } else { - @instrs = (@werrinstrs, @cerrinstrs, @$instrs); - } - - if ($options->{path}) { - $path = $options->{path}; - } elsif ($cmd =~ /^\//) { - $path = $cmd; - } else { - $path = $AFScmd{$cmd}; - } - - if ($AFS_Trace{wrapper}) { - print STDERR "Instructions:\n"; - foreach $instr (@$instrs) { - print STDERR " /", $instr->[0], "/\n"; - if ($AFS_Trace{wrapper} > 2) { - my(@actions) = @$instr; - shift(@actions); - print " => ", - join(', ', map { ref($_) ? "<" . ref($_) . " reference>" - : $_ } @actions), - "\n"; - } - } - } - - ## Start the child - if ($options->{pass_stdout}) { - open(REALSTDOUT, ">&STDOUT"); - } - $pid = open(AFSCMD, "-|"); - if (!defined($pid)) { - die "wrapper: Fork failed for $cmd: $!\n"; - } - - ## Run the appropriate program - if (!$pid) { - - if ($AFS_Trace{wrapper} > 1) { - print STDERR "Command: $path ", join(' ', @$args), "\n"; - } - - open(STDERR, ">&STDOUT") if (!$options{pass_stderr}); - if ($options{pass_stdout}) { - open(STDOUT, ">&REALSTDOUT"); - close(REALSTDOUT); - } - - { exec($path $cmd, @$args); } - # Need to be careful here - we might be doing "vos dump" to STDOUT - if ($options{pass_stdout}) { - print STDERR "wrapper: Exec failed for $cmd: $!\n"; - } else { - print STDOUT "wrapper: Exec failed for $cmd: $!\n"; - } - exit(127); - } - if ($options{pass_stdout}) { - close(REALSTDOUT); - } - - ## Now, parse the output - line: - while () { - my($skip) = 0; - - print STDERR $_ if ($AFS_Trace{wrapper} > 3); - chop; - - instr: - foreach $instr (@instrs) { - my($dot, $action, @actions); - - if ($skip) { - $skip--; - next instr; - } - $dot = 0; - if ($instr->[0]) { - @values = ($_ =~ $instr->[0]); - next instr if (!@values); - } else { - @values = (); - } - - act: - @actions = @$instr; - shift(@actions); - foreach $action (@actions) { - if (ref($action) eq 'SCALAR') { - if (@values) { - $$action = shift(@values); - } else { - last act; - } - } elsif (ref($action) eq 'ARRAY') { - push(@$action, @values); - @values = (); - } elsif (ref($action) eq 'HASH') { - if (@values > 1) { - $$action{$values[0]} = $values[1]; - shift(@values); shift(@values); - } elsif (@values) { - $$action{shift @values} = ''; - last act; - } else { - last act; - } - } elsif (ref($action) eq 'CODE') { - @values = &$action(@values); - } elsif (ref($action)) { - $exception = "Unknown reference to " . ref($action) - . "in parse instructions"; - last line; - } else { ## Must be a string! - if ($action eq '.') { - $dot = 1; - } elsif ($action =~ /\+(\d+)/) { - $skip = $1; - } elsif ($action =~ /-(.*)/) { - my($pat) = $1; - - if ($pat && $prevline) { - ($exception) = ($prevline =~ $pat); - } elsif (@values) { - $exception = shift(@values); - } else { - $exception = $_; - } - } elsif ($action eq '?') { - print STDOUT (@values ? shift(@values) : $_), "\n"; - } elsif (@values) { - $result{$action} = shift(@values); - } else { - last act; - } - } - } - - last line if ($exception); - last instr if ($dot); - } - $prevline = $_; - } - close(AFSCMD); - $exception .= "\n" if ($exception && $exception !~ /\n$/); - die $exception if ($exception); - %result; -} - - -## Generate code for a fast wrapper (see example below) -sub _fastwrap_gen { - my($instrs, $refs) = @_; - my($SRC, $N, $N1, $X, $instr, $pattern, @actions, $action); - - $N = $X = 0; - $N1 = 1; - - $SRC = <<'#####'; -sub { - my($FD, $refs) = @_; - my($prevline, @values, $skip, $exception); - - line: while (<$FD>) { -##### - - $SRC .= " print STDERR \$_;\n" if ($AFS_Trace{'wrapper'} > 3); - $SRC .= " chop;\n"; - - foreach $instr (@$instrs) { - ($pattern, @actions) = (@$instr); - $SRC .= ($pattern ? <<"#####" : <<"#####"); - - instr_$N: - die \$exception if \$exception; - if (\$skip) { \$skip-- } else { - \@values = (\$_ =~ /$pattern/); - if (\@values) { -##### - - instr_$N: - die \$exception if \$exception; - if (\$skip) { \$skip-- } else { - \@values = (); - if (1) { -##### - - foreach $action (@actions) { - if (ref($action) eq 'SCALAR') { - $refs[++$X] = $action; - $SRC .= <<"#####"; - - if (\@values) { \${\$refs[$X]} = shift (\@values) } - else { goto instr_$N1 } -##### - - } elsif (ref($action) eq 'ARRAY') { - $refs[++$X] = $action; - $SRC .= <<"#####"; - - push(\@{\$refs[$X]}, \@values); - \@values = (); -##### - - } elsif (ref($action) eq 'HASH') { - $refs[++$X] = $action; - $SRC .= <<"#####"; - - if (\@values > 1) { - \$refs[$X]{\$values[0]} = shift(\$values[1]); - shift(\@values); shift(\@values); - } elsif (\@values) { - \$refs[$X]{shift(\@values)} = ''; - goto instr_$N1; - } else { - goto instr_$N1; - } -##### - - } elsif (ref($action) eq 'CODE') { - $refs[++$X] = $action; - $SRC .= "\n \@values = \$refs[$X]->(\@values);\n"; - - } elsif (ref($action)) { - die "Unknown reference to " . ref($action) . "in parse instructions\n"; - - } elsif ($action eq '.') { - $SRC .= "\n next line;\n"; - - } elsif ($action eq '?') { - $SRC .= <<"#####"; - - if (\@values) { print STDOUT shift(\@values), "\\n" } - else { print STDOUT \$_, "\\n" } -##### - - } elsif ($action =~ /\+(\d+)/) { - $SRC .= "\n \$skip = $1;\n"; - - } elsif ($action =~ /-(.*)/) { - $SRC .= $1 ? <<"#####" : <<"#####"; - - if (\$prevline) { (\$exception) = (\$prevline =~ /$1/) } - elsif (\@values) { \$exception = shift(\@values) } - else { \$exception = \$_ } -##### - - if (\@values) { \$exception = shift(\@values) } - else { \$exception = \$_ } -##### - - } else { - $SRC .= <<"#####"; - - if (\@values) { \$result{"\Q$action\E"} = shift(\@values) } - else { goto instr_$N1 } -##### - } - } - - $N++; $N1++; - $SRC .= <<'#####'; - } - } -##### - } - - $SRC .= <<'#####'; - } continue { - die $exception if $exception; - $prevline = $_; - } -} -##### - - $SRC; -} - -####################### Example code ####################### -# sub { -# my($FD, $refs) = @_; -# my($prevline, @values, $skip, $exception); -# -# line: while (<$FD>) { -# print STDERR $_; ## if ($AFS_Trace{'wrapper'} > 3); -# chop; -# -# ## Following block repeated for each instruction -# instr_N: -# die $exception if $exception; -# if ($skip) { $skip-- } else { -# @values = ($_ =~ /## pattern ##/); ## () if no pattern -# if (@values) { ## 1 if no pattern -# ## For each action, include one of the following blocks: -# -# ## SCALAR ref -# if (@values) { ${$refs[X]} = shift (@values) } -# else { goto instr_N+1 } -# -# ## ARRAY ref -# push(@{$refs[X]}, @values); -# @values = (); -# -# ## HASH ref -# if (@values > 1) { -# $refs[X]{shift(@values)} = shift(@values); -# } elsif (@values) { -# $refs[X]{shift(@values)} = ''; -# goto instr_N+1; -# } else { -# goto instr_N+1; -# } -# -# ## CODE ref -# @values = $refs[X]->(@values); -# -# ## string '.' -# next line; -# -# ## string '?' -# if (@values) { print STDOUT shift(@values), "\n" } -# else { print STDOUT $_, "\n" } -# -# ## string '+DDD' -# $skip = DDD; -# -# ## string '-XXX' -# if ($prevline) { ($exception) = ($prefline =~ /XXX/) } -# elsif (@values) { $exception = shift(@values) } -# else { $exception = $_ } -# -# ## string '-' -# if (@values) { $exception = shift(@values) } -# else { $exception = $_ } -# -# ## anything else -# if (@values) { $result{XXX} = shift(@values) } -# else { goto instr_N+1 } -# } -# } -# -# } continue { -# die $exception if $exception; -# $prevline = $_; -# } -# } -############################################################ - - -## The following does exactly the same thing as wrapper(), -## but should be considerably faster. Instead of interpreting -## parsing instructions, it translates them into perl code, -## which is then compiled into the interpreter. The chief -## benefit to this approach is that we no longer compile -## one RE per instruction per line of input. - -sub fast_wrapper { - my($cmd, $args, $instrs, $options) = @_; - my(@instrs, $SRC, $CODE, $path, $pid, $refs, $FD, $exception); - local(%result); - my(@werrinstrs) = ([ '^(wrapper\:.*)', '-' ]); - my(@cerrinstrs) = ([ '^(' . $cmd . '\:.*)', '-' ], - [ '^(' . $path . '\:.*)', '-' ]); - - $FD = gensym; - $refs = []; - if ($options->{errors_last}) { - @instrs = (@werrinstrs, @$instrs, @cerrinstrs); - } else { - @instrs = (@werrinstrs, @cerrinstrs, @$instrs); - } - $SRC = _fastwrap_gen(\@instrs, $refs); - $CODE = eval $SRC; - - if ($options->{path}) { - $path = $options->{path}; - } elsif ($cmd =~ /^\//) { - $path = $cmd; - } else { - $path = $AFScmd{$cmd}; - } - - if ($AFS_Trace{'wrapper'}) { - print STDERR "Instructions:\n"; - foreach $instr (@$instrs) { - print STDERR " /", $instr->[0], "/\n"; - if ($AFS_Trace{'wrapper'} > 2) { - my(@actions) = @$instr; - shift(@actions); - print " => ", - join(', ', map { ref($_) ? "<" . ref($_) . " reference>" - : $_ } @actions), - "\n"; - } - } - } - - if ($AFS_Trace{'wrapper'} > 2) { print STDERR "Input parse code:\n$SRC\n" } - - ## Start the child - if ($options->{pass_stdout}) { - open(REALSTDOUT, ">&STDOUT"); - } - $pid = open($FD, "-|"); - if (!defined($pid)) { - die "wrapper: Fork failed for $cmd: $!\n"; - } - - ## Run the appropriate program - if (!$pid) { - if ($AFS_Trace{'wrapper'} > 1) { - print STDERR "Command: $path ", join(' ', @$args), "\n"; - } - - open(STDERR, ">&STDOUT") if (!$options{pass_stderr}); - if ($options{pass_stdout}) { - open(STDOUT, ">&REALSTDOUT"); - close(REALSTDOUT); - } - - { exec($path $cmd, @$args) } - # Need to be careful here - we might be doing "vos dump" to STDOUT - if ($options{pass_stdout}) { - print STDERR "wrapper: Exec failed for $cmd: $!\n"; - } else { - print STDOUT "wrapper: Exec failed for $cmd: $!\n"; - } - exit(127); - } - if ($options{pass_stdout}) { - close(REALSTDOUT); - } - - ## Now, parse the output - eval { $CODE->($FD, $refs) }; - $exception = $@; - - close($FD); - - $exception .= "\n" if ($exception && $exception !~ /\n$/); - die $exception if ($exception); - %result; -} - - -1; - -=head1 EXAMPLES - -The following set of instructions is used by B to detect errors -issued by the command, or by the child process spawned to invoke the command. -I<$cmd> is the name of the command to run, and I<$path> is the path to the -binary actually invoked. - - [ '^(wrapper\:.*)', '-' ] - [ '^(' . $cmd . '\:.*)', '-' ] - [ '^(' . $path . '\:.*)', '-' ] - -The following instruction is added by the B module to catch errors -generated by B commands, which often take the form of a generic error -message (Error in vos XXX command), with a description of the specific problem -on the preceeding line: - - [ 'Error in vos (.*) command', '-(.*)' ] - -If the AFStools parameter I is nonzero, the following instruction -is added to force all lines of output to be copied to STDOUT. Note that this -is different from specifying the I option, which would pass the -command's STDOUT directly to ours without parsing it. - - [ '', '?' ] - -B uses the following instructions to parse the -output of "vos listvldb". This is a fairly complex example, which illustrates -many of the features of B. - - 1 ['^(VLDB|Total) entries', '.'] - 2 ['^(\S+)', sub { - my(%vinfo) = %OpenAFS::wrapper::result; - if ($vinfo{name}) { - $vinfo{rosites} = [@rosites] if (@rosites); - $vlist{$vinfo{name}} = \%vinfo; - @rosites = (); - %OpenAFS::wrapper::result = (); - } - }], - 3 ['^(\S+)', 'name' ], - 4 ['RWrite\:\s*(\d+)', 'rwid' ], - 5 ['ROnly\:\s*(\d+)', 'roid' ], - 6 ['Backup\:\s*(\d+)', 'bkid' ], - 7 ['Volume is currently (LOCKED)', 'locked' ], - 8 ['server (\S+) partition /vicep(\S+) RW Site', 'rwserv', 'rwpart'], - 9 ['server (\S+) partition /vicep(\S+) RO Site', sub { - push(@rosites, [$_[0], $_[1]]); - }], - -Instruction 1 matchees the header and trailer lines printed out by B, and -terminates processing of those lines before instructions 2 and 3 have a chance -to match it. This is a simple example of a conditional - the next two -instructions are used only if this one doesn't match. If we wanted to consider -additional instructions even on lines that do match this one, we could place -them above this one, or use '+2' instead of '.', which would skip only the next -two instructions and allow remaining ones to be processed. - -Instruction 2 matches the first line printed for each volume, stores away any -information that has been collected about the previous volume, and prepares for -the new one. Besides being a good example of use of a code reference as an -action, this instruction also takes advantage of the fact that B's -%result array is a dynamically-scoped variable, and so can be modified by code -referenced in parsing instructions. - -The remaining instructions are fairly simple. Instructions 3 through 8 use -simple strings to add information about the volume to %result. Instruction 9 -is a bit more complicated; it uses a function to add a server/partition pair -to the current volume's list of RO sites. - -=head1 COPYRIGHT - -The CMUCS AFStools, including this module are -Copyright (c) 1996, 2001 Carnegie Mellon University. All rights reserved. -For use and redistribution information, see CMUCS/CMU_copyright.pm - -=cut