#!/usr/bin/perl -w # File tracehash.pl created by B J Zander. # 05/08/2011 - Update by andrewg to work in host boot environment use strict; sub determine_args(); sub launch_cpp_and_parse($$); sub cpp_dir($); sub read_string_file(); sub collect_files($); sub assimilate_file($); sub hash_strings(); sub write_string_file(); sub help(); select (STDERR); $| = 1; # Make all prints to STDERR flush the buffer immediately select (STDOUT); $| = 1; # Make all prints to STDOUT flush the buffer immediately # Constants my $HEAD_SEP = "|||"; my $HEAD_EYE_CATCHER = "#FSP_TRACE_v"; my $HEAD_BUILD_FLAG = "BUILD:"; my $HEAD_VER_FLAG = 2; my $BB_STRING_FILE = "/opt/fsp/etc/BB_StringFile"; # Global Variables my $debug = 0; my $seperator = "&&&&"; my $file_name = "trexStringFile"; my $in_sand; my ($backing) = $ENV{'bb'}; my $hash_prog = "trexhash"; #default to in path my $build = ""; my ($sandbox) = $ENV{'SANDBOX'} || ""; my ($context) = $ENV{'CONTEXT'} || ""; my ($sandboxbase) = $ENV{'SANDBOXBASE'} || ""; my ($bb); my ($sourcebase) = "$sandboxbase/src"; my ($version) = $HEAD_VER_FLAG; # default to oldest version my ($collect) = 0; my ($INCLUDE, $Arg, $file, $dir, $string_file); my $args = ""; my $fail_on_collision = 0; # 1 = exit with error if hash collision occurs my $hash_filename_too = 0; # 1 = hash is calculated over format string + filename print "sourcebase = $sourcebase\n" if $debug; print "sandbox = $sandbox\n" if $debug; print "backing = $backing\n" if $debug; print "context = $context\n" if $debug; if ($context =~ /x86/) { $bb = "i586-pc-linux-gnu"; } else { $bb = "powerpc-linux"; } if(($sourcebase =~ /\w+/) && ($sandbox =~ /\w+/)) { $INCLUDE = "-I $sandboxbase/export/$context/fips/include -I $backing/export/$context/fips/include -I /opt/fsp/$bb/include/fsp -I/opt/fsp/$bb/include/ -include /opt/fsp/$bb/include/fsp/tracinterface.H"; } else { print "Not in Sandbox so guessing Include Paths...\n" if $debug; $INCLUDE = "-I/opt/fsp/i586-pc-linux-gnu/include/fsp -I/opt/fsp/i586-pc-linux-gnu/include/ -include /opt/fsp/i586-pc-linux-gnu/include/fsp/tracinterface.H"; } # I/P Series work in ODE sandbox env. if ($sandboxbase =~ /\w+/) { $in_sand = 1; print "backing = $backing\n" if $debug; } else { $in_sand = 0; } # Parse the input parameters. while (@ARGV) { $Arg = shift; if ($Arg eq "-h" || $Arg eq "-H") { help(); exit(127); } if ($Arg eq "-f") { $file = shift; next; } if ($Arg eq "-d") { $dir = shift; next; } if ($Arg eq "-s") { $string_file = shift; next; } if ($Arg eq "-c") { $collect = 1; next; } if ($Arg eq "-v") { $debug = 1; print "debug on\n" if $debug; next; } if ($Arg eq "-C") { # fail if a hash collision is detected $fail_on_collision = 1; next; } if ($Arg eq "-F") { # hash is calculated over format string + file name $hash_filename_too = 1; next; } if ($Arg eq "-S") { $BB_STRING_FILE = ""; next; } #just pass it onto compiler $args = $args . " " . $Arg; } print "args = $args\n" if $debug; if (!$file && !$dir && !$in_sand) { help(); exit(127); } ################################# # M A I N # ################################# my $clock = `date`; $build = $HEAD_EYE_CATCHER . "$HEAD_VER_FLAG" . $HEAD_SEP . $clock . $HEAD_SEP . $HEAD_BUILD_FLAG; $build =~ s/\n//g; # Global array to hold the parsed TRAC macro calls. my @strings = (); # Assoc. arrays to hold hash|string values. my %string_file_array = (); my %hash_strings_array = (); # Check all provided arguments and look for defaults if not provided by user determine_args(); # Scan the appropriate files or directories for TRAC macro calls. if (defined $dir) { $build = $build . $dir; # default to put at top of string file if($collect) { collect_files($dir); } else { cpp_dir($dir); # Hash the string that have been scanned. %hash_strings_array = hash_strings(); } } else { $build = $build . $file; # default to put at top of string file if($collect) { assimilate_file($file); } else { # make sure include path includes directory that file is in if($file =~ /^(.+)\/[^\/]+\.C$/) { launch_cpp_and_parse($file,$1); } else { # No path in front of file so it has to be local dir launch_cpp_and_parse($file,"./"); } # Hash the string that have been scanned. %hash_strings_array = hash_strings(); } } # Read the existing string file into memory. %string_file_array = read_string_file(); # Write out the new string file. check for collisions of new/old string here write_string_file(); print "Hashing Started at $clock\n"; $clock = `date`; print "Hashing Finished at $clock\n"; exit 0; ################################# # S U B R O U T I N E S # ################################# #============================================================================= # Enhance usability by figuring out which build env. we are in #============================================================================= sub determine_args() { # Find trexhash program # but only if needed (i.e. not in collect mode) if (!$collect) { my $tmp = `which $hash_prog`; chomp $tmp; if ($tmp eq '') { print STDOUT "\nWarning: Program trexhash does not exist in path.\n" if $debug; $hash_prog = "./trexhash"; $tmp = `which $hash_prog`; chomp $tmp; if ($tmp eq '') { print STDOUT "\nError: Unable to find trexhash \n"; exit(127); } } } # Verify input values. if ((!defined $file) && (!defined $dir)) { if(!($in_sand)) { print STDOUT "\nError: No input directory or file provided as input to scan\n"; exit(127); } # Assume they want sandbox scanned if($collect) { # collect all string files generated by tracepp and merge $dir = "$sandboxbase/obj/"; } else { # generate our own string file by pre-compiling all source code $dir = "$sandboxbase/src/"; } print STDOUT "\n-f or -d not found...scanning $dir by default\n\n"; } if (!defined $string_file) { if ($in_sand) { # Copy the current string file from backing build into our sandbox system ("cp $backing/obj/$file_name $sandboxbase/obj/$file_name") if !(-e "$sandboxbase/obj/$file_name"); $string_file = "$sandboxbase/obj/$file_name"; } else { $string_file = "./$file_name"; } print STDOUT "-sf not specified, using $string_file instead...\n\n" if $debug; } # Try Creating the string file `touch $string_file`; if (! -f $string_file) { print STDOUT "\nError: File $string_file does not exist. Current directory may not be writable.\n\n"; help(); exit(127); } # Make sure trexStringFile is readable/writeable system("chmod ugo+rw $string_file"); } #============================================================================= # Launch cpp script and grab input from it looking for trace calls. #============================================================================= sub launch_cpp_and_parse($$) { my ($l_loc, $l_dir) = @_; print "Processing file $l_loc\n" if $debug; my $cmd = "/usr/bin/cpp $INCLUDE -I $l_dir $args $l_loc|"; print "$cmd\n" if $debug; open(FH,"$cmd") or die ("Cannot open $_:$!,stopped"); # Read through all lines in the file.. my $line = ; while (defined $line) { chop $line; # remove EOL $line =~ s/^\s*//; # remove unneccesary beginning white space. $line =~ s/\s*$//; # remove unneccesary ending white space. # Look for lines that are trace macro calls. #if (/(trace_adal_hash)(\()( *)(".+")(,)(\d)/) #if ($line =~ /(.*?)(trace_adal_hash)(\()( *)(".+")(,)(\d)\)+(.*\d.*)/) while($line =~ m/^(.*?)trace_adal_hash\s*\(\s*(("[^"]*"\s*)+),\s*(\d+)\s*\)(.*)$/) { my ($prefix, $strings, $salt, $suffix) = ($1, $2, $4, $5); print STDOUT "$strings $salt\n" if $debug; $strings =~ s/"\s*$//; # remove trailing " and space $strings =~ s/^"//; # remove leading " $strings =~ s/"\s*"//g; # Check to see if it's contained on a single line, or if we # have to combine lines to get a complete trace call. # Save the macro call so it can be hashed later.. push (@strings, [$l_loc, $strings, $salt]); $line = $suffix; # check rest of line for a second trace call } my $nextline = ; last if !defined $nextline; # if a trace call is spread over multiple lines we have to add the next # line from the source. the only problem is the definition/declaration # of trace_adal_hash: we have to ignore that. we catch that by requiring # a " after the function name. hopefully nobody writes a comment with # a " after the function declaration ... if ($line =~ /trace_adal_hash.*"/) { $line .= $nextline; } else { $line = $nextline; } } close(FH); } #============================================================================= # run cpp on all files in this directory and return the output #============================================================================= sub cpp_dir($) { my ($l_dir) = @_; my @dir_entry; my $l_entry; # Open the directory and read all entry names. opendir ( DH , "$l_dir") or die ("Cannot open $l_dir: $!, stopped"); print STDOUT "Processing directory $l_dir\n" if $debug; @dir_entry = readdir(DH); closedir(DH); while (@dir_entry) { $l_entry = shift(@dir_entry); if ($l_dir =~ m"/$") { $l_entry = "$l_dir$l_entry"; } else { $l_entry = "$l_dir/$l_entry"; } # Is the entry a directory? if (-d $l_entry) { if($l_entry =~ m"/?([^/]+)$") { # check dir we are going into print "dir = $1\n" if $debug; # should we recurse into this directory. if ($1 =~ m/^(\.\.?|sim[ou]|bldv)$/) { next; # skip '.', '..' and some fips dirs } cpp_dir($l_entry); } else { # unable to determine name of dir (no / in filename) # should we recurse into this directory. if ($l_entry =~ m/^(\.\.?|sim[ou]|bldv)$/) { next; # skip '.', '..' and some fips dirs } cpp_dir($l_entry); } } # Is the entry a file? elsif ((-f $l_entry) && ($l_entry =~ m/\.C$/)) { # it's a file so launch_cpp_and_parse($l_entry,$l_dir); } else { # Not a file or directory so ignore it... } } } #============================================================================= # Read in strings from the existing trace string file.... #============================================================================= sub read_string_file() { my %o_strings; my ($line) = ""; my ($l_hash) = ""; my ($l_str) = ""; my ($cur_build) = ""; my ($l_file) = ""; # Make sure we can open each file. open ( FH , "<$string_file") or die ("Cannot open $_: $!, stopped"); $line = ; print "first line in trexStringFile= $line\n" if $debug; if((defined $line) && ($line =~ /^$HEAD_EYE_CATCHER(\d)/)) { $version = $1; print "version = $version\n" if $debug; #Always put latest version in file $line =~ s/^$HEAD_EYE_CATCHER\d/${HEAD_EYE_CATCHER}${HEAD_VER_FLAG}/; # Take previous version in file and use it. $build = $line; chomp($build); $line = ; while (defined $line) { chomp $line; # remove EOL if($version eq "1") { ($l_hash, $l_file ,$l_str) = split(/\|\|/, $line); } elsif($version eq "2") { ($l_hash, $l_str ,$l_file) = split(/\|\|/, $line); } else { print "Unknown version of stringfile $version\n"; exit(127); } $o_strings{$l_hash} = $l_str . "||" . $l_file; $line = ; } } else { # If there is a file then we are dealing with the first # version of trexStringFile so don't look for file name. if ($debug) { print "version 0 stringfile detected: $string_file\n"; } # there is a file and it doesn't have a header $version = 0; while (defined $line) { chomp $line; # remove EOL ($l_hash,$l_str) = split(/\|\|/, $line); $o_strings{$l_hash} =$l_str . "||" . "NO FILE"; $line = ; } } close(FH); #Time to look for a building block string file if($BB_STRING_FILE ne "" and $string_file ne $BB_STRING_FILE and -f $BB_STRING_FILE) { # Make sure we can open the file. open ( FH , "<$BB_STRING_FILE") or die ("Cannot open $_: $!, stopped"); $line = ; print "first line in BB_StringFile = $line\n" if $debug; if((defined $line) && ($line =~ /^$HEAD_EYE_CATCHER(\d)/)) { $version = $1; $line = ; while (defined $line) { chop $line; # remove EOL if($version eq "1") { ($l_hash, $l_file ,$l_str) = split(/\|\|/, $line); } elsif($version eq "2") { ($l_hash, $l_str ,$l_file) = split(/\|\|/, $line); } #($l_hash, $l_file ,$l_str) = split(/\|\|/, $line); $o_strings{$l_hash} = $l_str . "||" . $l_file ; $line = ; } } else { print "*** ERROR: BB_StringFile '$BB_STRING_FILE' should always have version!!!\n" } } else { print "$BB_STRING_FILE is not available\n" if $debug; } #All files are latest version now. $version = $HEAD_VER_FLAG; return %o_strings; } #============================================================================= # Read in strings from the existing trace string file.... #============================================================================= sub collect_files($) { my ($l_dir) = @_; my (@dir_entry); my ($l_entry) = ""; # Open the directory and read all entry names. opendir ( DH , "$l_dir") or die ("Cannot open $l_dir: $!, stopped"); print STDOUT "Processing directory $l_dir\n" if $debug; @dir_entry = readdir(DH); closedir(DH); while (@dir_entry) { $l_entry = shift(@dir_entry); if ($l_dir =~ m"/$") { $l_entry = "$l_dir$l_entry"; } else { $l_entry = "$l_dir/$l_entry"; } # Is the entry a directory? if (-d $l_entry) { # should we recurse into this directory. if ($l_entry =~ m/\/(\.\.?|sim[ou]|bldv)$/) { next; # skip '.', '..' and some fips dirs } collect_files($l_entry); } # Is the entry a file? elsif ((-f $l_entry) && ($l_entry =~ m"\.hash$")) { # it's a file so assimilate_file($l_entry); } else { # Not a file or directory so ignore it... } } } #============================================================================= # Read in data from file and add to master one #============================================================================= sub assimilate_file($) { my ($l_loc) = @_; my (%o_strings); my ($line) = ""; my ($l_hash) = ""; my ($l_str) = ""; my ($l_file) = ""; # Make sure we can open each file. open ( FH , "<$l_loc") or die ("Cannot open $_: $!, stopped"); $line = ; print "Assimilate: first line in $l_loc = $line" if $debug; if((defined $line) && ($line =~ /^$HEAD_EYE_CATCHER(\d)/)) { $version = $1; if ($version eq "1") { if ($hash_filename_too) { print "*** ERROR: hash_filename_too (-F) isn't possible with trace version 1\n"; print " please rebuild all .hash files and global trexStringFile\n"; print " version 1 file is '$l_loc'\n"; exit(127); } } elsif ($version ne "2") { print "Unknown version of stringfile $version\n"; exit(127); } $line = ; while (defined $line) { chop $line; # remove EOL # 64 bit support $line =~ s/\%d/\%lld/g; $line =~ s/\%u/\%llu/g; $line =~ s/\%x/\%llx/g; $line =~ s/\%X/\%llX/g; $line =~ s/\%p/0x\%llX/g; # Replace pointer format with hex value $line =~ s/\%c/0x\%02llX/g; # Replace character format with 1 byte hex display #print "line: $line\n"; if($version eq "1") { ($l_hash, $l_file ,$l_str) = split(/\|\|/, $line); } elsif($version eq "2") { ($l_hash, $l_str ,$l_file) = split(/\|\|/, $line); } my $newstring = $l_str . "||" . $l_file; if (exists $hash_strings_array{$l_hash}) { my $hashstr1 = $hash_strings_array{$l_hash}; my $hashstr2 = $newstring; if (!$hash_filename_too) { # hash was made over format string only, remove file name $hashstr1 =~ s/\|\|.*$//; $hashstr2 = $l_str; } if ($debug) { print "a_f: compare $hashstr1\n", " vs. $hashstr2\n"; } if ($hashstr1 ne $hashstr2) { print "*** ERROR: HASH Collision! (a_f)\n", " Two different strings have the same hash value ($l_hash)\n", " String 1: $hash_strings_array{$l_hash}\n", " String 2: $newstring\n"; if ($fail_on_collision) { exit(1); } } } $hash_strings_array{$l_hash} = $newstring; $line = ; } } else { # If there is a file then we are dealing with the first # version of trexStringFile so don't look for file name. # these files shouldn't be there anymore. we don't check for collisions here if ($debug) { print "version 0 stringfile detected: $string_file\n"; } if(defined $line) { # there is a file and it doesn't have a header $version = 0; } while (defined $line) { chop $line; # remove EOL ($l_hash,$l_str) = split(/\|\|/, $line); $hash_strings_array{$l_hash} = $l_str . "||" . "NO FILE"; $line = ; } } $version = $HEAD_VER_FLAG; close(FH); } #============================================================================= #============================================================================= sub hash_strings() { my ($hash_val, $l_key, $l_hash, %l_hash_strings); my ($line_feed) = chr(10); my ($l_file_name) = "NO FILENAME"; print "\nHashing printf strings.\n\n"; foreach my $str (@strings) { my $printf_string; $l_file_name = $str->[0]; $printf_string = $str->[1]; $l_key = $str->[2]; print "printf_string = $printf_string\n" if $debug; $printf_string =~ s/"\s?"//g; #multi line traces will have extra " in them $printf_string =~ s/`/\\`/g; # excape ' $printf_string =~ s/\\n/$line_feed/g; # escape \n if ($hash_filename_too) { $printf_string .= "||" . $l_file_name; } # call the hasher. print "$hash_prog \"$printf_string\" $l_key\n" if $debug; $hash_val = `$hash_prog \"$printf_string\" $l_key`; if ($?) { my ($hp_ret, $hp_sig) = ($? >> 8, $? & 127); if ($hp_sig) { print "*** ERROR: $hash_prog died with signal $hp_sig\n"; } elsif ($hp_ret) { print "*** ERROR: $hash_prog returned the error $hp_ret\n"; if ($hash_val) { print " error from $hash_prog:\n$hash_val"; } } exit(1); } print "printf_string = $printf_string l_key = $l_key hash val = $hash_val\n" if $debug; # undo escaping $printf_string =~ s/$line_feed/\\n/g; $printf_string =~ s/\\`/`/g; if (exists $l_hash_strings{$hash_val}) { # hash val was found before. check if it's the same string # else we have a hash collision my $l_tmp = $l_hash_strings{$hash_val}; if (!$hash_filename_too) { $l_tmp =~ s/\|\|.*$//; } if ($l_tmp ne $printf_string) { print "*** ERROR: HASH Collision! (h_s)\n", " Two different strings have the same hash value ($hash_val)\n", " String 1: $l_hash_strings{$hash_val}\n", " String 2: $printf_string (file $l_file_name)\n"; if ($fail_on_collision) { exit(1); } } } # this will overwrite an old string with a new one if a collision occurred # but we might want to bail out in this case anyway $printf_string = $printf_string . "||" . $l_file_name; $l_hash_strings{$hash_val} = $printf_string; } return %l_hash_strings; } #============================================================================= #============================================================================= sub write_string_file() { my (@keys) = (); my ($l_key) = ""; # Combine the contents of the existing string file with the trace calls # that we have just hashed. print STDOUT "\nCombining Hash strings...\n\n"; @keys = keys(%hash_strings_array); foreach $l_key (@keys) { my $l_tmp = $hash_strings_array{$l_key}; # freshly collected strings if (exists $string_file_array{$l_key}) { # hash exists in list from trexStringFile my $l_tmp2 = $string_file_array{$l_key}; if (!$hash_filename_too) { $l_tmp =~ s/\|\|.*$//; $l_tmp2 =~ s/\|\|.*$//; } # Check for hash collisions. if ($l_tmp ne $l_tmp2) { print "*** ERROR: HASH Collision! (w_s_f)\n", " Two different strings have the same hash value ($l_key)\n", " String 1: $hash_strings_array{$l_key}\n", " String 2: $string_file_array{$l_key}\n"; if ($fail_on_collision) { exit(1); } # don't fail, write new one } } if($version > 0) { # add/replace the new string to the string_file_array. $string_file_array{$l_key} = $hash_strings_array{$l_key} } else { # old version so only write out format string (not file name to) $string_file_array{$l_key} = $l_tmp; } } # Write out the updated string file. print STDOUT "\nWriting updated hash||string file...\n\n"; @keys = sort(keys(%string_file_array)); open ( FH , ">$string_file") or die ("Cannot open $_: $!, stopped"); if($version > 0) { print FH "$build\n"; # only print version if newer then version 0 } foreach $l_key (@keys) { print FH "$l_key||$string_file_array{$l_key}\n"; } close FH; } #============================================================================= #============================================================================= # Display command invokation help for this program... #============================================================================= sub help() { print << "EOF"; tracehash.pl - create a trace string file from sources or collect tracepp files Usage: tracehash.pl [options] General options: -h - Print this help text. -v - Be verbose, tell what's going on (debug output) Operation modes -c - Collect StringFiles created by tracepp and merge. default - Scan source files for trace calls. Collect mode: tracehash.pl -c [-vFCS] [-d ] [-s ] tracehash.pl -c [-vFCS] [-f ] [-s ] Collect string files created by tracepp (.hash) from directory tree at or read them from string file and write to file , adding entries already in this file. -f - String file to read and write/add to . -d - Start of directory tree to scan for .hash files. Default = . -s - File with trace strings (and hashes) to read from and write to default = ./trexStringFile -F - hash is calculated over trace string and source file name, otherwise without source file name -C - report an error if a hash collisions occurs -S - don't read global FLD-2.2 string file ($BB_STRING_FILE) If tracehash.pl is called in a FipS build sandbox without -d and -f defaults for the sandbox will be used. Scan mode: tracehash.pl [-vFCS] [-d ] [-s ] [ccpopts] tracehash.pl [-vFCS] [-f ] [-s ] [cppopts] Scan all files in directory tree or scan file and write strings to file . Strings already in this file will be merged. -f - Source file to scan for trace entries. -d - Source directory to scan for trace entries. -s - File with trace strings (and hashes) to read from and write to. default = ./trexStringFile -F - hash for string was build from format string + source file name -C - report an error if hash collisions occur -S - don't read global FLD-2.2 string file ($BB_STRING_FILE) All other arguments will be passed verbatim to cpp EOF } #=============================================================================