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