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# buildcode -- Given a dictname and dictval, print the Message ID 31# 32# example: buildcode FMD 1 33# prints: FMD-8000-11 34# 35# usage: buildcode [-cvVt] dictname dictval 36# 37# -c trace checksumming process 38# 39# -v verbose, show how code is assembled 40# 41# -V even more verbose 42# 43# -t print table showing how codes work 44# 45# This is a completely separate implementation of how diagcodes 46# are built (see libdiagcode, or PSARC/2003/323). This separate 47# implementation provides us a way to test libdiagcode and, since 48# it is written in Perl, it provides a portable way to print Message 49# IDs without building libdiagcode. The event registry uses this 50# script to display diagcodes. 51# 52# NOTE: This implementation may not support the full range of 53# possible diagcodes (currently it only works up to 2^63-1 or 54# 9223372036854775807 on most machines). 55# 56# XXX could probably fix the above limitation by using Math::BigInt. 57# 58 59use strict; 60use integer; 61 62use Getopt::Std; 63 64use vars qw($opt_c $opt_v $opt_V $opt_t); 65 66my $Myname = $0; # save our name for error messages 67$Myname =~ s,.*/,,; 68 69$SIG{HUP} = $SIG{INT} = $SIG{TERM} = $SIG{__DIE__} = sub { 70 die "$Myname: ERROR: @_"; 71}; 72 73# the alphabet used for diagcodes, indexed by 5-bit values 74my $Alphabet = "0123456789ACDEFGHJKLMNPQRSTUVWXY"; 75 76# map codelen to the two-bit binary code size field in diagcode 77my @Codesize = ( '00', '01', '10', '11' ); 78 79# map codelen to the sprintf format we use for dictval 80my @Dictvalformat = ( '%021b', '%038b', '%055b', '%072b' ); 81 82# map codelen to number of data bits for dictval 83my @Dictvalbits = ( 21, 38, 55, 72 ); 84 85# map codelen to the number of checksum bits used in diagcode 86my @Csumbits = ( 5, 8, 11, 14 ); 87 88# 89# buildcode -- build the Message ID from passed-in dictname & dictval 90# 91sub buildcode { 92 my $dictname = shift; 93 my $dictval = shift; 94 my $csum = 0; 95 my $i; 96 my $bits; 97 my $codelen; 98 99 # force dictname to upper case 100 $dictname = uc($dictname); 101 102 # check for integer overflow 103 die "dictval $dictval converts to " . sprintf("%d", $dictval) . 104 " (integer overflow?)\n" if sprintf("%d", $dictval) ne $dictval; 105 106 # largest possible dictval is (2^21 + 2^38 + 2^55 + 2^72-1) 107 # XXX the following check itself causes integer overflow, but 108 # XXX disabling it doesn't matter for now since the above check 109 # XXX tops out at 2^63-1 110 #die "dictval $dictval too big\n" if $dictval > 4722402511941544181759; 111 112 print " Dictname: \"$dictname\"\n" if $opt_v; 113 114 # using sprintf will show conversion/overflow errors 115 print " Dictval: " . sprintf("%d", $dictval) . ": " if $opt_v; 116 117 # determine which size Message ID to use 118 if ($dictval < 2097152) { 119 $codelen = 0; 120 print "below 2^21\n" if $opt_v; 121 if ($opt_V) { 122 print " Format 0: " . 123 "DICT-XXXX-XX\n"; 124 print " 2 bits code type\n"; 125 print " 2 bits size\n"; 126 print " 21 bits dictval\n"; 127 print " 8 bits checksum\n"; 128 } 129 } elsif (274880004096 < 0) { 130 # this prevents errors on some versions of Linux 131 die "dictval $dictval too big for Perl on this machine\n"; 132 } elsif ($dictval < 274880004096) { 133 $codelen = 1; 134 $dictval -= 2097152; 135 print "above 2^21-1, below 2^38-1\n" if $opt_v; 136 if ($opt_V) { 137 print " Format 1: " . 138 "DICT-XXXX-XXXX-XX\n"; 139 print " 2 bits code type\n"; 140 print " 2 bits size\n"; 141 print " 38 bits dictval " . 142 "(adjusted dictval $dictval)\n"; 143 print " 8 bits checksum\n"; 144 } 145 } elsif (36029071898968064 < 0) { 146 # this prevents errors on some versions of Linux 147 die "dictval $dictval too big for Perl on this machine\n"; 148 } elsif ($dictval < 36029071898968064) { 149 $codelen = 2; 150 $dictval -= 274880004096; 151 print "above 2^38-1, below 2^55-1\n" if $opt_v; 152 if ($opt_V) { 153 print " Format 2: " . 154 "DICT-XXXX-XXXX-XXXX-XX\n"; 155 print " 2 bits code type\n"; 156 print " 2 bits size\n"; 157 print " 55 bits dictval " . 158 "(adjusted dictval $dictval)\n"; 159 print " 11 bits checksum\n"; 160 } 161 } else { 162 $codelen = 3; 163 $dictval -= 36029071898968064; 164 print "above 2^55-1, below 2^72-1\n" if $opt_v; 165 if ($opt_V) { 166 print " Format 3: " . 167 "DICT-XXXX-XXXX-XXXX-XXXX-XX\n"; 168 print " 2 bits code type\n"; 169 print " 2 bits size\n"; 170 print " 72 bits dictval " . 171 "(adjusted dictval $dictval)\n"; 172 print " 14 bits checksum\n"; 173 } 174 } 175 176 # first run dictname through checksum 177 foreach $i (unpack('C*', $dictname)) { 178 $csum = crc($csum, $i); 179 } 180 181 # 2 bit code type, set to 01 182 print " Code type: 01\n" if $opt_v; 183 $bits = "01"; 184 185 # 2 bit size field 186 print " Code size: " . $Codesize[$codelen] . "\n" if $opt_v; 187 $bits .= $Codesize[$codelen]; 188 189 # data bits of the dictval 190 $dictval = sprintf($Dictvalformat[$codelen], $dictval); 191 print " Dictval: $dictval\n" if $opt_v; 192 die "binary dictval is " . length($dictval) . 193 " bits instead of the expected $Dictvalbits[$codelen]\n" 194 if length($dictval) != $Dictvalbits[$codelen]; 195 $bits .= $dictval; 196 197 # csum bits, zeroed 198 $bits .= '0' x $Csumbits[$codelen]; 199 200 # compute csum by taking 5 bits at a time from left to right 201 my $bitscopy = $bits; 202 while ($bitscopy =~ /(.....)/) { 203 $csum = crc($csum, oct('0b' . $1)); 204 $bitscopy =~ s/.....//; 205 } 206 207 printf("CRC: 0x%x\n", $csum) if $opt_c; 208 209 # change the zeroed csum bits to the computed value, masking 210 # the computed checksum down to the appropriate number of bits 211 print " Checksum: " . substr(sprintf("%014b", $csum), 212 - $Csumbits[$codelen], $Csumbits[$codelen]) . "\n" if $opt_v; 213 substr($bits, - $Csumbits[$codelen], $Csumbits[$codelen]) = 214 substr(sprintf("%b", $csum), 215 - $Csumbits[$codelen], $Csumbits[$codelen]); 216 217 # convert to diagcode alphabet, 5 bits at a time from left to right 218 print " Converted:\n" if $opt_V; 219 my $x; 220 while ($bits =~ /(.....)/) { 221 print " $1 = " . 222 substr($Alphabet, oct('0b' . $1), 1) . "\n" if $opt_V; 223 $x .= substr($Alphabet, oct('0b' . $1), 1); 224 $bits =~ s/.....//; 225 } 226 227 # insert the dashes at the appropriate points 228 $x =~ s/(..)$/-$1/; 229 $x =~ s/([^-]{4})([^-])/$1-$2/; 230 $x =~ s/([^-]{4})([^-])/$1-$2/; 231 $x =~ s/([^-]{4})([^-])/$1-$2/; 232 $x =~ s/([^-]{4})([^-])/$1-$2/; 233 234 return "$dictname-$x"; 235} 236 237# table used by crc() 238my @Crctab = ( 2390x00000000, 2400x04C11DB7, 0x09823B6E, 0x0D4326D9, 0x130476DC, 0x17C56B6B, 2410x1A864DB2, 0x1E475005, 0x2608EDB8, 0x22C9F00F, 0x2F8AD6D6, 2420x2B4BCB61, 0x350C9B64, 0x31CD86D3, 0x3C8EA00A, 0x384FBDBD, 2430x4C11DB70, 0x48D0C6C7, 0x4593E01E, 0x4152FDA9, 0x5F15ADAC, 2440x5BD4B01B, 0x569796C2, 0x52568B75, 0x6A1936C8, 0x6ED82B7F, 2450x639B0DA6, 0x675A1011, 0x791D4014, 0x7DDC5DA3, 0x709F7B7A, 2460x745E66CD, 0x9823B6E0, 0x9CE2AB57, 0x91A18D8E, 0x95609039, 2470x8B27C03C, 0x8FE6DD8B, 0x82A5FB52, 0x8664E6E5, 0xBE2B5B58, 2480xBAEA46EF, 0xB7A96036, 0xB3687D81, 0xAD2F2D84, 0xA9EE3033, 2490xA4AD16EA, 0xA06C0B5D, 0xD4326D90, 0xD0F37027, 0xDDB056FE, 2500xD9714B49, 0xC7361B4C, 0xC3F706FB, 0xCEB42022, 0xCA753D95, 2510xF23A8028, 0xF6FB9D9F, 0xFBB8BB46, 0xFF79A6F1, 0xE13EF6F4, 2520xE5FFEB43, 0xE8BCCD9A, 0xEC7DD02D, 0x34867077, 0x30476DC0, 2530x3D044B19, 0x39C556AE, 0x278206AB, 0x23431B1C, 0x2E003DC5, 2540x2AC12072, 0x128E9DCF, 0x164F8078, 0x1B0CA6A1, 0x1FCDBB16, 2550x018AEB13, 0x054BF6A4, 0x0808D07D, 0x0CC9CDCA, 0x7897AB07, 2560x7C56B6B0, 0x71159069, 0x75D48DDE, 0x6B93DDDB, 0x6F52C06C, 2570x6211E6B5, 0x66D0FB02, 0x5E9F46BF, 0x5A5E5B08, 0x571D7DD1, 2580x53DC6066, 0x4D9B3063, 0x495A2DD4, 0x44190B0D, 0x40D816BA, 2590xACA5C697, 0xA864DB20, 0xA527FDF9, 0xA1E6E04E, 0xBFA1B04B, 2600xBB60ADFC, 0xB6238B25, 0xB2E29692, 0x8AAD2B2F, 0x8E6C3698, 2610x832F1041, 0x87EE0DF6, 0x99A95DF3, 0x9D684044, 0x902B669D, 2620x94EA7B2A, 0xE0B41DE7, 0xE4750050, 0xE9362689, 0xEDF73B3E, 2630xF3B06B3B, 0xF771768C, 0xFA325055, 0xFEF34DE2, 0xC6BCF05F, 2640xC27DEDE8, 0xCF3ECB31, 0xCBFFD686, 0xD5B88683, 0xD1799B34, 2650xDC3ABDED, 0xD8FBA05A, 0x690CE0EE, 0x6DCDFD59, 0x608EDB80, 2660x644FC637, 0x7A089632, 0x7EC98B85, 0x738AAD5C, 0x774BB0EB, 2670x4F040D56, 0x4BC510E1, 0x46863638, 0x42472B8F, 0x5C007B8A, 2680x58C1663D, 0x558240E4, 0x51435D53, 0x251D3B9E, 0x21DC2629, 2690x2C9F00F0, 0x285E1D47, 0x36194D42, 0x32D850F5, 0x3F9B762C, 2700x3B5A6B9B, 0x0315D626, 0x07D4CB91, 0x0A97ED48, 0x0E56F0FF, 2710x1011A0FA, 0x14D0BD4D, 0x19939B94, 0x1D528623, 0xF12F560E, 2720xF5EE4BB9, 0xF8AD6D60, 0xFC6C70D7, 0xE22B20D2, 0xE6EA3D65, 2730xEBA91BBC, 0xEF68060B, 0xD727BBB6, 0xD3E6A601, 0xDEA580D8, 2740xDA649D6F, 0xC423CD6A, 0xC0E2D0DD, 0xCDA1F604, 0xC960EBB3, 2750xBD3E8D7E, 0xB9FF90C9, 0xB4BCB610, 0xB07DABA7, 0xAE3AFBA2, 2760xAAFBE615, 0xA7B8C0CC, 0xA379DD7B, 0x9B3660C6, 0x9FF77D71, 2770x92B45BA8, 0x9675461F, 0x8832161A, 0x8CF30BAD, 0x81B02D74, 2780x857130C3, 0x5D8A9099, 0x594B8D2E, 0x5408ABF7, 0x50C9B640, 2790x4E8EE645, 0x4A4FFBF2, 0x470CDD2B, 0x43CDC09C, 0x7B827D21, 2800x7F436096, 0x7200464F, 0x76C15BF8, 0x68860BFD, 0x6C47164A, 2810x61043093, 0x65C52D24, 0x119B4BE9, 0x155A565E, 0x18197087, 2820x1CD86D30, 0x029F3D35, 0x065E2082, 0x0B1D065B, 0x0FDC1BEC, 2830x3793A651, 0x3352BBE6, 0x3E119D3F, 0x3AD08088, 0x2497D08D, 2840x2056CD3A, 0x2D15EBE3, 0x29D4F654, 0xC5A92679, 0xC1683BCE, 2850xCC2B1D17, 0xC8EA00A0, 0xD6AD50A5, 0xD26C4D12, 0xDF2F6BCB, 2860xDBEE767C, 0xE3A1CBC1, 0xE760D676, 0xEA23F0AF, 0xEEE2ED18, 2870xF0A5BD1D, 0xF464A0AA, 0xF9278673, 0xFDE69BC4, 0x89B8FD09, 2880x8D79E0BE, 0x803AC667, 0x84FBDBD0, 0x9ABC8BD5, 0x9E7D9662, 2890x933EB0BB, 0x97FFAD0C, 0xAFB010B1, 0xAB710D06, 0xA6322BDF, 2900xA2F33668, 0xBCB4666D, 0xB8757BDA, 0xB5365D03, 0xB1F740B4 291); 292 293# 294# crc -- calculate a CRC using passed-in starting value & additional data 295# 296sub crc { 297 my $cval = shift; 298 my $val = shift; 299 300 printf("crc(0x%08x, 0x%x)\n", $cval, $val) if $opt_c; 301 302 return (($cval<<8) ^ $Crctab[((($cval>>24) & 0xff) ^ $val) & 0xff]); 303} 304 305# 306# usage -- print a usage message and exit 307# 308sub usage { 309 my $msg = shift; 310 311 warn "$Myname: $msg\n" if defined($msg); 312 warn "usage: $Myname [-cvVt] dictname dictval\n"; 313 exit 1; 314} 315 316# 317# the "main" for this script... 318# 319getopts('cvVt') or usage; 320 321$opt_v = 1 if $opt_V; # big V implies small v 322 323# even before printing any usage messages, spew table if asked 324if ($opt_t) { 325 print <<EOF; 326 TABLE OF TYPE 1 DIAGCODE FORMATS 327 328Format 0: "dict-XXXX-XX", 21 data bits, 5 checksum bits 329 0 through 2097151 (2^21-1) 330 331 332Format 1: "dict-XXXX-XXXX-XX", 38 data bits, 8 checksum bits 333 2097152 through 274880004095 (2^21 + 2^38-1) 334 335 336Format 2: "dict-XXXX-XXXX-XXXX-XX", 55 data bits, 11 checksum bits 337 274880004096 through 36029071898968063 (2^21 + 2^38 + 2^55-1) 338 339 340Format 3: "dict-XXXX-XXXX-XXXX-XXXX-XX", 72 data bits, 14 checksum bits 341 36029071898968064 through 4722402511941544181759 (2^21 + 2^38 + 2^55 + 2^72-1) 342 343Code alphabet is: $Alphabet 344 345EOF 346} 347 348my $dictname = shift; 349my $dictval = shift; 350usage unless defined($dictname) && defined($dictval); 351usage if @ARGV; 352if ($opt_v) { 353 print "SUNW-MSG-ID: " . buildcode($dictname, $dictval) . "\n"; 354} else { 355 print buildcode($dictname, $dictval) . "\n"; 356} 357exit 0; 358