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 \
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 \
+++ /dev/null
-# 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 = <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 = <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;
+++ /dev/null
-## 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;
+++ /dev/null
-# 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;
+++ /dev/null
-# 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;
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)
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:
+++ /dev/null
-# 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;
+++ /dev/null
-# 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;
--- /dev/null
+# 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 = <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 = <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;
--- /dev/null
+## 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;
--- /dev/null
+# 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;
--- /dev/null
+# 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;
--- /dev/null
+# 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;
--- /dev/null
+# 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;
--- /dev/null
+# 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<CellServDB>. 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<fs> 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<ThisCell> 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 = <THISCELL>);
+ 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<CellServDB>.
+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<AFS_conf_canoncell>,
+I<$cellname> may be any unique prefix of a cell name. The resulting list
+contains server hostnames, as found in F<CellServDB>.
+
+=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 (<CELLSERVDB>) {
+ $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<CellServDB>) 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 (<CELLSERVDB>) {
+ 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 = <CACHEINFO>);
+ 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'} = <SRVFILE>;
+ 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
--- /dev/null
+# 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;
--- /dev/null
+# 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<installation> of AFStools
+should act, not how it should act upon a particular B<cell>. 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<confdir> is
+set, it will generally be searched before this directory. Normally, this
+should be set to F</usr/vice/etc> 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<OpenAFS::wrapper::wrapper>. 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<OpenAFS::wrapper::wrapper> 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
--- /dev/null
+# 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
--- /dev/null
+# 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;
+}
+
--- /dev/null
+# 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;
--- /dev/null
+# 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;
--- /dev/null
+# 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<vos> utilities. The default is 0,
+which disables any tracing of activity of B<vos> 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<vos> 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<OpenAFS::util>. 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<testbed>, 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<OpenAFS::util::AFS_SetParm>.
+
+=item %AFS_Trace - Tracing levels [Private]
+
+This array contains the tracing levels set with B<OpenAFS::util::AFS_Trace>.
+
+=item %AFScmd - AFS command locations [Private]
+
+This array contains paths to the various AFS command binaries, for use
+by B<OpenAFS::wrapper::wrapper> 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
--- /dev/null
+# 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;
--- /dev/null
+# 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<OpenAFS::wrapper::wrapper>, 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<wrapper()> 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<exec()>.
+
+=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<wrapper()> 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<die>), describing the reason for the
+failure.
+
+The I<%options> table may be used to pass any or all of the following
+options into B<wrapper()>, 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<vos dump> 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<wrapper()>, 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<wrapper> 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<wrapper>, 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<n> 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<x> is given,
+it will be used as a regexp to match against the B<previous> 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 (<AFSCMD>) {
+ 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<wrapper> 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<OpenAFS::vos> module to catch errors
+generated by B<vos> 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<vostrace> 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<pass_stdout> option, which would pass the
+command's STDOUT directly to ours without parsing it.
+
+ [ '', '?' ]
+
+B<OpenAFS::vos::AFS_vos_listvldb> 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<wrapper>.
+
+ 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<vos>, 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<wrapper>'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
+++ /dev/null
-# 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<CellServDB>. 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<fs> 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<ThisCell> 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 = <THISCELL>);
- 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<CellServDB>.
-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<AFS_conf_canoncell>,
-I<$cellname> may be any unique prefix of a cell name. The resulting list
-contains server hostnames, as found in F<CellServDB>.
-
-=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 (<CELLSERVDB>) {
- $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<CellServDB>) 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 (<CELLSERVDB>) {
- 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 = <CACHEINFO>);
- 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'} = <SRVFILE>;
- 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
#include <rx/rx_null.h>
/*#include <krb.h>*/
-#include <com_err.h>
+#include <afs/com_err.h>
struct VenusFid {
afs_int32 Cell;
+++ /dev/null
-# 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;
+++ /dev/null
-# 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<installation> of AFStools
-should act, not how it should act upon a particular B<cell>. 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<confdir> is
-set, it will generally be searched before this directory. Normally, this
-should be set to F</usr/vice/etc> 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<OpenAFS::wrapper::wrapper>. 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<OpenAFS::wrapper::wrapper> 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
+++ /dev/null
-# 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
+++ /dev/null
-# 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;
-}
-
+++ /dev/null
-# 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;
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/mman.h>
+#include <sys/time.h>
#include <unistd.h>
+++ /dev/null
-# 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;
#include <stdlib.h>
#include <string.h>
#include <errno.h>
+#include <signal.h>
#include <sys/types.h>
#include <sys/stat.h>
+++ /dev/null
-# 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<vos> utilities. The default is 0,
-which disables any tracing of activity of B<vos> 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<vos> 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<OpenAFS::util>. 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<testbed>, 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<OpenAFS::util::AFS_SetParm>.
-
-=item %AFS_Trace - Tracing levels [Private]
-
-This array contains the tracing levels set with B<OpenAFS::util::AFS_Trace>.
-
-=item %AFScmd - AFS command locations [Private]
-
-This array contains paths to the various AFS command binaries, for use
-by B<OpenAFS::wrapper::wrapper> 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
+++ /dev/null
-# 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;
+++ /dev/null
-# 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<OpenAFS::wrapper::wrapper>, 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<wrapper()> 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<exec()>.
-
-=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<wrapper()> 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<die>), describing the reason for the
-failure.
-
-The I<%options> table may be used to pass any or all of the following
-options into B<wrapper()>, 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<vos dump> 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<wrapper()>, 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<wrapper> 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<wrapper>, 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<n> 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<x> is given,
-it will be used as a regexp to match against the B<previous> 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 (<AFSCMD>) {
- 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<wrapper> 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<OpenAFS::vos> module to catch errors
-generated by B<vos> 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<vostrace> 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<pass_stdout> option, which would pass the
-command's STDOUT directly to ours without parsing it.
-
- [ '', '?' ]
-
-B<OpenAFS::vos::AFS_vos_listvldb> 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<wrapper>.
-
- 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<vos>, 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<wrapper>'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
projects / packages / o / openafs.git / commitdiff