util/mkdef.pl

   1 #! /usr/bin/env perl
   2 # Copyright 1995-2017 The OpenSSL Project Authors. All Rights Reserved.
   3 #
   4 # Licensed under the OpenSSL license (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 #
  10 # generate a .def file
  11 #
  12 # It does this by parsing the header files and looking for the
  13 # prototyped functions: it then prunes the output.
  14 #
  15 # Intermediary files are created, call libcrypto.num and libssl.num,
  16 # The format of these files is:
  17 #
  18 #       routine-name    nnnn    vers    info
  19 #
  20 # The "nnnn" and "vers" fields are the numeric id and version for the symbol
  21 # respectively. The "info" part is actually a colon-separated string of fields
  22 # with the following meaning:
  23 #
  24 #       existence:platform:kind:algorithms
  25 #
  26 # - "existence" can be "EXIST" or "NOEXIST" depending on if the symbol is
  27 #   found somewhere in the source,
  28 # - "platforms" is empty if it exists on all platforms, otherwise it contains
  29 #   comma-separated list of the platform, just as they are if the symbol exists
  30 #   for those platforms, or prepended with a "!" if not.  This helps resolve
  31 #   symbol name variants for platforms where the names are too long for the
  32 #   compiler or linker, or if the systems is case insensitive and there is a
  33 #   clash, or the symbol is implemented differently (see
  34 #   EXPORT_VAR_AS_FUNCTION).  This script assumes renaming of symbols is found
  35 #   in the file crypto/symhacks.h.
  36 #   The semantics for the platforms is that every item is checked against the
  37 #   environment.  For the negative items ("!FOO"), if any of them is false
  38 #   (i.e. "FOO" is true) in the environment, the corresponding symbol can't be
  39 #   used.  For the positive items, if all of them are false in the environment,
  40 #   the corresponding symbol can't be used.  Any combination of positive and
  41 #   negative items are possible, and of course leave room for some redundancy.
  42 # - "kind" is "FUNCTION" or "VARIABLE".  The meaning of that is obvious.
  43 # - "algorithms" is a comma-separated list of algorithm names.  This helps
  44 #   exclude symbols that are part of an algorithm that some user wants to
  45 #   exclude.
  46 #
  47
  48 use lib ".";
  49 use configdata;
  50 use File::Spec::Functions;
  51 use File::Basename;
  52 use FindBin;
  53 use lib "$FindBin::Bin/perl";
  54 use OpenSSL::Glob;
  55
  56 # When building a "variant" shared library, with a custom SONAME, also customize
  57 # all the symbol versions.  This produces a shared object that can coexist
  58 # without conflict in the same address space as a default build, or an object
  59 # with a different variant tag.
  60 #
  61 # For example, with a target definition that includes:
  62 #
  63 #         shlib_variant => "-opt",
  64 #
  65 # we build the following objects:
  66 #
  67 # $ perl -le '
  68 #     for (@ARGV) {
  69 #         if ($l = readlink) {
  70 #             printf "%s -> %s\n", $_, $l
  71 #         } else {
  72 #             print
  73 #         }
  74 #     }' *.so*
  75 # libcrypto-opt.so.1.1
  76 # libcrypto.so -> libcrypto-opt.so.1.1
  77 # libssl-opt.so.1.1
  78 # libssl.so -> libssl-opt.so.1.1
  79 #
  80 # whose SONAMEs and dependencies are:
  81 #
  82 # $ for l in *.so; do
  83 #     echo $l
  84 #     readelf -d $l | egrep 'SONAME|NEEDED.*(ssl|crypto)'
  85 #   done
  86 # libcrypto.so
  87 #  0x000000000000000e (SONAME)             Library soname: [libcrypto-opt.so.1.1]
  88 # libssl.so
  89 #  0x0000000000000001 (NEEDED)             Shared library: [libcrypto-opt.so.1.1]
  90 #  0x000000000000000e (SONAME)             Library soname: [libssl-opt.so.1.1]
  91 #
  92 # We case-fold the variant tag to upper case and replace all non-alnum
  93 # characters with "_".  This yields the following symbol versions:
  94 #
  95 # $ nm libcrypto.so | grep -w A
  96 # 0000000000000000 A OPENSSL_OPT_1_1_0
  97 # 0000000000000000 A OPENSSL_OPT_1_1_0a
  98 # 0000000000000000 A OPENSSL_OPT_1_1_0c
  99 # 0000000000000000 A OPENSSL_OPT_1_1_0d
 100 # 0000000000000000 A OPENSSL_OPT_1_1_0f
 101 # 0000000000000000 A OPENSSL_OPT_1_1_0g
 102 # $ nm libssl.so | grep -w A
 103 # 0000000000000000 A OPENSSL_OPT_1_1_0
 104 # 0000000000000000 A OPENSSL_OPT_1_1_0d
 105 #
 106 (my $SO_VARIANT = qq{\U$target{"shlib_variant"}}) =~ s/\W/_/g;
 107
 108 my $debug=0;
 109
 110 my $crypto_num= catfile($config{sourcedir},"util","libcrypto.num");
 111 my $ssl_num=    catfile($config{sourcedir},"util","libssl.num");
 112 my $libname;
 113
 114 my $do_update = 0;
 115 my $do_rewrite = 1;
 116 my $do_crypto = 0;
 117 my $do_ssl = 0;
 118 my $do_ctest = 0;
 119 my $do_ctestall = 0;
 120 my $do_checkexist = 0;
 121
 122 my $VMS=0;
 123 my $W32=0;
 124 my $NT=0;
 125 my $UNIX=0;
 126 my $linux=0;
 127 # Set this to make typesafe STACK definitions appear in DEF
 128 my $safe_stack_def = 0;
 129
 130 my @known_platforms = ( "__FreeBSD__", "PERL5",
 131                         "EXPORT_VAR_AS_FUNCTION", "ZLIB", "_WIN32"
 132                         );
 133 my @known_ossl_platforms = ( "UNIX", "VMS", "WIN32", "WINNT", "OS2" );
 134 my @known_algorithms = ( "RC2", "RC4", "RC5", "IDEA", "DES", "BF",
 135                          "CAST", "MD2", "MD4", "MD5", "SHA", "SHA0", "SHA1",
 136                          "SHA256", "SHA512", "RMD160",
 137                          "MDC2", "WHIRLPOOL", "RSA", "DSA", "DH", "EC", "EC2M",
 138                          "HMAC", "AES", "CAMELLIA", "SEED", "GOST", "ARIA", "SM4",
 139                          "SCRYPT", "CHACHA", "POLY1305", "BLAKE2",
 140                          "SIPHASH", "SM3",
 141                          # EC_NISTP_64_GCC_128
 142                          "EC_NISTP_64_GCC_128",
 143                          # Envelope "algorithms"
 144                          "EVP", "X509", "ASN1_TYPEDEFS",
 145                          # Helper "algorithms"
 146                          "BIO", "COMP", "BUFFER", "LHASH", "STACK", "ERR",
 147                          "LOCKING",
 148                          # External "algorithms"
 149                          "FP_API", "STDIO", "SOCK", "DGRAM",
 150                          "CRYPTO_MDEBUG",
 151                          # Engines
 152                          "STATIC_ENGINE", "ENGINE", "HW", "GMP",
 153                          # Entropy Gathering
 154                          "EGD",
 155                          # Certificate Transparency
 156                          "CT",
 157                          # RFC3779
 158                          "RFC3779",
 159                          # TLS
 160                          "PSK", "SRP", "HEARTBEATS",
 161                          # CMS
 162                          "CMS",
 163                          "OCSP",
 164                          # CryptoAPI Engine
 165                          "CAPIENG",
 166                          # SSL methods
 167                          "SSL3_METHOD", "TLS1_METHOD", "TLS1_1_METHOD", "TLS1_2_METHOD", "DTLS1_METHOD", "DTLS1_2_METHOD",
 168                          # NEXTPROTONEG
 169                          "NEXTPROTONEG",
 170                          # Deprecated functions
 171                          "DEPRECATEDIN_0_9_8",
 172                          "DEPRECATEDIN_1_0_0",
 173                          "DEPRECATEDIN_1_1_0",
 174                          "DEPRECATEDIN_1_2_0",
 175                          # SCTP
 176                          "SCTP",
 177                          # SRTP
 178                          "SRTP",
 179                          # SSL TRACE
 180                          "SSL_TRACE",
 181                          # Unit testing
 182                          "UNIT_TEST",
 183                          # User Interface
 184                          "UI_CONSOLE",
 185                          #
 186                          "TS",
 187                          # OCB mode
 188                          "OCB",
 189                          "CMAC",
 190                          # APPLINK (win build feature?)
 191                          "APPLINK"
 192                      );
 193
 194 my %disabled_algorithms;
 195
 196 foreach (@known_algorithms) {
 197     $disabled_algorithms{$_} = 0;
 198 }
 199 # disabled by default
 200 $disabled_algorithms{"STATIC_ENGINE"} = 1;
 201
 202 my $apiv = sprintf "%x%02x%02x", split(/\./, $config{api});
 203 foreach (keys %disabled_algorithms) {
 204         if (/^DEPRECATEDIN_(\d+)_(\d+)_(\d+)$/) {
 205                 my $depv = sprintf "%x%02x%02x", $1, $2, $3;
 206                 $disabled_algorithms{$_} = 1 if $apiv ge $depv;
 207         }
 208 }
 209
 210 my $zlib;
 211
 212 foreach (@ARGV, split(/ /, $config{options}))
 213         {
 214         $debug=1 if $_ eq "debug";
 215         $W32=1 if $_ eq "32";
 216         die "win16 not supported" if $_ eq "16";
 217         if($_ eq "NT") {
 218                 $W32 = 1;
 219                 $NT = 1;
 220         }
 221         if ($_ eq "linux") {
 222                 $linux=1;
 223                 $UNIX=1;
 224         }
 225         $VMS=1 if $_ eq "VMS";
 226         if ($_ eq "zlib" || $_ eq "enable-zlib" || $_ eq "zlib-dynamic"
 227                          || $_ eq "enable-zlib-dynamic") {
 228                 $zlib = 1;
 229         }
 230
 231         $do_ssl=1 if $_ eq "libssl";
 232         if ($_ eq "ssl") {
 233                 $do_ssl=1;
 234                 $libname=$_
 235         }
 236         $do_crypto=1 if $_ eq "libcrypto";
 237         if ($_ eq "crypto") {
 238                 $do_crypto=1;
 239                 $libname=$_;
 240         }
 241         $do_update=1 if $_ eq "update";
 242         $do_rewrite=1 if $_ eq "rewrite";
 243         $do_ctest=1 if $_ eq "ctest";
 244         $do_ctestall=1 if $_ eq "ctestall";
 245         $do_checkexist=1 if $_ eq "exist";
 246         if (/^(enable|disable|no)-(.*)$/) {
 247                 my $alg = uc $2;
 248                 $alg =~ tr/-/_/;
 249                 if (exists $disabled_algorithms{$alg}) {
 250                         $disabled_algorithms{$alg} = $1 eq "enable" ? 0 : 1;
 251                 }
 252         }
 253
 254         }
 255
 256 if (!$libname) {
 257         if ($do_ssl) {
 258                 $libname="LIBSSL";
 259         }
 260         if ($do_crypto) {
 261                 $libname="LIBCRYPTO";
 262         }
 263 }
 264
 265 # If no platform is given, assume WIN32
 266 if ($W32 + $VMS + $linux == 0) {
 267         $W32 = 1;
 268 }
 269 die "Please, only one platform at a time"
 270     if ($W32 + $VMS + $linux > 1);
 271
 272 if (!$do_ssl && !$do_crypto)
 273         {
 274         print STDERR "usage: $0 ( ssl | crypto ) [ 16 | 32 | NT | OS2 | linux | VMS ]\n";
 275         exit(1);
 276         }
 277
 278 %ssl_list=&load_numbers($ssl_num);
 279 $max_ssl = $max_num;
 280 %crypto_list=&load_numbers($crypto_num);
 281 $max_crypto = $max_num;
 282
 283 my $ssl="include/openssl/ssl.h";
 284 $ssl.=" include/openssl/sslerr.h";
 285 $ssl.=" include/openssl/tls1.h";
 286 $ssl.=" include/openssl/srtp.h";
 287
 288 # When scanning include/openssl, skip all SSL files and some internal ones.
 289 my %skipthese;
 290 foreach my $f ( split(/\s+/, $ssl) ) {
 291     $skipthese{$f} = 1;
 292 }
 293 $skipthese{'include/openssl/conf_api.h'} = 1;
 294 $skipthese{'include/openssl/ebcdic.h'} = 1;
 295 $skipthese{'include/openssl/opensslconf.h'} = 1;
 296
 297 # We use headers found in include/openssl and include/internal only.
 298 # The latter is needed so libssl.so/.dll/.exe can link properly.
 299 my $crypto ="include/internal/dso.h";
 300 $crypto.=" include/internal/o_dir.h";
 301 $crypto.=" include/internal/o_str.h";
 302 $crypto.=" include/internal/err.h";
 303 $crypto.=" include/internal/rand.h";
 304 foreach my $f ( glob(catfile($config{sourcedir},'include/openssl/*.h')) ) {
 305     my $fn = "include/openssl/" . lc(basename($f));
 306     $crypto .= " $fn" if !defined $skipthese{$fn} && $f !~ m@/[a-z]+err\.h$@;
 307 }
 308
 309 my $symhacks="include/openssl/symhacks.h";
 310
 311 my @ssl_symbols = &do_defs("LIBSSL", $ssl, $symhacks);
 312 my @crypto_symbols = &do_defs("LIBCRYPTO", $crypto, $symhacks);
 313
 314 if ($do_update) {
 315
 316 if ($do_ssl == 1) {
 317
 318         &maybe_add_info("LIBSSL",*ssl_list,@ssl_symbols);
 319         if ($do_rewrite == 1) {
 320                 open(OUT, ">$ssl_num");
 321                 &rewrite_numbers(*OUT,"LIBSSL",*ssl_list,@ssl_symbols);
 322         } else {
 323                 open(OUT, ">>$ssl_num");
 324         }
 325         &update_numbers(*OUT,"LIBSSL",*ssl_list,$max_ssl,@ssl_symbols);
 326         close OUT;
 327 }
 328
 329 if($do_crypto == 1) {
 330
 331         &maybe_add_info("LIBCRYPTO",*crypto_list,@crypto_symbols);
 332         if ($do_rewrite == 1) {
 333                 open(OUT, ">$crypto_num");
 334                 &rewrite_numbers(*OUT,"LIBCRYPTO",*crypto_list,@crypto_symbols);
 335         } else {
 336                 open(OUT, ">>$crypto_num");
 337         }
 338         &update_numbers(*OUT,"LIBCRYPTO",*crypto_list,$max_crypto,@crypto_symbols);
 339         close OUT;
 340 }
 341
 342 } elsif ($do_checkexist) {
 343         &check_existing(*ssl_list, @ssl_symbols)
 344                 if $do_ssl == 1;
 345         &check_existing(*crypto_list, @crypto_symbols)
 346                 if $do_crypto == 1;
 347 } elsif ($do_ctest || $do_ctestall) {
 348
 349         print <<"EOF";
 350
 351 /* Test file to check all DEF file symbols are present by trying
 352  * to link to all of them. This is *not* intended to be run!
 353  */
 354
 355 int main()
 356 {
 357 EOF
 358         &print_test_file(*STDOUT,"LIBSSL",*ssl_list,$do_ctestall,@ssl_symbols)
 359                 if $do_ssl == 1;
 360
 361         &print_test_file(*STDOUT,"LIBCRYPTO",*crypto_list,$do_ctestall,@crypto_symbols)
 362                 if $do_crypto == 1;
 363
 364         print "}\n";
 365
 366 } else {
 367
 368         &print_def_file(*STDOUT,$libname,*ssl_list,@ssl_symbols)
 369                 if $do_ssl == 1;
 370
 371         &print_def_file(*STDOUT,$libname,*crypto_list,@crypto_symbols)
 372                 if $do_crypto == 1;
 373
 374 }
 375
 376
 377 sub do_defs
 378 {
 379         my($name,$files,$symhacksfile)=@_;
 380         my $file;
 381         my @ret;
 382         my %syms;
 383         my %platform;           # For anything undefined, we assume ""
 384         my %kind;               # For anything undefined, we assume "FUNCTION"
 385         my %algorithm;          # For anything undefined, we assume ""
 386         my %variant;
 387         my %variant_cnt;        # To be able to allocate "name{n}" if "name"
 388                                 # is the same name as the original.
 389         my $cpp;
 390         my %unknown_algorithms = ();
 391         my $parens = 0;
 392
 393         foreach $file (split(/\s+/,$symhacksfile." ".$files))
 394                 {
 395                 my $fn = catfile($config{sourcedir},$file);
 396                 print STDERR "DEBUG: starting on $fn:\n" if $debug;
 397                 open(IN,"<$fn") || die "Can't open $fn, $!,";
 398                 my $line = "", my $def= "";
 399                 my %tag = (
 400                         (map { $_ => 0 } @known_platforms),
 401                         (map { "OPENSSL_SYS_".$_ => 0 } @known_ossl_platforms),
 402                         (map { "OPENSSL_NO_".$_ => 0 } @known_algorithms),
 403                         (map { "OPENSSL_USE_".$_ => 0 } @known_algorithms),
 404                         (grep /^DEPRECATED_/, @known_algorithms),
 405                         NOPROTO         => 0,
 406                         PERL5           => 0,
 407                         _WINDLL         => 0,
 408                         CONST_STRICT    => 0,
 409                         TRUE            => 1,
 410                 );
 411                 my $symhacking = $file eq $symhacksfile;
 412                 my @current_platforms = ();
 413                 my @current_algorithms = ();
 414
 415                 # params: symbol, alias, platforms, kind
 416                 # The reason to put this subroutine in a variable is that
 417                 # it will otherwise create it's own, unshared, version of
 418                 # %tag and %variant...
 419                 my $make_variant = sub
 420                 {
 421                         my ($s, $a, $p, $k) = @_;
 422                         my ($a1, $a2);
 423
 424                         print STDERR "DEBUG: make_variant: Entered with ",$s,", ",$a,", ",(defined($p)?$p:""),", ",(defined($k)?$k:""),"\n" if $debug;
 425                         if (defined($p))
 426                         {
 427                                 $a1 = join(",",$p,
 428                                            grep(!/^$/,
 429                                                 map { $tag{$_} == 1 ? $_ : "" }
 430                                                 @known_platforms));
 431                         }
 432                         else
 433                         {
 434                                 $a1 = join(",",
 435                                            grep(!/^$/,
 436                                                 map { $tag{$_} == 1 ? $_ : "" }
 437                                                 @known_platforms));
 438                         }
 439                         $a2 = join(",",
 440                                    grep(!/^$/,
 441                                         map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ : "" }
 442                                         @known_ossl_platforms));
 443                         print STDERR "DEBUG: make_variant: a1 = $a1; a2 = $a2\n" if $debug;
 444                         if ($a1 eq "") { $a1 = $a2; }
 445                         elsif ($a1 ne "" && $a2 ne "") { $a1 .= ",".$a2; }
 446                         if ($a eq $s)
 447                         {
 448                                 if (!defined($variant_cnt{$s}))
 449                                 {
 450                                         $variant_cnt{$s} = 0;
 451                                 }
 452                                 $variant_cnt{$s}++;
 453                                 $a .= "{$variant_cnt{$s}}";
 454                         }
 455                         my $toadd = $a.":".$a1.(defined($k)?":".$k:"");
 456                         my $togrep = $s.'(\{[0-9]+\})?:'.$a1.(defined($k)?":".$k:"");
 457                         if (!grep(/^$togrep$/,
 458                                   split(/;/, defined($variant{$s})?$variant{$s}:""))) {
 459                                 if (defined($variant{$s})) { $variant{$s} .= ";"; }
 460                                 $variant{$s} .= $toadd;
 461                         }
 462                         print STDERR "DEBUG: make_variant: Exit with variant of ",$s," = ",$variant{$s},"\n" if $debug;
 463                 };
 464
 465                 print STDERR "DEBUG: parsing ----------\n" if $debug;
 466                 while(<IN>) {
 467                         s|\R$||; # Better chomp
 468                         if($parens > 0) {
 469                                 #Inside a DEPRECATEDIN
 470                                 $stored_multiline .= $_;
 471                                 print STDERR "DEBUG: Continuing multiline DEPRECATEDIN: $stored_multiline\n" if $debug;
 472                                 $parens = count_parens($stored_multiline);
 473                                 if ($parens == 0) {
 474                                         $def .= do_deprecated($stored_multiline,
 475                                                         \@current_platforms,
 476                                                         \@current_algorithms);
 477                                 }
 478                                 next;
 479                         }
 480                         if (/\/\* Error codes for the \w+ functions\. \*\//)
 481                                 {
 482                                 undef @tag;
 483                                 last;
 484                                 }
 485                         if ($line ne '') {
 486                                 $_ = $line . $_;
 487                                 $line = '';
 488                         }
 489
 490                         if (/\\$/) {
 491                                 $line = $`; # keep what was before the backslash
 492                                 next;
 493                         }
 494
 495                         if(/\/\*/) {
 496                                 if (not /\*\//) {       # multi-line comment...
 497                                         $line = $_;     # ... just accumulate
 498                                         next;
 499                                 } else {
 500                                         s/\/\*.*?\*\///gs;# wipe it
 501                                 }
 502                         }
 503
 504                         if ($cpp) {
 505                                 $cpp++ if /^#\s*if/;
 506                                 $cpp-- if /^#\s*endif/;
 507                                 next;
 508                         }
 509                         if (/^#.*ifdef.*cplusplus/) {
 510                                 $cpp = 1;
 511                                 next;
 512                         }
 513
 514                         s/{[^{}]*}//gs;                      # ignore {} blocks
 515                         print STDERR "DEBUG: \$def=\"$def\"\n" if $debug && $def ne "";
 516                         print STDERR "DEBUG: \$_=\"$_\"\n" if $debug;
 517                         if (/^\#\s*if\s+OPENSSL_API_COMPAT\s*(\S)\s*(0x[0-9a-fA-F]{8})L\s*$/) {
 518                                 my $op = $1;
 519                                 my $v = hex($2);
 520                                 if ($op ne '<' && $op ne '>=') {
 521                                     die "$file unacceptable operator $op: $_\n";
 522                                 }
 523                                 my ($one, $major, $minor) =
 524                                     ( ($v >> 28) & 0xf,
 525                                       ($v >> 20) & 0xff,
 526                                       ($v >> 12) & 0xff );
 527                                 my $t = "DEPRECATEDIN_${one}_${major}_${minor}";
 528                                 push(@tag,"-");
 529                                 push(@tag,$t);
 530                                 $tag{$t}=($op eq '<' ? 1 : -1);
 531                                 print STDERR "DEBUG: $file: found tag $t = $tag{$t}\n" if $debug;
 532                         } elsif (/^\#\s*ifndef\s+(.*)/) {
 533                                 push(@tag,"-");
 534                                 push(@tag,$1);
 535                                 $tag{$1}=-1;
 536                                 print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
 537                         } elsif (/^\#\s*if\s+!defined\(([^\)]+)\)/) {
 538                                 push(@tag,"-");
 539                                 if (/^\#\s*if\s+(!defined\(([^\)]+)\)(\s+\&\&\s+!defined\(([^\)]+)\))*)$/) {
 540                                         my $tmp_1 = $1;
 541                                         my $tmp_;
 542                                         foreach $tmp_ (split '\&\&',$tmp_1) {
 543                                                 $tmp_ =~ /!defined\(([^\)]+)\)/;
 544                                                 print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
 545                                                 push(@tag,$1);
 546                                                 $tag{$1}=-1;
 547                                         }
 548                                 } else {
 549                                         print STDERR "Warning: $file: complicated expression: $_" if $debug; # because it is O...
 550                                         print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
 551                                         push(@tag,$1);
 552                                         $tag{$1}=-1;
 553                                 }
 554                         } elsif (/^\#\s*ifdef\s+(\S*)/) {
 555                                 push(@tag,"-");
 556                                 push(@tag,$1);
 557                                 $tag{$1}=1;
 558                                 print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
 559                         } elsif (/^\#\s*if\s+defined\(([^\)]+)\)/) {
 560                                 push(@tag,"-");
 561                                 if (/^\#\s*if\s+(defined\(([^\)]+)\)(\s+\|\|\s+defined\(([^\)]+)\))*)$/) {
 562                                         my $tmp_1 = $1;
 563                                         my $tmp_;
 564                                         foreach $tmp_ (split '\|\|',$tmp_1) {
 565                                                 $tmp_ =~ /defined\(([^\)]+)\)/;
 566                                                 print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
 567                                                 push(@tag,$1);
 568                                                 $tag{$1}=1;
 569                                         }
 570                                 } else {
 571                                         print STDERR "Warning: $file: complicated expression: $_\n" if $debug; # because it is O...
 572                                         print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
 573                                         push(@tag,$1);
 574                                         $tag{$1}=1;
 575                                 }
 576                         } elsif (/^\#\s*error\s+(\w+) is disabled\./) {
 577                                 my $tag_i = $#tag;
 578                                 while($tag[$tag_i] ne "-") {
 579                                         if ($tag[$tag_i] eq "OPENSSL_NO_".$1) {
 580                                                 $tag{$tag[$tag_i]}=2;
 581                                                 print STDERR "DEBUG: $file: changed tag $1 = 2\n" if $debug;
 582                                         }
 583                                         $tag_i--;
 584                                 }
 585                         } elsif (/^\#\s*endif/) {
 586                                 my $tag_i = $#tag;
 587                                 while($tag_i > 0 && $tag[$tag_i] ne "-") {
 588                                         my $t=$tag[$tag_i];
 589                                         print STDERR "DEBUG: \$t=\"$t\"\n" if $debug;
 590                                         if ($tag{$t}==2) {
 591                                                 $tag{$t}=-1;
 592                                         } else {
 593                                                 $tag{$t}=0;
 594                                         }
 595                                         print STDERR "DEBUG: $file: changed tag ",$t," = ",$tag{$t},"\n" if $debug;
 596                                         pop(@tag);
 597                                         if ($t =~ /^OPENSSL_NO_([A-Z0-9_]+)$/) {
 598                                                 $t=$1;
 599                                         } elsif($t =~ /^OPENSSL_USE_([A-Z0-9_]+)$/) {
 600                                                 $t=$1;
 601                                         } else {
 602                                                 $t="";
 603                                         }
 604                                         if ($t ne ""
 605                                             && !grep(/^$t$/, @known_algorithms)) {
 606                                                 $unknown_algorithms{$t} = 1;
 607                                                 #print STDERR "DEBUG: Added as unknown algorithm: $t\n" if $debug;
 608                                         }
 609                                         $tag_i--;
 610                                 }
 611                                 pop(@tag);
 612                         } elsif (/^\#\s*else/) {
 613                                 my $tag_i = $#tag;
 614                                 die "$file unmatched else\n" if $tag_i < 0;
 615                                 while($tag[$tag_i] ne "-") {
 616                                         my $t=$tag[$tag_i];
 617                                         $tag{$t}= -$tag{$t};
 618                                         print STDERR "DEBUG: $file: changed tag ",$t," = ",$tag{$t},"\n" if $debug;
 619                                         $tag_i--;
 620                                 }
 621                         } elsif (/^\#\s*if\s+1/) {
 622                                 push(@tag,"-");
 623                                 # Dummy tag
 624                                 push(@tag,"TRUE");
 625                                 $tag{"TRUE"}=1;
 626                                 print STDERR "DEBUG: $file: found 1\n" if $debug;
 627                         } elsif (/^\#\s*if\s+0/) {
 628                                 push(@tag,"-");
 629                                 # Dummy tag
 630                                 push(@tag,"TRUE");
 631                                 $tag{"TRUE"}=-1;
 632                                 print STDERR "DEBUG: $file: found 0\n" if $debug;
 633                         } elsif (/^\#\s*if\s+/) {
 634                                 #Some other unrecognized "if" style
 635                                 push(@tag,"-");
 636                         } elsif (/^\#\s*define\s+(\w+)\s+(\w+)/
 637                                  && $symhacking && $tag{'TRUE'} != -1) {
 638                                 # This is for aliasing.  When we find an alias,
 639                                 # we have to invert
 640                                 &$make_variant($1,$2);
 641                                 print STDERR "DEBUG: $file: defined $1 = $2\n" if $debug;
 642                         }
 643                         if (/^\#/) {
 644                                 @current_platforms =
 645                                     grep(!/^$/,
 646                                          map { $tag{$_} == 1 ? $_ :
 647                                                    $tag{$_} == -1 ? "!".$_  : "" }
 648                                          @known_platforms);
 649                                 push @current_platforms
 650                                     , grep(!/^$/,
 651                                            map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ :
 652                                                      $tag{"OPENSSL_SYS_".$_} == -1 ? "!".$_  : "" }
 653                                            @known_ossl_platforms);
 654                                 @current_algorithms = ();
 655                                 @current_algorithms =
 656                                     grep(!/^$/,
 657                                          map { $tag{"OPENSSL_NO_".$_} == -1 ? $_ : "" }
 658                                          @known_algorithms);
 659                                 push @current_algorithms
 660                                     , grep(!/^$/,
 661                                          map { $tag{"OPENSSL_USE_".$_} == 1 ? $_ : "" }
 662                                          @known_algorithms);
 663                                 push @current_algorithms,
 664                                     grep { /^DEPRECATEDIN_/ && $tag{$_} == 1 }
 665                                     @known_algorithms;
 666                                 $def .=
 667                                     "#INFO:"
 668                                         .join(',',@current_platforms).":"
 669                                             .join(',',@current_algorithms).";";
 670                                 next;
 671                         }
 672                         if ($tag{'TRUE'} != -1) {
 673                                 if (/^\s*DEFINE_STACK_OF\s*\(\s*(\w*)\s*\)/
 674                                                 || /^\s*DEFINE_STACK_OF_CONST\s*\(\s*(\w*)\s*\)/) {
 675                                         next;
 676                                 } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) {
 677                                         $def .= "int d2i_$3(void);";
 678                                         $def .= "int i2d_$3(void);";
 679                                         # Variant for platforms that do not
 680                                         # have to access global variables
 681                                         # in shared libraries through functions
 682                                         $def .=
 683                                             "#INFO:"
 684                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 685                                                     .join(',',@current_algorithms).";";
 686                                         $def .= "OPENSSL_EXTERN int $2_it;";
 687                                         $def .=
 688                                             "#INFO:"
 689                                                 .join(',',@current_platforms).":"
 690                                                     .join(',',@current_algorithms).";";
 691                                         # Variant for platforms that have to
 692                                         # access global variables in shared
 693                                         # libraries through functions
 694                                         &$make_variant("$2_it","$2_it",
 695                                                       "EXPORT_VAR_AS_FUNCTION",
 696                                                       "FUNCTION");
 697                                         next;
 698                                 } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_fname\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) {
 699                                         $def .= "int d2i_$3(void);";
 700                                         $def .= "int i2d_$3(void);";
 701                                         $def .= "int $3_free(void);";
 702                                         $def .= "int $3_new(void);";
 703                                         # Variant for platforms that do not
 704                                         # have to access global variables
 705                                         # in shared libraries through functions
 706                                         $def .=
 707                                             "#INFO:"
 708                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 709                                                     .join(',',@current_algorithms).";";
 710                                         $def .= "OPENSSL_EXTERN int $2_it;";
 711                                         $def .=
 712                                             "#INFO:"
 713                                                 .join(',',@current_platforms).":"
 714                                                     .join(',',@current_algorithms).";";
 715                                         # Variant for platforms that have to
 716                                         # access global variables in shared
 717                                         # libraries through functions
 718                                         &$make_variant("$2_it","$2_it",
 719                                                       "EXPORT_VAR_AS_FUNCTION",
 720                                                       "FUNCTION");
 721                                         next;
 722                                 } elsif (/^\s*DECLARE_ASN1_FUNCTIONS\s*\(\s*(\w*)\s*\)/ ||
 723                                          /^\s*DECLARE_ASN1_FUNCTIONS_const\s*\(\s*(\w*)\s*\)/) {
 724                                         $def .= "int d2i_$1(void);";
 725                                         $def .= "int i2d_$1(void);";
 726                                         $def .= "int $1_free(void);";
 727                                         $def .= "int $1_new(void);";
 728                                         # Variant for platforms that do not
 729                                         # have to access global variables
 730                                         # in shared libraries through functions
 731                                         $def .=
 732                                             "#INFO:"
 733                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 734                                                     .join(',',@current_algorithms).";";
 735                                         $def .= "OPENSSL_EXTERN int $1_it;";
 736                                         $def .=
 737                                             "#INFO:"
 738                                                 .join(',',@current_platforms).":"
 739                                                     .join(',',@current_algorithms).";";
 740                                         # Variant for platforms that have to
 741                                         # access global variables in shared
 742                                         # libraries through functions
 743                                         &$make_variant("$1_it","$1_it",
 744                                                       "EXPORT_VAR_AS_FUNCTION",
 745                                                       "FUNCTION");
 746                                         next;
 747                                 } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS_const\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
 748                                         $def .= "int d2i_$2(void);";
 749                                         $def .= "int i2d_$2(void);";
 750                                         # Variant for platforms that do not
 751                                         # have to access global variables
 752                                         # in shared libraries through functions
 753                                         $def .=
 754                                             "#INFO:"
 755                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 756                                                     .join(',',@current_algorithms).";";
 757                                         $def .= "OPENSSL_EXTERN int $2_it;";
 758                                         $def .=
 759                                             "#INFO:"
 760                                                 .join(',',@current_platforms).":"
 761                                                     .join(',',@current_algorithms).";";
 762                                         # Variant for platforms that have to
 763                                         # access global variables in shared
 764                                         # libraries through functions
 765                                         &$make_variant("$2_it","$2_it",
 766                                                       "EXPORT_VAR_AS_FUNCTION",
 767                                                       "FUNCTION");
 768                                         next;
 769                                 } elsif (/^\s*DECLARE_ASN1_ALLOC_FUNCTIONS\s*\(\s*(\w*)\s*\)/) {
 770                                         $def .= "int $1_free(void);";
 771                                         $def .= "int $1_new(void);";
 772                                         next;
 773                                 } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
 774                                         $def .= "int d2i_$2(void);";
 775                                         $def .= "int i2d_$2(void);";
 776                                         $def .= "int $2_free(void);";
 777                                         $def .= "int $2_new(void);";
 778                                         # Variant for platforms that do not
 779                                         # have to access global variables
 780                                         # in shared libraries through functions
 781                                         $def .=
 782                                             "#INFO:"
 783                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 784                                                     .join(',',@current_algorithms).";";
 785                                         $def .= "OPENSSL_EXTERN int $2_it;";
 786                                         $def .=
 787                                             "#INFO:"
 788                                                 .join(',',@current_platforms).":"
 789                                                     .join(',',@current_algorithms).";";
 790                                         # Variant for platforms that have to
 791                                         # access global variables in shared
 792                                         # libraries through functions
 793                                         &$make_variant("$2_it","$2_it",
 794                                                       "EXPORT_VAR_AS_FUNCTION",
 795                                                       "FUNCTION");
 796                                         next;
 797                                 } elsif (/^\s*DECLARE_ASN1_ITEM\s*\(\s*(\w*)\s*\)/) {
 798                                         # Variant for platforms that do not
 799                                         # have to access global variables
 800                                         # in shared libraries through functions
 801                                         $def .=
 802                                             "#INFO:"
 803                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 804                                                     .join(',',@current_algorithms).";";
 805                                         $def .= "OPENSSL_EXTERN int $1_it;";
 806                                         $def .=
 807                                             "#INFO:"
 808                                                 .join(',',@current_platforms).":"
 809                                                     .join(',',@current_algorithms).";";
 810                                         # Variant for platforms that have to
 811                                         # access global variables in shared
 812                                         # libraries through functions
 813                                         &$make_variant("$1_it","$1_it",
 814                                                       "EXPORT_VAR_AS_FUNCTION",
 815                                                       "FUNCTION");
 816                                         next;
 817                                 } elsif (/^\s*DECLARE_ASN1_NDEF_FUNCTION\s*\(\s*(\w*)\s*\)/) {
 818                                         $def .= "int i2d_$1_NDEF(void);";
 819                                 } elsif (/^\s*DECLARE_ASN1_SET_OF\s*\(\s*(\w*)\s*\)/) {
 820                                         next;
 821                                 } elsif (/^\s*DECLARE_ASN1_PRINT_FUNCTION\s*\(\s*(\w*)\s*\)/) {
 822                                         $def .= "int $1_print_ctx(void);";
 823                                         next;
 824                                 } elsif (/^\s*DECLARE_ASN1_PRINT_FUNCTION_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
 825                                         $def .= "int $2_print_ctx(void);";
 826                                         next;
 827                                 } elsif (/^\s*DECLARE_PKCS12_STACK_OF\s*\(\s*(\w*)\s*\)/) {
 828                                         next;
 829                                 } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ ||
 830                                          /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ ||
 831                                          /^DECLARE_PEM_rw_const\s*\(\s*(\w*)\s*,/ ) {
 832                                         $def .=
 833                                             "#INFO:"
 834                                                 .join(',',@current_platforms).":"
 835                                                     .join(',',"STDIO",@current_algorithms).";";
 836                                         $def .= "int PEM_read_$1(void);";
 837                                         $def .= "int PEM_write_$1(void);";
 838                                         $def .=
 839                                             "#INFO:"
 840                                                 .join(',',@current_platforms).":"
 841                                                     .join(',',@current_algorithms).";";
 842                                         # Things that are everywhere
 843                                         $def .= "int PEM_read_bio_$1(void);";
 844                                         $def .= "int PEM_write_bio_$1(void);";
 845                                         next;
 846                                 } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ ||
 847                                         /^DECLARE_PEM_write_const\s*\(\s*(\w*)\s*,/ ||
 848                                          /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) {
 849                                         $def .=
 850                                             "#INFO:"
 851                                                 .join(',',@current_platforms).":"
 852                                                     .join(',',"STDIO",@current_algorithms).";";
 853                                         $def .= "int PEM_write_$1(void);";
 854                                         $def .=
 855                                             "#INFO:"
 856                                                 .join(',',@current_platforms).":"
 857                                                     .join(',',@current_algorithms).";";
 858                                         # Things that are everywhere
 859                                         $def .= "int PEM_write_bio_$1(void);";
 860                                         next;
 861                                 } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ ||
 862                                          /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) {
 863                                         $def .=
 864                                             "#INFO:"
 865                                                 .join(',',@current_platforms).":"
 866                                                     .join(',',"STDIO",@current_algorithms).";";
 867                                         $def .= "int PEM_read_$1(void);";
 868                                         $def .=
 869                                             "#INFO:"
 870                                                 .join(',',@current_platforms).":"
 871                                                     .join(',',"STDIO",@current_algorithms).";";
 872                                         # Things that are everywhere
 873                                         $def .= "int PEM_read_bio_$1(void);";
 874                                         next;
 875                                 } elsif (/^OPENSSL_DECLARE_GLOBAL\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
 876                                         # Variant for platforms that do not
 877                                         # have to access global variables
 878                                         # in shared libraries through functions
 879                                         $def .=
 880                                             "#INFO:"
 881                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 882                                                     .join(',',@current_algorithms).";";
 883                                         $def .= "OPENSSL_EXTERN int _shadow_$2;";
 884                                         $def .=
 885                                             "#INFO:"
 886                                                 .join(',',@current_platforms).":"
 887                                                     .join(',',@current_algorithms).";";
 888                                         # Variant for platforms that have to
 889                                         # access global variables in shared
 890                                         # libraries through functions
 891                                         &$make_variant("_shadow_$2","_shadow_$2",
 892                                                       "EXPORT_VAR_AS_FUNCTION",
 893                                                       "FUNCTION");
 894                                 } elsif (/^\s*DEPRECATEDIN/) {
 895                                         $parens = count_parens($_);
 896                                         if ($parens == 0) {
 897                                                 $def .= do_deprecated($_,
 898                                                         \@current_platforms,
 899                                                         \@current_algorithms);
 900                                         } else {
 901                                                 $stored_multiline = $_;
 902                                                 print STDERR "DEBUG: Found multiline DEPRECATEDIN starting with: $stored_multiline\n" if $debug;
 903                                                 next;
 904                                         }
 905                                 } elsif ($tag{'CONST_STRICT'} != 1) {
 906                                         if (/\{|\/\*|\([^\)]*$/) {
 907                                                 $line = $_;
 908                                         } else {
 909                                                 $def .= $_;
 910                                         }
 911                                 }
 912                         }
 913                 }
 914                 close(IN);
 915                 die "$file: Unmatched tags\n" if $#tag >= 0;
 916
 917                 my $algs;
 918                 my $plays;
 919
 920                 print STDERR "DEBUG: postprocessing ----------\n" if $debug;
 921                 foreach (split /;/, $def) {
 922                         my $s; my $k = "FUNCTION"; my $p; my $a;
 923                         s/^[\n\s]*//g;
 924                         s/[\n\s]*$//g;
 925                         next if(/\#undef/);
 926                         next if(/typedef\W/);
 927                         next if(/\#define/);
 928
 929                         # Reduce argument lists to empty ()
 930                         # fold round brackets recursively: (t(*v)(t),t) -> (t{}{},t) -> {}
 931                         while(/\(.*\)/s) {
 932                                 s/\([^\(\)]+\)/\{\}/gs;
 933                                 s/\(\s*\*\s*(\w+)\s*\{\}\s*\)/$1/gs;    #(*f{}) -> f
 934                         }
 935                         # pretend as we didn't use curly braces: {} -> ()
 936                         s/\{\}/\(\)/gs;
 937
 938                         s/STACK_OF\(\)/void/gs;
 939                         s/LHASH_OF\(\)/void/gs;
 940
 941                         print STDERR "DEBUG: \$_ = \"$_\"\n" if $debug;
 942                         if (/^\#INFO:([^:]*):(.*)$/) {
 943                                 $plats = $1;
 944                                 $algs = $2;
 945                                 print STDERR "DEBUG: found info on platforms ($plats) and algorithms ($algs)\n" if $debug;
 946                                 next;
 947                         } elsif (/^\s*OPENSSL_EXTERN\s.*?(\w+(\{[0-9]+\})?)(\[[0-9]*\])*\s*$/) {
 948                                 $s = $1;
 949                                 $k = "VARIABLE";
 950                                 print STDERR "DEBUG: found external variable $s\n" if $debug;
 951                         } elsif (/TYPEDEF_\w+_OF/s) {
 952                                 next;
 953                         } elsif (/(\w+)\s*\(\).*/s) {   # first token prior [first] () is
 954                                 $s = $1;                # a function name!
 955                                 print STDERR "DEBUG: found function $s\n" if $debug;
 956                         } elsif (/\(/ and not (/=/)) {
 957                                 print STDERR "File $file: cannot parse: $_;\n";
 958                                 next;
 959                         } else {
 960                                 next;
 961                         }
 962
 963                         $syms{$s} = 1;
 964                         $kind{$s} = $k;
 965
 966                         $p = $plats;
 967                         $a = $algs;
 968
 969                         $platform{$s} =
 970                             &reduce_platforms((defined($platform{$s})?$platform{$s}.',':"").$p);
 971                         $algorithm{$s} .= ','.$a;
 972
 973                         if (defined($variant{$s})) {
 974                                 foreach $v (split /;/,$variant{$s}) {
 975                                         (my $r, my $p, my $k) = split(/:/,$v);
 976                                         my $ip = join ',',map({ /^!(.*)$/ ? $1 : "!".$_ } split /,/, $p);
 977                                         $syms{$r} = 1;
 978                                         if (!defined($k)) { $k = $kind{$s}; }
 979                                         $kind{$r} = $k."(".$s.")";
 980                                         $algorithm{$r} = $algorithm{$s};
 981                                         $platform{$r} = &reduce_platforms($platform{$s}.",".$p.",".$p);
 982                                         $platform{$s} = &reduce_platforms($platform{$s}.','.$ip.','.$ip);
 983                                         print STDERR "DEBUG: \$variant{\"$s\"} = ",$v,"; \$r = $r; \$p = ",$platform{$r},"; \$a = ",$algorithm{$r},"; \$kind = ",$kind{$r},"\n" if $debug;
 984                                 }
 985                         }
 986                         print STDERR "DEBUG: \$s = $s; \$p = ",$platform{$s},"; \$a = ",$algorithm{$s},"; \$kind = ",$kind{$s},"\n" if $debug;
 987                 }
 988         }
 989
 990         # Prune the returned symbols
 991
 992         delete $syms{"bn_dump1"};
 993         $platform{"BIO_s_log"} .= ",!WIN32,!macintosh";
 994
 995         $platform{"PEM_read_NS_CERT_SEQ"} = "VMS";
 996         $platform{"PEM_write_NS_CERT_SEQ"} = "VMS";
 997         $platform{"PEM_read_P8_PRIV_KEY_INFO"} = "VMS";
 998         $platform{"PEM_write_P8_PRIV_KEY_INFO"} = "VMS";
 999
1000         # Info we know about
1001
1002         push @ret, map { $_."\\".&info_string($_,"EXIST",
1003                                               $platform{$_},
1004                                               $kind{$_},
1005                                               $algorithm{$_}) } keys %syms;
1006
1007         if (keys %unknown_algorithms) {
1008                 print STDERR "WARNING: mkdef.pl doesn't know the following algorithms:\n";
1009                 print STDERR "\t",join("\n\t",keys %unknown_algorithms),"\n";
1010         }
1011         return(@ret);
1012 }
1013
1014 # Param: string of comma-separated platform-specs.
1015 sub reduce_platforms
1016 {
1017         my ($platforms) = @_;
1018         my $pl = defined($platforms) ? $platforms : "";
1019         my %p = map { $_ => 0 } split /,/, $pl;
1020         my $ret;
1021
1022         print STDERR "DEBUG: Entered reduce_platforms with \"$platforms\"\n"
1023             if $debug;
1024         # We do this, because if there's code like the following, it really
1025         # means the function exists in all cases and should therefore be
1026         # everywhere.  By increasing and decreasing, we may attain 0:
1027         #
1028         # ifndef WIN16
1029         #    int foo();
1030         # else
1031         #    int _fat foo();
1032         # endif
1033         foreach $platform (split /,/, $pl) {
1034                 if ($platform =~ /^!(.*)$/) {
1035                         $p{$1}--;
1036                 } else {
1037                         $p{$platform}++;
1038                 }
1039         }
1040         foreach $platform (keys %p) {
1041                 if ($p{$platform} == 0) { delete $p{$platform}; }
1042         }
1043
1044         delete $p{""};
1045
1046         $ret = join(',',sort(map { $p{$_} < 0 ? "!".$_ : $_ } keys %p));
1047         print STDERR "DEBUG: Exiting reduce_platforms with \"$ret\"\n"
1048             if $debug;
1049         return $ret;
1050 }
1051
1052 sub info_string
1053 {
1054         (my $symbol, my $exist, my $platforms, my $kind, my $algorithms) = @_;
1055
1056         my %a = defined($algorithms) ?
1057             map { $_ => 1 } split /,/, $algorithms : ();
1058         my $k = defined($kind) ? $kind : "FUNCTION";
1059         my $ret;
1060         my $p = &reduce_platforms($platforms);
1061
1062         delete $a{""};
1063
1064         $ret = $exist;
1065         $ret .= ":".$p;
1066         $ret .= ":".$k;
1067         $ret .= ":".join(',',sort keys %a);
1068         return $ret;
1069 }
1070
1071 sub maybe_add_info
1072 {
1073         (my $name, *nums, my @symbols) = @_;
1074         my $sym;
1075         my $new_info = 0;
1076         my %syms=();
1077
1078         foreach $sym (@symbols) {
1079                 (my $s, my $i) = split /\\/, $sym;
1080                 if (defined($nums{$s})) {
1081                         $i =~ s/^(.*?:.*?:\w+)(\(\w+\))?/$1/;
1082                         (my $n, my $vers, my $dummy) = split /\\/, $nums{$s};
1083                         if (!defined($dummy) || $i ne $dummy) {
1084                                 $nums{$s} = $n."\\".$vers."\\".$i;
1085                                 $new_info++;
1086                                 print STDERR "DEBUG: maybe_add_info for $s: \"$dummy\" => \"$i\"\n" if $debug;
1087                         }
1088                 }
1089                 $syms{$s} = 1;
1090         }
1091
1092         my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums;
1093         foreach $sym (@s) {
1094                 (my $n, my $vers, my $i) = split /\\/, $nums{$sym};
1095                 if (!defined($syms{$sym}) && $i !~ /^NOEXIST:/) {
1096                         $new_info++;
1097                         print STDERR "DEBUG: maybe_add_info for $sym: -> undefined\n" if $debug;
1098                 }
1099         }
1100         if ($new_info) {
1101                 print STDERR "$name: $new_info old symbols have updated info\n";
1102                 if (!$do_rewrite) {
1103                         print STDERR "You should do a rewrite to fix this.\n";
1104                 }
1105         } else {
1106         }
1107 }
1108
1109 # Param: string of comma-separated keywords, each possibly prefixed with a "!"
1110 sub is_valid
1111 {
1112         my ($keywords_txt,$platforms) = @_;
1113         my (@keywords) = split /,/,$keywords_txt;
1114         my ($falsesum, $truesum) = (0, 1);
1115
1116         # Param: one keyword
1117         sub recognise
1118         {
1119                 my ($keyword,$platforms) = @_;
1120
1121                 if ($platforms) {
1122                         # platforms
1123                         if ($keyword eq "UNIX" && $UNIX) { return 1; }
1124                         if ($keyword eq "VMS" && $VMS) { return 1; }
1125                         if ($keyword eq "WIN32" && $W32) { return 1; }
1126                         if ($keyword eq "_WIN32" && $W32) { return 1; }
1127                         if ($keyword eq "WINNT" && $NT) { return 1; }
1128                         # Special platforms:
1129                         # EXPORT_VAR_AS_FUNCTION means that global variables
1130                         # will be represented as functions.
1131                         if ($keyword eq "EXPORT_VAR_AS_FUNCTION" && $W32) {
1132                                 return 1;
1133                         }
1134                         if ($keyword eq "ZLIB" && $zlib) { return 1; }
1135                         return 0;
1136                 } else {
1137                         # algorithms
1138                         if ($disabled_algorithms{$keyword} == 1) { return 0;}
1139
1140                         # Nothing recognise as true
1141                         return 1;
1142                 }
1143         }
1144
1145         foreach $k (@keywords) {
1146                 if ($k =~ /^!(.*)$/) {
1147                         $falsesum += &recognise($1,$platforms);
1148                 } else {
1149                         $truesum *= &recognise($k,$platforms);
1150                 }
1151         }
1152         print STDERR "DEBUG: [",$#keywords,",",$#keywords < 0,"] is_valid($keywords_txt) => (\!$falsesum) && $truesum = ",(!$falsesum) && $truesum,"\n" if $debug;
1153         return (!$falsesum) && $truesum;
1154 }
1155
1156 sub print_test_file
1157 {
1158         (*OUT,my $name,*nums,my $testall,my @symbols)=@_;
1159         my $n = 1; my @e; my @r;
1160         my $sym; my $prev = ""; my $prefSSLeay;
1161
1162         (@e)=grep(/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols);
1163         (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:.*/ && !/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols);
1164         @symbols=((sort @e),(sort @r));
1165
1166         foreach $sym (@symbols) {
1167                 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
1168                 my $v = 0;
1169                 $v = 1 if $i=~ /^.*?:.*?:VARIABLE/;
1170                 my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
1171                 my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
1172                 if (!defined($nums{$s})) {
1173                         print STDERR "Warning: $s does not have a number assigned\n"
1174                             if(!$do_update);
1175                 } elsif (is_valid($p,1) && is_valid($a,0)) {
1176                         my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1);
1177                         if ($prev eq $s2) {
1178                                 print OUT "\t/* The following has already appeared previously */\n";
1179                                 print STDERR "Warning: Symbol '",$s2,"' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n";
1180                         }
1181                         $prev = $s2;    # To warn about duplicates...
1182
1183                         (my $nn, my $vers, my $ni) = split /\\/, $nums{$s2};
1184                         if ($v) {
1185                                 print OUT "\textern int $s2; /* type unknown */ /* $nn $ni */\n";
1186                         } else {
1187                                 print OUT "\textern int $s2(); /* type unknown */ /* $nn $ni */\n";
1188                         }
1189                 }
1190         }
1191 }
1192
1193 sub get_version
1194 {
1195    return $config{version};
1196 }
1197
1198 sub print_def_file
1199 {
1200         (*OUT,my $name,*nums,my @symbols)=@_;
1201         my $n = 1; my @e; my @r; my @v; my $prev="";
1202         my $liboptions="";
1203         my $libname = $name;
1204         my $http_vendor = 'www.openssl.org/';
1205         my $version = get_version();
1206         my $what = "OpenSSL: implementation of Secure Socket Layer";
1207         my $description = "$what $version, $name - http://$http_vendor";
1208         my $prevsymversion = "", $prevprevsymversion = "";
1209         # For VMS
1210         my $prevnum = 0;
1211         my $symvtextcount = 0;
1212
1213         if ($W32)
1214                 { $libname.="32"; }
1215
1216         if ($W32)
1217                 {
1218                 print OUT <<"EOF";
1219 ;
1220 ; Definition file for the DLL version of the $name library from OpenSSL
1221 ;
1222
1223 LIBRARY         $libname        $liboptions
1224
1225 EOF
1226
1227                 print "EXPORTS\n";
1228                 }
1229         elsif ($VMS)
1230                 {
1231                 print OUT <<"EOF";
1232 CASE_SENSITIVE=YES
1233 SYMBOL_VECTOR=(-
1234 EOF
1235                 $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-"
1236                 }
1237
1238         (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:FUNCTION/,@symbols);
1239         (@v)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:VARIABLE/,@symbols);
1240         if ($VMS) {
1241             # VMS needs to have the symbols on slot number order
1242             @symbols=(map { $_->[1] }
1243                       sort { $a->[0] <=> $b->[0] }
1244                       map { (my $s, my $i) = $_ =~ /^(.*?)\\(.*)$/;
1245                             die "Error: $s doesn't have a number assigned\n"
1246                                 if !defined($nums{$s});
1247                             (my $n, my @rest) = split /\\/, $nums{$s};
1248                             [ $n, $_ ] } (@e, @r, @v));
1249         } else {
1250             @symbols=((sort @e),(sort @r), (sort @v));
1251         }
1252
1253         my ($baseversion, $currversion) = get_openssl_version();
1254         my $thisversion;
1255         do {
1256                 if (!defined($thisversion)) {
1257                         $thisversion = $baseversion;
1258                 } else {
1259                         $thisversion = get_next_version($thisversion);
1260                 }
1261                 foreach $sym (@symbols) {
1262                         (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
1263                         my $v = 0;
1264                         $v = 1 if $i =~ /^.*?:.*?:VARIABLE/;
1265                         if (!defined($nums{$s})) {
1266                                 die "Error: $s does not have a number assigned\n"
1267                                         if(!$do_update);
1268                         } else {
1269                                 (my $n, my $symversion, my $dummy) = split /\\/, $nums{$s};
1270                                 my %pf = ();
1271                                 my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
1272                                 my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
1273                                 if (is_valid($p,1) && is_valid($a,0)) {
1274                                         my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1);
1275                                         if ($prev eq $s2) {
1276                                                 print STDERR "Warning: Symbol '",$s2,
1277                                                         "' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),
1278                                                         ", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n";
1279                                         }
1280                                         $prev = $s2;    # To warn about duplicates...
1281                                         if($linux) {
1282                                                 next if $symversion ne $thisversion;
1283                                                 if ($symversion ne $prevsymversion) {
1284                                                         if ($prevsymversion ne "") {
1285                                                                 if ($prevprevsymversion ne "") {
1286                                                                         print OUT "} OPENSSL${SO_VARIANT}_"
1287                                                                                                 ."$prevprevsymversion;\n\n";
1288                                                                 } else {
1289                                                                         print OUT "};\n\n";
1290                                                                 }
1291                                                         }
1292                                                         print OUT "OPENSSL${SO_VARIANT}_$symversion {\n    global:\n";
1293                                                         $prevprevsymversion = $prevsymversion;
1294                                                         $prevsymversion = $symversion;
1295                                                 }
1296                                                 print OUT "        $s2;\n";
1297                                         } elsif ($VMS) {
1298                                             while(++$prevnum < $n) {
1299                                                 my $symline=" ,SPARE -\n  ,SPARE -\n";
1300                                                 if ($symvtextcount + length($symline) - 2 > 1024) {
1301                                                     print OUT ")\nSYMBOL_VECTOR=(-\n";
1302                                                     $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-"
1303                                                 }
1304                                                 if ($symvtextcount == 16) {
1305                                                     # Take away first comma
1306                                                     $symline =~ s/,//;
1307                                                 }
1308                                                 print OUT $symline;
1309                                                 $symvtextcount += length($symline) - 2;
1310                                             }
1311                                             (my $s_uc = $s) =~ tr/a-z/A-Z/;
1312                                             my $symtype=
1313                                                 $v ? "DATA" : "PROCEDURE";
1314                                             my $symline=
1315                                                 ($s_uc ne $s
1316                                                  ? " ,$s_uc/$s=$symtype -\n  ,$s=$symtype -\n"
1317                                                  : " ,$s=$symtype -\n  ,SPARE -\n");
1318                                             if ($symvtextcount + length($symline) - 2 > 1024) {
1319                                                 print OUT ")\nSYMBOL_VECTOR=(-\n";
1320                                                 $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-"
1321                                             }
1322                                             if ($symvtextcount == 16) {
1323                                                 # Take away first comma
1324                                                 $symline =~ s/,//;
1325                                             }
1326                                             print OUT $symline;
1327                                             $symvtextcount += length($symline) - 2;
1328                                         } elsif($v) {
1329                                                 printf OUT "    %s%-39s DATA\n",
1330                                                                 ($W32)?"":"_",$s2;
1331                                         } else {
1332                                                 printf OUT "    %s%s\n",
1333                                                                 ($W32)?"":"_",$s2;
1334                                         }
1335                                 }
1336                         }
1337                 }
1338         } while ($linux && $thisversion ne $currversion);
1339         if ($linux) {
1340                 if ($prevprevsymversion ne "") {
1341                         print OUT "    local: *;\n} OPENSSL${SO_VARIANT}_$prevprevsymversion;\n\n";
1342                 } else {
1343                         print OUT "    local: *;\n};\n\n";
1344                 }
1345         } elsif ($VMS) {
1346             print OUT ")\n";
1347             (my $libvmaj, my $libvmin, my $libvedit) =
1348                 $currversion =~ /^(\d+)_(\d+)_(\d+)$/;
1349             # The reason to multiply the edit number with 100 is to make space
1350             # for the possibility that we want to encode the patch letters
1351             print OUT "GSMATCH=LEQUAL,",($libvmaj * 100 + $libvmin),",",($libvedit * 100),"\n";
1352         }
1353         printf OUT "\n";
1354 }
1355
1356 sub load_numbers
1357 {
1358         my($name)=@_;
1359         my(@a,%ret);
1360         my $prevversion;
1361
1362         $max_num = 0;
1363         $num_noinfo = 0;
1364         $prev = "";
1365         $prev_cnt = 0;
1366
1367         my ($baseversion, $currversion) = get_openssl_version();
1368
1369         open(IN,"<$name") || die "unable to open $name:$!\n";
1370         while (<IN>) {
1371                 s|\R$||;        # Better chomp
1372                 s/#.*$//;
1373                 next if /^\s*$/;
1374                 @a=split;
1375                 if (defined $ret{$a[0]}) {
1376                         # This is actually perfectly OK
1377                         #print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n";
1378                 }
1379                 if ($max_num > $a[1]) {
1380                         print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n";
1381                 }
1382                 elsif ($max_num == $a[1]) {
1383                         # This is actually perfectly OK
1384                         #print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n";
1385                         if ($a[0] eq $prev) {
1386                                 $prev_cnt++;
1387                                 $a[0] .= "{$prev_cnt}";
1388                         }
1389                 }
1390                 else {
1391                         $prev_cnt = 0;
1392                 }
1393                 if ($#a < 2) {
1394                         # Existence will be proven later, in do_defs
1395                         $ret{$a[0]}=$a[1];
1396                         $num_noinfo++;
1397                 } else {
1398                         #Sanity check the version number
1399                         if (defined $prevversion) {
1400                                 check_version_lte($prevversion, $a[2]);
1401                         }
1402                         check_version_lte($a[2], $currversion);
1403                         $prevversion = $a[2];
1404                         $ret{$a[0]}=$a[1]."\\".$a[2]."\\".$a[3]; # \\ is a special marker
1405                 }
1406                 $max_num = $a[1] if $a[1] > $max_num;
1407                 $prev=$a[0];
1408         }
1409         if ($num_noinfo) {
1410                 print STDERR "Warning: $num_noinfo symbols were without info.";
1411                 if ($do_rewrite) {
1412                         printf STDERR "  The rewrite will fix this.\n";
1413                 } else {
1414                         printf STDERR "  You should do a rewrite to fix this.\n";
1415                 }
1416         }
1417         close(IN);
1418         return(%ret);
1419 }
1420
1421 sub parse_number
1422 {
1423         (my $str, my $what) = @_;
1424         (my $n, my $v, my $i) = split(/\\/,$str);
1425         if ($what eq "n") {
1426                 return $n;
1427         } else {
1428                 return $i;
1429         }
1430 }
1431
1432 sub rewrite_numbers
1433 {
1434         (*OUT,$name,*nums,@symbols)=@_;
1435         my $thing;
1436
1437         my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols);
1438         my $r; my %r; my %rsyms;
1439         foreach $r (@r) {
1440                 (my $s, my $i) = split /\\/, $r;
1441                 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/;
1442                 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/;
1443                 $r{$a} = $s."\\".$i;
1444                 $rsyms{$s} = 1;
1445         }
1446
1447         my %syms = ();
1448         foreach $_ (@symbols) {
1449                 (my $n, my $i) = split /\\/;
1450                 $syms{$n} = 1;
1451         }
1452
1453         my @s=sort {
1454             &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n")
1455             || $a cmp $b
1456         } keys %nums;
1457         foreach $sym (@s) {
1458                 (my $n, my $vers, my $i) = split /\\/, $nums{$sym};
1459                 next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/;
1460                 next if defined($rsyms{$sym});
1461                 print STDERR "DEBUG: rewrite_numbers for sym = ",$sym,": i = ",$i,", n = ",$n,", rsym{sym} = ",$rsyms{$sym},"syms{sym} = ",$syms{$sym},"\n" if $debug;
1462                 $i="NOEXIST::FUNCTION:"
1463                         if !defined($i) || $i eq "" || !defined($syms{$sym});
1464                 my $s2 = $sym;
1465                 $s2 =~ s/\{[0-9]+\}$//;
1466                 printf OUT "%s%-39s %d\t%s\t%s\n","",$s2,$n,$vers,$i;
1467                 if (exists $r{$sym}) {
1468                         (my $s, $i) = split /\\/,$r{$sym};
1469                         my $s2 = $s;
1470                         $s2 =~ s/\{[0-9]+\}$//;
1471                         printf OUT "%s%-39s %d\t%s\t%s\n","",$s2,$n,$vers,$i;
1472                 }
1473         }
1474 }
1475
1476 sub update_numbers
1477 {
1478         (*OUT,$name,*nums,my $start_num, my @symbols)=@_;
1479         my $new_syms = 0;
1480         my $basevers;
1481         my $vers;
1482
1483         ($basevers, $vers) = get_openssl_version();
1484
1485         my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols);
1486         my $r; my %r; my %rsyms;
1487         foreach $r (@r) {
1488                 (my $s, my $i) = split /\\/, $r;
1489                 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/;
1490                 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/;
1491                 $r{$a} = $s."\\".$i;
1492                 $rsyms{$s} = 1;
1493         }
1494
1495         foreach $sym (@symbols) {
1496                 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
1497                 next if $i =~ /^.*?:.*?:\w+\(\w+\)/;
1498                 next if defined($rsyms{$sym});
1499                 die "ERROR: Symbol $sym had no info attached to it."
1500                     if $i eq "";
1501                 if (!exists $nums{$s}) {
1502                         $new_syms++;
1503                         my $s2 = $s;
1504                         $s2 =~ s/\{[0-9]+\}$//;
1505                         printf OUT "%s%-39s %d\t%s\t%s\n","",$s2, ++$start_num,$vers,$i;
1506                         if (exists $r{$s}) {
1507                                 ($s, $i) = split /\\/,$r{$s};
1508                                 $s =~ s/\{[0-9]+\}$//;
1509                                 printf OUT "%s%-39s %d\t%s\t%s\n","",$s, $start_num,$vers,$i;
1510                         }
1511                 }
1512         }
1513         if($new_syms) {
1514                 print STDERR "$name: Added $new_syms new symbols\n";
1515         } else {
1516                 print STDERR "$name: No new symbols added\n";
1517         }
1518 }
1519
1520 sub check_existing
1521 {
1522         (*nums, my @symbols)=@_;
1523         my %existing; my @remaining;
1524         @remaining=();
1525         foreach $sym (@symbols) {
1526                 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
1527                 $existing{$s}=1;
1528         }
1529         foreach $sym (keys %nums) {
1530                 if (!exists $existing{$sym}) {
1531                         push @remaining, $sym;
1532                 }
1533         }
1534         if(@remaining) {
1535                 print STDERR "The following symbols do not seem to exist:\n";
1536                 foreach $sym (@remaining) {
1537                         print STDERR "\t",$sym,"\n";
1538                 }
1539         }
1540 }
1541
1542 sub count_parens
1543 {
1544         my $line = shift(@_);
1545
1546         my $open = $line =~ tr/\(//;
1547         my $close = $line =~ tr/\)//;
1548
1549         return $open - $close;
1550 }
1551
1552 #Parse opensslv.h to get the current version number. Also work out the base
1553 #version, i.e. the lowest version number that is binary compatible with this
1554 #version
1555 sub get_openssl_version()
1556 {
1557         my $fn = catfile($config{sourcedir},"include","openssl","opensslv.h");
1558         open (IN, "$fn") || die "Can't open opensslv.h";
1559
1560         while(<IN>) {
1561                 if (/OPENSSL_VERSION_TEXT\s+"OpenSSL (\d\.\d\.)(\d[a-z]*)(-| )/) {
1562                         my $suffix = $2;
1563                         (my $baseversion = $1) =~ s/\./_/g;
1564                         close IN;
1565                         return ($baseversion."0", $baseversion.$suffix);
1566                 }
1567         }
1568         die "Can't find OpenSSL version number\n";
1569 }
1570
1571 #Given an OpenSSL version number, calculate the next version number. If the
1572 #version number gets to a.b.czz then we go to a.b.(c+1)
1573 sub get_next_version()
1574 {
1575         my $thisversion = shift;
1576
1577         my ($base, $letter) = $thisversion =~ /^(\d_\d_\d)([a-z]{0,2})$/;
1578
1579         if ($letter eq "zz") {
1580                 my $lastnum = substr($base, -1);
1581                 return substr($base, 0, length($base)-1).(++$lastnum);
1582         }
1583         return $base.get_next_letter($letter);
1584 }
1585
1586 #Given the letters off the end of an OpenSSL version string, calculate what
1587 #the letters for the next release would be.
1588 sub get_next_letter()
1589 {
1590         my $thisletter = shift;
1591         my $baseletter = "";
1592         my $endletter;
1593
1594         if ($thisletter eq "") {
1595                 return "a";
1596         }
1597         if ((length $thisletter) > 1) {
1598                 ($baseletter, $endletter) = $thisletter =~ /([a-z]+)([a-z])/;
1599         } else {
1600                 $endletter = $thisletter;
1601         }
1602
1603         if ($endletter eq "z") {
1604                 return $thisletter."a";
1605         } else {
1606                 return $baseletter.(++$endletter);
1607         }
1608 }
1609
1610 #Check if a version is less than or equal to the current version. Its a fatal
1611 #error if not. They must also only differ in letters, or the last number (i.e.
1612 #the first two numbers must be the same)
1613 sub check_version_lte()
1614 {
1615         my ($testversion, $currversion) = @_;
1616         my $lentv;
1617         my $lencv;
1618         my $cvbase;
1619
1620         my ($cvnums) = $currversion =~ /^(\d_\d_\d)[a-z]*$/;
1621         my ($tvnums) = $testversion =~ /^(\d_\d_\d)[a-z]*$/;
1622
1623         #Die if we can't parse the version numbers or they don't look sane
1624         die "Invalid version number: $testversion and $currversion\n"
1625                 if (!defined($cvnums) || !defined($tvnums)
1626                         || length($cvnums) != 5
1627                         || length($tvnums) != 5);
1628
1629         #If the base versions (without letters) don't match check they only differ
1630         #in the last number
1631         if ($cvnums ne $tvnums) {
1632                 die "Invalid version number: $testversion "
1633                         ."for current version $currversion\n"
1634                         if (substr($cvnums, 0, 4) ne substr($tvnums, 0, 4));
1635                 return;
1636         }
1637         #If we get here then the base version (i.e. the numbers) are the same - they
1638         #only differ in the letters
1639
1640         $lentv = length $testversion;
1641         $lencv = length $currversion;
1642
1643         #If the testversion has more letters than the current version then it must
1644         #be later (or malformed)
1645         if ($lentv > $lencv) {
1646                 die "Invalid version number: $testversion "
1647                         ."is greater than $currversion\n";
1648         }
1649
1650         #Get the last letter from the current version
1651         my ($cvletter) = $currversion =~ /([a-z])$/;
1652         if (defined $cvletter) {
1653                 ($cvbase) = $currversion =~ /(\d_\d_\d[a-z]*)$cvletter$/;
1654         } else {
1655                 $cvbase = $currversion;
1656         }
1657         die "Unable to parse version number $currversion" if (!defined $cvbase);
1658         my $tvbase;
1659         my ($tvletter) = $testversion =~ /([a-z])$/;
1660         if (defined $tvletter) {
1661                 ($tvbase) = $testversion =~ /(\d_\d_\d[a-z]*)$tvletter$/;
1662         } else {
1663                 $tvbase = $testversion;
1664         }
1665         die "Unable to parse version number $testversion" if (!defined $tvbase);
1666
1667         if ($lencv > $lentv) {
1668                 #If current version has more letters than testversion then testversion
1669                 #minus the final letter must be a substring of the current version
1670                 die "Invalid version number $testversion "
1671                         ."is greater than $currversion or is invalid\n"
1672                         if (index($cvbase, $tvbase) != 0);
1673         } else {
1674                 #If both versions have the same number of letters then they must be
1675                 #equal up to the last letter, and the last letter in testversion must
1676                 #be less than or equal to the last letter in current version.
1677                 die "Invalid version number $testversion "
1678                         ."is greater than $currversion\n"
1679                         if (($cvbase ne $tvbase) && ($tvletter gt $cvletter));
1680         }
1681 }
1682
1683 sub do_deprecated()
1684 {
1685         my ($decl, $plats, $algs) = @_;
1686         $decl =~ /^\s*(DEPRECATEDIN_\d+_\d+_\d+)\s*\((.*)\)\s*$/
1687             or die "Bad DEPRECATEDIN: $decl\n";
1688         my $info1 .= "#INFO:";
1689         $info1 .= join(',', @{$plats}) . ":";
1690         my $info2 = $info1;
1691         $info1 .= join(',',@{$algs}, $1) . ";";
1692         $info2 .= join(',',@{$algs}) . ";";
1693         return $info1 . $2 . ";" . $info2;
1694 }