summaryrefslogtreecommitdiffstats
path: root/tools/fix-encoding-args.pl
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-10 20:34:10 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-10 20:34:10 +0000
commite4ba6dbc3f1e76890b22773807ea37fe8fa2b1bc (patch)
tree68cb5ef9081156392f1dd62a00c6ccc1451b93df /tools/fix-encoding-args.pl
parentInitial commit. (diff)
downloadwireshark-e4ba6dbc3f1e76890b22773807ea37fe8fa2b1bc.tar.xz
wireshark-e4ba6dbc3f1e76890b22773807ea37fe8fa2b1bc.zip
Adding upstream version 4.2.2.upstream/4.2.2
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'tools/fix-encoding-args.pl')
-rwxr-xr-xtools/fix-encoding-args.pl698
1 files changed, 698 insertions, 0 deletions
diff --git a/tools/fix-encoding-args.pl b/tools/fix-encoding-args.pl
new file mode 100755
index 0000000..04151a2
--- /dev/null
+++ b/tools/fix-encoding-args.pl
@@ -0,0 +1,698 @@
+#!/usr/bin/env perl
+#
+# Copyright 2011, William Meier <wmeier[AT]newsguy.com>
+#
+# A program to fix encoding args for certain Wireshark API function calls
+# from TRUE/FALSE to ENC_?? as appropriate (and possible)
+# - proto_tree_add_item
+# - proto_tree_add_bits_item
+# - proto_tree_add_bits_ret_val
+# - proto_tree_add_bitmask
+# - proto_tree_add_bitmask_text !! ToDo: encoding arg not last arg
+# - tvb_get_bits
+# - tvb_get_bits16
+# - tvb_get_bits24
+# - tvb_get_bits32
+# - tvb_get_bits64
+# - ptvcursor_add
+# - ptvcursor_add_no_advance
+# - ptvcursor_add_with_subtree !! ToDo: encoding arg not last arg
+#
+# ToDo: Rework program so that it can better be used to *validate* encoding-args
+#
+# Wireshark - Network traffic analyzer
+# By Gerald Combs <gerald@wireshark.org>
+# Copyright 1998 Gerald Combs
+#
+# SPDX-License-Identifier: GPL-2.0-or-later
+#
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+
+# Conversion "Requests"
+
+# Standard conversions
+my $searchReplaceFalseTrueHRef =
+ {
+ "FALSE" => "ENC_BIG_ENDIAN",
+ "0" => "ENC_BIG_ENDIAN",
+ "TRUE" => "ENC_LITTLE_ENDIAN",
+ "1" => "ENC_LITTLE_ENDIAN"
+ };
+
+my $searchReplaceEncNAHRef =
+ {
+ "FALSE" => "ENC_NA",
+ "0" => "ENC_NA",
+ "TRUE" => "ENC_NA",
+ "1" => "ENC_NA",
+ "ENC_LITTLE_ENDIAN" => "ENC_NA",
+ "ENC_BIG_ENDIAN" => "ENC_NA",
+ "ENC_ASCII|ENC_NA" => "ENC_NA",
+ "ENC_ASCII | ENC_NA" => "ENC_NA"
+ };
+
+my $searchReplaceDissectorTable =
+ {
+ "FALSE" => "STRING_CASE_SENSITIVE",
+ "0" => "STRING_CASE_SENSITIVE",
+ "BASE_NONE" => "STRING_CASE_SENSITIVE",
+ "TRUE" => "STRING_CASE_INSENSITIVE",
+ "1" => "STRING_CASE_INSENSITIVE"
+ };
+
+# ---------------------------------------------------------------------
+# Conversion "request" structure
+# (
+# [ <list of field types for which this conversion request applies> ],
+# { <hash of desired encoding arg conversions> }
+# }
+
+my @types_NA =
+ (
+ [ qw (FT_NONE FT_BYTES FT_ETHER FT_IPv6 FT_IPXNET FT_OID FT_REL_OID)],
+ $searchReplaceEncNAHRef
+ );
+
+my @types_INT =
+ (
+ [ qw (FT_UINT8 FT_UINT16 FT_UINT24 FT_UINT32 FT_UINT64 FT_INT8
+ FT_INT16 FT_INT24 FT_INT32 FT_INT64 FT_FLOAT FT_DOUBLE)],
+ $searchReplaceFalseTrueHRef
+ );
+
+my @types_MISC =
+ (
+ [ qw (FT_BOOLEAN FT_IPv4 FT_GUID FT_EUI64)],
+ $searchReplaceFalseTrueHRef
+ );
+
+my @types_STRING =
+ (
+ [qw (FT_STRING FT_STRINGZ)],
+ {
+ "FALSE" => "ENC_ASCII",
+ "0" => "ENC_ASCII",
+ "TRUE" => "ENC_ASCII",
+ "1" => "ENC_ASCII",
+ "ENC_LITTLE_ENDIAN" => "ENC_ASCII",
+ "ENC_BIG_ENDIAN" => "ENC_ASCII",
+ "ENC_NA" => "ENC_ASCII",
+
+ "ENC_ASCII|ENC_LITTLE_ENDIAN" => "ENC_ASCII",
+ "ENC_ASCII|ENC_BIG_ENDIAN" => "ENC_ASCII",
+
+ "ENC_UTF_8|ENC_LITTLE_ENDIAN" => "ENC_UTF_8",
+ "ENC_UTF_8|ENC_BIG_ENDIAN" => "ENC_UTF_8",
+
+ "ENC_EBCDIC|ENC_LITTLE_ENDIAN" => "ENC_EBCDIC",
+ "ENC_EBCDIC|ENC_BIG_ENDIAN" => "ENC_EBCDIC",
+ }
+ );
+
+my @types_UINT_STRING =
+ (
+ [qw (FT_UINT_STRING)],
+ {
+ "FALSE" => "ENC_ASCII|ENC_BIG_ENDIAN",
+ "0" => "ENC_ASCII|ENC_BIG_ENDIAN",
+ "TRUE" => "ENC_ASCII|ENC_LITTLE_ENDIAN",
+ "1" => "ENC_ASCII|ENC_LITTLE_ENDIAN",
+ "ENC_BIG_ENDIAN" => "ENC_ASCII|ENC_BIG_ENDIAN",
+ "ENC_LITTLE_ENDIAN" => "ENC_ASCII|ENC_LITTLE_ENDIAN",
+ "ENC_ASCII|ENC_NA" => "ENC_ASCII|ENC_BIG_ENDIAN",
+ "ENC_ASCII" => "ENC_ASCII|ENC_BIG_ENDIAN",
+ "ENC_NA" => "ENC_ASCII|ENC_BIG_ENDIAN"
+ }
+ );
+
+my @types_REG_PROTO =
+ (
+ [ qw (REG_PROTO)],
+ $searchReplaceEncNAHRef
+ );
+
+# ---------------------------------------------------------------------
+
+my @findAllFunctionList =
+## proto_tree_add_bitmask_text !! ToDo: encoding arg not last arg
+## ptvcursor_add_with_subtree !! ToDo: encoding Arg not last arg
+ qw (
+ proto_tree_add_item
+ proto_tree_add_bits_item
+ proto_tree_add_bits_ret_val
+ proto_tree_add_bitmask
+ proto_tree_add_bitmask_with_flags
+ tvb_get_bits
+ tvb_get_bits16
+ tvb_get_bits24
+ tvb_get_bits32
+ tvb_get_bits64
+ ptvcursor_add
+ ptvcursor_add_no_advance
+ register_dissector_table
+ );
+
+# ---------------------------------------------------------------------
+#
+# MAIN
+#
+my $writeFlag = '';
+my $helpFlag = '';
+my $action = 'fix-all';
+
+my $result = GetOptions(
+ 'action=s' => \$action,
+ 'write' => \$writeFlag,
+ 'help|?' => \$helpFlag
+ );
+
+if (!$result || $helpFlag || !$ARGV[0]) {
+ usage();
+}
+
+if (($action ne 'fix-all') && ($action ne 'find-all')) {
+ usage();
+}
+
+sub usage {
+ print "\nUsage: $0 [--action=fix-all|find-all] [--write] FILENAME [...]\n\n";
+ print " --action = fix-all (default)\n";
+ print " Fix <certain-fcn-names>() encoding arg when possible in FILENAME(s)\n";
+ print " Fixes (if any) are listed on stdout)\n\n";
+ print " --write create FILENAME.encoding-arg-fixes (original file with fixes)\n";
+ print " (effective only for fix-all)\n";
+ print "\n";
+ print " --action = find-all\n";
+ print " Find all occurrences of <certain-fcn-names>() statements)\n";
+ print " highlighting the 'encoding' arg\n";
+ exit(1);
+}
+
+# Read through the files; fix up encoding parameter of proto_tree_add_item() calls
+# Essentially:
+# For each file {
+# . Create a hash of the hf_index_names & associated field types from the entries in hf[]
+# . For each requested "conversion request" {
+# . . For each hf[] entry hf_index_name with a field type in a set of specified field types {
+# . . . For each proto_tree_add_item() statement
+# . . . . - replace encoding arg in proto_tree_add_item(..., hf_index_name, ..., 'encoding-arg')
+# specific values ith new values
+# . . . . - print the statement showing the change
+# . . . }
+# . . }
+# . }
+# . If requested and if replacements done: write new file "orig-filename.encoding-arg-fixes"
+# }
+#
+# Note: The proto_tree_add_item() encoding arg will be converted only if
+# the hf_index_name referenced is in one of the entries in hf[] in the same file
+
+my $found_total = 0;
+
+while (my $fileName = $ARGV[0]) {
+ shift;
+ my $fileContents = '';
+
+ die "No such file: \"$fileName\"\n" if (! -e $fileName);
+
+ # delete leading './'
+ $fileName =~ s{ ^ \. / } {}xo;
+ ##print "$fileName\n";
+
+ # Read in the file (ouch, but it's easier that way)
+ open(FCI, "<", $fileName) || die("Couldn't open $fileName");
+ while (<FCI>) {
+ $fileContents .= $_;
+ }
+ close(FCI);
+
+ # Create a hash of the hf[] entries (name_index_name=>field_type)
+ my $hfArrayEntryFieldTypeHRef = find_hf_array_entries(\$fileContents, $fileName);
+
+ if ($action eq "fix-all") {
+
+ # Find and replace: <fcn_name_pattern>() encoding arg in $fileContents for:
+ # - hf[] entries with specified field types;
+ # - 'proto' as returned from proto_register_protocol()
+ my $fcn_name = "(?:proto_tree_add_item|ptvcursor_add(?:_no_advance)?)";
+ my $found = 0;
+ $found += fix_encoding_args_by_hf_type(1, \@types_NA, $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
+ $found += fix_encoding_args_by_hf_type(1, \@types_INT, $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
+ $found += fix_encoding_args_by_hf_type(1, \@types_MISC, $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
+ $found += fix_encoding_args_by_hf_type(1, \@types_STRING, $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
+ $found += fix_encoding_args_by_hf_type(1, \@types_UINT_STRING, $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
+ $found += fix_encoding_args_by_hf_type(1, \@types_REG_PROTO, $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
+
+ # Find and replace: alters <fcn_name>() encoding arg in $fileContents
+ $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "proto_tree_add_bits_(?:item|ret_val)", \$fileContents, $fileName);
+ $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "proto_tree_add_bitmask", \$fileContents, $fileName);
+ $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "proto_tree_add_bitmask_with_flags", \$fileContents, $fileName);
+ $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "tvb_get_bits(?:16|24|32|64)?", \$fileContents, $fileName);
+ $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "tvb_get_(?:ephemeral_)?unicode_string[z]?", \$fileContents, $fileName);
+
+ $found += fix_dissector_table_args(1, $searchReplaceDissectorTable, "register_dissector_table", \$fileContents, $fileName);
+
+ # If desired and if any changes, write out the changed version to a file
+ if (($writeFlag) && ($found > 0)) {
+ open(FCO, ">", $fileName . ".encoding-arg-fixes");
+# open(FCO, ">", $fileName );
+ print FCO "$fileContents";
+ close(FCO);
+ }
+ $found_total += $found;
+ }
+
+ if ($action eq "find-all") {
+ # Find all proto_tree_add_item() statements
+ # and output same highlighting the encoding arg
+ $found_total += find_all(\@findAllFunctionList, \$fileContents, $fileName);
+ }
+
+} # while
+
+exit $found_total;
+
+# ---------------------------------------------------------------------
+# Create a hash containing an entry (hf_index_name => field_type) for each hf[]entry.
+# also: create an entry in the hash for the 'protocol name' variable (proto... => FT_PROTOCOL)
+# returns: ref to the hash
+
+sub find_hf_array_entries {
+ my ($fileContentsRef, $fileName) = @_;
+
+ # The below Regexp is based on one from:
+ # https://web.archive.org/web/20080614012925/http://aspn.activestate.com/ASPN/Cookbook/Rx/Recipe/59811
+ # It is in the public domain.
+ # A complicated regex which matches C-style comments.
+ my $CCommentRegEx = qr{ / [*] [^*]* [*]+ (?: [^/*] [^*]* [*]+ )* / }xo;
+
+ # hf[] entry regex (to extract an hf_index_name and associated field type)
+ my $hfArrayFieldTypeRegEx = qr {
+ \{
+ \s*
+ &\s*([A-Z0-9_\[\]-]+) # &hf
+ \s*,\s*
+ \{\s*
+ .+? # (a bit dangerous)
+ \s*,\s*
+ (FT_[A-Z0-9_]+) # field type
+ \s*,\s*
+ .+?
+ \s*,\s*
+ HFILL # HFILL
+ }xios;
+
+ # create a copy of $fileContents with comments removed
+ my $fileContentsWithoutComments = $$fileContentsRef;
+ $fileContentsWithoutComments =~ s {$CCommentRegEx} []xg;
+
+ # find all the hf[] entries (searching $fileContentsWithoutComments).
+ # Create a hash keyed by the hf_index_name with the associated value being the field_type
+ my %hfArrayEntryFieldType;
+ while ($fileContentsWithoutComments =~ m{ $hfArrayFieldTypeRegEx }xgis) {
+# print "$1 $2\n";
+ if (exists $hfArrayEntryFieldType{$1}) {
+ printf "%-35.35s: ? duplicate hf[] entry: no fixes done for: $1; manual action may be req'd\n", $fileName;
+ $hfArrayEntryFieldType{$1} = "???"; # prevent any substitutions for this hf_index_name
+ } else {
+ $hfArrayEntryFieldType{$1} = $2;
+ }
+ }
+
+ # pre-process contents to fold multiple lines and speed up matching.
+ $fileContentsWithoutComments =~ s/\s*=\s*/=/gs;
+ $fileContentsWithoutComments =~ s/^\s+//g;
+
+ # RegEx to get "proto" variable name
+ my $protoRegEx = qr /
+ ^ # note m modifier below
+ (
+ [a-zA-Z0-9_]+
+ )
+ =
+ proto_register_protocol\b
+ /xom;
+
+ # Find all registered protocols
+ while ($fileContentsWithoutComments =~ m { $protoRegEx }xgom ) {
+ ##print "$1\n";
+ if (exists $hfArrayEntryFieldType{$1}) {
+ printf "%-35.35s: ? duplicate 'proto': no fixes done for: $1; manual action may be req'd\n", $fileName;
+ $hfArrayEntryFieldType{$1} = "???"; # prevent any substitutions for this protocol
+ } else {
+ $hfArrayEntryFieldType{$1} = "REG_PROTO";
+ }
+ }
+
+ return \%hfArrayEntryFieldType;
+}
+
+# ---------------------------------------------------------------------
+# fix_encoding_args
+# Substitute new values for the specified <fcn_name>() encoding arg values
+# when the encoding arg is the *last* arg of the call to fcn_name
+# args:
+# substitute_flag: 1: replace specified encoding arg values by a new value (keys/values in search hash);
+# ref to hash containing search (keys) and replacement (values) for encoding arg
+# fcn_name string
+# ref to string containing file contents
+# filename string
+#
+{ # block begin
+
+ # shared variables
+ my $fileName;
+ my $searchReplaceHRef;
+ my $found;
+
+ sub fix_encoding_args {
+ (my $subFlag, $searchReplaceHRef, my $fcn_name, my $fileContentsRef, $fileName) = @_;
+
+ my $encArgPat;
+
+ if ($subFlag == 1) {
+ # just match for <fcn_name>() statements which have an encoding arg matching one of the
+ # keys in the searchReplace hash.
+ # Escape any "|" characters in the keys
+ # and then create "alternatives" string containing all the resulting key strings. Ex: "(A|B|C\|D|..."
+ $encArgPat = join "|", map { my $copy = $_; $copy =~ s{ ( \| ) }{\\$1}gx; $copy } keys %$searchReplaceHRef;
+ } elsif ($subFlag == 3) {
+ # match for <fcn_name>() statements for any value of the encoding parameter
+ # IOW: find all the <fcn_name> statements
+ $encArgPat = qr / [^,)]+? /x;
+ }
+
+ # build the complete pattern
+ my $patRegEx = qr /
+ # part 1: $1
+ (
+ (?:^|=) # don't try to handle fcn_name call when arg of another fcn call
+ \s*
+ $fcn_name \s* \(
+ [^;]+? # a bit dangerous
+ ,\s*
+ )
+
+ # part 2: $2
+ # exact match of pattern (including spaces)
+ ((?-x)$encArgPat)
+
+ # part 3: $3
+ (
+ \s* \)
+ \s* ;
+ )
+ /xms; # m for ^ above
+
+ ##print "$patRegEx\n";
+
+ ## Match and substitute as specified
+ $found = 0;
+
+ $$fileContentsRef =~ s/ $patRegEx /patsubx($1,$2,$3)/xges;
+
+ return $found;
+ }
+
+ # Called from fix_encoding_args to determine replacement string when a regex match is encountered
+ # $_[0]: part 1
+ # $_[1]: part 2: encoding arg
+ # $_[2]: part 3
+ # lookup the desired replacement value for the encoding arg
+ # print match string showing and highlighting the encoding arg replacement
+ # return "replacement" string
+ sub patsubx {
+ $found += 1;
+ my $substr = exists $$searchReplaceHRef{$_[1]} ? $$searchReplaceHRef{$_[1]} : "???";
+ my $str = sprintf("%s[[%s]-->[%s]]%s", $_[0], $_[1], $substr, $_[2]);
+ $str =~ tr/\t\n\r/ /d;
+ printf "%s: $str\n", $fileName;
+ return $_[0] . $substr . $_[2];
+ }
+} # block end
+
+# ---------------------------------------------------------------------
+# fix_encoding_args_by_hf_type
+#
+# Substitute new values for certain proto_tree_add_item() encoding arg
+# values (for specified hf field types)
+# Variants: search for and display for "exceptions" to allowed encoding arg values;
+# search for and display all encoding arg values
+# args:
+# substitute_flag: 1: replace specified encoding arg values by a new value (keys/values in search hash);
+# 2: search for "exceptions" to allowed encoding arg values (values in search hash);
+# 3: search for all encoding arg values
+# ref to array containing two elements:
+# - ref to array containing hf[] types to be processed (FT_STRING, etc)
+# - ref to hash containing search (keys) and replacement (values) for encoding arg
+# fcn_name string
+# ref to string containing file contents
+# ref to hfArrayEntries hash (key: hf name; value: field type)
+# filename string
+
+{ # block begin
+
+# shared variables
+ my $fileName;
+ my $searchReplaceHRef;
+ my $found;
+ my $hf_field_type;
+
+ sub fix_encoding_args_by_hf_type {
+
+ (my $subFlag, my $mapArg, my $fcn_name, my $fileContentsRef, my $hfArrayEntryFieldTypeHRef, $fileName) = @_;
+
+ my $hf_index_name;
+ my $hfTypesARef;
+ my $encArgPat;
+
+ $hfTypesARef = $$mapArg[0];
+ $searchReplaceHRef = $$mapArg[1];
+
+ my %hfTypes;
+ @hfTypes{@$hfTypesARef}=();
+
+ # set up the encoding arg match pattern
+ if ($subFlag == 1) {
+ # just match for <fcn_name>() statements which have an encoding arg matching one of the
+ # keys in the searchReplace hash.
+ # Escape any "|" characters in the keys
+ # and then create "alternatives" string containing all the resulting key strings. Ex: "A|B|C\|D|..."
+ $encArgPat = join "|", map { my $copy = $_; $copy =~ s{ ( \| ) }{\\$1}gx; $copy } keys %$searchReplaceHRef;
+ } elsif ($subFlag == 2) {
+ # Find all the <fcn_name>() statements wherein the encoding arg is a value other than
+ # one of the "replace" values.
+ # Uses zero-length negative-lookahead to find <fcn_name>() statements for which the encoding
+ # arg is something other than one of the provided replace values.
+ # Escape any "|" characters in the values to be matched
+ # and then create "alternatives" string containing all the value strings. Ex: "A|B|C\|D|..."
+ my $match_str = join "|", map { my $copy = $_; $copy =~ s{ ( \| ) }{\\$1}gx; $copy } values %$searchReplaceHRef;
+ $encArgPat = qr /
+ (?! # negative zero-length look-ahead
+ \s*
+ (?: $match_str ) # alternatives we don't want to match
+ \s*
+ )
+ [^,)]+? # OK: enoding arg is other than one of the alternatives:
+ # match to end of the arg
+ /x;
+ } elsif ($subFlag == 3) {
+ # match for <fcn_name>() statements for any value of the encoding parameter
+ # IOW: find all the proto_tree_add_item statements with an hf entry of the desired types
+ $encArgPat = qr / [^,)]+? /x;
+ }
+
+ my @hf_index_names;
+
+ # For each hf[] entry which matches a type in %hfTypes do replacements
+ $found = 0;
+ foreach my $key (keys %$hfArrayEntryFieldTypeHRef) {
+ $hf_index_name = $key;
+ $hf_field_type = $$hfArrayEntryFieldTypeHRef{$key};
+ ##printf "--> %-35.35s: %s\n", $hf_index_name, $hf_field_type;
+
+ next unless exists $hfTypes{$hf_field_type}; # Do we want to process for this hf[] entry type ?
+
+ ##print "\n$hf_index_name $hf_field_type\n";
+ push @hf_index_names, $hf_index_name;
+ }
+
+ if (@hf_index_names) {
+ # build the complete pattern
+ my $hf_index_names_re = join('|', @hf_index_names);
+ $hf_index_names_re =~ s/\[|\]/\\$&/g; # escape any "[" or "]" characters
+ my $patRegEx = qr /
+ # part 1: $1
+ (
+ $fcn_name \s* \(
+ [^;]+?
+ ,\s*
+ (?:$hf_index_names_re)
+ \s*,
+ [^;]+
+ ,\s*
+ )
+
+ # part 2: $2
+ # exact match of pattern (including spaces)
+ ((?-x)$encArgPat)
+
+ # part 3: $3
+ (
+ \s* \)
+ \s* ;
+ )
+ /xs;
+
+ ##print "\n$patRegEx\n";
+
+ ## Match and substitute as specified
+ $$fileContentsRef =~ s/ $patRegEx /patsub($1,$2,$3)/xges;
+
+ }
+
+ return $found;
+ }
+
+ # Called from fix_encoding_args to determine replacement string when a regex match is encountered
+ # $_[0]: part 1
+ # $_[1]: part 2: encoding arg
+ # $_[2]: part 3
+ # lookup the desired replacement value for the encoding arg
+ # print match string showing and highlighting the encoding arg replacement
+ # return "replacement" string
+ sub patsub {
+ $found += 1;
+ my $substr = exists $$searchReplaceHRef{$_[1]} ? $$searchReplaceHRef{$_[1]} : "???";
+ my $str = sprintf("%s[[%s]-->[%s]]%s", $_[0], $_[1], $substr, $_[2]);
+ $str =~ tr/\t\n\r/ /d;
+ printf "%s: %-17.17s $str\n", $fileName, $hf_field_type . ":";
+ return $_[0] . $substr . $_[2];
+ }
+} # block end
+
+# ---------------------------------------------------------------------
+# fix_dissector_table_args
+# Substitute new values for the specified <fcn_name>() encoding arg values
+# when the encoding arg is the *last* arg of the call to fcn_name
+# args:
+# substitute_flag: 1: replace specified encoding arg values by a new value (keys/values in search hash);
+# ref to hash containing search (keys) and replacement (values) for encoding arg
+# fcn_name string
+# ref to string containing file contents
+# filename string
+#
+{ # block begin
+
+ # shared variables
+ my $fileName;
+ my $searchReplaceHRef;
+ my $found;
+
+ sub fix_dissector_table_args {
+ (my $subFlag, $searchReplaceHRef, my $fcn_name, my $fileContentsRef, $fileName) = @_;
+
+ my $encArgPat;
+
+ if ($subFlag == 1) {
+ # just match for <fcn_name>() statements which have an encoding arg matching one of the
+ # keys in the searchReplace hash.
+ # Escape any "|" characters in the keys
+ # and then create "alternatives" string containing all the resulting key strings. Ex: "(A|B|C\|D|..."
+ $encArgPat = join "|", map { my $copy = $_; $copy =~ s{ ( \| ) }{\\$1}gx; $copy } keys %$searchReplaceHRef;
+ } elsif ($subFlag == 3) {
+ # match for <fcn_name>() statements for any value of the encoding parameter
+ # IOW: find all the <fcn_name> statements
+ $encArgPat = qr / [^,)]+? /x;
+ }
+
+ # build the complete pattern
+ my $patRegEx = qr /
+ # part 1: $1
+ (
+ (?:^|=) # don't try to handle fcn_name call when arg of another fcn call
+ \s*
+ $fcn_name \s* \(
+ [^;]+? # a bit dangerous
+ ,\s*
+ FT_STRING[A-Z]*
+ ,\s*
+ )
+
+ # part 2: $2
+ # exact match of pattern (including spaces)
+ ((?-x)$encArgPat)
+
+ # part 3: $3
+ (
+ \s* \)
+ \s* ;
+ )
+ /xms; # m for ^ above
+
+ ##print "$patRegEx\n";
+
+ ## Match and substitute as specified
+ $found = 0;
+
+ $$fileContentsRef =~ s/ $patRegEx /patsuby($1,$2,$3)/xges;
+
+ return $found;
+ }
+
+ # Called from fix_encoding_args to determine replacement string when a regex match is encountered
+ # $_[0]: part 1
+ # $_[1]: part 2: encoding arg
+ # $_[2]: part 3
+ # lookup the desired replacement value for the encoding arg
+ # print match string showing and highlighting the encoding arg replacement
+ # return "replacement" string
+ sub patsuby {
+ $found += 1;
+ my $substr = exists $$searchReplaceHRef{$_[1]} ? $$searchReplaceHRef{$_[1]} : "???";
+ my $str = sprintf("%s[[%s]-->[%s]]%s", $_[0], $_[1], $substr, $_[2]);
+ $str =~ tr/\t\n\r/ /d;
+ printf "%s: $str\n", $fileName;
+ return $_[0] . $substr . $_[2];
+ }
+} # block end
+
+# ---------------------------------------------------------------------
+# Find all <fcnList> statements
+# and output same highlighting the encoding arg
+# Currently: encoding arg is matched as the *last* arg of the function call
+
+sub find_all {
+ my( $fcnListARef, $fileContentsRef, $fileName) = @_;
+
+ my $found = 0;
+ my $fcnListPat = join "|", @$fcnListARef;
+ my $pat = qr /
+ (
+ (?:$fcnListPat) \s* \(
+ [^;]+
+ , \s*
+ )
+ (
+ [^ \t,)]+?
+ )
+ (
+ \s* \)
+ \s* ;
+ )
+ /xs;
+
+ while ($$fileContentsRef =~ / $pat /xgso) {
+ my $str = "${1}[[${2}]]${3}\n";
+ $str =~ tr/\t\n\r/ /d;
+ $str =~ s/ \s+ / /xg;
+ print "$fileName: $str\n";
+ $found += 1;
+ }
+ return $found;
+}
+