usr/src/cmd/fm/scripts/bustcode.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # CDDL HEADER START
   4 #
   5 # The contents of this file are subject to the terms of the
   6 # Common Development and Distribution License, Version 1.0 only
   7 # (the "License").  You may not use this file except in compliance
   8 # with the License.
   9 #
  10 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
  11 # or http://www.opensolaris.org/os/licensing.
  12 # See the License for the specific language governing permissions
  13 # and limitations under the License.
  14 #
  15 # When distributing Covered Code, include this CDDL HEADER in each
  16 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
  17 # If applicable, add the following below this CDDL HEADER, with the
  18 # fields enclosed by brackets "[]" replaced with your own identifying
  19 # information: Portions Copyright [yyyy] [name of copyright owner]
  20 #
  21 # CDDL HEADER END
  22 #
  23 #
  24 # ident "%Z%%M% %I%     %E% SMI"
  25 #
  26 # Copyright 2004 Sun Microsystems, Inc.  All rights reserved.
  27 # Use is subject to license terms.
  28 #
  29 #
  30 # bustcode -- Given a Message ID, bust it up into fields and print them
  31 #
  32 # usage: bustcode [-cq] message-id
  33 #
  34 #       -c      trace checksumming process
  35 #
  36 #       -q      quiet mode, only output dictname and dictval
  37 #
  38 # This script is used for testing & debugging of libdiagcode
  39 # (PSARC/2003/323).
  40 #
  41 # NOTE: This implementation may not support the full range of
  42 # possible diagcodes (currently it only works up to 2^63-1 or
  43 # 9223372036854775807 on most machines).
  44 #
  45 # XXX could probably fix the above limitation by using Math::BigInt.
  46 #
  47
  48 use strict;
  49 use integer;
  50
  51 use Getopt::Std;
  52
  53 use vars qw($opt_c $opt_q);
  54
  55 my $Myname = $0;        # save our name for error messages
  56 $Myname =~ s,.*/,,;
  57
  58 $SIG{HUP} = $SIG{INT} = $SIG{TERM} = $SIG{__DIE__} = sub {
  59         die "$Myname: ERROR: @_";
  60 };
  61
  62 # the alphabet used for diagcodes, indexed by 5-bit values
  63 my $Alphabet = "0123456789ACDEFGHJKLMNPQRSTUVWXY";
  64
  65 # map codelen to the two-bit binary code size field in diagcode
  66 my @Codesize = ( '00', '01', '10', '11' );
  67
  68 # map codelen to the sprintf format we use for dictval
  69 my @Dictvalformat = ( '%021b', '%038b', '%055b', '%072b' );
  70
  71 # map codelen to number of data bits for dictval
  72 my @Dictvalbits = ( 21, 38, 55, 72 );
  73
  74 # map codelen to the number of checksum bits used in diagcode
  75 my @Csumbits = ( 5, 8, 11, 14 );
  76
  77 #
  78 # bustcode -- bust up a Message ID into fields
  79 #
  80 sub bustcode {
  81         my $id = shift;
  82         my $dictname;
  83         my $xpart;
  84         my $dictval;
  85         my $csum = 0;
  86         my $csumfromcode;
  87         my $bits;
  88         my $codelen;
  89         my $x;
  90         my $i;
  91
  92         die "\"$id\" malformed Message ID\n"
  93             unless $id =~ /^(\w+)-(([a-zA-Z0-9]{4}-){1,4}[a-zA-Z0-9]{2})$/;
  94
  95         $dictname = $1;
  96         $xpart = $2;
  97
  98         if ($xpart =~ /(([a-zA-Z0-9]{4}-){4}[a-zA-Z0-9]{2})/) {
  99                 $codelen = 3;
 100         } elsif ($xpart =~ /(([a-zA-Z0-9]{4}-){3}[a-zA-Z0-9]{2})/) {
 101                 $codelen = 2;
 102         } elsif ($xpart =~ /(([a-zA-Z0-9]{4}-){2}[a-zA-Z0-9]{2})/) {
 103                 $codelen = 1;
 104         } elsif ($xpart =~ /(([a-zA-Z0-9]{4}-){1}[a-zA-Z0-9]{2})/) {
 105                 $codelen = 0;
 106         } else {
 107                 die "internal error: code len patterns are wrong\n";
 108         }
 109         print "             Bust up code: \"$id\" (format $codelen)\n"
 110             unless $opt_q;
 111
 112         $dictname = uc($dictname);
 113         $xpart = uc($xpart);
 114         $xpart =~ s/B/8/g;
 115         $xpart =~ s/I/1/g;
 116         $xpart =~ s/O/0/g;
 117         $xpart =~ s/Z/2/g;
 118
 119         unless ($opt_q) {
 120                 print "After alphabet correction: \"$dictname-$xpart\"\n"
 121                     if $id ne "$dictname-$xpart";
 122
 123                 print "          Dictionary name: \"$dictname\"\n";
 124         }
 125
 126         # first run dictname through checksum
 127         foreach $i (unpack('C*', $dictname)) {
 128                 $csum = crc($csum, $i);
 129         }
 130
 131         # convert xpart to binary number (really a string of [01])
 132         print "               Conversion:\n" unless $opt_q;
 133         while ($xpart =~ /(.)/) {
 134                 $x = $1;
 135                 $xpart =~ s/.//;
 136                 next if $x eq '-';
 137                 $i = 0;
 138                 while (1) {
 139
 140                         die "illegal character in Message ID: \"$x\"\n"
 141                             unless $i < length($Alphabet);
 142
 143                         last if $x eq substr($Alphabet, $i, 1);
 144                         $i++;
 145                 }
 146                 print "                           $x = " .
 147                     sprintf('%05b', $i) . "\n" unless $opt_q;
 148                 $bits .= sprintf('%05b', $i);
 149         }
 150
 151         die "no code type in bits \"$bits\"\n"
 152             unless $bits =~ /^(..)/;
 153         print "         2 bits code type: $1\n" unless $opt_q;
 154         die "unrecognized code type (must be 01)\n" unless $1 eq '01';
 155
 156         die "no code length in bits \"$bits\"\n"
 157             unless $bits =~ /^..(..)/;
 158         print "              2 bits size: $1\n" unless $opt_q;
 159         die "size field doesn't match format\n"
 160             unless oct('0b' . $1) == $codelen;
 161
 162         # extract the dictval (skip 4 bits for code type & size fields)
 163         $dictval = substr($bits, 4, $Dictvalbits[$codelen]);
 164         die "no dictval in bits \"$bits\"\n"
 165             unless length($dictval) == $Dictvalbits[$codelen];
 166         print "          " . sprintf('%2d', $Dictvalbits[$codelen]) .
 167             " bits dictval: $dictval\n" unless $opt_q;
 168         $dictval = bintoi($dictval);
 169         print "          Decimal dictval: $dictval\n" unless $opt_q;
 170
 171         # check for integer overflow
 172         warn "$Myname: ERROR: dictval is negative (integer overflow)\n"
 173                 if $dictval < 0;
 174
 175         if ($codelen == 1) {
 176                 print "      Add format 1 offset: 2097152\n" unless $opt_q;
 177                 $dictval += 2097152;
 178                 print "         Adjusted dictval: $dictval\n" unless $opt_q;
 179         } elsif ($codelen == 2) {
 180                 print "      Add format 2 offset: 274880004096\n" unless $opt_q;
 181                 $dictval += 274880004096;
 182                 print "         Adjusted dictval: $dictval\n" unless $opt_q;
 183         } elsif ($codelen == 3) {
 184                 print "      Add format 3 offset: 36029071898968064\n"
 185                     unless $opt_q;
 186                 $dictval += 36029071898968064;
 187                 print "         Adjusted dictval: $dictval\n" unless $opt_q;
 188         }
 189
 190         # check for integer overflow
 191         warn "$Myname: ERROR: dictval $dictval converts to " .
 192             sprintf("%d", $dictval) . " (integer overflow?)\n"
 193             if sprintf("%d", $dictval) ne $dictval;
 194
 195         # save the checksum given to us in the code
 196         $csumfromcode =
 197             substr($bits, - $Csumbits[$codelen],  $Csumbits[$codelen]);
 198         die "no checksum in bits \"$bits\"\n"
 199             unless length($csumfromcode) == $Csumbits[$codelen];
 200
 201         # zero the checksum for our calculation
 202         substr($bits, - $Csumbits[$codelen],  $Csumbits[$codelen]) =
 203             '0' x $Csumbits[$codelen];
 204
 205         # compute csum by taking 5 bits at a time from left to right
 206         my $bitscopy = $bits;
 207         while ($bitscopy =~ /(.....)/) {
 208                 $csum = crc($csum, oct('0b' . $1));
 209                 $bitscopy =~ s/.....//;
 210         }
 211
 212         printf("CRC: 0x%x\n", $csum) if $opt_c;
 213
 214         # changed the zeroed csum bits to the computed value, masking
 215         # the computed checksum down to the appropriate number of bits
 216         unless ($opt_q) {
 217                 print "         " . sprintf('%2d', $Csumbits[$codelen]) .
 218                     " bits checksum: ";
 219                 print "$csumfromcode ";
 220         }
 221         if ($csumfromcode eq substr(sprintf('%014b', $csum),
 222             - $Csumbits[$codelen],  $Csumbits[$codelen])) {
 223                 print "(correct)\n" unless $opt_q;
 224         } else {
 225                 if ($opt_q) {
 226                         warn "$Myname: ERROR: incorrect checksum " .
 227                             "($csumfromcode should be " .
 228                             substr(sprintf('%014b', $csum),
 229                             - $Csumbits[$codelen],
 230                             $Csumbits[$codelen]) . ")\n";
 231                 } else {
 232                         print "INCORRECT (should be " .
 233                             substr(sprintf('%014b', $csum),
 234                             - $Csumbits[$codelen],
 235                             $Csumbits[$codelen]) . ")\n";
 236                 }
 237         }
 238
 239         return "$dictname $dictval";
 240 }
 241
 242 #
 243 # bintoi -- convert string of binary digits to a number
 244 #
 245 # XXX there's got to be a better way to do this, but using oct()
 246 # XXX causes a warning about non-portable binary numbers...
 247 #
 248 sub bintoi {
 249         my $bits = shift;
 250         my $mul = 1;
 251         my $retval = 0;
 252
 253         while ($bits =~ /(.)$/) {
 254                 $retval += $mul if $1 eq '1';
 255                 $mul *= 2;
 256                 $bits =~ s/.$//;
 257         }
 258
 259         return $retval;
 260 }
 261
 262 # table used by crc()
 263 my @Crctab = (
 264 0x00000000,
 265 0x04C11DB7, 0x09823B6E, 0x0D4326D9, 0x130476DC, 0x17C56B6B,
 266 0x1A864DB2, 0x1E475005, 0x2608EDB8, 0x22C9F00F, 0x2F8AD6D6,
 267 0x2B4BCB61, 0x350C9B64, 0x31CD86D3, 0x3C8EA00A, 0x384FBDBD,
 268 0x4C11DB70, 0x48D0C6C7, 0x4593E01E, 0x4152FDA9, 0x5F15ADAC,
 269 0x5BD4B01B, 0x569796C2, 0x52568B75, 0x6A1936C8, 0x6ED82B7F,
 270 0x639B0DA6, 0x675A1011, 0x791D4014, 0x7DDC5DA3, 0x709F7B7A,
 271 0x745E66CD, 0x9823B6E0, 0x9CE2AB57, 0x91A18D8E, 0x95609039,
 272 0x8B27C03C, 0x8FE6DD8B, 0x82A5FB52, 0x8664E6E5, 0xBE2B5B58,
 273 0xBAEA46EF, 0xB7A96036, 0xB3687D81, 0xAD2F2D84, 0xA9EE3033,
 274 0xA4AD16EA, 0xA06C0B5D, 0xD4326D90, 0xD0F37027, 0xDDB056FE,
 275 0xD9714B49, 0xC7361B4C, 0xC3F706FB, 0xCEB42022, 0xCA753D95,
 276 0xF23A8028, 0xF6FB9D9F, 0xFBB8BB46, 0xFF79A6F1, 0xE13EF6F4,
 277 0xE5FFEB43, 0xE8BCCD9A, 0xEC7DD02D, 0x34867077, 0x30476DC0,
 278 0x3D044B19, 0x39C556AE, 0x278206AB, 0x23431B1C, 0x2E003DC5,
 279 0x2AC12072, 0x128E9DCF, 0x164F8078, 0x1B0CA6A1, 0x1FCDBB16,
 280 0x018AEB13, 0x054BF6A4, 0x0808D07D, 0x0CC9CDCA, 0x7897AB07,
 281 0x7C56B6B0, 0x71159069, 0x75D48DDE, 0x6B93DDDB, 0x6F52C06C,
 282 0x6211E6B5, 0x66D0FB02, 0x5E9F46BF, 0x5A5E5B08, 0x571D7DD1,
 283 0x53DC6066, 0x4D9B3063, 0x495A2DD4, 0x44190B0D, 0x40D816BA,
 284 0xACA5C697, 0xA864DB20, 0xA527FDF9, 0xA1E6E04E, 0xBFA1B04B,
 285 0xBB60ADFC, 0xB6238B25, 0xB2E29692, 0x8AAD2B2F, 0x8E6C3698,
 286 0x832F1041, 0x87EE0DF6, 0x99A95DF3, 0x9D684044, 0x902B669D,
 287 0x94EA7B2A, 0xE0B41DE7, 0xE4750050, 0xE9362689, 0xEDF73B3E,
 288 0xF3B06B3B, 0xF771768C, 0xFA325055, 0xFEF34DE2, 0xC6BCF05F,
 289 0xC27DEDE8, 0xCF3ECB31, 0xCBFFD686, 0xD5B88683, 0xD1799B34,
 290 0xDC3ABDED, 0xD8FBA05A, 0x690CE0EE, 0x6DCDFD59, 0x608EDB80,
 291 0x644FC637, 0x7A089632, 0x7EC98B85, 0x738AAD5C, 0x774BB0EB,
 292 0x4F040D56, 0x4BC510E1, 0x46863638, 0x42472B8F, 0x5C007B8A,
 293 0x58C1663D, 0x558240E4, 0x51435D53, 0x251D3B9E, 0x21DC2629,
 294 0x2C9F00F0, 0x285E1D47, 0x36194D42, 0x32D850F5, 0x3F9B762C,
 295 0x3B5A6B9B, 0x0315D626, 0x07D4CB91, 0x0A97ED48, 0x0E56F0FF,
 296 0x1011A0FA, 0x14D0BD4D, 0x19939B94, 0x1D528623, 0xF12F560E,
 297 0xF5EE4BB9, 0xF8AD6D60, 0xFC6C70D7, 0xE22B20D2, 0xE6EA3D65,
 298 0xEBA91BBC, 0xEF68060B, 0xD727BBB6, 0xD3E6A601, 0xDEA580D8,
 299 0xDA649D6F, 0xC423CD6A, 0xC0E2D0DD, 0xCDA1F604, 0xC960EBB3,
 300 0xBD3E8D7E, 0xB9FF90C9, 0xB4BCB610, 0xB07DABA7, 0xAE3AFBA2,
 301 0xAAFBE615, 0xA7B8C0CC, 0xA379DD7B, 0x9B3660C6, 0x9FF77D71,
 302 0x92B45BA8, 0x9675461F, 0x8832161A, 0x8CF30BAD, 0x81B02D74,
 303 0x857130C3, 0x5D8A9099, 0x594B8D2E, 0x5408ABF7, 0x50C9B640,
 304 0x4E8EE645, 0x4A4FFBF2, 0x470CDD2B, 0x43CDC09C, 0x7B827D21,
 305 0x7F436096, 0x7200464F, 0x76C15BF8, 0x68860BFD, 0x6C47164A,
 306 0x61043093, 0x65C52D24, 0x119B4BE9, 0x155A565E, 0x18197087,
 307 0x1CD86D30, 0x029F3D35, 0x065E2082, 0x0B1D065B, 0x0FDC1BEC,
 308 0x3793A651, 0x3352BBE6, 0x3E119D3F, 0x3AD08088, 0x2497D08D,
 309 0x2056CD3A, 0x2D15EBE3, 0x29D4F654, 0xC5A92679, 0xC1683BCE,
 310 0xCC2B1D17, 0xC8EA00A0, 0xD6AD50A5, 0xD26C4D12, 0xDF2F6BCB,
 311 0xDBEE767C, 0xE3A1CBC1, 0xE760D676, 0xEA23F0AF, 0xEEE2ED18,
 312 0xF0A5BD1D, 0xF464A0AA, 0xF9278673, 0xFDE69BC4, 0x89B8FD09,
 313 0x8D79E0BE, 0x803AC667, 0x84FBDBD0, 0x9ABC8BD5, 0x9E7D9662,
 314 0x933EB0BB, 0x97FFAD0C, 0xAFB010B1, 0xAB710D06, 0xA6322BDF,
 315 0xA2F33668, 0xBCB4666D, 0xB8757BDA, 0xB5365D03, 0xB1F740B4
 316 );
 317
 318 #
 319 # crc -- calculate a CRC using passed-in starting value & additional data
 320 #
 321 sub crc {
 322         my $cval = shift;
 323         my $val = shift;
 324
 325         printf("crc(0x%08x, 0x%x)\n", $cval, $val) if $opt_c;
 326
 327         return (($cval<<8) ^ $Crctab[((($cval>>24) & 0xff) ^ $val) & 0xff]);
 328 }
 329
 330 #
 331 # usage -- print a usage message and exit
 332 #
 333 sub usage {
 334         my $msg = shift;
 335
 336         warn "$Myname: $msg\n" if defined($msg);
 337         warn "usage: $Myname [-q] message-id\n";
 338         exit 1;
 339 }
 340
 341 #
 342 # the "main" for this script...
 343 #
 344 getopts('cq') or usage;
 345
 346 my $id = shift || usage;
 347 usage if @ARGV;
 348 if ($opt_q) {
 349         print bustcode($id) . "\n";
 350 } else {
 351         bustcode($id);
 352 }
 353 exit 0;