src/tests/OpenAFS/errtrans.pm

   1 # CMUCS AFStools
   2 # Copyright (c) 1996, Carnegie Mellon University
   3 # All rights reserved.
   4 #
   5 # See CMUCS/CMU_copyright.pm for use and distribution information
   6
   7 package OpenAFS::errtrans;
   8
   9 =head1 NAME
  10
  11 OpenAFS::errtrans - com_err error translation
  12
  13 =head1 SYNOPSIS
  14
  15   use OpenAFS::errtrans
  16   $code = errcode($name);
  17   $code = errcode($pkg, $err);
  18   $string = errstr($code, [$volerrs]);
  19
  20 =head1 DESCRIPTION
  21
  22 This module translates "common" error codes such as those produced
  23 by MIT's com_err package, and used extensively in AFS.  It also knows
  24 how to translate system error codes, negative error codes used by Rx,
  25 and a few "special" error codes used by AFS's volume package.
  26
  27 In order to work, these routines depend on the existence of error
  28 table files in $err_table_dir, which is usually /usr/local/lib/errtbl.
  29 Each file should be named after a com_err error package, and contain
  30 the definition for that package.
  31
  32 Note that the AFS version of com_err translates package names to uppercase
  33 before generating error codes, so a table which claims to define the 'pt'
  34 package actually defines the 'PT' package when compiled by AFS's compile_et.
  35 Tables that are normally fed to AFS's compile_et should be installed using
  36 the _uppercase_ version of the package name.
  37
  38 The error tables used in AFS are part of copyrighted AFS source code, and
  39 are not included with this package.  However, I have included a utility
  40 (gen_et) which can generate error tables from the .h files normally
  41 produced by compile_et, and Transarc provides many of these header files
  42 with binary AFS distributions (in .../include/afs).  See the gen_et
  43 program for more details.
  44
  45 =cut
  46
  47 use OpenAFS::CMU_copyright;
  48 use OpenAFS::util qw(:DEFAULT :afs_internal);
  49 use OpenAFS::config qw($err_table_dir);
  50 use Symbol;
  51 use Exporter;
  52 use POSIX;
  53
  54 $VERSION   = '';
  55 $VERSION   = '1.00';
  56 @ISA       = qw(Exporter);
  57 @EXPORT    = qw(&errcode &errstr);
  58
  59
  60 @NumToChar = ('', 'A'..'Z', 'a'..'z', '0'..'9', '_');
  61 %CharToNum = map(($NumToChar[$_], $_), (1 .. $#NumToChar));
  62
  63 %Vol_Codes = ( VSALVAGE    => 101,
  64                VNOVNODE    => 102,
  65                VNOVOL      => 103,
  66                VVOLEXISTS  => 104,
  67                VNOSERVICE  => 105,
  68                VOFFLINE    => 106,
  69                VONLINE     => 107,
  70                VDISKFULL   => 108,
  71                VOVERQUOTA  => 109,
  72                VBUSY       => 110,
  73                VMOVED      => 111
  74              );
  75 %Vol_Desc  = ( 101 => "volume needs to be salvaged",
  76                102 => "no such entry (vnode)",
  77                103 => "volume does not exist / did not salvage",
  78                104 => "volume already exists",
  79                105 => "volume out of service",
  80                106 => "volume offline (utility running)",
  81                107 => "volume already online",
  82                108 => "unknown volume error 108",
  83                109 => "unknown volume error 109",
  84                110 => "volume temporarily busy",
  85                111 => "volume moved"
  86              );
  87 %Rx_Codes  = ( RX_CALL_DEAD           => -1,
  88                RX_INVALID_OPERATION   => -2,
  89                RX_CALL_TIMEOUT        => -3,
  90                RX_EOF                 => -4,
  91                RX_PROTOCOL_ERROR      => -5,
  92                RX_USER_ABORT          => -6,
  93                RX_ADDRINUSE           => -7,
  94                RX_MSGSIZE             => -8,
  95                RXGEN_CC_MARSHAL       => -450,
  96                RXGEN_CC_UNMARSHAL     => -451,
  97                RXGEN_SS_MARSHAL       => -452,
  98                RXGEN_SS_UNMARSHAL     => -453,
  99                RXGEN_DECODE           => -454,
 100                RXGEN_OPCODE           => -455,
 101                RXGEN_SS_XDRFREE       => -456,
 102                RXGEN_CC_XDRFREE       => -457
 103              );
 104 %Rx_Desc   = (   -1 => "server or network not responding",
 105                  -2 => "invalid RPC (Rx) operation",
 106                  -3 => "server not responding promptly",
 107                  -4 => "Rx unexpected EOF",
 108                  -5 => "Rx protocol error",
 109                  -6 => "Rx user abort",
 110                  -7 => "port address already in use",
 111                  -8 => "Rx message size incorrect",
 112                -450 => "Rx client: XDR marshall failed",
 113                -451 => "Rx client: XDR unmarshall failed",
 114                -452 => "Rx server: XDR marshall failed",
 115                -453 => "Rx server: XDR unmarshall failed",
 116                -454 => "Rx: Decode failed",
 117                -455 => "Rx: Invalid RPC opcode",
 118                -456 => "Rx server: XDR free failed",
 119                -457 => "Rx client: XDR free failed",
 120                map(($_ => "RPC interface mismatch ($_)"), (-499 .. -458)),
 121                -999 => "Unknown error"
 122              );
 123
 124
 125 sub _tbl_to_num {
 126   my(@tbl) = split(//, $_[0]);
 127   my($n);
 128
 129   @tbl = @tbl[0..3] if (@tbl > 4);
 130   foreach (@tbl) { $n = ($n << 6) + $CharToNum{$_} }
 131   $n << 8;
 132 }
 133
 134
 135 sub _num_to_tbl {
 136   my($n) = $_[0] >> 8;
 137   my($tbl);
 138
 139   while ($n) {
 140     $tbl = @NumToChar[$n & 0x3f] . $tbl;
 141     $n >>= 6;
 142   }
 143   $tbl;
 144 }
 145
 146
 147 sub _load_system_errors {
 148   my($file) = @_;
 149   my($fh) = &gensym();
 150
 151   return if ($did_include{$file});
 152 # print "Loading $file...\n";
 153   $did_include{$file} = 'yes';
 154   if (open($fh, "/usr/include/$file")) {
 155     while (<$fh>) {
 156       if (/^\#define\s*(E\w+)\s*(\d+)/) {
 157         $Codes{$1} = $2;
 158       } elsif (/^\#include\s*\"([^"]+)\"/
 159            ||  /^\#include\s*\<([^>]+)\>/) {
 160         &_load_system_errors($1);
 161       }
 162     }
 163     close($fh);
 164   }
 165 }
 166
 167
 168 # Load an error table into memory
 169 sub _load_error_table {
 170   my($pkg) = @_;
 171   my($fh, @words, $curval, $tval, $nval);
 172   my($tid, $tfn, $code, $val, $desc);
 173
 174   return if ($Have_Table{$pkg});
 175   # Read in the input file, and split it into words
 176   $fh = &gensym();
 177   return unless open($fh, "$err_table_dir/$pkg");
 178 # print "Loading $pkg...\n";
 179   line: while (<$fh>) {
 180     s/^\s*//;  # Strip leading whitespace
 181     while ($_) {
 182       next line if (/^#/);
 183       if    (/^(error_table|et)\s*/) { push(@words, 'et');  $_ = $' }
 184       elsif (/^(error_code|ec)\s*/)  { push(@words, 'ec');  $_ = $' }
 185       elsif (/^end\s*/)              { push(@words, 'end'); $_ = $' }
 186       elsif (/^(\w+)\s*/)            { push(@words, $1);    $_ = $' }
 187       elsif (/^\"([^"]*)\"\s*/)      { push(@words, $1);    $_ = $' }
 188       elsif (/^([,=])\s*/)           { push(@words, $1);    $_ = $' }
 189       else { close($fh); return }
 190     }
 191   }
 192   close($fh);
 193
 194   # Parse the table header
 195   $_ = shift(@words); return unless ($_ eq 'et');
 196   if ($words[1] eq 'ec')    { $tid = shift(@words) }
 197   elsif ($words[2] eq 'ec') { ($tfn, $tid) = splice(@words, 0, 2) }
 198   else { return; }
 199   if ($tid ne $pkg) {
 200     $Have_Table{$tid} = 'yes';
 201     $_ = $tid;
 202     $_ =~ tr/a-z/A-Z/;
 203     $tid = $_ if ($_ eq $pkg);
 204   }
 205   $tval = &_tbl_to_num($tid);
 206   $Have_Table{$pkg} = 'yes';
 207 # print "Package $pkg: table-id = $tid, table-fun = $tfn, base = $tval\n";
 208
 209   while (@words) {
 210     $_ = shift(@words); return unless ($_ eq 'ec');
 211     $code = shift(@words);
 212     $_ = shift(@words);
 213     if ($_ eq '=') {
 214       $val = shift(@words);
 215       $_ = shift(@words);
 216     } else {
 217       $val = $curval;
 218     }
 219     return unless ($_ eq ',');
 220     $desc = shift(@words);
 221     $nval = $tval + $val;
 222     $curval = $val + 1;
 223     $Desc{$nval} = $desc;
 224     $Codes{$code} = $nval;
 225 #   print "  code $code: value = $nval ($tval + $val), desc = \"$desc\"\n";
 226   }
 227 }
 228
 229 =head2 errcode($name)
 230
 231 Returns the numeric error code corresponding to the specified error
 232 name.  This routine knows about names of system errors, a few special
 233 Rx and volume-package errors, and any errors defined in installed
 234 error tables.  If the specified error code is not found, returns -999.
 235
 236 =head2 errcode($pkg, $code)
 237
 238 Shifts $code into the specified error package, and returns the
 239 resulting com_err code.  This can be used to generate error codes
 240 for _any_ valid com_err package.
 241
 242 =cut
 243
 244 sub errcode {
 245   if (@_ > 1) {
 246     my($pkg, $code) = @_;
 247     &_tbl_to_num($pkg) + $code;
 248   } else {
 249     my($name) = @_;
 250     my($dir, @tbls, $code);
 251
 252     &_load_system_errors("errno.h");
 253     if ($Vol_Codes{$name})   { $Vol_Codes{$name} }
 254     elsif ($Rx_Codes{$name}) { $Rx_Codes{$name} }
 255     elsif ($Codes{$name})    { $Codes{$name} }
 256     else {
 257       if ($name =~ /^E/) {  # Might be a POSIX error constant
 258         $! = 0;
 259         $code = &POSIX::constant($name, 0);
 260         if (!$!) { return $code; }
 261       }
 262       $dir = &gensym();
 263       if (opendir($dir, $err_table_dir)) {
 264         @tbls = grep(!/^\.?\.$/, readdir($dir));
 265         close($dir);
 266         foreach (@tbls) { &_load_error_table($_) }
 267       }
 268       $Codes{$name} ? $Codes{$name} : -999;
 269     }
 270   }
 271 }
 272
 273
 274 =head2 errstr($code, [$volerrs])
 275
 276 Returns the error string corresponding to a specified com_err, Rx,
 277 or system error code.  If $volerrs is specified and non-zero, then
 278 volume-package errors are considered before system errors with the
 279 same values.
 280
 281 =cut
 282
 283 sub errstr {
 284   my($code, $volerrs) = @_;
 285   my($pkg, $sub);
 286
 287   if ($Rx_Desc{$code}) { return $Rx_Desc{$code} }
 288   if ($volerrs && $Vol_Desc{$code}) { return $Vol_Desc{$code} }
 289   $sub = $code & 0xff;
 290   $pkg = &_num_to_tbl($code);
 291   if ($pkg eq '') {
 292     $! = $sub + 0;
 293     $_ = $! . '';
 294     if (/^(Error )?\d+$/) { $Vol_Desc{$sub} ? $Vol_Desc{$sub} : "Error $sub" }
 295     else { $_ }
 296   } else {
 297     &_load_error_table($pkg);
 298     $Desc{$code} ? $Desc{$code} : "Unknown code $pkg $sub ($code)";
 299   }
 300 }
 301
 302 1;
 303
 304 =head1 COPYRIGHT
 305
 306 The CMUCS AFStools, including this module are
 307 Copyright (c) 1996, Carnegie Mellon University.  All rights reserved.
 308 For use and redistribution information, see CMUCS/CMU_copyright.pm
 309
 310 =cut