util/perl/OpenSSL/ParseC.pm

   1 #! /usr/bin/env perl
   2 # Copyright 2018-2021 The OpenSSL Project Authors. All Rights Reserved.
   3 #
   4 # Licensed under the Apache License 2.0 (the "License").  You may not use
   5 # this file except in compliance with the License.  You can obtain a copy
   6 # in the file LICENSE in the source distribution or at
   7 # https://www.openssl.org/source/license.html
   8
   9 package OpenSSL::ParseC;
  10
  11 use strict;
  12 use warnings;
  13
  14 use Exporter;
  15 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  16 $VERSION = "0.9";
  17 @ISA = qw(Exporter);
  18 @EXPORT = qw(parse);
  19
  20 # Global handler data
  21 my @preprocessor_conds;         # A list of simple preprocessor conditions,
  22                                 # each item being a list of macros defined
  23                                 # or not defined.
  24
  25 # Handler helpers
  26 sub all_conds {
  27     return map { ( @$_ ) } @preprocessor_conds;
  28 }
  29
  30 # A list of handlers that will look at a "complete" string and try to
  31 # figure out what to make of it.
  32 # Each handler is a hash with the following keys:
  33 #
  34 # regexp                a regexp to compare the "complete" string with.
  35 # checker               a function that does a more complex comparison.
  36 #                       Use this instead of regexp if that isn't enough.
  37 # massager              massages the "complete" string into an array with
  38 #                       the following elements:
  39 #
  40 #                       [0]     String that needs further processing (this
  41 #                               applies to typedefs of structs), or empty.
  42 #                       [1]     The name of what was found.
  43 #                       [2]     A character that denotes what type of thing
  44 #                               this is: 'F' for function, 'S' for struct,
  45 #                               'T' for typedef, 'M' for macro, 'V' for
  46 #                               variable.
  47 #                       [3]     Return type (only for type 'F' and 'V')
  48 #                       [4]     Value (for type 'M') or signature (for type 'F',
  49 #                               'V', 'T' or 'S')
  50 #                       [5...]  The list of preprocessor conditions this is
  51 #                               found in, as in checks for macro definitions
  52 #                               (stored as the macro's name) or the absence
  53 #                               of definition (stored as the macro's name
  54 #                               prefixed with a '!'
  55 #
  56 #                       If the massager returns an empty list, it means the
  57 #                       "complete" string has side effects but should otherwise
  58 #                       be ignored.
  59 #                       If the massager is undefined, the "complete" string
  60 #                       should be ignored.
  61 my @opensslcpphandlers = (
  62     ##################################################################
  63     # OpenSSL CPP specials
  64     #
  65     # These are used to convert certain pre-precessor expressions into
  66     # others that @cpphandlers have a better chance to understand.
  67
  68     # This changes any OPENSSL_NO_DEPRECATED_x_y[_z] check to a check of
  69     # OPENSSL_NO_DEPRECATEDIN_x_y[_z].  That's due to <openssl/macros.h>
  70     # creating OPENSSL_NO_DEPRECATED_x_y[_z], but the ordinals files using
  71     # DEPRECATEDIN_x_y[_z].
  72     { regexp   => qr/#if(def|ndef) OPENSSL_NO_DEPRECATED_(\d+_\d+(?:_\d+)?)$/,
  73       massager => sub {
  74           return (<<"EOF");
  75 #if$1 OPENSSL_NO_DEPRECATEDIN_$2
  76 EOF
  77       }
  78     }
  79 );
  80 my @cpphandlers = (
  81     ##################################################################
  82     # CPP stuff
  83
  84     { regexp   => qr/#ifdef ?(.*)/,
  85       massager => sub {
  86           my %opts;
  87           if (ref($_[$#_]) eq "HASH") {
  88               %opts = %{$_[$#_]};
  89               pop @_;
  90           }
  91           push @preprocessor_conds, [ $1 ];
  92           print STDERR "DEBUG[",$opts{debug_type},"]: preprocessor level: ", scalar(@preprocessor_conds), "\n"
  93               if $opts{debug};
  94           return ();
  95       },
  96     },
  97     { regexp   => qr/#ifndef ?(.*)/,
  98       massager => sub {
  99           my %opts;
 100           if (ref($_[$#_]) eq "HASH") {
 101               %opts = %{$_[$#_]};
 102               pop @_;
 103           }
 104           push @preprocessor_conds, [ '!'.$1 ];
 105           print STDERR "DEBUG[",$opts{debug_type},"]: preprocessor level: ", scalar(@preprocessor_conds), "\n"
 106               if $opts{debug};
 107           return ();
 108       },
 109     },
 110     { regexp   => qr/#if (0|1)/,
 111       massager => sub {
 112           my %opts;
 113           if (ref($_[$#_]) eq "HASH") {
 114               %opts = %{$_[$#_]};
 115               pop @_;
 116           }
 117           if ($1 eq "1") {
 118               push @preprocessor_conds, [ "TRUE" ];
 119           } else {
 120               push @preprocessor_conds, [ "!TRUE" ];
 121           }
 122           print STDERR "DEBUG[",$opts{debug_type},"]: preprocessor level: ", scalar(@preprocessor_conds), "\n"
 123               if $opts{debug};
 124           return ();
 125       },
 126     },
 127     { regexp   => qr/#if ?(.*)/,
 128       massager => sub {
 129           my %opts;
 130           if (ref($_[$#_]) eq "HASH") {
 131               %opts = %{$_[$#_]};
 132               pop @_;
 133           }
 134           my @results = ();
 135           my $conds = $1;
 136           if ($conds =~ m|^defined<<<\(([^\)]*)\)>>>(.*)$|) {
 137               push @results, $1; # Handle the simple case
 138               my $rest = $2;
 139               my $re = qr/^(?:\|\|defined<<<\([^\)]*\)>>>)*$/;
 140               print STDERR "DEBUG[",$opts{debug_type},"]: Matching '$rest' with '$re'\n"
 141                   if $opts{debug};
 142               if ($rest =~ m/$re/) {
 143                   my @rest = split /\|\|/, $rest;
 144                   shift @rest;
 145                   foreach (@rest) {
 146                       m|^defined<<<\(([^\)]*)\)>>>$|;
 147                       die "Something wrong...$opts{PLACE}" if $1 eq "";
 148                       push @results, $1;
 149                   }
 150               } else {
 151                   $conds =~ s/<<<|>>>//g;
 152                   warn "Warning: complicated #if expression(1): $conds$opts{PLACE}"
 153                       if $opts{warnings};
 154               }
 155           } elsif ($conds =~ m|^!defined<<<\(([^\)]*)\)>>>(.*)$|) {
 156               push @results, '!'.$1; # Handle the simple case
 157               my $rest = $2;
 158               my $re = qr/^(?:\&\&!defined<<<\([^\)]*\)>>>)*$/;
 159               print STDERR "DEBUG[",$opts{debug_type},"]: Matching '$rest' with '$re'\n"
 160                   if $opts{debug};
 161               if ($rest =~ m/$re/) {
 162                   my @rest = split /\&\&/, $rest;
 163                   shift @rest;
 164                   foreach (@rest) {
 165                       m|^!defined<<<\(([^\)]*)\)>>>$|;
 166                       die "Something wrong...$opts{PLACE}" if $1 eq "";
 167                       push @results, '!'.$1;
 168                   }
 169               } else {
 170                   $conds =~ s/<<<|>>>//g;
 171                   warn "Warning: complicated #if expression(2): $conds$opts{PLACE}"
 172                       if $opts{warnings};
 173               }
 174           } else {
 175               $conds =~ s/<<<|>>>//g;
 176               warn "Warning: complicated #if expression(3): $conds$opts{PLACE}"
 177                   if $opts{warnings};
 178           }
 179           print STDERR "DEBUG[",$opts{debug_type},"]: Added preprocessor conds: '", join("', '", @results), "'\n"
 180               if $opts{debug};
 181           push @preprocessor_conds, [ @results ];
 182           print STDERR "DEBUG[",$opts{debug_type},"]: preprocessor level: ", scalar(@preprocessor_conds), "\n"
 183               if $opts{debug};
 184           return ();
 185       },
 186     },
 187     { regexp   => qr/#elif (.*)/,
 188       massager => sub {
 189           my %opts;
 190           if (ref($_[$#_]) eq "HASH") {
 191               %opts = %{$_[$#_]};
 192               pop @_;
 193           }
 194           die "An #elif without corresponding condition$opts{PLACE}"
 195               if !@preprocessor_conds;
 196           pop @preprocessor_conds;
 197           print STDERR "DEBUG[",$opts{debug_type},"]: preprocessor level: ", scalar(@preprocessor_conds), "\n"
 198               if $opts{debug};
 199           return (<<"EOF");
 200 #if $1
 201 EOF
 202       },
 203     },
 204     { regexp   => qr/#else/,
 205       massager => sub {
 206           my %opts;
 207           if (ref($_[$#_]) eq "HASH") {
 208               %opts = %{$_[$#_]};
 209               pop @_;
 210           }
 211           die "An #else without corresponding condition$opts{PLACE}"
 212               if !@preprocessor_conds;
 213           # Invert all conditions on the last level
 214           my $stuff = pop @preprocessor_conds;
 215           push @preprocessor_conds, [
 216               map { m|^!(.*)$| ? $1 : '!'.$_ } @$stuff
 217           ];
 218           print STDERR "DEBUG[",$opts{debug_type},"]: preprocessor level: ", scalar(@preprocessor_conds), "\n"
 219               if $opts{debug};
 220           return ();
 221       },
 222     },
 223     { regexp   => qr/#endif ?/,
 224       massager => sub {
 225           my %opts;
 226           if (ref($_[$#_]) eq "HASH") {
 227               %opts = %{$_[$#_]};
 228               pop @_;
 229           }
 230           die "An #endif without corresponding condition$opts{PLACE}"
 231               if !@preprocessor_conds;
 232           pop @preprocessor_conds;
 233           print STDERR "DEBUG[",$opts{debug_type},"]: preprocessor level: ", scalar(@preprocessor_conds), "\n"
 234               if $opts{debug};
 235           return ();
 236       },
 237     },
 238     { regexp   => qr/#define ([[:alpha:]_]\w*)(<<<\(.*?\)>>>)?( (.*))?/,
 239       massager => sub {
 240           my $name = $1;
 241           my $params = $2;
 242           my $spaceval = $3||"";
 243           my $val = $4||"";
 244           return ("",
 245                   $1, 'M', "", $params ? "$name$params$spaceval" : $val,
 246                   all_conds()); }
 247     },
 248     { regexp   => qr/#.*/,
 249       massager => sub { return (); }
 250     },
 251     );
 252
 253 my @opensslchandlers = (
 254     ##################################################################
 255     # OpenSSL C specials
 256     #
 257     # They are really preprocessor stuff, but they look like C stuff
 258     # to this parser.  All of these do replacements, anything else is
 259     # an error.
 260
 261     #####
 262     # Deprecated stuff, by OpenSSL release.
 263
 264     # OSSL_DEPRECATEDIN_x_y[_z] is simply ignored.  Such declarations are
 265     # supposed to be guarded with an '#ifdef OPENSSL_NO_DEPRECATED_x_y[_z]'
 266     { regexp   => qr/OSSL_DEPRECATEDIN_\d+_\d+(?:_\d+)?\s+(.*)/,
 267       massager => sub { return $1; },
 268     },
 269     { regexp   => qr/(.*?)\s+OSSL_DEPRECATEDIN_\d+_\d+(?:_\d+)?\s+(.*)/,
 270       massager => sub { return "$1 $2"; },
 271     },
 272
 273     #####
 274     # Core stuff
 275
 276     # OSSL_CORE_MAKE_FUNC is a macro to create the necessary data and inline
 277     # function the libcrypto<->provider interface
 278     { regexp   => qr/OSSL_CORE_MAKE_FUNC<<<\((.*?),(.*?),(.*?)\)>>>/,
 279       massager => sub {
 280           return (<<"EOF");
 281 typedef $1 OSSL_FUNC_$2_fn$3;
 282 static ossl_inline OSSL_FUNC_$2_fn *OSSL_FUNC_$2(const OSSL_DISPATCH *opf);
 283 EOF
 284       },
 285     },
 286
 287     #####
 288     # LHASH stuff
 289
 290     # LHASH_OF(foo) is used as a type, but the chandlers won't take it
 291     # gracefully, so we expand it here.
 292     { regexp   => qr/(.*)\bLHASH_OF<<<\((.*?)\)>>>(.*)/,
 293       massager => sub { return ("$1struct lhash_st_$2$3"); }
 294     },
 295     { regexp   => qr/DEFINE_LHASH_OF(?:_INTERNAL)?<<<\((.*)\)>>>/,
 296       massager => sub {
 297           return (<<"EOF");
 298 static ossl_inline LHASH_OF($1) * lh_$1_new(unsigned long (*hfn)(const $1 *),
 299                                             int (*cfn)(const $1 *, const $1 *));
 300 static ossl_inline void lh_$1_free(LHASH_OF($1) *lh);
 301 static ossl_inline $1 *lh_$1_insert(LHASH_OF($1) *lh, $1 *d);
 302 static ossl_inline $1 *lh_$1_delete(LHASH_OF($1) *lh, const $1 *d);
 303 static ossl_inline $1 *lh_$1_retrieve(LHASH_OF($1) *lh, const $1 *d);
 304 static ossl_inline int lh_$1_error(LHASH_OF($1) *lh);
 305 static ossl_inline unsigned long lh_$1_num_items(LHASH_OF($1) *lh);
 306 static ossl_inline void lh_$1_node_stats_bio(const LHASH_OF($1) *lh, BIO *out);
 307 static ossl_inline void lh_$1_node_usage_stats_bio(const LHASH_OF($1) *lh,
 308                                                    BIO *out);
 309 static ossl_inline void lh_$1_stats_bio(const LHASH_OF($1) *lh, BIO *out);
 310 static ossl_inline unsigned long lh_$1_get_down_load(LHASH_OF($1) *lh);
 311 static ossl_inline void lh_$1_set_down_load(LHASH_OF($1) *lh, unsigned long dl);
 312 static ossl_inline void lh_$1_doall(LHASH_OF($1) *lh, void (*doall)($1 *));
 313 LHASH_OF($1)
 314 EOF
 315       }
 316      },
 317
 318     #####
 319     # STACK stuff
 320
 321     # STACK_OF(foo) is used as a type, but the chandlers won't take it
 322     # gracefully, so we expand it here.
 323     { regexp   => qr/(.*)\bSTACK_OF<<<\((.*?)\)>>>(.*)/,
 324       massager => sub { return ("$1struct stack_st_$2$3"); }
 325     },
 326 #    { regexp   => qr/(.*)\bSTACK_OF\((.*?)\)(.*)/,
 327 #      massager => sub {
 328 #          my $before = $1;
 329 #          my $stack_of = "struct stack_st_$2";
 330 #          my $after = $3;
 331 #          if ($after =~ m|^\w|) { $after = " ".$after; }
 332 #          return ("$before$stack_of$after");
 333 #      }
 334 #    },
 335     { regexp   => qr/SKM_DEFINE_STACK_OF<<<\((.*),\s*(.*),\s*(.*)\)>>>/,
 336       massager => sub {
 337           return (<<"EOF");
 338 STACK_OF($1);
 339 typedef int (*sk_$1_compfunc)(const $3 * const *a, const $3 *const *b);
 340 typedef void (*sk_$1_freefunc)($3 *a);
 341 typedef $3 * (*sk_$1_copyfunc)(const $3 *a);
 342 static ossl_inline int sk_$1_num(const STACK_OF($1) *sk);
 343 static ossl_inline $2 *sk_$1_value(const STACK_OF($1) *sk, int idx);
 344 static ossl_inline STACK_OF($1) *sk_$1_new(sk_$1_compfunc compare);
 345 static ossl_inline STACK_OF($1) *sk_$1_new_null(void);
 346 static ossl_inline STACK_OF($1) *sk_$1_new_reserve(sk_$1_compfunc compare,
 347                                                    int n);
 348 static ossl_inline int sk_$1_reserve(STACK_OF($1) *sk, int n);
 349 static ossl_inline void sk_$1_free(STACK_OF($1) *sk);
 350 static ossl_inline void sk_$1_zero(STACK_OF($1) *sk);
 351 static ossl_inline $2 *sk_$1_delete(STACK_OF($1) *sk, int i);
 352 static ossl_inline $2 *sk_$1_delete_ptr(STACK_OF($1) *sk, $2 *ptr);
 353 static ossl_inline int sk_$1_push(STACK_OF($1) *sk, $2 *ptr);
 354 static ossl_inline int sk_$1_unshift(STACK_OF($1) *sk, $2 *ptr);
 355 static ossl_inline $2 *sk_$1_pop(STACK_OF($1) *sk);
 356 static ossl_inline $2 *sk_$1_shift(STACK_OF($1) *sk);
 357 static ossl_inline void sk_$1_pop_free(STACK_OF($1) *sk,
 358                                        sk_$1_freefunc freefunc);
 359 static ossl_inline int sk_$1_insert(STACK_OF($1) *sk, $2 *ptr, int idx);
 360 static ossl_inline $2 *sk_$1_set(STACK_OF($1) *sk, int idx, $2 *ptr);
 361 static ossl_inline int sk_$1_find(STACK_OF($1) *sk, $2 *ptr);
 362 static ossl_inline int sk_$1_find_ex(STACK_OF($1) *sk, $2 *ptr);
 363 static ossl_inline void sk_$1_sort(STACK_OF($1) *sk);
 364 static ossl_inline int sk_$1_is_sorted(const STACK_OF($1) *sk);
 365 static ossl_inline STACK_OF($1) * sk_$1_dup(const STACK_OF($1) *sk);
 366 static ossl_inline STACK_OF($1) *sk_$1_deep_copy(const STACK_OF($1) *sk,
 367                                                  sk_$1_copyfunc copyfunc,
 368                                                  sk_$1_freefunc freefunc);
 369 static ossl_inline sk_$1_compfunc sk_$1_set_cmp_func(STACK_OF($1) *sk,
 370                                                      sk_$1_compfunc compare);
 371 EOF
 372       }
 373     },
 374     { regexp   => qr/SKM_DEFINE_STACK_OF_INTERNAL<<<\((.*),\s*(.*),\s*(.*)\)>>>/,
 375       massager => sub {
 376           return (<<"EOF");
 377 STACK_OF($1);
 378 typedef int (*sk_$1_compfunc)(const $3 * const *a, const $3 *const *b);
 379 typedef void (*sk_$1_freefunc)($3 *a);
 380 typedef $3 * (*sk_$1_copyfunc)(const $3 *a);
 381 static ossl_unused ossl_inline $2 *ossl_check_$1_type($2 *ptr);
 382 static ossl_unused ossl_inline const OPENSSL_STACK *ossl_check_const_$1_sk_type(const STACK_OF($1) *sk);
 383 static ossl_unused ossl_inline OPENSSL_sk_compfunc ossl_check_$1_compfunc_type(sk_$1_compfunc cmp);
 384 static ossl_unused ossl_inline OPENSSL_sk_copyfunc ossl_check_$1_copyfunc_type(sk_$1_copyfunc cpy);
 385 static ossl_unused ossl_inline OPENSSL_sk_freefunc ossl_check_$1_freefunc_type(sk_$1_freefunc fr);
 386 EOF
 387       }
 388     },
 389     { regexp   => qr/DEFINE_SPECIAL_STACK_OF<<<\((.*),\s*(.*)\)>>>/,
 390       massager => sub { return ("SKM_DEFINE_STACK_OF($1,$2,$2)"); },
 391     },
 392     { regexp   => qr/DEFINE_STACK_OF<<<\((.*)\)>>>/,
 393       massager => sub { return ("SKM_DEFINE_STACK_OF($1,$1,$1)"); },
 394     },
 395     { regexp   => qr/DEFINE_SPECIAL_STACK_OF_CONST<<<\((.*),\s*(.*)\)>>>/,
 396       massager => sub { return ("SKM_DEFINE_STACK_OF($1,const $2,$2)"); },
 397     },
 398     { regexp   => qr/DEFINE_STACK_OF_CONST<<<\((.*)\)>>>/,
 399       massager => sub { return ("SKM_DEFINE_STACK_OF($1,const $1,$1)"); },
 400     },
 401
 402     #####
 403     # ASN1 stuff
 404     { regexp   => qr/DECLARE_ASN1_ITEM<<<\((.*)\)>>>/,
 405       massager => sub {
 406           return (<<"EOF");
 407 const ASN1_ITEM *$1_it(void);
 408 EOF
 409       },
 410     },
 411     { regexp   => qr/DECLARE_ASN1_ENCODE_FUNCTIONS_only<<<\((.*),\s*(.*)\)>>>/,
 412       massager => sub {
 413           return (<<"EOF");
 414 int d2i_$2(void);
 415 int i2d_$2(void);
 416 EOF
 417       },
 418     },
 419     { regexp   => qr/DECLARE_ASN1_ENCODE_FUNCTIONS<<<\((.*),\s*(.*),\s*(.*)\)>>>/,
 420       massager => sub {
 421           return (<<"EOF");
 422 int d2i_$3(void);
 423 int i2d_$3(void);
 424 DECLARE_ASN1_ITEM($2)
 425 EOF
 426       },
 427     },
 428     { regexp   => qr/DECLARE_ASN1_ENCODE_FUNCTIONS_name<<<\((.*),\s*(.*)\)>>>/,
 429       massager => sub {
 430           return (<<"EOF");
 431 int d2i_$2(void);
 432 int i2d_$2(void);
 433 DECLARE_ASN1_ITEM($2)
 434 EOF
 435       },
 436     },
 437     { regexp   => qr/DECLARE_ASN1_ALLOC_FUNCTIONS_name<<<\((.*),\s*(.*)\)>>>/,
 438       massager => sub {
 439           return (<<"EOF");
 440 int $2_free(void);
 441 int $2_new(void);
 442 EOF
 443       },
 444     },
 445     { regexp   => qr/DECLARE_ASN1_ALLOC_FUNCTIONS<<<\((.*)\)>>>/,
 446       massager => sub {
 447           return (<<"EOF");
 448 int $1_free(void);
 449 int $1_new(void);
 450 EOF
 451       },
 452     },
 453     { regexp   => qr/DECLARE_ASN1_FUNCTIONS_name<<<\((.*),\s*(.*)\)>>>/,
 454       massager => sub {
 455           return (<<"EOF");
 456 int d2i_$2(void);
 457 int i2d_$2(void);
 458 int $2_free(void);
 459 int $2_new(void);
 460 DECLARE_ASN1_ITEM($2)
 461 EOF
 462       },
 463     },
 464     { regexp   => qr/DECLARE_ASN1_FUNCTIONS<<<\((.*)\)>>>/,
 465       massager => sub { return (<<"EOF");
 466 int d2i_$1(void);
 467 int i2d_$1(void);
 468 int $1_free(void);
 469 int $1_new(void);
 470 DECLARE_ASN1_ITEM($1)
 471 EOF
 472       }
 473     },
 474     { regexp   => qr/DECLARE_ASN1_NDEF_FUNCTION<<<\((.*)\)>>>/,
 475       massager => sub {
 476           return (<<"EOF");
 477 int i2d_$1_NDEF(void);
 478 EOF
 479       }
 480     },
 481     { regexp   => qr/DECLARE_ASN1_PRINT_FUNCTION<<<\((.*)\)>>>/,
 482       massager => sub {
 483           return (<<"EOF");
 484 int $1_print_ctx(void);
 485 EOF
 486       }
 487     },
 488     { regexp   => qr/DECLARE_ASN1_PRINT_FUNCTION_name<<<\((.*),\s*(.*)\)>>>/,
 489       massager => sub {
 490           return (<<"EOF");
 491 int $2_print_ctx(void);
 492 EOF
 493       }
 494     },
 495     { regexp   => qr/DECLARE_ASN1_SET_OF<<<\((.*)\)>>>/,
 496       massager => sub { return (); }
 497     },
 498     { regexp   => qr/DECLARE_ASN1_DUP_FUNCTION<<<\((.*)\)>>>/,
 499       massager => sub {
 500           return (<<"EOF");
 501 int $1_dup(void);
 502 EOF
 503       }
 504     },
 505     { regexp   => qr/DECLARE_ASN1_DUP_FUNCTION_name<<<\((.*),\s*(.*)\)>>>/,
 506       massager => sub {
 507           return (<<"EOF");
 508 int $2_dup(void);
 509 EOF
 510       }
 511     },
 512     # Universal translator of attributed PEM declarators
 513     { regexp   => qr/
 514           DECLARE_ASN1
 515           (_ENCODE_FUNCTIONS_only|_ENCODE_FUNCTIONS|_ENCODE_FUNCTIONS_name
 516            |_ALLOC_FUNCTIONS_name|_ALLOC_FUNCTIONS|_FUNCTIONS_name|_FUNCTIONS
 517            |_NDEF_FUNCTION|_PRINT_FUNCTION|_PRINT_FUNCTION_name
 518            |_DUP_FUNCTION|_DUP_FUNCTION_name)
 519           _attr
 520           <<<\(\s*OSSL_DEPRECATEDIN_(.*?)\s*,(.*?)\)>>>
 521       /x,
 522       massager => sub { return (<<"EOF");
 523 DECLARE_ASN1$1($3)
 524 EOF
 525       },
 526     },
 527     { regexp   => qr/DECLARE_PKCS12_SET_OF<<<\((.*)\)>>>/,
 528       massager => sub { return (); }
 529     },
 530
 531     #####
 532     # PEM stuff
 533     { regexp   => qr/DECLARE_PEM(?|_rw|_rw_cb|_rw_const)<<<\((.*?),.*\)>>>/,
 534       massager => sub { return (<<"EOF");
 535 #ifndef OPENSSL_NO_STDIO
 536 int PEM_read_$1(void);
 537 int PEM_write_$1(void);
 538 #endif
 539 int PEM_read_bio_$1(void);
 540 int PEM_write_bio_$1(void);
 541 EOF
 542       },
 543     },
 544     { regexp   => qr/DECLARE_PEM(?|_rw|_rw_cb|_rw_const)_ex<<<\((.*?),.*\)>>>/,
 545       massager => sub { return (<<"EOF");
 546 #ifndef OPENSSL_NO_STDIO
 547 int PEM_read_$1(void);
 548 int PEM_write_$1(void);
 549 int PEM_read_$1_ex(void);
 550 int PEM_write_$1_ex(void);
 551 #endif
 552 int PEM_read_bio_$1(void);
 553 int PEM_write_bio_$1(void);
 554 int PEM_read_bio_$1_ex(void);
 555 int PEM_write_bio_$1_ex(void);
 556 EOF
 557       },
 558     },
 559     { regexp   => qr/DECLARE_PEM(?|_write|_write_cb|_write_const)<<<\((.*?),.*\)>>>/,
 560       massager => sub { return (<<"EOF");
 561 #ifndef OPENSSL_NO_STDIO
 562 int PEM_write_$1(void);
 563 #endif
 564 int PEM_write_bio_$1(void);
 565 EOF
 566       },
 567     },
 568     { regexp   => qr/DECLARE_PEM(?|_write|_write_cb|_write_const)_ex<<<\((.*?),.*\)>>>/,
 569       massager => sub { return (<<"EOF");
 570 #ifndef OPENSSL_NO_STDIO
 571 int PEM_write_$1(void);
 572 int PEM_write_$1_ex(void);
 573 #endif
 574 int PEM_write_bio_$1(void);
 575 int PEM_write_bio_$1_ex(void);
 576 EOF
 577       },
 578     },
 579     { regexp   => qr/DECLARE_PEM(?|_read|_read_cb)<<<\((.*?),.*\)>>>/,
 580       massager => sub { return (<<"EOF");
 581 #ifndef OPENSSL_NO_STDIO
 582 int PEM_read_$1(void);
 583 #endif
 584 int PEM_read_bio_$1(void);
 585 EOF
 586       },
 587     },
 588     { regexp   => qr/DECLARE_PEM(?|_read|_read_cb)_ex<<<\((.*?),.*\)>>>/,
 589       massager => sub { return (<<"EOF");
 590 #ifndef OPENSSL_NO_STDIO
 591 int PEM_read_$1(void);
 592 int PEM_read_$1_ex(void);
 593 #endif
 594 int PEM_read_bio_$1(void);
 595 int PEM_read_bio_$1_ex(void);
 596 EOF
 597       },
 598     },
 599     # Universal translator of attributed PEM declarators
 600     { regexp   => qr/
 601           DECLARE_PEM
 602           ((?:_rw|_rw_cb|_rw_const|_write|_write_cb|_write_const|_read|_read_cb)
 603            (?:_ex)?)
 604           _attr
 605           <<<\(\s*OSSL_DEPRECATEDIN_(.*?)\s*,(.*?)\)>>>
 606       /x,
 607       massager => sub { return (<<"EOF");
 608 DECLARE_PEM$1($3)
 609 EOF
 610       },
 611     },
 612
 613     # Spurious stuff found in the OpenSSL headers
 614     # Usually, these are just macros that expand to, well, something
 615     { regexp   => qr/__NDK_FPABI__/,
 616       massager => sub { return (); }
 617     },
 618     );
 619
 620 my $anoncnt = 0;
 621
 622 my @chandlers = (
 623     ##################################################################
 624     # C stuff
 625
 626     # extern "C" of individual items
 627     # Note that the main parse function has a special hack for 'extern "C" {'
 628     # which can't be done in handlers
 629     # We simply ignore it.
 630     { regexp   => qr/^extern "C" (.*(?:;|>>>))/,
 631       massager => sub { return ($1); },
 632     },
 633     # any other extern is just ignored
 634     { regexp   => qr/^\s*                       # Any spaces before
 635                      extern                     # The keyword we look for
 636                      \b                         # word to non-word boundary
 637                      .*                         # Anything after
 638                      ;
 639                     /x,
 640       massager => sub { return (); },
 641     },
 642     # union, struct and enum definitions
 643     # Because this one might appear a little everywhere within type
 644     # definitions, we take it out and replace it with just
 645     # 'union|struct|enum name' while registering it.
 646     # This makes use of the parser trick to surround the outer braces
 647     # with <<< and >>>
 648     { regexp   => qr/(.*)                       # Anything before       ($1)
 649                      \b                         # word to non-word boundary
 650                      (union|struct|enum)        # The word used         ($2)
 651                      (?:\s([[:alpha:]_]\w*))?   # Struct or enum name   ($3)
 652                      <<<(\{.*?\})>>>            # Struct or enum definition ($4)
 653                      (.*)                       # Anything after        ($5)
 654                      ;
 655                     /x,
 656       massager => sub {
 657           my $before = $1;
 658           my $word = $2;
 659           my $name = $3
 660               || sprintf("__anon%03d", ++$anoncnt); # Anonymous struct
 661           my $definition = $4;
 662           my $after = $5;
 663           my $type = $word eq "struct" ? 'S' : 'E';
 664           if ($before ne "" || $after ne ";") {
 665               if ($after =~ m|^\w|) { $after = " ".$after; }
 666               return ("$before$word $name$after;",
 667                       "$word $name", $type, "", "$word$definition", all_conds());
 668           }
 669           # If there was no before nor after, make the return much simple
 670           return ("", "$word $name", $type, "", "$word$definition", all_conds());
 671       }
 672     },
 673     # Named struct and enum forward declarations
 674     # We really just ignore them, but we need to parse them or the variable
 675     # declaration handler further down will think it's a variable declaration.
 676     { regexp   => qr/^(union|struct|enum) ([[:alpha:]_]\w*);/,
 677       massager => sub { return (); }
 678     },
 679     # Function returning function pointer declaration
 680     # This sort of declaration may have a body (inline functions, for example)
 681     { regexp   => qr/(?:(typedef)\s?)?          # Possible typedef      ($1)
 682                      ((?:\w|\*|\s)*?)           # Return type           ($2)
 683                      \s?                        # Possible space
 684                      <<<\(\*
 685                      ([[:alpha:]_]\w*)          # Function name         ($3)
 686                      (\(.*\))                   # Parameters            ($4)
 687                      \)>>>
 688                      <<<(\(.*\))>>>             # F.p. parameters       ($5)
 689                      (?:<<<\{.*\}>>>|;)         # Body or semicolon
 690                     /x,
 691       massager => sub {
 692           return ("", $3, 'T', "", "$2(*$4)$5", all_conds())
 693               if defined $1;
 694           return ("", $3, 'F', "$2(*)$5", "$2(*$4)$5", all_conds()); }
 695     },
 696     # Function pointer declaration, or typedef thereof
 697     # This sort of declaration never has a function body
 698     { regexp   => qr/(?:(typedef)\s?)?          # Possible typedef      ($1)
 699                      ((?:\w|\*|\s)*?)           # Return type           ($2)
 700                      <<<\(\*([[:alpha:]_]\w*)\)>>> # T.d. or var name   ($3)
 701                      <<<(\(.*\))>>>             # F.p. parameters       ($4)
 702                      ;
 703                     /x,
 704       massager => sub {
 705           return ("", $3, 'T', "", "$2(*)$4", all_conds())
 706               if defined $1;
 707           return ("", $3, 'V', "$2(*)$4", "$2(*)$4", all_conds());
 708       },
 709     },
 710     # Function declaration, or typedef thereof
 711     # This sort of declaration may have a body (inline functions, for example)
 712     { regexp   => qr/(?:(typedef)\s?)?          # Possible typedef      ($1)
 713                      ((?:\w|\*|\s)*?)           # Return type           ($2)
 714                      \s?                        # Possible space
 715                      ([[:alpha:]_]\w*)          # Function name         ($3)
 716                      <<<(\(.*\))>>>             # Parameters            ($4)
 717                      (?:<<<\{.*\}>>>|;)         # Body or semicolon
 718                     /x,
 719       massager => sub {
 720           return ("", $3, 'T', "", "$2$4", all_conds())
 721               if defined $1;
 722           return ("", $3, 'F', $2, "$2$4", all_conds());
 723       },
 724     },
 725     # Variable declaration, including arrays, or typedef thereof
 726     { regexp   => qr/(?:(typedef)\s?)?          # Possible typedef      ($1)
 727                      ((?:\w|\*|\s)*?)           # Type                  ($2)
 728                      \s?                        # Possible space
 729                      ([[:alpha:]_]\w*)          # Variable name         ($3)
 730                      ((?:<<<\[[^\]]*\]>>>)*)    # Possible array declaration ($4)
 731                      ;
 732                     /x,
 733       massager => sub {
 734           return ("", $3, 'T', "", $2.($4||""), all_conds())
 735               if defined $1;
 736           return ("", $3, 'V', $2.($4||""), $2.($4||""), all_conds());
 737       },
 738     },
 739 );
 740
 741 # End handlers are almost the same as handlers, except they are run through
 742 # ONCE when the input has been parsed through.  These are used to check for
 743 # remaining stuff, such as an unfinished #ifdef and stuff like that that the
 744 # main parser can't check on its own.
 745 my @endhandlers = (
 746     { massager => sub {
 747         my %opts = %{$_[0]};
 748
 749         die "Unfinished preprocessor conditions levels: ",scalar(@preprocessor_conds),($opts{filename} ? " in file ".$opts{filename}: ""),$opts{PLACE}
 750             if @preprocessor_conds;
 751       }
 752     }
 753     );
 754
 755 # takes a list of strings that can each contain one or several lines of code
 756 # also takes a hash of options as last argument.
 757 #
 758 # returns a list of hashes with information:
 759 #
 760 #       name            name of the thing
 761 #       type            type, see the massage handler function
 762 #       returntype      return type of functions and variables
 763 #       value           value for macros, signature for functions, variables
 764 #                       and structs
 765 #       conds           preprocessor conditions (array ref)
 766
 767 sub parse {
 768     my %opts;
 769     if (ref($_[$#_]) eq "HASH") {
 770         %opts = %{$_[$#_]};
 771         pop @_;
 772     }
 773     my %state = (
 774         in_extern_C => 0,       # An exception to parenthesis processing.
 775         cpp_parens => [],       # A list of ending parens and braces found in
 776                                 # preprocessor directives
 777         c_parens => [],         # A list of ending parens and braces found in
 778                                 # C statements
 779         in_string => "",        # empty string when outside a string, otherwise
 780                                 # "'" or '"' depending on the starting quote.
 781         in_comment => "",       # empty string when outside a comment, otherwise
 782                                 # "/*" or "//" depending on the type of comment
 783                                 # found.  The latter will never be multiline
 784                                 # NOTE: in_string and in_comment will never be
 785                                 # true (in perl semantics) at the same time.
 786         current_line => 0,
 787         );
 788     my @result = ();
 789     my $normalized_line = "";   # $input_line, but normalized.  In essence, this
 790                                 # means that ALL whitespace is removed unless
 791                                 # it absolutely has to be present, and in that
 792                                 # case, there's only one space.
 793                                 # The cases where a space needs to stay present
 794                                 # are:
 795                                 # 1. between words
 796                                 # 2. between words and number
 797                                 # 3. after the first word of a preprocessor
 798                                 #    directive.
 799                                 # 4. for the #define directive, between the macro
 800                                 #    name/args and its value, so we end up with:
 801                                 #       #define FOO val
 802                                 #       #define BAR(x) something(x)
 803     my $collected_stmt = "";    # Where we're building up a C line until it's a
 804                                 # complete definition/declaration, as determined
 805                                 # by any handler being capable of matching it.
 806
 807     # We use $_ shamelessly when looking through @lines.
 808     # In case we find a \ at the end, we keep filling it up with more lines.
 809     $_ = undef;
 810
 811     foreach my $line (@_) {
 812         # split tries to be smart when a string ends with the thing we split on
 813         $line .= "\n" unless $line =~ m|\R$|;
 814         $line .= "#";
 815
 816         # We use ¦undef¦ as a marker for a new line from the file.
 817         # Since we convert one line to several and unshift that into @lines,
 818         # that's the only safe way we have to track the original lines
 819         my @lines = map { ( undef, $_ ) } split $/, $line;
 820
 821         # Remember that extra # we added above?  Now we remove it
 822         pop @lines;
 823         pop @lines;             # Don't forget the undef
 824
 825         while (@lines) {
 826             if (!defined($lines[0])) {
 827                 shift @lines;
 828                 $state{current_line}++;
 829                 if (!defined($_)) {
 830                     $opts{PLACE} = " at ".$opts{filename}." line ".$state{current_line}."\n";
 831                     $opts{PLACE2} = $opts{filename}.":".$state{current_line};
 832                 }
 833                 next;
 834             }
 835
 836             $_ = "" unless defined $_;
 837             $_ .= shift @lines;
 838
 839             if (m|\\$|) {
 840                 $_ = $`;
 841                 next;
 842             }
 843
 844             if ($opts{debug}) {
 845                 print STDERR "DEBUG:----------------------------\n";
 846                 print STDERR "DEBUG: \$_      = '$_'\n";
 847             }
 848
 849             ##########################################################
 850             # Now that we have a full line, let's process through it
 851             while(1) {
 852                 unless ($state{in_comment}) {
 853                     # Begin with checking if the current $normalized_line
 854                     # contains a preprocessor directive
 855                     # This is only done if we're not inside a comment and
 856                     # if it's a preprocessor directive and it's finished.
 857                     if ($normalized_line =~ m|^#| && $_ eq "") {
 858                         print STDERR "DEBUG[OPENSSL CPP]: \$normalized_line = '$normalized_line'\n"
 859                             if $opts{debug};
 860                         $opts{debug_type} = "OPENSSL CPP";
 861                         my @r = ( _run_handlers($normalized_line,
 862                                                 @opensslcpphandlers,
 863                                                 \%opts) );
 864                         if (shift @r) {
 865                             # Checking if there are lines to inject.
 866                             if (@r) {
 867                                 @r = split $/, (pop @r).$_;
 868                                 print STDERR "DEBUG[OPENSSL CPP]: injecting '", join("', '", @r),"'\n"
 869                                     if $opts{debug} && @r;
 870                                 @lines = ( @r, @lines );
 871
 872                                 $_ = "";
 873                             }
 874                         } else {
 875                             print STDERR "DEBUG[CPP]: \$normalized_line = '$normalized_line'\n"
 876                                 if $opts{debug};
 877                             $opts{debug_type} = "CPP";
 878                             my @r = ( _run_handlers($normalized_line,
 879                                                     @cpphandlers,
 880                                                     \%opts) );
 881                             if (shift @r) {
 882                                 if (ref($r[0]) eq "HASH") {
 883                                     push @result, shift @r;
 884                                 }
 885
 886                                 # Now, check if there are lines to inject.
 887                                 # Really, this should never happen, it IS a
 888                                 # preprocessor directive after all...
 889                                 if (@r) {
 890                                     @r = split $/, pop @r;
 891                                     print STDERR "DEBUG[CPP]: injecting '", join("', '", @r),"'\n"
 892                                     if $opts{debug} && @r;
 893                                     @lines = ( @r, @lines );
 894                                     $_ = "";
 895                                 }
 896                             }
 897                         }
 898
 899                         # Note: we simply ignore all directives that no
 900                         # handler matches
 901                         $normalized_line = "";
 902                     }
 903
 904                     # If the two strings end and start with a character that
 905                     # shouldn't get concatenated, add a space
 906                     my $space =
 907                         ($collected_stmt =~ m/(?:"|')$/
 908                          || ($collected_stmt =~ m/(?:\w|\d)$/
 909                              && $normalized_line =~ m/^(?:\w|\d)/)) ? " " : "";
 910
 911                     # Now, unless we're building up a preprocessor directive or
 912                     # are in the middle of a string, or the parens et al aren't
 913                     # balanced up yet, let's try and see if there's a OpenSSL
 914                     # or C handler that can make sense of what we have so far.
 915                     if ( $normalized_line !~ m|^#|
 916                          && ($collected_stmt ne "" || $normalized_line ne "")
 917                          && ! @{$state{c_parens}}
 918                          && ! $state{in_string} ) {
 919                         if ($opts{debug}) {
 920                             print STDERR "DEBUG[OPENSSL C]: \$collected_stmt  = '$collected_stmt'\n";
 921                             print STDERR "DEBUG[OPENSSL C]: \$normalized_line = '$normalized_line'\n";
 922                         }
 923                         $opts{debug_type} = "OPENSSL C";
 924                         my @r = ( _run_handlers($collected_stmt
 925                                                     .$space
 926                                                     .$normalized_line,
 927                                                 @opensslchandlers,
 928                                                 \%opts) );
 929                         if (shift @r) {
 930                             # Checking if there are lines to inject.
 931                             if (@r) {
 932                                 @r = split $/, (pop @r).$_;
 933                                 print STDERR "DEBUG[OPENSSL]: injecting '", join("', '", @r),"'\n"
 934                                     if $opts{debug} && @r;
 935                                 @lines = ( @r, @lines );
 936
 937                                 $_ = "";
 938                             }
 939                             $normalized_line = "";
 940                             $collected_stmt = "";
 941                         } else {
 942                             if ($opts{debug}) {
 943                                 print STDERR "DEBUG[C]: \$collected_stmt  = '$collected_stmt'\n";
 944                                 print STDERR "DEBUG[C]: \$normalized_line = '$normalized_line'\n";
 945                             }
 946                             $opts{debug_type} = "C";
 947                             my @r = ( _run_handlers($collected_stmt
 948                                                         .$space
 949                                                         .$normalized_line,
 950                                                     @chandlers,
 951                                                     \%opts) );
 952                             if (shift @r) {
 953                                 if (ref($r[0]) eq "HASH") {
 954                                     push @result, shift @r;
 955                                 }
 956
 957                                 # Checking if there are lines to inject.
 958                                 if (@r) {
 959                                     @r = split $/, (pop @r).$_;
 960                                     print STDERR "DEBUG[C]: injecting '", join("', '", @r),"'\n"
 961                                         if $opts{debug} && @r;
 962                                     @lines = ( @r, @lines );
 963
 964                                     $_ = "";
 965                                 }
 966                                 $normalized_line = "";
 967                                 $collected_stmt = "";
 968                             }
 969                         }
 970                     }
 971                     if ($_ eq "") {
 972                         $collected_stmt .= $space.$normalized_line;
 973                         $normalized_line = "";
 974                     }
 975                 }
 976
 977                 if ($_ eq "") {
 978                     $_ = undef;
 979                     last;
 980                 }
 981
 982                 # Take care of inside string first.
 983                 if ($state{in_string}) {
 984                     if (m/ (?:^|(?<!\\))        # Make sure it's not escaped
 985                            $state{in_string}    # Look for matching quote
 986                          /x) {
 987                         $normalized_line .= $`.$&;
 988                         $state{in_string} = "";
 989                         $_ = $';
 990                         next;
 991                     } else {
 992                         die "Unfinished string without continuation found$opts{PLACE}\n";
 993                     }
 994                 }
 995                 # ... or inside comments, whichever happens to apply
 996                 elsif ($state{in_comment}) {
 997
 998                     # This should never happen
 999                     die "Something went seriously wrong, multiline //???$opts{PLACE}\n"
1000                         if ($state{in_comment} eq "//");
1001
1002                     # A note: comments are simply discarded.
1003
1004                     if (m/ (?:^|(?<!\\))        # Make sure it's not escaped
1005                            \*\/                 # Look for C comment end
1006                          /x) {
1007                         $state{in_comment} = "";
1008                         $_ = $';
1009                         print STDERR "DEBUG: Found end of comment, followed by '$_'\n"
1010                             if $opts{debug};
1011                         next;
1012                     } else {
1013                         $_ = "";
1014                         next;
1015                     }
1016                 }
1017
1018                 # At this point, it's safe to remove leading whites, but
1019                 # we need to be careful with some preprocessor lines
1020                 if (m|^\s+|) {
1021                     my $rest = $';
1022                     my $space = "";
1023                     $space = " "
1024                         if ($normalized_line =~ m/^
1025                                                   \#define\s\w(?:\w|\d)*(?:<<<\([^\)]*\)>>>)?
1026                                                   | \#[a-z]+
1027                                                   $/x);
1028                     print STDERR "DEBUG: Processing leading spaces: \$normalized_line = '$normalized_line', \$space = '$space', \$rest = '$rest'\n"
1029                         if $opts{debug};
1030                     $_ = $space.$rest;
1031                 }
1032
1033                 my $parens =
1034                     $normalized_line =~ m|^#| ? 'cpp_parens' : 'c_parens';
1035                 (my $paren_singular = $parens) =~ s|s$||;
1036
1037                 # Now check for specific tokens, and if they are parens,
1038                 # check them against $state{$parens}.  Note that we surround
1039                 # the outermost parens with extra "<<<" and ">>>".  Those
1040                 # are for the benefit of handlers who to need to detect
1041                 # them, and they will be removed from the final output.
1042                 if (m|^[\{\[\(]|) {
1043                     my $body = $&;
1044                     $_ = $';
1045                     if (!@{$state{$parens}}) {
1046                         if ("$normalized_line$body" =~ m|^extern "C"\{$|) {
1047                             $state{in_extern_C} = 1;
1048                             print STDERR "DEBUG: found start of 'extern \"C\"' ($normalized_line$body)\n"
1049                                 if $opts{debug};
1050                             $normalized_line = "";
1051                         } else {
1052                             $normalized_line .= "<<<".$body;
1053                         }
1054                     } else {
1055                         $normalized_line .= $body;
1056                     }
1057
1058                     if ($normalized_line ne "") {
1059                         print STDERR "DEBUG: found $paren_singular start '$body'\n"
1060                             if $opts{debug};
1061                         $body =~ tr|\{\[\(|\}\]\)|;
1062                         print STDERR "DEBUG: pushing $paren_singular end '$body'\n"
1063                             if $opts{debug};
1064                         push @{$state{$parens}}, $body;
1065                     }
1066                 } elsif (m|^[\}\]\)]|) {
1067                     $_ = $';
1068
1069                     if (!@{$state{$parens}}
1070                         && $& eq '}' && $state{in_extern_C}) {
1071                         print STDERR "DEBUG: found end of 'extern \"C\"'\n"
1072                             if $opts{debug};
1073                         $state{in_extern_C} = 0;
1074                     } else {
1075                         print STDERR "DEBUG: Trying to match '$&' against '"
1076                             ,join("', '", @{$state{$parens}})
1077                             ,"'\n"
1078                             if $opts{debug};
1079                         die "Unmatched parentheses$opts{PLACE}\n"
1080                             unless (@{$state{$parens}}
1081                                     && pop @{$state{$parens}} eq $&);
1082                         if (!@{$state{$parens}}) {
1083                             $normalized_line .= $&.">>>";
1084                         } else {
1085                             $normalized_line .= $&;
1086                         }
1087                     }
1088                 } elsif (m|^["']|) { # string start
1089                     my $body = $&;
1090                     $_ = $';
1091
1092                     # We want to separate strings from \w and \d with one space.
1093                     $normalized_line .= " " if $normalized_line =~ m/(\w|\d)$/;
1094                     $normalized_line .= $body;
1095                     $state{in_string} = $body;
1096                 } elsif (m|^\/\*|) { # C style comment
1097                     print STDERR "DEBUG: found start of C style comment\n"
1098                         if $opts{debug};
1099                     $state{in_comment} = $&;
1100                     $_ = $';
1101                 } elsif (m|^\/\/|) { # C++ style comment
1102                     print STDERR "DEBUG: found C++ style comment\n"
1103                         if $opts{debug};
1104                     $_ = "";    # (just discard it entirely)
1105                 } elsif (m/^ (?| (?: 0[xX][[:xdigit:]]+ | 0[bB][01]+ | [0-9]+ )
1106                                  (?i: U | L | UL | LL | ULL )?
1107                                | [0-9]+\.[0-9]+(?:[eE][\-\+]\d+)? (?i: F | L)?
1108                                ) /x) {
1109                     print STDERR "DEBUG: Processing numbers: \$normalized_line = '$normalized_line', \$& = '$&', \$' = '$''\n"
1110                         if $opts{debug};
1111                     $normalized_line .= $&;
1112                     $_ = $';
1113                 } elsif (m/^[[:alpha:]_]\w*/) {
1114                     my $body = $&;
1115                     my $rest = $';
1116                     my $space = "";
1117
1118                     # Now, only add a space if it's needed to separate
1119                     # two \w characters, and we also surround strings with
1120                     # a space.  In this case, that's if $normalized_line ends
1121                     # with a \w, \d, " or '.
1122                     $space = " "
1123                         if ($normalized_line =~ m/("|')$/
1124                             || ($normalized_line =~ m/(\w|\d)$/
1125                                 && $body =~ m/^(\w|\d)/));
1126
1127                     print STDERR "DEBUG: Processing words: \$normalized_line = '$normalized_line', \$space = '$space', \$body = '$body', \$rest = '$rest'\n"
1128                         if $opts{debug};
1129                     $normalized_line .= $space.$body;
1130                     $_ = $rest;
1131                 } elsif (m|^(?:\\)?.|) { # Catch-all
1132                     $normalized_line .= $&;
1133                     $_ = $';
1134                 }
1135             }
1136         }
1137     }
1138     foreach my $handler (@endhandlers) {
1139         if ($handler->{massager}) {
1140             $handler->{massager}->(\%opts);
1141         }
1142     }
1143     return @result;
1144 }
1145
1146 # arg1:    line to check
1147 # arg2...: handlers to check
1148 # return undef when no handler matched
1149 sub _run_handlers {
1150     my %opts;
1151     if (ref($_[$#_]) eq "HASH") {
1152         %opts = %{$_[$#_]};
1153         pop @_;
1154     }
1155     my $line = shift;
1156     my @handlers = @_;
1157
1158     foreach my $handler (@handlers) {
1159         if ($handler->{regexp}
1160             && $line =~ m|^$handler->{regexp}$|) {
1161             if ($handler->{massager}) {
1162                 if ($opts{debug}) {
1163                     print STDERR "DEBUG[",$opts{debug_type},"]: Trying to handle '$line'\n";
1164                     print STDERR "DEBUG[",$opts{debug_type},"]: (matches /\^",$handler->{regexp},"\$/)\n";
1165                 }
1166                 my $saved_line = $line;
1167                 my @massaged =
1168                     map { s/(<<<|>>>)//g; $_ }
1169                     $handler->{massager}->($saved_line, \%opts);
1170                 print STDERR "DEBUG[",$opts{debug_type},"]: Got back '"
1171                     , join("', '", @massaged), "'\n"
1172                     if $opts{debug};
1173
1174                 # Because we may get back new lines to be
1175                 # injected before whatever else that follows,
1176                 # and the injected stuff might include
1177                 # preprocessor lines, we need to inject them
1178                 # in @lines and set $_ to the empty string to
1179                 # break out from the inner loops
1180                 my $injected_lines = shift @massaged || "";
1181
1182                 if (@massaged) {
1183                     return (1,
1184                             {
1185                                 name    => shift @massaged,
1186                                 type    => shift @massaged,
1187                                 returntype => shift @massaged,
1188                                 value   => shift @massaged,
1189                                 conds   => [ @massaged ]
1190                             },
1191                             $injected_lines
1192                         );
1193                 } else {
1194                     print STDERR "DEBUG[",$opts{debug_type},"]:   (ignore, possible side effects)\n"
1195                         if $opts{debug} && $injected_lines eq "";
1196                     return (1, $injected_lines);
1197                 }
1198             }
1199             return (1);
1200         }
1201     }
1202     return (0);
1203 }