tools/fix-encoding-args.pl

   1 #!/usr/bin/env perl
   2 #
   3 # Copyright 2011, William Meier <wmeier[AT]newsguy.com>
   4 #
   5 # A program to fix encoding args for certain Wireshark API function calls
   6 #   from TRUE/FALSE to ENC_?? as appropriate (and possible)
   7 #   - proto_tree_add_item
   8 #   - proto_tree_add_bits_item
   9 #   - proto_tree_add_bits_ret_val
  10 #   - proto_tree_add_bitmask
  11 #   - proto_tree_add_bitmask_text  !! ToDo: encoding arg not last arg
  12 #   - tvb_get_bits
  13 #   - tvb_get_bits16
  14 #   - tvb_get_bits24
  15 #   - tvb_get_bits32
  16 #   - tvb_get_bits64
  17 #   - ptvcursor_add
  18 #   - ptvcursor_add_no_advance
  19 #   - ptvcursor_add_with_subtree   !! ToDo: encoding arg not last arg
  20 #
  21 # ToDo: Rework program so that it can better be used to *validate* encoding-args
  22 #
  23 # Wireshark - Network traffic analyzer
  24 # By Gerald Combs <gerald@wireshark.org>
  25 # Copyright 1998 Gerald Combs
  26 #
  27 # SPDX-License-Identifier: GPL-2.0-or-later
  28 #
  29
  30 use strict;
  31 use warnings;
  32
  33 use Getopt::Long;
  34
  35 # Conversion "Requests"
  36
  37 # Standard conversions
  38 my $searchReplaceFalseTrueHRef =
  39   {
  40    "FALSE"              => "ENC_BIG_ENDIAN",
  41    "0"                  => "ENC_BIG_ENDIAN",
  42    "TRUE"               => "ENC_LITTLE_ENDIAN",
  43    "1"                  => "ENC_LITTLE_ENDIAN"
  44   };
  45
  46 my $searchReplaceEncNAHRef =
  47    {
  48     "FALSE"              => "ENC_NA",
  49     "0"                  => "ENC_NA",
  50     "TRUE"               => "ENC_NA",
  51     "1"                  => "ENC_NA",
  52     "ENC_LITTLE_ENDIAN"  => "ENC_NA",
  53     "ENC_BIG_ENDIAN"     => "ENC_NA",
  54     "ENC_ASCII|ENC_NA"   => "ENC_NA",
  55     "ENC_ASCII | ENC_NA" => "ENC_NA"
  56    };
  57
  58 my $searchReplaceDissectorTable =
  59   {
  60    "FALSE"              => "STRING_CASE_SENSITIVE",
  61    "0"                  => "STRING_CASE_SENSITIVE",
  62    "BASE_NONE"          => "STRING_CASE_SENSITIVE",
  63    "TRUE"               => "STRING_CASE_INSENSITIVE",
  64    "1"                  => "STRING_CASE_INSENSITIVE"
  65   };
  66
  67 # ---------------------------------------------------------------------
  68 # Conversion "request" structure
  69 # (
  70 #   [ <list of field types for which this conversion request applies> ],
  71 #   { <hash of desired encoding arg conversions> }
  72 # }
  73
  74 my @types_NA  =
  75   (
  76    [ qw (FT_NONE FT_BYTES FT_ETHER FT_IPv6 FT_IPXNET FT_OID FT_REL_OID)],
  77    $searchReplaceEncNAHRef
  78   );
  79
  80 my @types_INT =
  81   (
  82    [ qw (FT_UINT8 FT_UINT16 FT_UINT24 FT_UINT32 FT_UINT64 FT_INT8
  83          FT_INT16 FT_INT24 FT_INT32 FT_INT64 FT_FLOAT FT_DOUBLE)],
  84    $searchReplaceFalseTrueHRef
  85   );
  86
  87 my @types_MISC =
  88   (
  89    [ qw (FT_BOOLEAN FT_IPv4 FT_GUID FT_EUI64)],
  90    $searchReplaceFalseTrueHRef
  91   );
  92
  93 my @types_STRING =
  94   (
  95    [qw (FT_STRING FT_STRINGZ)],
  96    {
  97     "FALSE"                        => "ENC_ASCII",
  98     "0"                            => "ENC_ASCII",
  99     "TRUE"                         => "ENC_ASCII",
 100     "1"                            => "ENC_ASCII",
 101     "ENC_LITTLE_ENDIAN"            => "ENC_ASCII",
 102     "ENC_BIG_ENDIAN"               => "ENC_ASCII",
 103     "ENC_NA"                       => "ENC_ASCII",
 104
 105     "ENC_ASCII|ENC_LITTLE_ENDIAN"  => "ENC_ASCII",
 106     "ENC_ASCII|ENC_BIG_ENDIAN"     => "ENC_ASCII",
 107
 108     "ENC_UTF_8|ENC_LITTLE_ENDIAN"  => "ENC_UTF_8",
 109     "ENC_UTF_8|ENC_BIG_ENDIAN"     => "ENC_UTF_8",
 110
 111     "ENC_EBCDIC|ENC_LITTLE_ENDIAN" => "ENC_EBCDIC",
 112     "ENC_EBCDIC|ENC_BIG_ENDIAN"    => "ENC_EBCDIC",
 113    }
 114   );
 115
 116 my @types_UINT_STRING =
 117   (
 118    [qw (FT_UINT_STRING)],
 119    {
 120     "FALSE"                   => "ENC_ASCII|ENC_BIG_ENDIAN",
 121     "0"                       => "ENC_ASCII|ENC_BIG_ENDIAN",
 122     "TRUE"                    => "ENC_ASCII|ENC_LITTLE_ENDIAN",
 123     "1"                       => "ENC_ASCII|ENC_LITTLE_ENDIAN",
 124     "ENC_BIG_ENDIAN"          => "ENC_ASCII|ENC_BIG_ENDIAN",
 125     "ENC_LITTLE_ENDIAN"       => "ENC_ASCII|ENC_LITTLE_ENDIAN",
 126     "ENC_ASCII|ENC_NA"        => "ENC_ASCII|ENC_BIG_ENDIAN",
 127     "ENC_ASCII"               => "ENC_ASCII|ENC_BIG_ENDIAN",
 128     "ENC_NA"                  => "ENC_ASCII|ENC_BIG_ENDIAN"
 129    }
 130   );
 131
 132 my @types_REG_PROTO  =
 133   (
 134    [ qw (REG_PROTO)],
 135    $searchReplaceEncNAHRef
 136   );
 137
 138 # ---------------------------------------------------------------------
 139
 140 my @findAllFunctionList =
 141 ##         proto_tree_add_bitmask_text  !! ToDo: encoding arg not last arg
 142 ##         ptvcursor_add_with_subtree   !! ToDo: encoding Arg not last arg
 143   qw (
 144          proto_tree_add_item
 145          proto_tree_add_bits_item
 146          proto_tree_add_bits_ret_val
 147          proto_tree_add_bitmask
 148          proto_tree_add_bitmask_with_flags
 149          tvb_get_bits
 150          tvb_get_bits16
 151          tvb_get_bits24
 152          tvb_get_bits32
 153          tvb_get_bits64
 154          ptvcursor_add
 155          ptvcursor_add_no_advance
 156          register_dissector_table
 157     );
 158
 159 # ---------------------------------------------------------------------
 160 #
 161 # MAIN
 162 #
 163 my $writeFlag = '';
 164 my $helpFlag  = '';
 165 my $action    = 'fix-all';
 166
 167 my $result = GetOptions(
 168                         'action=s' => \$action,
 169                         'write'    => \$writeFlag,
 170                         'help|?'   => \$helpFlag
 171                        );
 172
 173 if (!$result || $helpFlag || !$ARGV[0]) {
 174     usage();
 175 }
 176
 177 if (($action ne 'fix-all') && ($action ne 'find-all')) {
 178     usage();
 179 }
 180
 181 sub usage {
 182         print "\nUsage: $0 [--action=fix-all|find-all] [--write] FILENAME [...]\n\n";
 183         print "  --action = fix-all (default)\n";
 184         print "    Fix <certain-fcn-names>() encoding arg when possible in FILENAME(s)\n";
 185         print "    Fixes (if any) are listed on stdout)\n\n";
 186         print "  --write     create FILENAME.encoding-arg-fixes (original file with fixes)\n";
 187         print "              (effective only for fix-all)\n";
 188         print "\n";
 189         print "  --action = find-all\n";
 190         print "    Find all occurrences of <certain-fcn-names>() statements)\n";
 191         print "     highlighting the 'encoding' arg\n";
 192         exit(1);
 193 }
 194
 195 # Read through the files; fix up encoding parameter of proto_tree_add_item() calls
 196 # Essentially:
 197 #  For each file {
 198 #  .  Create a hash of the hf_index_names & associated field types from the entries in hf[]
 199 #  .  For each requested "conversion request" {
 200 #  .  .  For each hf[] entry hf_index_name with a field type in a set of specified field types {
 201 #  .  .  .  For each proto_tree_add_item() statement
 202 #  .  .  .  .  - replace encoding arg in proto_tree_add_item(..., hf_index_name, ..., 'encoding-arg')
 203 #                  specific values ith new values
 204 #  .  .  .  .  - print the statement showing the change
 205 #  .  .  .  }
 206 #  .  .  }
 207 #  .  }
 208 #  .  If requested and if replacements done: write new file "orig-filename.encoding-arg-fixes"
 209 #  }
 210 #
 211 # Note: The proto_tree_add_item() encoding arg will be converted only if
 212 #        the hf_index_name referenced is in one of the entries in hf[] in the same file
 213
 214 my $found_total = 0;
 215
 216 while (my $fileName = $ARGV[0]) {
 217     shift;
 218     my $fileContents = '';
 219
 220     die "No such file: \"$fileName\"\n" if (! -e $fileName);
 221
 222     # delete leading './'
 223     $fileName =~ s{ ^ \. / } {}xo;
 224     ##print "$fileName\n";
 225
 226     # Read in the file (ouch, but it's easier that way)
 227     open(FCI, "<", $fileName) || die("Couldn't open $fileName");
 228     while (<FCI>) {
 229         $fileContents .= $_;
 230     }
 231     close(FCI);
 232
 233     # Create a hash of the hf[] entries (name_index_name=>field_type)
 234     my $hfArrayEntryFieldTypeHRef = find_hf_array_entries(\$fileContents, $fileName);
 235
 236     if ($action eq "fix-all") {
 237
 238         # Find and replace: <fcn_name_pattern>() encoding arg in $fileContents for:
 239         #     - hf[] entries with specified field types;
 240         #     - 'proto' as returned from proto_register_protocol()
 241         my $fcn_name = "(?:proto_tree_add_item|ptvcursor_add(?:_no_advance)?)";
 242         my $found = 0;
 243         $found += fix_encoding_args_by_hf_type(1, \@types_NA,          $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 244         $found += fix_encoding_args_by_hf_type(1, \@types_INT,         $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 245         $found += fix_encoding_args_by_hf_type(1, \@types_MISC,        $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 246         $found += fix_encoding_args_by_hf_type(1, \@types_STRING,      $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 247         $found += fix_encoding_args_by_hf_type(1, \@types_UINT_STRING, $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 248         $found += fix_encoding_args_by_hf_type(1, \@types_REG_PROTO,   $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 249
 250         # Find and replace: alters <fcn_name>() encoding arg in $fileContents
 251         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "proto_tree_add_bits_(?:item|ret_val)",      \$fileContents, $fileName);
 252         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "proto_tree_add_bitmask",                    \$fileContents, $fileName);
 253         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "proto_tree_add_bitmask_with_flags",         \$fileContents, $fileName);
 254         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "tvb_get_bits(?:16|24|32|64)?",              \$fileContents, $fileName);
 255         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "tvb_get_(?:ephemeral_)?unicode_string[z]?", \$fileContents, $fileName);
 256
 257         $found += fix_dissector_table_args(1, $searchReplaceDissectorTable, "register_dissector_table",           \$fileContents, $fileName);
 258
 259         # If desired and if any changes, write out the changed version to a file
 260         if (($writeFlag) && ($found > 0)) {
 261             open(FCO, ">", $fileName . ".encoding-arg-fixes");
 262 #        open(FCO, ">", $fileName );
 263             print FCO "$fileContents";
 264             close(FCO);
 265         }
 266         $found_total += $found;
 267     }
 268
 269     if ($action eq "find-all") {
 270         # Find all proto_tree_add_item() statements
 271         #  and output same highlighting the encoding arg
 272         $found_total += find_all(\@findAllFunctionList, \$fileContents, $fileName);
 273     }
 274
 275 } # while
 276
 277 exit $found_total;
 278
 279 # ---------------------------------------------------------------------
 280 # Create a hash containing an entry (hf_index_name => field_type) for each hf[]entry.
 281 # also: create an entry in the hash for the 'protocol name' variable (proto... => FT_PROTOCOL)
 282 # returns: ref to the hash
 283
 284 sub find_hf_array_entries {
 285     my ($fileContentsRef, $fileName) = @_;
 286
 287     # The below Regexp is based on one from:
 288     # https://web.archive.org/web/20080614012925/http://aspn.activestate.com/ASPN/Cookbook/Rx/Recipe/59811
 289     # It is in the public domain.
 290     # A complicated regex which matches C-style comments.
 291     my $CCommentRegEx = qr{ / [*] [^*]* [*]+ (?: [^/*] [^*]* [*]+ )* / }xo;
 292
 293     # hf[] entry regex (to extract an hf_index_name and associated field type)
 294     my $hfArrayFieldTypeRegEx = qr {
 295                                        \{
 296                                        \s*
 297                                        &\s*([A-Z0-9_\[\]-]+)                # &hf
 298                                        \s*,\s*
 299                                        \{\s*
 300                                        .+?                                  # (a bit dangerous)
 301                                        \s*,\s*
 302                                        (FT_[A-Z0-9_]+)                      # field type
 303                                        \s*,\s*
 304                                        .+?
 305                                        \s*,\s*
 306                                        HFILL                                # HFILL
 307                                }xios;
 308
 309     # create a copy of $fileContents with comments removed
 310     my $fileContentsWithoutComments = $$fileContentsRef;
 311     $fileContentsWithoutComments =~ s {$CCommentRegEx} []xg;
 312
 313     # find all the hf[] entries (searching $fileContentsWithoutComments).
 314     # Create a hash keyed by the hf_index_name with the associated value being the field_type
 315     my %hfArrayEntryFieldType;
 316     while ($fileContentsWithoutComments =~ m{ $hfArrayFieldTypeRegEx }xgis) {
 317 #        print "$1 $2\n";
 318         if (exists $hfArrayEntryFieldType{$1}) {
 319             printf "%-35.35s: ? duplicate hf[] entry: no fixes done for: $1; manual action may be req'd\n", $fileName;
 320             $hfArrayEntryFieldType{$1} = "???"; # prevent any substitutions for this hf_index_name
 321         } else {
 322             $hfArrayEntryFieldType{$1} = $2;
 323         }
 324     }
 325
 326     # pre-process contents to fold multiple lines and speed up matching.
 327     $fileContentsWithoutComments =~ s/\s*=\s*/=/gs;
 328     $fileContentsWithoutComments =~ s/^\s+//g;
 329
 330     # RegEx to get "proto" variable name
 331     my $protoRegEx = qr /
 332                             ^                         # note m modifier below
 333                             (
 334                                 [a-zA-Z0-9_]+
 335                             )
 336                             =
 337                             proto_register_protocol\b
 338                         /xom;
 339
 340     # Find all registered protocols
 341     while ($fileContentsWithoutComments =~ m { $protoRegEx }xgom ) {
 342         ##print "$1\n";
 343         if (exists $hfArrayEntryFieldType{$1}) {
 344             printf "%-35.35s: ? duplicate 'proto': no fixes done for: $1; manual action may be req'd\n", $fileName;
 345             $hfArrayEntryFieldType{$1} = "???"; # prevent any substitutions for this protocol
 346         } else {
 347             $hfArrayEntryFieldType{$1} = "REG_PROTO";
 348         }
 349     }
 350
 351     return \%hfArrayEntryFieldType;
 352 }
 353
 354 # ---------------------------------------------------------------------
 355 # fix_encoding_args
 356 # Substitute new values for the specified <fcn_name>() encoding arg values
 357 #    when the encoding arg is the *last* arg of the call to fcn_name
 358 # args:
 359 #   substitute_flag: 1: replace specified encoding arg values by a new value (keys/values in search hash);
 360 #   ref to hash containing search (keys) and replacement (values) for encoding arg
 361 #   fcn_name string
 362 #   ref to string containing file contents
 363 #   filename string
 364 #
 365 { # block begin
 366
 367     # shared variables
 368     my $fileName;
 369     my $searchReplaceHRef;
 370     my $found;
 371
 372     sub fix_encoding_args {
 373         (my $subFlag, $searchReplaceHRef, my $fcn_name, my $fileContentsRef, $fileName) = @_;
 374
 375         my $encArgPat;
 376
 377         if ($subFlag == 1) {
 378             # just match for <fcn_name>() statements which have an encoding arg matching one of the
 379             #   keys in the searchReplace hash.
 380             # Escape any "|" characters in the keys
 381             #  and then create "alternatives" string containing all the resulting key strings. Ex: "(A|B|C\|D|..."
 382             $encArgPat = join "|",  map { my $copy = $_; $copy =~ s{ ( \| ) }{\\$1}gx; $copy } keys %$searchReplaceHRef;
 383         } elsif ($subFlag == 3) {
 384             # match for <fcn_name>() statements for any value of the encoding parameter
 385             # IOW: find all the <fcn_name> statements
 386             $encArgPat = qr / [^,)]+? /x;
 387         }
 388
 389         # build the complete pattern
 390         my $patRegEx = qr /
 391                               # part 1: $1
 392                               (
 393                                   (?:^|=)            # don't try to handle fcn_name call when arg of another fcn call
 394                                   \s*
 395                                   $fcn_name \s* \(
 396                                   [^;]+?             # a bit dangerous
 397                                   ,\s*
 398                               )
 399
 400                               # part 2: $2
 401                               #  exact match of pattern (including spaces)
 402                               ((?-x)$encArgPat)
 403
 404                               # part 3: $3
 405                               (
 406                                   \s* \)
 407                                   \s* ;
 408                               )
 409                           /xms;  # m for ^ above
 410
 411         ##print "$patRegEx\n";
 412
 413         ## Match and substitute as specified
 414         $found = 0;
 415
 416         $$fileContentsRef =~ s/ $patRegEx /patsubx($1,$2,$3)/xges;
 417
 418         return $found;
 419     }
 420
 421     # Called from fix_encoding_args to determine replacement string when a regex match is encountered
 422     #  $_[0]: part 1
 423     #  $_[1]: part 2: encoding arg
 424     #  $_[2]: part 3
 425     #  lookup the desired replacement value for the encoding arg
 426     #  print match string showing and highlighting the encoding arg replacement
 427     #  return "replacement" string
 428     sub patsubx {
 429         $found += 1;
 430         my $substr = exists $$searchReplaceHRef{$_[1]} ? $$searchReplaceHRef{$_[1]} : "???";
 431         my $str = sprintf("%s[[%s]-->[%s]]%s", $_[0], $_[1], $substr,  $_[2]);
 432         $str =~ tr/\t\n\r/ /d;
 433         printf "%s: $str\n", $fileName;
 434         return $_[0] . $substr . $_[2];
 435     }
 436 } # block end
 437
 438 # ---------------------------------------------------------------------
 439 # fix_encoding_args_by_hf_type
 440 #
 441 # Substitute new values for certain proto_tree_add_item() encoding arg
 442 #     values (for specified hf field types)
 443 #  Variants: search for and display for "exceptions" to allowed encoding arg values;
 444 #            search for and display all encoding arg values
 445 # args:
 446 #   substitute_flag: 1: replace specified encoding arg values by a new value (keys/values in search hash);
 447 #                    2: search for "exceptions" to allowed encoding arg values (values in search hash);
 448 #                    3: search for all encoding arg values
 449 #   ref to array containing two elements:
 450 #      - ref to array containing hf[] types to be processed (FT_STRING, etc)
 451 #      - ref to hash containing search (keys) and replacement (values) for encoding arg
 452 #   fcn_name string
 453 #   ref to string containing file contents
 454 #   ref to hfArrayEntries hash (key: hf name; value: field type)
 455 #   filename string
 456
 457 {  # block begin
 458
 459 # shared variables
 460     my $fileName;
 461     my $searchReplaceHRef;
 462     my $found;
 463     my $hf_field_type;
 464
 465     sub fix_encoding_args_by_hf_type {
 466
 467         (my $subFlag, my $mapArg, my $fcn_name, my $fileContentsRef, my $hfArrayEntryFieldTypeHRef, $fileName) = @_;
 468
 469         my $hf_index_name;
 470         my $hfTypesARef;
 471         my $encArgPat;
 472
 473         $hfTypesARef       = $$mapArg[0];
 474         $searchReplaceHRef = $$mapArg[1];
 475
 476         my %hfTypes;
 477         @hfTypes{@$hfTypesARef}=();
 478
 479         # set up the encoding arg match pattern
 480         if ($subFlag == 1) {
 481             # just match for <fcn_name>() statements which have an encoding arg matching one of the
 482             #   keys in the searchReplace hash.
 483             # Escape any "|" characters in the keys
 484             #  and then create "alternatives" string containing all the resulting key strings. Ex: "A|B|C\|D|..."
 485             $encArgPat = join "|",  map { my $copy = $_; $copy =~ s{ ( \| ) }{\\$1}gx; $copy } keys %$searchReplaceHRef;
 486         } elsif ($subFlag == 2) {
 487             # Find all the <fcn_name>() statements wherein the encoding arg is a value other than
 488             #      one of the "replace" values.
 489             #  Uses zero-length negative-lookahead to find <fcn_name>() statements for which the encoding
 490             #    arg is something other than one of the provided replace values.
 491             # Escape any "|" characters in the values to be matched
 492             #  and then create "alternatives" string containing all the value strings. Ex: "A|B|C\|D|..."
 493             my $match_str = join "|",  map { my $copy = $_; $copy =~ s{ ( \| ) }{\\$1}gx; $copy } values %$searchReplaceHRef;
 494             $encArgPat = qr /
 495                                 (?!                  # negative zero-length look-ahead
 496                                     \s*
 497                                     (?: $match_str ) # alternatives we don't want to match
 498                                     \s*
 499                                 )
 500                                 [^,)]+?              # OK: enoding arg is other than one of the alternatives:
 501                                                      #   match to end of the arg
 502                             /x;
 503         } elsif ($subFlag == 3) {
 504             # match for <fcn_name>() statements for any value of the encoding parameter
 505             # IOW: find all the proto_tree_add_item statements with an hf entry of the desired types
 506             $encArgPat = qr / [^,)]+? /x;
 507         }
 508
 509         my @hf_index_names;
 510
 511         # For each hf[] entry which matches a type in %hfTypes do replacements
 512         $found = 0;
 513         foreach my $key (keys %$hfArrayEntryFieldTypeHRef) {
 514             $hf_index_name = $key;
 515             $hf_field_type = $$hfArrayEntryFieldTypeHRef{$key};
 516             ##printf "--> %-35.35s: %s\n", $hf_index_name,  $hf_field_type;
 517
 518             next unless exists $hfTypes{$hf_field_type};    # Do we want to process for this hf[] entry type ?
 519
 520             ##print "\n$hf_index_name $hf_field_type\n";
 521             push @hf_index_names, $hf_index_name;
 522         }
 523
 524         if (@hf_index_names) {
 525             # build the complete pattern
 526             my $hf_index_names_re = join('|', @hf_index_names);
 527             $hf_index_names_re =~ s/\[|\]/\\$&/g;   # escape any "[" or "]" characters
 528             my $patRegEx = qr /
 529                                   # part 1: $1
 530                                   (
 531                                       $fcn_name \s* \(
 532                                       [^;]+?
 533                                       ,\s*
 534                                       (?:$hf_index_names_re)
 535                                       \s*,
 536                                       [^;]+
 537                                       ,\s*
 538                                   )
 539
 540                                   # part 2: $2
 541                                   #  exact match of pattern (including spaces)
 542                                   ((?-x)$encArgPat)
 543
 544                                   # part 3: $3
 545                                   (
 546                                       \s* \)
 547                                       \s* ;
 548                                   )
 549                               /xs;
 550
 551             ##print "\n$patRegEx\n";
 552
 553             ## Match and substitute as specified
 554             $$fileContentsRef =~ s/ $patRegEx /patsub($1,$2,$3)/xges;
 555
 556         }
 557
 558         return $found;
 559     }
 560
 561     # Called from fix_encoding_args to determine replacement string when a regex match is encountered
 562     #  $_[0]: part 1
 563     #  $_[1]: part 2: encoding arg
 564     #  $_[2]: part 3
 565     #  lookup the desired replacement value for the encoding arg
 566     #  print match string showing and highlighting the encoding arg replacement
 567     #  return "replacement" string
 568     sub patsub {
 569         $found += 1;
 570         my $substr = exists $$searchReplaceHRef{$_[1]} ? $$searchReplaceHRef{$_[1]} : "???";
 571         my $str = sprintf("%s[[%s]-->[%s]]%s", $_[0], $_[1], $substr,  $_[2]);
 572         $str =~ tr/\t\n\r/ /d;
 573         printf "%s:  %-17.17s $str\n", $fileName, $hf_field_type . ":";
 574         return $_[0] . $substr . $_[2];
 575     }
 576 }  # block end
 577
 578 # ---------------------------------------------------------------------
 579 # fix_dissector_table_args
 580 # Substitute new values for the specified <fcn_name>() encoding arg values
 581 #    when the encoding arg is the *last* arg of the call to fcn_name
 582 # args:
 583 #   substitute_flag: 1: replace specified encoding arg values by a new value (keys/values in search hash);
 584 #   ref to hash containing search (keys) and replacement (values) for encoding arg
 585 #   fcn_name string
 586 #   ref to string containing file contents
 587 #   filename string
 588 #
 589 { # block begin
 590
 591     # shared variables
 592     my $fileName;
 593     my $searchReplaceHRef;
 594     my $found;
 595
 596     sub fix_dissector_table_args {
 597         (my $subFlag, $searchReplaceHRef, my $fcn_name, my $fileContentsRef, $fileName) = @_;
 598
 599         my $encArgPat;
 600
 601         if ($subFlag == 1) {
 602             # just match for <fcn_name>() statements which have an encoding arg matching one of the
 603             #   keys in the searchReplace hash.
 604             # Escape any "|" characters in the keys
 605             #  and then create "alternatives" string containing all the resulting key strings. Ex: "(A|B|C\|D|..."
 606             $encArgPat = join "|",  map { my $copy = $_; $copy =~ s{ ( \| ) }{\\$1}gx; $copy } keys %$searchReplaceHRef;
 607         } elsif ($subFlag == 3) {
 608             # match for <fcn_name>() statements for any value of the encoding parameter
 609             # IOW: find all the <fcn_name> statements
 610             $encArgPat = qr / [^,)]+? /x;
 611         }
 612
 613         # build the complete pattern
 614         my $patRegEx = qr /
 615                               # part 1: $1
 616                               (
 617                                   (?:^|=)            # don't try to handle fcn_name call when arg of another fcn call
 618                                   \s*
 619                                   $fcn_name \s* \(
 620                                   [^;]+?             # a bit dangerous
 621                                   ,\s*
 622                                   FT_STRING[A-Z]*
 623                                   ,\s*
 624                               )
 625
 626                               # part 2: $2
 627                               #  exact match of pattern (including spaces)
 628                               ((?-x)$encArgPat)
 629
 630                               # part 3: $3
 631                               (
 632                                   \s* \)
 633                                   \s* ;
 634                               )
 635                           /xms;  # m for ^ above
 636
 637         ##print "$patRegEx\n";
 638
 639         ## Match and substitute as specified
 640         $found = 0;
 641
 642         $$fileContentsRef =~ s/ $patRegEx /patsuby($1,$2,$3)/xges;
 643
 644         return $found;
 645     }
 646
 647     # Called from fix_encoding_args to determine replacement string when a regex match is encountered
 648     #  $_[0]: part 1
 649     #  $_[1]: part 2: encoding arg
 650     #  $_[2]: part 3
 651     #  lookup the desired replacement value for the encoding arg
 652     #  print match string showing and highlighting the encoding arg replacement
 653     #  return "replacement" string
 654     sub patsuby {
 655         $found += 1;
 656         my $substr = exists $$searchReplaceHRef{$_[1]} ? $$searchReplaceHRef{$_[1]} : "???";
 657         my $str = sprintf("%s[[%s]-->[%s]]%s", $_[0], $_[1], $substr,  $_[2]);
 658         $str =~ tr/\t\n\r/ /d;
 659         printf "%s: $str\n", $fileName;
 660         return $_[0] . $substr . $_[2];
 661     }
 662 } # block end
 663
 664 # ---------------------------------------------------------------------
 665 # Find all <fcnList> statements
 666 #  and output same highlighting the encoding arg
 667 #  Currently: encoding arg is matched as the *last* arg of the function call
 668
 669 sub find_all {
 670     my( $fcnListARef, $fileContentsRef, $fileName) = @_;
 671
 672     my $found = 0;
 673     my $fcnListPat = join "|", @$fcnListARef;
 674     my $pat = qr /
 675                      (
 676                          (?:$fcnListPat) \s* \(
 677                          [^;]+
 678                          , \s*
 679                      )
 680                      (
 681                          [^ \t,)]+?
 682                      )
 683                      (
 684                          \s* \)
 685                          \s* ;
 686                      )
 687                  /xs;
 688
 689     while ($$fileContentsRef =~ / $pat /xgso) {
 690         my $str = "${1}[[${2}]]${3}\n";
 691         $str =~ tr/\t\n\r/ /d;
 692         $str =~ s/ \s+ / /xg;
 693         print "$fileName: $str\n";
 694         $found += 1;
 695     }
 696     return $found;
 697 }
 698