1package 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 35use strict; 36use 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# 47sub 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# 128sub 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# 256sub 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 267sub 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# 300sub 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. 3331; 334