usr/src/tools/scripts/onbld_elfmod.pm

   1 package onbld_elfmod;
   2
   3 #
   4 # CDDL HEADER START
   5 #
   6 # The contents of this file are subject to the terms of the
   7 # Common Development and Distribution License (the "License").
   8 # You may not use this file except in compliance 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 #
  25 # Copyright 2009 Sun Microsystems, Inc.  All rights reserved.
  26 # Use is subject to license terms.
  27 #
  28
  29 #
  30 # This perl module contains code shared between the ELF analysis
  31 # tools found in this directory: find_elf, check_rtime, interface_check,
  32 # and interface_cmp.
  33 #
  34
  35 use strict;
  36 use File::Basename;
  37
  38 ## GetLine(FileHandleRef, LineNumRef)
  39 #
  40 # Read the next non-empty line from the given file handle reference
  41 # and return it.
  42 #
  43 # entry:
  44 #       FileHandleRef - Reference to open file handle to read from
  45 #       LineNumRef - Reference to integer to increment as lines are input
  46 #
  47 sub GetLine {
  48         my ($fh, $LineNum) = @_;
  49         my $ret_line = '';
  50         my $line;
  51         my $cont = 1;
  52
  53         while ($cont && ($line = <$fh>)) {
  54                 $$LineNum++;
  55                 chomp $line;
  56
  57                 # A backslash at the end of the line indicates that the
  58                 # following line is a continuation of this line if the
  59                 # backslash is the only character on the line, or if it is
  60                 # preceded by a space.
  61                 next if ($line eq '\\');
  62                 $cont = ($line =~ s/\s+\\$//);
  63
  64                 # The # character starts a comment if it is the first
  65                 # character on the line, or if it is preceeded by a space.
  66                 if ($line =~ /^\#/) {
  67                         $cont = 1;
  68                         next;
  69                 }
  70                 $line =~ s/\s+\#.*$//;          # Strip Comments
  71                 $line =~ s/\s*$//;              # Trailing whitespace
  72
  73                 if ($line !~ /^\s*$/) {         # Non-empty string
  74                         $line =~ s/^\s+//;      # Leading whitespace
  75                         if ($ret_line eq '') {
  76                                 $ret_line = $line;
  77                         } else {
  78                                 $ret_line = "$ret_line $line";
  79                         }
  80                 }
  81
  82                 # If our result string is still null, act as if a
  83                 # continuation is present and read another line.
  84                 $cont = 1 if ($ret_line eq '');
  85         }
  86
  87         # The above loop won't exit while $ret_line is a null string
  88         # unless the read failed, so return undef() in that case.
  89         # Otherwise, use the value in $ret_line.
  90         return ($ret_line ne '') ? $ret_line : undef();
  91 }
  92
  93
  94 ## LoadExceptionsToEXRE(name)
  95 #
  96 # Locate the exceptions file and process its contents. This function can be
  97 # used by any program with exception files that consist of a single
  98 # verb, followed by a single regular expression:
  99 #
 100 #       VERB regex
 101 #
 102 # For each such verb, the global level of the main:: namespace must
 103 # have a variable named $EXRE_verb. The $EXRE_ prefix must only be used
 104 # for these variables, and not for any other. The caller must define these
 105 # variables, but leave them undefined.
 106 #
 107 # entry:
 108 #       Any variables in the main:: global symbol table starting with
 109 #       the prefix 'EXRE_xxx' are taken to represent the regular expression
 110 #       for the exception named xxx.
 111 #
 112 #       name - Name of script (i.e. 'check_rtime')
 113 #       $main::opt{e} - Calling program must accept a '-e' option
 114 #               that allows the user to specify an exception file
 115 #               to use, and the value of that option must be found
 116 #               in $main::opt{e}.
 117 #
 118 # exit:
 119 #       The $main::EXRE_xxx variables are updated to contain any regular
 120 #       expressions specified by the exception file. If a given exception
 121 #       is not encountered, its variable is not modified.
 122 #
 123 # note:
 124 #       We expand strings of the form MACH(dir) to match the given
 125 #       directory as well as any 64-bit architecture subdirectory that
 126 #       might be present (i.e. amd64, sparcv9).
 127 #
 128 sub LoadExceptionsToEXRE {
 129         my $name = $_[0];
 130         my $file;
 131         my $Line;
 132         my $LineNum = 0;
 133         my $err = 0;
 134         my %except_names = ();
 135         my %except_re = ();
 136
 137         # Examine the main global symbol table and find all variables
 138         # named EXRE_xxx. By convention established for this program,
 139         # all such variables contain the regular expression for the
 140         # exception named xxx.
 141         foreach my $entry (keys %main::) {
 142                 $except_names{$entry} = 1 if $entry =~ /^EXRE_/;
 143         }
 144
 145         # Locate the exception file
 146         FILE: {
 147                 # If -e is specified, that file must be used
 148                 if ($main::opt{e}) {
 149                         $file = $main::opt{e};
 150                         last FILE;
 151                 }
 152
 153                 # If this is an activated workspace, use the exception
 154                 # file found in the exceptions_list directory.
 155                 if (defined($ENV{CODEMGR_WS})) {
 156                         $file = "$ENV{CODEMGR_WS}/exception_lists/$name";
 157                         last FILE if (-f $file);
 158                 }
 159
 160                 # As a final backstop, the SUNWonbld package provides a
 161                 # copy of the exception file. This can be useful if we
 162                 # are being used with an older workspace.
 163                 #
 164                 # This script is installed in the SUNWonbld bin directory,
 165                 # while the exception file is in etc/exception_lists. Find
 166                 # it relative to the script location given by $0.
 167                 $file = dirname($0) . "/../etc/exception_lists/$name";
 168                 last FILE if (-f $file);
 169
 170                 # No exception file was found.
 171                 return;
 172         }
 173
 174         open (EFILE, $file) ||
 175                 die "$name: unable to open exceptions file: $file";
 176         while ($Line = onbld_elfmod::GetLine(\*EFILE, \$LineNum)) {
 177                 # Expand MACH()
 178                 $Line =~ s/MACH\(([^)]+)\)/$1(\/amd64|\/sparcv9)?/;
 179
 180                 # %except_re is a hash indexed by regular expression variable
 181                 # name, with a value that contains the corresponding regular
 182                 # expression string. If we recognize an exception verb, add
 183                 # it to %except_re.
 184                 if ($Line =~ /^\s*([^\s]+)\s+(.*)$/i) {
 185                         my $verb = $1;
 186                         my $re = $2;
 187
 188                         $verb =~ tr/A-Z/a-z/;
 189                         $verb = "EXRE_$verb";
 190                         if ($except_names{$verb}) {
 191                                 if (defined($except_re{$verb})) {
 192                                         $except_re{$verb} .= '|' . $re;
 193                                 } else {
 194                                         $except_re{$verb} = $re;
 195                                 }
 196                         }
 197                         next;
 198                 }
 199
 200                 $err++;
 201                 printf(STDERR "$file: Unrecognized option: ".
 202                     "line $LineNum: $Line\n");
 203         }
 204         close EFILE;
 205
 206         # Every exception that we encountered in the file exists
 207         # in %except_re. Compile them and assign the results into the
 208         # global symbol of the same name.
 209         #
 210         # Note that this leaves the global symbols for unused exceptions
 211         # untouched, and therefore, undefined. All users of these variables
 212         # are required to test them with defined() before using them.
 213         foreach my $verb (sort keys %except_names) {
 214                 next if !defined($except_re{$verb});
 215
 216                 # Turn off strict refs so that we can do a symbolic
 217                 # indirection to set the global variable of the name given
 218                 # by verb in the main namespace. 'strict' is lexically scoped,
 219                 # so its influence is limited to this enclosing block.
 220                 no strict 'refs';
 221                 ${"main::$verb"} = qr/$except_re{$verb}/;
 222         }
 223
 224         exit 1 if ($err != 0);
 225 }
 226
 227
 228 ## OutMsg(FileHandleRef, Ttl, obj, msg)
 229 ## OutMsg2(FileHandleRef, Ttl, old_obj, new_obj, msg)
 230 #
 231 # Create an output message, either a one-liner (under -o) or preceded by the
 232 # files relative pathname as a title.
 233 #
 234 # OutMsg() is used when issuing a message about a single object.
 235 #
 236 # OutMsg2() is for when the message involves an old and new instance
 237 # of the same object. If old_obj and new_obj are the same, as is usually
 238 # the case, then the output is the same as generated by OutMsg(). If they
 239 # differ, as can happen when the new object has changed names, and has been
 240 # found via an alias, both the old and new names are shown.
 241 #
 242 # entry:
 243 #       FileHandleRef - File handle to output file
 244 #       Ttl - Reference to variable containing the number of times
 245 #               this function has been called for the current object.
 246 #       obj - For OutMsg, the path for the current object
 247 #       old_obj, new_obj - For OutMsg2, the names of the "old" and "new"
 248 #               objects.
 249 #       msg - Message to output
 250 #
 251 #       $main::opt{o} - Calling program must accept a '-o' option
 252 #               that allows the user to specify "one-line-mode',
 253 #               and the value of that option must be found
 254 #               in $main::opt{o}.
 255 #
 256 sub OutMsg {
 257         my($fh, $Ttl, $obj, $msg) = @_;
 258
 259         if ($main::opt{o}) {
 260                 print $fh "$obj: $msg\n";
 261         } else {
 262                 print $fh "==== $obj ====\n" if ($$Ttl++ eq 0);
 263                 print $fh "\t$msg\n";
 264         }
 265 }
 266
 267 sub OutMsg2 {
 268         my ($fh, $Ttl, $old_obj, $new_obj, $msg) = @_;
 269
 270         # If old and new are the same, give it to OutMsg()
 271         if ($old_obj eq $new_obj) {
 272                 OutMsg($fh, $Ttl, $old_obj, $msg);
 273                 return;
 274         }
 275
 276         if ($main::opt{o}) {
 277                 print "old $old_obj: new $new_obj: $msg\n";
 278         } else {
 279                 print "==== old: $old_obj / new: $new_obj ====\n"
 280                     if ($$Ttl++ eq 0);
 281                 print "\t$msg\n";
 282         }
 283 }
 284
 285
 286 ## header(FileHandleRef, ScriptPath, Argv)
 287 #
 288 # Generate a header for the top of generated output, including a copyright
 289 # and CDDL, such that the file will pass ON copyright/CDDL rules if it is
 290 # checked into the repository.
 291 #
 292 # entry:
 293 #       FileHandleRef - File handle reference to output text to
 294 #       ScriptPath - Value of $0 from caller, giving path to running script
 295 #       Argv - Reference to array containing @ARGV from caller.
 296 #
 297 # note:
 298 #       We assume that the calling script contains a value CDDL block.
 299 #
 300 sub Header {
 301
 302         my ($fh, $ScriptPath, $Argv) = @_;
 303         my $year = 1900 + (localtime())[5];
 304
 305         print $fh "#\n";
 306         print $fh "# Copyright $year Sun Microsystems, Inc.  ",
 307             "All rights reserved.\n";
 308         print $fh "# Use is subject to license terms.\n#\n";
 309
 310         # The CDDL text is copied from this script, the path to which is
 311         # assigned to $0 by the Perl interpreter.
 312         if (open(CDDL, $ScriptPath)) {
 313                 my $out = 0;
 314                 my $Line;
 315
 316                 while ($Line = <CDDL>) {
 317                         $out = 1 if ($Line =~ /^\# CDDL HEADER START/);
 318
 319                         print $fh $Line if $out;
 320                         last if ($Line =~ /^\# CDDL HEADER END/);
 321                 }
 322                 print $fh "#\n\n";
 323                 close CDDL;
 324         }
 325
 326         print $fh '# Date:    ', scalar(localtime()), "\n";
 327         $ScriptPath =~ s/^.*\///;
 328         $ScriptPath =~ s/\.pl$//;
 329         print $fh "# Command: $ScriptPath ", join(' ', @$Argv), "\n\n";
 330 }
 331
 332 # Perl modules pulled in via 'require' must return an exit status.
 333 1;