usr/src/cmd/fm/scripts/dictck.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 (the "License").
   7 # You may not use this file except in compliance with the License.
   8 #
   9 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
  10 # or http://www.opensolaris.org/os/licensing.
  11 # See the License for the specific language governing permissions
  12 # and limitations under the License.
  13 #
  14 # When distributing Covered Code, include this CDDL HEADER in each
  15 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
  16 # If applicable, add the following below this CDDL HEADER, with the
  17 # fields enclosed by brackets "[]" replaced with your own identifying
  18 # information: Portions Copyright [yyyy] [name of copyright owner]
  19 #
  20 # CDDL HEADER END
  21 #
  22 # Copyright (c) 2004, 2010, Oracle and/or its affiliates. All rights reserved.
  23 #
  24 #
  25 # dictck -- Sanity check a .dict file and optionally the corresponding .po file
  26 #
  27 # example: dickck FMD.dict FMD.po
  28 #
  29 # usage: dickck [-vp] [ -b buildcode ] dictfile [ pofile ]
  30 #
  31 #       -b      specify location of "buildcode" command
  32 #
  33 #       -p      print a .po file template to stdout, based on dictfile given
  34 #
  35 #       -v      verbose, show how code is assembled
  36 #
  37 # Note: this program requires the "buildcode" program in your search path.
  38 #
  39
  40 use strict;
  41
  42 use Getopt::Std;
  43
  44 use vars qw($opt_b $opt_p $opt_v);
  45
  46 my $Myname = $0;        # save our name for error messages
  47 $Myname =~ s,.*/,,;
  48
  49 $SIG{HUP} = $SIG{INT} = $SIG{TERM} = $SIG{__DIE__} = sub {
  50         # although fatal, we prepend "WARNING:" to make sure the
  51         # commonly-used "nightly" script flags this as lint on the .dict file
  52         die "$Myname: WARNING: @_";
  53 };
  54
  55 #
  56 # Category 1 event classes
  57 #
  58 my @cat1ev = qw(fault defect upset ereport list ireport);
  59
  60 #
  61 # usage -- print a usage message and exit
  62 #
  63 sub usage {
  64         my $msg = shift;
  65
  66         warn "$Myname: $msg\n" if defined($msg);
  67         warn "usage: $Myname [-pv] [ -b buildcode ] dictfile [ pofile ]\n";
  68         exit 1;
  69 }
  70
  71 my %keys2val;
  72 my %val2keys;
  73 my %code2val;
  74
  75 my $buildcode = 'buildcode';
  76
  77 #
  78 # the "main" for this script...
  79 #
  80 getopts('b:pv') or usage;
  81
  82 my $dictfile = shift;
  83 my $pofile = shift;
  84 usage unless defined($dictfile);
  85 usage if @ARGV;
  86 $buildcode = $opt_b if defined($opt_b);
  87 dodict($dictfile);
  88 dopo($pofile) if defined($pofile);
  89 exit 0;
  90
  91 #
  92 # dodict -- load up a .dict file, sanity checking it as we go
  93 #
  94 sub dodict {
  95         my $name = shift;
  96         my $dname;
  97         my $line = 0;
  98         my $lhs;
  99         my $rhs;
 100         my %props;
 101         my $maxkey = 1;
 102
 103         if ($name =~ m,([^/]+)\.dict$,) {
 104                 $dname = $1;
 105         } else {
 106                 die "dictname \"$name\" not something.dict as expected\n";
 107         }
 108
 109         open(F, $name) or die "$name: $!\n";
 110         print "parsing \"$name\"\n" if $opt_v;
 111         while (<F>) {
 112                 $line++;
 113                 next if /^\s*#/;
 114                 chomp;
 115                 next if /^\s*$/;
 116                 die "$name:$line: first non-comment line must be FMDICT line\n"
 117                     unless /^FMDICT:/;
 118                 print "FMDICT keyword found on line $line\n" if $opt_v;
 119                 s/FMDICT:\s*//;
 120                 my $s = $_;
 121                 while ($s =~ /^\s*([^=\s]+)(.*)$/) {
 122                         $lhs = $1;
 123                         $rhs = "";
 124                         $s = $+;
 125                         if ($s =~ /^\s*=\s*(.*)$/) {
 126                                 $s = $+;
 127                                 die "$name:$line: property \"$lhs\" incomplete\n"
 128                                     unless $s ne "";
 129                         }
 130                         if ($s =~ /^"((?:[^"]|\\")*)"(.*)$/) {
 131                                 $s = $+;
 132                                 $rhs = $1;
 133                         } else {
 134                                 $s =~ /^([^\s]*)(.*)$/;
 135                                 $s = $+;
 136                                 $rhs = $1;
 137                         }
 138                         $rhs =~ s/\\(.)/dobs($1)/ge;
 139                         $props{$lhs} = $rhs;
 140                         print "property \"$lhs\" value \"$rhs\"\n" if $opt_v;
 141                 }
 142                 last;
 143         }
 144         # check for required headers
 145         die "$name: no version property in header\n"
 146             unless defined($props{'version'});
 147         die "$name: no name property in header\n"
 148             unless defined($props{'name'});
 149         die "$name: no maxkey property in header\n"
 150             unless defined($props{'maxkey'});
 151
 152         # check version
 153         die "$name:$line: unexpected version: \"$props{'version'}\"\n"
 154             unless $props{'version'} eq "1";
 155
 156         # check name
 157         die "$name:$line: name \"$props{'name'}\" doesn't match \"$dname\" from filename\n"
 158             unless $props{'name'} eq $dname;
 159
 160         # check format of maxkey (value checked later)
 161         die "$name:$line: maxkey property must be a number\n"
 162             unless $props{'maxkey'} =~ /^\d+$/;
 163
 164         # check for old bits property
 165         die "$name: obsolete \"bits\" property found in header\n"
 166             if defined($props{'bits'});
 167
 168         # parse entries
 169         while (<F>) {
 170                 $line++;
 171                 chomp;
 172                 s/#.*//;
 173                 next if /^\s*$/;
 174                 die "$name:$line: malformed entry\n"
 175                     unless /^([^=]+)=(\d+)$/;
 176                 $lhs = $1;
 177                 $rhs = $2;
 178
 179                 # make sure keys are sorted
 180                 my $elhs = join(' ', sort split(/\s/, $lhs));
 181                 die "$name:$line: keys not in expected format of:\n" .
 182                     "    \"$elhs\"\n"
 183                     unless $elhs eq $lhs;
 184
 185                 # check for duplicate or unexpected keys
 186                 my %keys;
 187                 my $cat1pat = join('|', @cat1ev);
 188                 foreach my $e (split(/\s/, $lhs)) {
 189                         die "$name:$line: unknown event type \"$e\"\n"
 190                             unless $e =~
 191                             /^($cat1pat)\..*[^.]$/;
 192                         die "$name:$line: key repeated: \"$e\"\n"
 193                             if defined($keys{$e});
 194                         $keys{$e} = 1;
 195                 }
 196                 $maxkey = keys(%keys) if $maxkey < keys(%keys);
 197
 198                 die "$name:$line: duplicate entry for keys\n"
 199                     if defined($keys2val{$lhs});
 200                 die "$name:$line: duplicate entry for value $rhs\n"
 201                     if defined($val2keys{$rhs});
 202                 $keys2val{$lhs} = $rhs;
 203                 $val2keys{$rhs} = $lhs;
 204
 205                 open(B, "$buildcode $dname $rhs|") or
 206                     die "can't run buildcode: $!\n";
 207                 my $code = <B>;
 208                 chomp $code;
 209                 close(B);
 210                 print "code: $code keys: $lhs\n" if $opt_v;
 211                 $code2val{$code} = $rhs;
 212
 213                 if ($opt_p) {
 214                         print <<EOF;
 215 #
 216 # code: $code
 217 # keys: $lhs
 218 #
 219 msgid "$code.type"
 220 msgstr "XXX"
 221 msgid "$code.severity"
 222 msgstr "XXX"
 223 msgid "$code.description"
 224 msgstr "XXX"
 225 msgid "$code.response"
 226 msgstr "XXX"
 227 msgid "$code.impact"
 228 msgstr "XXX"
 229 msgid "$code.action"
 230 msgstr "XXX"
 231 EOF
 232                 }
 233         }
 234
 235         print "computed maxkey: $maxkey\n" if $opt_v;
 236
 237         # check maxkey
 238         die "$name: maxkey too low, should be $maxkey\n"
 239             if $props{'maxkey'} < $maxkey;
 240
 241         close(F);
 242 }
 243
 244 #
 245 # dobs -- handle backslashed sequences
 246 #
 247 sub dobs {
 248         my $s = shift;
 249
 250         return "\n" if $s eq 'n';
 251         return "\r" if $s eq 'r';
 252         return "\t" if $s eq 't';
 253         return $s;
 254 }
 255
 256 #
 257 # dopo -- sanity check a po file
 258 #
 259 sub dopo {
 260         my $name = shift;
 261         my $line = 0;
 262         my $id;
 263         my $code;
 264         my $suffix;
 265         my %ids;
 266
 267         open(F, $name) or die "$name: $!\n";
 268         print "parsing \"$name\"\n" if $opt_v;
 269         while (<F>) {
 270                 $line++;
 271                 next if /^\s*#/;
 272                 chomp;
 273                 next if /^\s*$/;
 274                 next unless /^msgid\s*"([^"]+)"$/;
 275                 $id = $1;
 276                 next unless $id =~
 277                    /^(.*)\.(type|severity|description|response|impact|action)$/;
 278                 $code = $1;
 279                 $suffix = $2;
 280                 die "$name:$line: no dict entry for code \"$code\"\n"
 281                    unless defined($code2val{$code});
 282                 $ids{$id} = $line;
 283         }
 284         close(F);
 285
 286         # above checks while reading in file ensured that node code was
 287         # mentioned in .po file that didn't exist in .dict file.  now
 288         # check the other direction: make sure the full set of entries
 289         # exist for each code in the .dict file
 290         foreach $code (sort keys %code2val) {
 291                 die "$name: missing entry for \"$code.type\"\n"
 292                     unless defined($ids{"$code.type"});
 293                 die "$name: missing entry for \"$code.severity\"\n"
 294                     unless defined($ids{"$code.severity"});
 295                 die "$name: missing entry for \"$code.description\"\n"
 296                     unless defined($ids{"$code.description"});
 297                 die "$name: missing entry for \"$code.response\"\n"
 298                     unless defined($ids{"$code.response"});
 299                 die "$name: missing entry for \"$code.impact\"\n"
 300                     unless defined($ids{"$code.impact"});
 301                 die "$name: missing entry for \"$code.action\"\n"
 302                     unless defined($ids{"$code.action"});
 303         }
 304 }