src/tests/OpenAFS/util.pm

   1 # CMUCS AFStools
   2 # Copyright (c) 1996, Carnegie Mellon University
   3 # All rights reserved.
   4 #
   5 # See CMUCS/CMU_copyright.ph for use and distribution information
   6
   7 package OpenAFS::util;
   8
   9 =head1 NAME
  10
  11 OpenAFS::util - General AFS utilities
  12
  13 =head1 SYNOPSIS
  14
  15   use OpenAFS::util;
  16
  17   AFS_Init();
  18   AFS_Trace($subject, $level);
  19   AFS_SetParm($parm, $value);
  20
  21   use OpenAFS::util qw(GetOpts_AFS);
  22   %options = GetOpts_AFS(\@argv, \@optlist);
  23
  24 =head1 DESCRIPTION
  25
  26 This module defines a variety of AFS-related utility functions.  Virtually
  27 every application that uses AFStools will need to use some of the utilities
  28 defined in this module.  In addition, a variety of global variables are
  29 defined here for use by all the AFStools modules.  Most of these are
  30 private, but a few are semi-public.
  31
  32 =cut
  33
  34 use OpenAFS::CMU_copyright;
  35 use OpenAFS::config;
  36 require OpenAFS::afsconf;   ## Avoid circular 'use' dependencies
  37 use Exporter;
  38
  39 $VERSION   = '';
  40 $VERSION   = '1.00';
  41 @ISA       = qw(Exporter);
  42 @EXPORT    = qw(&AFS_Init
  43                 &AFS_Trace
  44                 &AFS_SetParm);
  45 @EXPORT_OK = qw(%AFS_Parms
  46                 %AFS_Trace
  47                 %AFS_Help
  48                 %AFScmd
  49                 &GetOpts_AFS
  50                 &GetOpts_AFS_Help);
  51 %EXPORT_TAGS = (afs_internal => [qw(%AFS_Parms %AFS_Trace %AFScmd %AFS_Help)],
  52                 afs_getopts  => [qw(&GetOpts_AFS &GetOpts_AFS_Help)] );
  53
  54
  55 =head2 AFS_Init()
  56
  57 This function does basic initialization of AFStools.  It must be called before
  58 any other AFStools function.
  59
  60 =cut
  61
  62 sub AFS_Init
  63 {
  64   my(@dirs, $c, $i, $x);
  65
  66   $AFS_Parms{'authlvl'}  = 1;
  67   $AFS_Parms{'confdir'}  = $def_ConfDir;
  68   $AFS_Parms{'cell'}     = OpenAFS::afsconf::AFS_conf_localcell();
  69
  70   # Search for AFS commands
  71   @dirs = @CmdPath;
  72   foreach $c (@CmdList)
  73     {
  74       $AFScmd{$c} = '';
  75       foreach $i ($[ .. $#dirs)
  76         {
  77           $x = $dirs[$i];
  78           if (-x "$x/$c" && ! -d "$x/$c")
  79             {
  80               $AFScmd{$c} = "$x/$c";
  81               splice(@dirs, $i, 1);   # Move this item to the start of the array
  82               unshift(@dirs, $x);
  83               last;
  84             }
  85         }
  86       return "Unable to locate $c!" if (!$AFScmd{$c});
  87     }
  88   0;
  89 }
  90
  91
  92 =head2 AFS_Trace($subject, $level)
  93
  94 Sets the tracing level for a particular "subject" to the specified level.
  95 All tracing levels start at 0, and can be set to higher values to get debugging
  96 information from different parts of AFStools.  This function is generally
  97 only of use to people debugging or extending AFStools.
  98
  99 =cut
 100
 101 $AFS_Help{Trace} = '$subject, $level => void';
 102 sub AFS_Trace {
 103   my($subject, $level) = @_;
 104
 105   $AFS_Trace{$subject} = $level;
 106 }
 107
 108
 109 =head2 AFS_SetParm($parm, $value)
 110
 111 Sets the AFStools parameter I<$parm> to I<$value>.  AFStools parameters are
 112 used to alter the behaviour of various parts of the system.  The following
 113 parameters are currently defined:
 114
 115 =over 10
 116
 117 =item authlvl
 118
 119 The authentication level to use for commands that talk directly to AFS
 120 servers (bos, vos, pts, etc.).  Set to 0 for unauthenticated access (-noauth),
 121 1 to use the user's existing tokens, or 2 to use the AFS service key
 122 (-localauth).
 123
 124 =item cell
 125
 126 The default AFS cell in which to work.  This is initially the workstation's
 127 local cell.
 128
 129 =item confdir
 130
 131 The AFS configuration directory to use.  If none is specified, the default
 132 (as defined in OpenAFS::config) will be used.
 133
 134 =item vostrace
 135
 136 Set the tracing level used by various B<vos> utilities.  The default is 0,
 137 which disables any tracing of activity of B<vos> commands.  A setting of 1
 138 copies output from all commands except those which are invoked solely to
 139 get information; a setting of 2 additionally uses the "-verbose" command
 140 on any command whose output is copied.  If a setting of 3 is used, all
 141 B<vos> commands will be invoked with "-verbose", and have their output
 142 copied to stdout.
 143
 144 =back
 145
 146 =cut
 147
 148 $AFS_Help{SetParm} = '$parm, $value => void';
 149 sub AFS_SetParm {
 150   my($parm, $value) = @_;
 151
 152   $AFS_Parms{$parm} = $value;
 153 }
 154
 155
 156 #: GetOpts_AFS(\@argv, \@optlist)
 157 #: Parse AFS-style options.
 158 #: \@argv is a hard reference to the list of arguments to be parsed.
 159 #: \@optlist is a hard reference to the list of option specifications for valid
 160 #: options; in their default order.  Each option specification, in turn, is a
 161 #: hard reference to an associative array containing some of the following
 162 #: elements:
 163 #:     name       => The name of the argument
 164 #:     numargs    => Number of arguments (0, 1, or -1 for multiple)
 165 #:     required   => If nonzero, this argument is required
 166 #:     default    => Value to give this option if not specified
 167 #:     noauto     => Don't use this option for unadorned arguments
 168 #:
 169 #: Results are returned in the form of an associative array of options and
 170 #: their values:
 171 #: - Boolean (0-argument) options have a value of 1 if specified.  This type
 172 #:   of option may not be marked 'required'.
 173 #: - Simple (1-argument) options have a value which is the string given by the
 174 #:   user.
 175 #: - Multiple-argument options have a value which is a hard reference to an
 176 #:   array of values given by the user.
 177 #:
 178 #: Argument parsing is done in a similar manner to the argument parser used by
 179 #: various AFS utilities.  Options have multi-character names, and may not be
 180 #: combined with their arguments or other options.  Those options which take
 181 #: arguments use up at least the next argument, regardless of whether it begins
 182 #: with a dash.  Options which can take multiple arguments will eat at least
 183 #: one argument, as well as any following argument up to the next option (i.e.,
 184 #: the next argument beginning with a dash).  An "unadorned" argument will be
 185 #: used by the next argument-taking option.  If there are multiple unadorned
 186 #: arguments, they will be used up by successive arguments much in the same
 187 #: way Perl handles list assignment - each one-argument (scalar) option will
 188 #: use one argument; the first multi-argument (list) option will use up any
 189 #: remaining unadorned arguments.
 190 #:
 191 #: On completion, @argv will be left with any unparsed arguments (this can
 192 #: happen if the last option specified is _not_ a multi-argument option, and
 193 #: there are no "defaulted" options).  This is considered to be an error
 194 #: condition.
 195 #:
 196 sub GetOpts_AFS_Help {
 197   my($cmd, $optlist) = @_;
 198   my($option, $optname, $desc);
 199
 200   foreach $option (@$optlist) {
 201     $optname = '-' . $$option{name};
 202     if ($$option{numargs}) {
 203       $desc = $$option{desc} ? $$option{desc} : $$option{name};
 204       $desc = " <$desc>";
 205       $desc .= '+' if ($$option{numargs} < 0);
 206       $optname .= $desc;
 207     }
 208     $optname = "[$optname]" if (!$$option{required});
 209     $cmd .= " $optname";
 210   }
 211   $cmd;
 212 }
 213
 214 sub _which_opt {
 215   my($optname, @options) = @_;
 216   my($o, $which, $n);
 217
 218   foreach $o (@options) {
 219     next unless ($o =~ /^$optname/);
 220     $n++;
 221     $which = $o;
 222   }
 223   ($n == 1) ? $which : $optname;
 224 }
 225
 226 sub GetOpts_AFS {
 227   my($argv, $optlist) = @_;
 228   my(@autolist, %opttbl, %result);
 229   my($stop, $key, $value, $diemsg);
 230
 231   # Initialization:
 232   @autolist = map {
 233     if ($_->{numargs} && !$_->{noauto} && !$stop) {
 234       $stop = 1 if ($_->{numargs} < 0);
 235       ($_->{name});
 236     } else {
 237       ();
 238     }
 239   } (@$optlist, { name=>'-help', numargs=>0, required=>0 } );
 240   %opttbl = map { $_->{name} => $_ } @$optlist;
 241
 242   while (@$argv) {
 243     my($optname, $optkind);
 244
 245     # Parse the next argument.  It can either be an option, or an
 246     # unadorned argument.  If the former, shift it off and process it.
 247     # Otherwise, grab the next "automatic" option.  If there are no
 248     # more automatic options, we have extra arguments and should return.
 249     if ($argv->[0] =~ /^-(.+)/) {  # Got an option!
 250       $optname = $1;
 251       shift(@$argv);
 252     } else {                       # An unadorned argument
 253       if (@autolist) {
 254         $optname = shift(@autolist);
 255       } else {
 256         $diemsg = join(' ', "Extra arguments:", @$argv) unless ($diemsg);
 257         shift @$argv;
 258         next;
 259       }
 260     }
 261     $optname = &_which_opt($optname, keys %opttbl);
 262
 263     # Find out how many arguments this thing wants, then remove it from
 264     # the option table and automatic option list.
 265     $optkind = $opttbl{$optname}->{numargs};
 266     delete $opttbl{$optname};
 267     @autolist = grep($_ ne $optname, @autolist);
 268
 269     # Parse arguments (if any), and set the result value
 270     if (!$optkind) {               # Boolean!
 271       $result{$optname} = 1;
 272     } elsif ($optkind == 1) {      # Single argument
 273       # Shift off a single argument, or signal an error
 274       if (!@$argv) {
 275         $diemsg = "No argument for -$optname" unless ($diemsg);
 276         next;
 277       }
 278       $result{$optname} = shift(@$argv);
 279     } elsif ($optkind < 0) {       # Multiple arguments
 280       # Shift off at least one argument, and any additional
 281       # ones that are present.  EXCEPT, if there are no more
 282       # explicitly-specified options but there ARE automatic
 283       # options left in our list, then only eat up one.
 284       my($val, @val);
 285       if (!@$argv) {
 286         $diemsg = "No argument for -$optname" unless ($diemsg);
 287         next;
 288       }
 289       $val = shift(@$argv);
 290       push(@val, shift @$argv) while (@$argv && $argv->[0] !~ /^-/);
 291       if (@autolist && !@$argv) {
 292         unshift(@$argv, @val);
 293         @val = ($val);
 294       } else {
 295         unshift(@val, $val);
 296       }
 297       $result{$optname} = [@val];
 298     } else {
 299       die "Invalid argument spec for -$optname ($optkind)\n";
 300     }
 301   }
 302
 303   # Now for a little clean-up
 304   # Set default values for any unspecified option that has them.
 305   # Set an error condition if there are any required options that
 306   # were not specified.
 307   while (($key, $value) = each %opttbl) {
 308     if ($value->{required}) {
 309       $diemsg = "Required option -$key not specified" unless($diemsg);
 310     }
 311     $result{$key} = $value->{default};
 312   }
 313   if ($diemsg && !$result{help}) { die $diemsg . "\n" }
 314   %result;
 315 }
 316
 317
 318 1;
 319
 320 =head1 VARIABLES
 321
 322 The following global variables are defined by B<OpenAFS::util>.  None of these
 323 are exported by default.  Those marked "Private" should not be used outside
 324 AFStools; their names, meaning, and even existence may change at any time.
 325
 326 =over 12
 327
 328 =item %AFS_Help - Help info
 329
 330 This array contains argument lists for all publicly-exported AFStools
 331 functions with names of the form AFS_*.  It is intended for programs like
 332 B<testbed>, which provide a direct interactive interface to AFStools.
 333
 334 =item %AFS_Parms - Parameter settings  [Private]
 335
 336 This array contains the settings of AFStools parameters set with
 337 B<OpenAFS::util::AFS_SetParm>.
 338
 339 =item %AFS_Trace - Tracing levels  [Private]
 340
 341 This array contains the tracing levels set with B<OpenAFS::util::AFS_Trace>.
 342
 343 =item %AFScmd - AFS command locations  [Private]
 344
 345 This array contains paths to the various AFS command binaries, for use
 346 by B<OpenAFS::wrapper::wrapper> and possibly other AFStools functions.
 347
 348 =back
 349
 350 =head1 COPYRIGHT
 351
 352 The CMUCS AFStools, including this module are
 353 Copyright (c) 1996, Carnegie Mellon University.  All rights reserved.
 354 For use and redistribution information, see CMUCS/CMU_copyright.pm
 355
 356 =cut