util/mkdef.pl

   1 #! /usr/bin/env perl
   2 # Copyright 1995-2018 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 my $trace=0;
 110 my $verbose=0;
 111
 112 my $crypto_num= catfile($config{sourcedir},"util","libcrypto.num");
 113 my $ssl_num=    catfile($config{sourcedir},"util","libssl.num");
 114 my $libname;
 115
 116 my $do_update = 0;
 117 my $do_rewrite = 1;
 118 my $do_crypto = 0;
 119 my $do_ssl = 0;
 120 my $do_ctest = 0;
 121 my $do_ctestall = 0;
 122 my $do_checkexist = 0;
 123
 124 my $VMS=0;
 125 my $W32=0;
 126 my $NT=0;
 127 my $UNIX=0;
 128 my $linux=0;
 129 # Set this to make typesafe STACK definitions appear in DEF
 130 my $safe_stack_def = 0;
 131
 132 my @known_platforms = ( "__FreeBSD__", "PERL5",
 133                         "EXPORT_VAR_AS_FUNCTION", "ZLIB", "_WIN32"
 134                         );
 135 my @known_ossl_platforms = ( "UNIX", "VMS", "WIN32", "WINNT", "OS2" );
 136 my @known_algorithms = ( "RC2", "RC4", "RC5", "IDEA", "DES", "BF",
 137                          "CAST", "MD2", "MD4", "MD5", "SHA", "SHA0", "SHA1",
 138                          "SHA256", "SHA512", "RMD160",
 139                          "MDC2", "WHIRLPOOL", "RSA", "DSA", "DH", "EC", "EC2M",
 140                          "HMAC", "AES", "CAMELLIA", "SEED", "GOST", "ARIA", "SM4",
 141                          "SCRYPT", "CHACHA", "POLY1305", "BLAKE2",
 142                          "SIPHASH", "SM3",
 143                          # EC_NISTP_64_GCC_128
 144                          "EC_NISTP_64_GCC_128",
 145                          # Envelope "algorithms"
 146                          "EVP", "X509", "ASN1_TYPEDEFS",
 147                          # Helper "algorithms"
 148                          "BIO", "COMP", "BUFFER", "LHASH", "STACK", "ERR",
 149                          "LOCKING",
 150                          # External "algorithms"
 151                          "FP_API", "STDIO", "SOCK", "DGRAM",
 152                          "CRYPTO_MDEBUG",
 153                          # Engines
 154                          "STATIC_ENGINE", "ENGINE", "HW", "GMP",
 155                          # Entropy Gathering
 156                          "EGD",
 157                          # Certificate Transparency
 158                          "CT",
 159                          # RFC3779
 160                          "RFC3779",
 161                          # TLS
 162                          "PSK", "SRP", "HEARTBEATS",
 163                          # CMS
 164                          "CMS",
 165                          "OCSP",
 166                          # CryptoAPI Engine
 167                          "CAPIENG",
 168                          # SSL methods
 169                          "SSL3_METHOD", "TLS1_METHOD", "TLS1_1_METHOD", "TLS1_2_METHOD", "DTLS1_METHOD", "DTLS1_2_METHOD",
 170                          # NEXTPROTONEG
 171                          "NEXTPROTONEG",
 172                          # Deprecated functions
 173                          "DEPRECATEDIN_0_9_8",
 174                          "DEPRECATEDIN_1_0_0",
 175                          "DEPRECATEDIN_1_1_0",
 176                          "DEPRECATEDIN_1_2_0",
 177                          # SCTP
 178                          "SCTP",
 179                          # SRTP
 180                          "SRTP",
 181                          # SSL TRACE
 182                          "SSL_TRACE",
 183                          # Unit testing
 184                          "UNIT_TEST",
 185                          # User Interface
 186                          "UI_CONSOLE",
 187                          #
 188                          "TS",
 189                          # OCB mode
 190                          "OCB",
 191                          "CMAC",
 192                          # APPLINK (win build feature?)
 193                          "APPLINK"
 194                      );
 195
 196 my %disabled_algorithms;
 197
 198 foreach (@known_algorithms) {
 199     $disabled_algorithms{$_} = 0;
 200 }
 201 # disabled by default
 202 $disabled_algorithms{"STATIC_ENGINE"} = 1;
 203
 204 my $apiv = sprintf "%x%02x%02x", split(/\./, $config{api});
 205 foreach (keys %disabled_algorithms) {
 206         if (/^DEPRECATEDIN_(\d+)_(\d+)_(\d+)$/) {
 207                 my $depv = sprintf "%x%02x%02x", $1, $2, $3;
 208                 $disabled_algorithms{$_} = 1 if $apiv ge $depv;
 209         }
 210 }
 211
 212 my $zlib;
 213
 214 foreach (@ARGV, split(/ /, $config{options}))
 215         {
 216         $debug=1 if $_ eq "debug";
 217         $trace=1 if $_ eq "trace";
 218         $verbose=1 if $_ eq "verbose";
 219         $W32=1 if $_ eq "32";
 220         die "win16 not supported" if $_ eq "16";
 221         if($_ eq "NT") {
 222                 $W32 = 1;
 223                 $NT = 1;
 224         }
 225         if ($_ eq "linux") {
 226                 $linux=1;
 227                 $UNIX=1;
 228         }
 229         $VMS=1 if $_ eq "VMS";
 230         if ($_ eq "zlib" || $_ eq "enable-zlib" || $_ eq "zlib-dynamic"
 231                          || $_ eq "enable-zlib-dynamic") {
 232                 $zlib = 1;
 233         }
 234
 235         $do_crypto=1 if $_ eq "libcrypto" || $_ eq "crypto";
 236         $do_ssl=1 if $_ eq "libssl" || $_ eq "ssl";
 237
 238         $do_update=1 if $_ eq "update";
 239         $do_rewrite=1 if $_ eq "rewrite";
 240         $do_ctest=1 if $_ eq "ctest";
 241         $do_ctestall=1 if $_ eq "ctestall";
 242         $do_checkexist=1 if $_ eq "exist";
 243         if (/^(enable|disable|no)-(.*)$/) {
 244                 my $alg = uc $2;
 245                 $alg =~ tr/-/_/;
 246                 if (exists $disabled_algorithms{$alg}) {
 247                         $disabled_algorithms{$alg} = $1 eq "enable" ? 0 : 1;
 248                 }
 249         }
 250
 251         }
 252 $libname = $unified_info{sharednames}->{libcrypto} if $do_crypto;
 253 $libname = $unified_info{sharednames}->{libssl} if $do_ssl;
 254
 255 if (!$libname) {
 256         if ($do_ssl) {
 257                 $libname="LIBSSL";
 258         }
 259         if ($do_crypto) {
 260                 $libname="LIBCRYPTO";
 261         }
 262 }
 263
 264 # If no platform is given, assume WIN32
 265 if ($W32 + $VMS + $linux == 0) {
 266         $W32 = 1;
 267 }
 268 die "Please, only one platform at a time"
 269     if ($W32 + $VMS + $linux > 1);
 270
 271 if (!$do_ssl && !$do_crypto)
 272         {
 273         print STDERR "usage: $0 ( ssl | crypto ) [ 16 | 32 | NT | OS2 | linux | VMS ]\n";
 274         exit(1);
 275         }
 276
 277 %ssl_list=&load_numbers($ssl_num);
 278 $max_ssl = $max_num;
 279 %crypto_list=&load_numbers($crypto_num);
 280 $max_crypto = $max_num;
 281
 282 my $ssl="include/openssl/ssl.h";
 283 $ssl.=" include/openssl/sslerr.h";
 284 $ssl.=" include/openssl/tls1.h";
 285 $ssl.=" include/openssl/srtp.h";
 286
 287 # When scanning include/openssl, skip all SSL files and some internal ones.
 288 my %skipthese;
 289 foreach my $f ( split(/\s+/, $ssl) ) {
 290     $skipthese{$f} = 1;
 291 }
 292 $skipthese{'include/openssl/conf_api.h'} = 1;
 293 $skipthese{'include/openssl/ebcdic.h'} = 1;
 294 $skipthese{'include/openssl/opensslconf.h'} = 1;
 295
 296 # We use headers found in include/openssl and include/internal only.
 297 # The latter is needed so libssl.so/.dll/.exe can link properly.
 298 my $crypto ="include/internal/dso.h";
 299 $crypto.=" include/internal/o_dir.h";
 300 $crypto.=" include/internal/o_str.h";
 301 $crypto.=" include/internal/err.h";
 302 $crypto.=" include/internal/rand.h";
 303 foreach my $f ( glob(catfile($config{sourcedir},'include/openssl/*.h')) ) {
 304     my $fn = "include/openssl/" . lc(basename($f));
 305     $crypto .= " $fn" if !defined $skipthese{$fn} && $f !~ m@/[a-z]+err\.h$@;
 306 }
 307
 308 my $symhacks="include/openssl/symhacks.h";
 309
 310 my @ssl_symbols = &do_defs("LIBSSL", $ssl, $symhacks);
 311 my @crypto_symbols = &do_defs("LIBCRYPTO", $crypto, $symhacks);
 312
 313 if ($do_update) {
 314
 315 if ($do_ssl == 1) {
 316
 317         &maybe_add_info("LIBSSL",*ssl_list,@ssl_symbols);
 318         if ($do_rewrite == 1) {
 319                 open(OUT, ">$ssl_num");
 320                 &rewrite_numbers(*OUT,"LIBSSL",*ssl_list,@ssl_symbols);
 321         } else {
 322                 open(OUT, ">>$ssl_num");
 323         }
 324         &update_numbers(*OUT,"LIBSSL",*ssl_list,$max_ssl,@ssl_symbols);
 325         close OUT;
 326 }
 327
 328 if($do_crypto == 1) {
 329
 330         &maybe_add_info("LIBCRYPTO",*crypto_list,@crypto_symbols);
 331         if ($do_rewrite == 1) {
 332                 open(OUT, ">$crypto_num");
 333                 &rewrite_numbers(*OUT,"LIBCRYPTO",*crypto_list,@crypto_symbols);
 334         } else {
 335                 open(OUT, ">>$crypto_num");
 336         }
 337         &update_numbers(*OUT,"LIBCRYPTO",*crypto_list,$max_crypto,@crypto_symbols);
 338         close OUT;
 339 }
 340
 341 } elsif ($do_checkexist) {
 342         &check_existing(*ssl_list, @ssl_symbols)
 343                 if $do_ssl == 1;
 344         &check_existing(*crypto_list, @crypto_symbols)
 345                 if $do_crypto == 1;
 346 } elsif ($do_ctest || $do_ctestall) {
 347
 348         print <<"EOF";
 349
 350 /* Test file to check all DEF file symbols are present by trying
 351  * to link to all of them. This is *not* intended to be run!
 352  */
 353
 354 int main()
 355 {
 356 EOF
 357         &print_test_file(*STDOUT,"LIBSSL",*ssl_list,$do_ctestall,@ssl_symbols)
 358                 if $do_ssl == 1;
 359
 360         &print_test_file(*STDOUT,"LIBCRYPTO",*crypto_list,$do_ctestall,@crypto_symbols)
 361                 if $do_crypto == 1;
 362
 363         print "}\n";
 364
 365 } else {
 366
 367         &print_def_file(*STDOUT,$libname,*ssl_list,@ssl_symbols)
 368                 if $do_ssl == 1;
 369
 370         &print_def_file(*STDOUT,$libname,*crypto_list,@crypto_symbols)
 371                 if $do_crypto == 1;
 372
 373 }
 374
 375
 376 sub do_defs
 377 {
 378         my($name,$files,$symhacksfile)=@_;
 379         my $file;
 380         my @ret;
 381         my %syms;
 382         my %platform;           # For anything undefined, we assume ""
 383         my %kind;               # For anything undefined, we assume "FUNCTION"
 384         my %algorithm;          # For anything undefined, we assume ""
 385         my %variant;
 386         my %variant_cnt;        # To be able to allocate "name{n}" if "name"
 387                                 # is the same name as the original.
 388         my $cpp;
 389         my %unknown_algorithms = ();
 390         my $parens = 0;
 391
 392         foreach $file (split(/\s+/,$symhacksfile." ".$files))
 393                 {
 394                 my $fn = catfile($config{sourcedir},$file);
 395                 print STDERR "DEBUG: starting on $fn:\n" if $debug;
 396                 print STDERR "TRACE: start reading $fn\n" if $trace;
 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\s*\(([^\)]+)\)/) {
 538                                 push(@tag,"-");
 539                                 if (/^\#\s*if\s+(!defined\s*\(([^\)]+)\)(\s+\&\&\s+!defined\s*\(([^\)]+)\))*)$/) {
 540                                         my $tmp_1 = $1;
 541                                         my $tmp_;
 542                                         foreach $tmp_ (split '\&\&',$tmp_1) {
 543                                                 $tmp_ =~ /!defined\s*\(([^\)]+)\)/;
 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: taking only '!defined($1)' of complicated expression: $_" if $verbose; # 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\s*\(([^\)]+)\)/) {
 560                                 push(@tag,"-");
 561                                 if (/^\#\s*if\s+(defined\s*\(([^\)]+)\)(\s+\|\|\s+defined\s*\(([^\)]+)\))*)$/) {
 562                                         my $tmp_1 = $1;
 563                                         my $tmp_;
 564                                         foreach $tmp_ (split '\|\|',$tmp_1) {
 565                                                 $tmp_ =~ /defined\s*\(([^\)]+)\)/;
 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: taking only 'defined($1)' of complicated expression: $_\n" if $verbose; # 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                                 print STDERR "Warning: $file: ignoring unrecognized expression: $_\n" if $verbose; # because it is O...
 637                         } elsif (/^\#\s*define\s+(\w+)\s+(\w+)/
 638                                  && $symhacking && $tag{'TRUE'} != -1) {
 639                                 # This is for aliasing.  When we find an alias,
 640                                 # we have to invert
 641                                 &$make_variant($1,$2);
 642                                 print STDERR "DEBUG: $file: defined $1 = $2\n" if $debug;
 643                         }
 644                         if (/^\#/) {
 645                                 @current_platforms =
 646                                     grep(!/^$/,
 647                                          map { $tag{$_} == 1 ? $_ :
 648                                                    $tag{$_} == -1 ? "!".$_  : "" }
 649                                          @known_platforms);
 650                                 push @current_platforms
 651                                     , grep(!/^$/,
 652                                            map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ :
 653                                                      $tag{"OPENSSL_SYS_".$_} == -1 ? "!".$_  : "" }
 654                                            @known_ossl_platforms);
 655                                 @current_algorithms = ();
 656                                 @current_algorithms =
 657                                     grep(!/^$/,
 658                                          map { $tag{"OPENSSL_NO_".$_} == -1 ? $_ : "" }
 659                                          @known_algorithms);
 660                                 push @current_algorithms
 661                                     , grep(!/^$/,
 662                                          map { $tag{"OPENSSL_USE_".$_} == 1 ? $_ : "" }
 663                                          @known_algorithms);
 664                                 push @current_algorithms,
 665                                     grep { /^DEPRECATEDIN_/ && $tag{$_} == 1 }
 666                                     @known_algorithms;
 667                                 $def .=
 668                                     "#INFO:"
 669                                         .join(',',@current_platforms).":"
 670                                             .join(',',@current_algorithms).";";
 671                                 next;
 672                         }
 673                         if ($tag{'TRUE'} != -1) {
 674                                 if (/^\s*DEFINE_STACK_OF\s*\(\s*(\w*)\s*\)/
 675                                                 || /^\s*DEFINE_STACK_OF_CONST\s*\(\s*(\w*)\s*\)/) {
 676                                         next;
 677                                 } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) {
 678                                         $def .= "int d2i_$3(void);";
 679                                         $def .= "int i2d_$3(void);";
 680                                         # Variant for platforms that do not
 681                                         # have to access global variables
 682                                         # in shared libraries through functions
 683                                         $def .=
 684                                             "#INFO:"
 685                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 686                                                     .join(',',@current_algorithms).";";
 687                                         $def .= "OPENSSL_EXTERN int $2_it;";
 688                                         $def .=
 689                                             "#INFO:"
 690                                                 .join(',',@current_platforms).":"
 691                                                     .join(',',@current_algorithms).";";
 692                                         # Variant for platforms that have to
 693                                         # access global variables in shared
 694                                         # libraries through functions
 695                                         &$make_variant("$2_it","$2_it",
 696                                                       "EXPORT_VAR_AS_FUNCTION",
 697                                                       "FUNCTION");
 698                                         next;
 699                                 } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_fname\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) {
 700                                         $def .= "int d2i_$3(void);";
 701                                         $def .= "int i2d_$3(void);";
 702                                         $def .= "int $3_free(void);";
 703                                         $def .= "int $3_new(void);";
 704                                         # Variant for platforms that do not
 705                                         # have to access global variables
 706                                         # in shared libraries through functions
 707                                         $def .=
 708                                             "#INFO:"
 709                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 710                                                     .join(',',@current_algorithms).";";
 711                                         $def .= "OPENSSL_EXTERN int $2_it;";
 712                                         $def .=
 713                                             "#INFO:"
 714                                                 .join(',',@current_platforms).":"
 715                                                     .join(',',@current_algorithms).";";
 716                                         # Variant for platforms that have to
 717                                         # access global variables in shared
 718                                         # libraries through functions
 719                                         &$make_variant("$2_it","$2_it",
 720                                                       "EXPORT_VAR_AS_FUNCTION",
 721                                                       "FUNCTION");
 722                                         next;
 723                                 } elsif (/^\s*DECLARE_ASN1_FUNCTIONS\s*\(\s*(\w*)\s*\)/ ||
 724                                          /^\s*DECLARE_ASN1_FUNCTIONS_const\s*\(\s*(\w*)\s*\)/) {
 725                                         $def .= "int d2i_$1(void);";
 726                                         $def .= "int i2d_$1(void);";
 727                                         $def .= "int $1_free(void);";
 728                                         $def .= "int $1_new(void);";
 729                                         # Variant for platforms that do not
 730                                         # have to access global variables
 731                                         # in shared libraries through functions
 732                                         $def .=
 733                                             "#INFO:"
 734                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 735                                                     .join(',',@current_algorithms).";";
 736                                         $def .= "OPENSSL_EXTERN int $1_it;";
 737                                         $def .=
 738                                             "#INFO:"
 739                                                 .join(',',@current_platforms).":"
 740                                                     .join(',',@current_algorithms).";";
 741                                         # Variant for platforms that have to
 742                                         # access global variables in shared
 743                                         # libraries through functions
 744                                         &$make_variant("$1_it","$1_it",
 745                                                       "EXPORT_VAR_AS_FUNCTION",
 746                                                       "FUNCTION");
 747                                         next;
 748                                 } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS_const\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
 749                                         $def .= "int d2i_$2(void);";
 750                                         $def .= "int i2d_$2(void);";
 751                                         # Variant for platforms that do not
 752                                         # have to access global variables
 753                                         # in shared libraries through functions
 754                                         $def .=
 755                                             "#INFO:"
 756                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 757                                                     .join(',',@current_algorithms).";";
 758                                         $def .= "OPENSSL_EXTERN int $2_it;";
 759                                         $def .=
 760                                             "#INFO:"
 761                                                 .join(',',@current_platforms).":"
 762                                                     .join(',',@current_algorithms).";";
 763                                         # Variant for platforms that have to
 764                                         # access global variables in shared
 765                                         # libraries through functions
 766                                         &$make_variant("$2_it","$2_it",
 767                                                       "EXPORT_VAR_AS_FUNCTION",
 768                                                       "FUNCTION");
 769                                         next;
 770                                 } elsif (/^\s*DECLARE_ASN1_ALLOC_FUNCTIONS\s*\(\s*(\w*)\s*\)/) {
 771                                         $def .= "int $1_free(void);";
 772                                         $def .= "int $1_new(void);";
 773                                         next;
 774                                 } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
 775                                         $def .= "int d2i_$2(void);";
 776                                         $def .= "int i2d_$2(void);";
 777                                         $def .= "int $2_free(void);";
 778                                         $def .= "int $2_new(void);";
 779                                         # Variant for platforms that do not
 780                                         # have to access global variables
 781                                         # in shared libraries through functions
 782                                         $def .=
 783                                             "#INFO:"
 784                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 785                                                     .join(',',@current_algorithms).";";
 786                                         $def .= "OPENSSL_EXTERN int $2_it;";
 787                                         $def .=
 788                                             "#INFO:"
 789                                                 .join(',',@current_platforms).":"
 790                                                     .join(',',@current_algorithms).";";
 791                                         # Variant for platforms that have to
 792                                         # access global variables in shared
 793                                         # libraries through functions
 794                                         &$make_variant("$2_it","$2_it",
 795                                                       "EXPORT_VAR_AS_FUNCTION",
 796                                                       "FUNCTION");
 797                                         next;
 798                                 } elsif (/^\s*DECLARE_ASN1_ITEM\s*\(\s*(\w*)\s*\)/) {
 799                                         # Variant for platforms that do not
 800                                         # have to access global variables
 801                                         # in shared libraries through functions
 802                                         $def .=
 803                                             "#INFO:"
 804                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 805                                                     .join(',',@current_algorithms).";";
 806                                         $def .= "OPENSSL_EXTERN int $1_it;";
 807                                         $def .=
 808                                             "#INFO:"
 809                                                 .join(',',@current_platforms).":"
 810                                                     .join(',',@current_algorithms).";";
 811                                         # Variant for platforms that have to
 812                                         # access global variables in shared
 813                                         # libraries through functions
 814                                         &$make_variant("$1_it","$1_it",
 815                                                       "EXPORT_VAR_AS_FUNCTION",
 816                                                       "FUNCTION");
 817                                         next;
 818                                 } elsif (/^\s*DECLARE_ASN1_NDEF_FUNCTION\s*\(\s*(\w*)\s*\)/) {
 819                                         $def .= "int i2d_$1_NDEF(void);";
 820                                 } elsif (/^\s*DECLARE_ASN1_SET_OF\s*\(\s*(\w*)\s*\)/) {
 821                                         next;
 822                                 } elsif (/^\s*DECLARE_ASN1_PRINT_FUNCTION\s*\(\s*(\w*)\s*\)/) {
 823                                         $def .= "int $1_print_ctx(void);";
 824                                         next;
 825                                 } elsif (/^\s*DECLARE_ASN1_PRINT_FUNCTION_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
 826                                         $def .= "int $2_print_ctx(void);";
 827                                         next;
 828                                 } elsif (/^\s*DECLARE_PKCS12_STACK_OF\s*\(\s*(\w*)\s*\)/) {
 829                                         next;
 830                                 } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ ||
 831                                          /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ ||
 832                                          /^DECLARE_PEM_rw_const\s*\(\s*(\w*)\s*,/ ) {
 833                                         $def .=
 834                                             "#INFO:"
 835                                                 .join(',',@current_platforms).":"
 836                                                     .join(',',"STDIO",@current_algorithms).";";
 837                                         $def .= "int PEM_read_$1(void);";
 838                                         $def .= "int PEM_write_$1(void);";
 839                                         $def .=
 840                                             "#INFO:"
 841                                                 .join(',',@current_platforms).":"
 842                                                     .join(',',@current_algorithms).";";
 843                                         # Things that are everywhere
 844                                         $def .= "int PEM_read_bio_$1(void);";
 845                                         $def .= "int PEM_write_bio_$1(void);";
 846                                         next;
 847                                 } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ ||
 848                                         /^DECLARE_PEM_write_const\s*\(\s*(\w*)\s*,/ ||
 849                                          /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) {
 850                                         $def .=
 851                                             "#INFO:"
 852                                                 .join(',',@current_platforms).":"
 853                                                     .join(',',"STDIO",@current_algorithms).";";
 854                                         $def .= "int PEM_write_$1(void);";
 855                                         $def .=
 856                                             "#INFO:"
 857                                                 .join(',',@current_platforms).":"
 858                                                     .join(',',@current_algorithms).";";
 859                                         # Things that are everywhere
 860                                         $def .= "int PEM_write_bio_$1(void);";
 861                                         next;
 862                                 } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ ||
 863                                          /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) {
 864                                         $def .=
 865                                             "#INFO:"
 866                                                 .join(',',@current_platforms).":"
 867                                                     .join(',',"STDIO",@current_algorithms).";";
 868                                         $def .= "int PEM_read_$1(void);";
 869                                         $def .=
 870                                             "#INFO:"
 871                                                 .join(',',@current_platforms).":"
 872                                                     .join(',',"STDIO",@current_algorithms).";";
 873                                         # Things that are everywhere
 874                                         $def .= "int PEM_read_bio_$1(void);";
 875                                         next;
 876                                 } elsif (/^OPENSSL_DECLARE_GLOBAL\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
 877                                         # Variant for platforms that do not
 878                                         # have to access global variables
 879                                         # in shared libraries through functions
 880                                         $def .=
 881                                             "#INFO:"
 882                                                 .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
 883                                                     .join(',',@current_algorithms).";";
 884                                         $def .= "OPENSSL_EXTERN int _shadow_$2;";
 885                                         $def .=
 886                                             "#INFO:"
 887                                                 .join(',',@current_platforms).":"
 888                                                     .join(',',@current_algorithms).";";
 889                                         # Variant for platforms that have to
 890                                         # access global variables in shared
 891                                         # libraries through functions
 892                                         &$make_variant("_shadow_$2","_shadow_$2",
 893                                                       "EXPORT_VAR_AS_FUNCTION",
 894                                                       "FUNCTION");
 895                                 } elsif (/^\s*DEPRECATEDIN/) {
 896                                         $parens = count_parens($_);
 897                                         if ($parens == 0) {
 898                                                 $def .= do_deprecated($_,
 899                                                         \@current_platforms,
 900                                                         \@current_algorithms);
 901                                         } else {
 902                                                 $stored_multiline = $_;
 903                                                 print STDERR "DEBUG: Found multiline DEPRECATEDIN starting with: $stored_multiline\n" if $debug;
 904                                                 next;
 905                                         }
 906                                 } elsif ($tag{'CONST_STRICT'} != 1) {
 907                                         if (/\{|\/\*|\([^\)]*$/) {
 908                                                 $line = $_;
 909                                         } else {
 910                                                 $def .= $_;
 911                                         }
 912                                 }
 913                         }
 914                 }
 915                 close(IN);
 916                 die "$file: Unmatched tags\n" if $#tag >= 0;
 917
 918                 my $algs;
 919                 my $plays;
 920
 921                 print STDERR "DEBUG: postprocessing ----------\n" if $debug;
 922                 foreach (split /;/, $def) {
 923                         my $s; my $k = "FUNCTION"; my $p; my $a;
 924                         s/^[\n\s]*//g;
 925                         s/[\n\s]*$//g;
 926                         next if(/\#undef/);
 927                         next if(/typedef\W/);
 928                         next if(/\#define/);
 929
 930                         print STDERR "TRACE: processing $_\n" if $trace && !/^\#INFO:/;
 931                         # Reduce argument lists to empty ()
 932                         # fold round brackets recursively: (t(*v)(t),t) -> (t{}{},t) -> {}
 933                         my $nsubst = 1; # prevent infinite loop, e.g., on  int fn()
 934                         while($nsubst && /\(.*\)/s) {
 935                                 $nsubst = s/\([^\(\)]+\)/\{\}/gs;
 936                                 $nsubst+= s/\(\s*\*\s*(\w+)\s*\{\}\s*\)/$1/gs;  #(*f{}) -> f
 937                         }
 938                         # pretend as we didn't use curly braces: {} -> ()
 939                         s/\{\}/\(\)/gs;
 940
 941                         s/STACK_OF\(\)/void/gs;
 942                         s/LHASH_OF\(\)/void/gs;
 943
 944                         print STDERR "DEBUG: \$_ = \"$_\"\n" if $debug;
 945                         if (/^\#INFO:([^:]*):(.*)$/) {
 946                                 $plats = $1;
 947                                 $algs = $2;
 948                                 print STDERR "DEBUG: found info on platforms ($plats) and algorithms ($algs)\n" if $debug;
 949                                 next;
 950                         } elsif (/^\s*OPENSSL_EXTERN\s.*?(\w+(\{[0-9]+\})?)(\[[0-9]*\])*\s*$/) {
 951                                 $s = $1;
 952                                 $k = "VARIABLE";
 953                                 print STDERR "DEBUG: found external variable $s\n" if $debug;
 954                         } elsif (/TYPEDEF_\w+_OF/s) {
 955                                 next;
 956                         } elsif (/(\w+)\s*\(\).*/s) {   # first token prior [first] () is
 957                                 $s = $1;                # a function name!
 958                                 print STDERR "DEBUG: found function $s\n" if $debug;
 959                         } elsif (/\(/ and not (/=/)) {
 960                                 print STDERR "File $file: cannot parse: $_;\n";
 961                                 next;
 962                         } else {
 963                                 next;
 964                         }
 965
 966                         $syms{$s} = 1;
 967                         $kind{$s} = $k;
 968
 969                         $p = $plats;
 970                         $a = $algs;
 971
 972                         $platform{$s} =
 973                             &reduce_platforms((defined($platform{$s})?$platform{$s}.',':"").$p);
 974                         $algorithm{$s} .= ','.$a;
 975
 976                         if (defined($variant{$s})) {
 977                                 foreach $v (split /;/,$variant{$s}) {
 978                                         (my $r, my $p, my $k) = split(/:/,$v);
 979                                         my $ip = join ',',map({ /^!(.*)$/ ? $1 : "!".$_ } split /,/, $p);
 980                                         $syms{$r} = 1;
 981                                         if (!defined($k)) { $k = $kind{$s}; }
 982                                         $kind{$r} = $k."(".$s.")";
 983                                         $algorithm{$r} = $algorithm{$s};
 984                                         $platform{$r} = &reduce_platforms($platform{$s}.",".$p.",".$p);
 985                                         $platform{$s} = &reduce_platforms($platform{$s}.','.$ip.','.$ip);
 986                                         print STDERR "DEBUG: \$variant{\"$s\"} = ",$v,"; \$r = $r; \$p = ",$platform{$r},"; \$a = ",$algorithm{$r},"; \$kind = ",$kind{$r},"\n" if $debug;
 987                                 }
 988                         }
 989                         print STDERR "DEBUG: \$s = $s; \$p = ",$platform{$s},"; \$a = ",$algorithm{$s},"; \$kind = ",$kind{$s},"\n" if $debug;
 990                 }
 991         }
 992
 993         # Prune the returned symbols
 994
 995         delete $syms{"bn_dump1"};
 996         $platform{"BIO_s_log"} .= ",!WIN32,!macintosh";
 997
 998         $platform{"PEM_read_NS_CERT_SEQ"} = "VMS";
 999         $platform{"PEM_write_NS_CERT_SEQ"} = "VMS";
1000         $platform{"PEM_read_P8_PRIV_KEY_INFO"} = "VMS";
1001         $platform{"PEM_write_P8_PRIV_KEY_INFO"} = "VMS";
1002
1003         # Info we know about
1004
1005         push @ret, map { $_."\\".&info_string($_,"EXIST",
1006                                               $platform{$_},
1007                                               $kind{$_},
1008                                               $algorithm{$_}) } keys %syms;
1009
1010         if (keys %unknown_algorithms) {
1011                 print STDERR "WARNING: mkdef.pl doesn't know the following algorithms:\n";
1012                 print STDERR "\t",join("\n\t",keys %unknown_algorithms),"\n";
1013         }
1014         return(@ret);
1015 }
1016
1017 # Param: string of comma-separated platform-specs.
1018 sub reduce_platforms
1019 {
1020         my ($platforms) = @_;
1021         my $pl = defined($platforms) ? $platforms : "";
1022         my %p = map { $_ => 0 } split /,/, $pl;
1023         my $ret;
1024
1025         print STDERR "DEBUG: Entered reduce_platforms with \"$platforms\"\n"
1026             if $debug;
1027         # We do this, because if there's code like the following, it really
1028         # means the function exists in all cases and should therefore be
1029         # everywhere.  By increasing and decreasing, we may attain 0:
1030         #
1031         # ifndef WIN16
1032         #    int foo();
1033         # else
1034         #    int _fat foo();
1035         # endif
1036         foreach $platform (split /,/, $pl) {
1037                 if ($platform =~ /^!(.*)$/) {
1038                         $p{$1}--;
1039                 } else {
1040                         $p{$platform}++;
1041                 }
1042         }
1043         foreach $platform (keys %p) {
1044                 if ($p{$platform} == 0) { delete $p{$platform}; }
1045         }
1046
1047         delete $p{""};
1048
1049         $ret = join(',',sort(map { $p{$_} < 0 ? "!".$_ : $_ } keys %p));
1050         print STDERR "DEBUG: Exiting reduce_platforms with \"$ret\"\n"
1051             if $debug;
1052         return $ret;
1053 }
1054
1055 sub info_string
1056 {
1057         (my $symbol, my $exist, my $platforms, my $kind, my $algorithms) = @_;
1058
1059         my %a = defined($algorithms) ?
1060             map { $_ => 1 } split /,/, $algorithms : ();
1061         my $k = defined($kind) ? $kind : "FUNCTION";
1062         my $ret;
1063         my $p = &reduce_platforms($platforms);
1064
1065         delete $a{""};
1066
1067         $ret = $exist;
1068         $ret .= ":".$p;
1069         $ret .= ":".$k;
1070         $ret .= ":".join(',',sort keys %a);
1071         return $ret;
1072 }
1073
1074 sub maybe_add_info
1075 {
1076         (my $name, *nums, my @symbols) = @_;
1077         my $sym;
1078         my $new_info = 0;
1079         my %syms=();
1080
1081         foreach $sym (@symbols) {
1082                 (my $s, my $i) = split /\\/, $sym;
1083                 if (defined($nums{$s})) {
1084                         $i =~ s/^(.*?:.*?:\w+)(\(\w+\))?/$1/;
1085                         (my $n, my $vers, my $dummy) = split /\\/, $nums{$s};
1086                         if (!defined($dummy) || $i ne $dummy) {
1087                                 $nums{$s} = $n."\\".$vers."\\".$i;
1088                                 $new_info++;
1089                                 print STDERR "DEBUG: maybe_add_info for $s: \"$dummy\" => \"$i\"\n" if $debug;
1090                         }
1091                 }
1092                 $syms{$s} = 1;
1093         }
1094
1095         my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums;
1096         foreach $sym (@s) {
1097                 (my $n, my $vers, my $i) = split /\\/, $nums{$sym};
1098                 if (!defined($syms{$sym}) && $i !~ /^NOEXIST:/) {
1099                         $new_info++;
1100                         print STDERR "DEBUG: maybe_add_info for $sym: -> undefined\n" if $debug;
1101                 }
1102         }
1103         if ($new_info) {
1104                 print STDERR "$name: $new_info old symbols have updated info\n";
1105                 if (!$do_rewrite) {
1106                         print STDERR "You should do a rewrite to fix this.\n";
1107                 }
1108         } else {
1109         }
1110 }
1111
1112 # Param: string of comma-separated keywords, each possibly prefixed with a "!"
1113 sub is_valid
1114 {
1115         my ($keywords_txt,$platforms) = @_;
1116         my (@keywords) = split /,/,$keywords_txt;
1117         my ($falsesum, $truesum) = (0, 1);
1118
1119         # Param: one keyword
1120         sub recognise
1121         {
1122                 my ($keyword,$platforms) = @_;
1123
1124                 if ($platforms) {
1125                         # platforms
1126                         if ($keyword eq "UNIX" && $UNIX) { return 1; }
1127                         if ($keyword eq "VMS" && $VMS) { return 1; }
1128                         if ($keyword eq "WIN32" && $W32) { return 1; }
1129                         if ($keyword eq "_WIN32" && $W32) { return 1; }
1130                         if ($keyword eq "WINNT" && $NT) { return 1; }
1131                         # Special platforms:
1132                         # EXPORT_VAR_AS_FUNCTION means that global variables
1133                         # will be represented as functions.
1134                         if ($keyword eq "EXPORT_VAR_AS_FUNCTION" && $W32) {
1135                                 return 1;
1136                         }
1137                         if ($keyword eq "ZLIB" && $zlib) { return 1; }
1138                         return 0;
1139                 } else {
1140                         # algorithms
1141                         if ($disabled_algorithms{$keyword} == 1) { return 0;}
1142
1143                         # Nothing recognise as true
1144                         return 1;
1145                 }
1146         }
1147
1148         foreach $k (@keywords) {
1149                 if ($k =~ /^!(.*)$/) {
1150                         $falsesum += &recognise($1,$platforms);
1151                 } else {
1152                         $truesum *= &recognise($k,$platforms);
1153                 }
1154         }
1155         print STDERR "DEBUG: [",$#keywords,",",$#keywords < 0,"] is_valid($keywords_txt) => (\!$falsesum) && $truesum = ",(!$falsesum) && $truesum,"\n" if $debug;
1156         return (!$falsesum) && $truesum;
1157 }
1158
1159 sub print_test_file
1160 {
1161         (*OUT,my $name,*nums,my $testall,my @symbols)=@_;
1162         my $n = 1; my @e; my @r;
1163         my $sym; my $prev = ""; my $prefSSLeay;
1164
1165         (@e)=grep(/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols);
1166         (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:.*/ && !/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols);
1167         @symbols=((sort @e),(sort @r));
1168
1169         foreach $sym (@symbols) {
1170                 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
1171                 my $v = 0;
1172                 $v = 1 if $i=~ /^.*?:.*?:VARIABLE/;
1173                 my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
1174                 my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
1175                 if (!defined($nums{$s})) {
1176                         print STDERR "Warning: $s does not have a number assigned\n"
1177                             if(!$do_update);
1178                 } elsif (is_valid($p,1) && is_valid($a,0)) {
1179                         my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1);
1180                         if ($prev eq $s2) {
1181                                 print OUT "\t/* The following has already appeared previously */\n";
1182                                 print STDERR "Warning: Symbol '",$s2,"' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n";
1183                         }
1184                         $prev = $s2;    # To warn about duplicates...
1185
1186                         (my $nn, my $vers, my $ni) = split /\\/, $nums{$s2};
1187                         if ($v) {
1188                                 print OUT "\textern int $s2; /* type unknown */ /* $nn $ni */\n";
1189                         } else {
1190                                 print OUT "\textern int $s2(); /* type unknown */ /* $nn $ni */\n";
1191                         }
1192                 }
1193         }
1194 }
1195
1196 sub get_version
1197 {
1198    return $config{version};
1199 }
1200
1201 sub print_def_file
1202 {
1203         (*OUT,my $name,*nums,my @symbols)=@_;
1204         my $n = 1; my @e; my @r; my @v; my $prev="";
1205         my $liboptions="";
1206         my $libname = $name;
1207         my $http_vendor = 'www.openssl.org/';
1208         my $version = get_version();
1209         my $what = "OpenSSL: implementation of Secure Socket Layer";
1210         my $description = "$what $version, $name - http://$http_vendor";
1211         my $prevsymversion = "", $prevprevsymversion = "";
1212         # For VMS
1213         my $prevnum = 0;
1214         my $symvtextcount = 0;
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 IDENTIFICATION=$version
1233 CASE_SENSITIVE=YES
1234 SYMBOL_VECTOR=(-
1235 EOF
1236                 $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-"
1237                 }
1238
1239         (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:FUNCTION/,@symbols);
1240         (@v)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:VARIABLE/,@symbols);
1241         if ($VMS) {
1242             # VMS needs to have the symbols on slot number order
1243             @symbols=(map { $_->[1] }
1244                       sort { $a->[0] <=> $b->[0] }
1245                       map { (my $s, my $i) = $_ =~ /^(.*?)\\(.*)$/;
1246                             die "Error: $s doesn't have a number assigned\n"
1247                                 if !defined($nums{$s});
1248                             (my $n, my @rest) = split /\\/, $nums{$s};
1249                             [ $n, $_ ] } (@e, @r, @v));
1250         } else {
1251             @symbols=((sort @e),(sort @r), (sort @v));
1252         }
1253
1254         my ($baseversion, $currversion) = get_openssl_version();
1255         my $thisversion;
1256         do {
1257                 if (!defined($thisversion)) {
1258                         $thisversion = $baseversion;
1259                 } else {
1260                         $thisversion = get_next_version($thisversion);
1261                 }
1262                 foreach $sym (@symbols) {
1263                         (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
1264                         my $v = 0;
1265                         $v = 1 if $i =~ /^.*?:.*?:VARIABLE/;
1266                         if (!defined($nums{$s})) {
1267                                 die "Error: $s does not have a number assigned\n"
1268                                         if(!$do_update);
1269                         } else {
1270                                 (my $n, my $symversion, my $dummy) = split /\\/, $nums{$s};
1271                                 my %pf = ();
1272                                 my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
1273                                 my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
1274                                 if (is_valid($p,1) && is_valid($a,0)) {
1275                                         my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1);
1276                                         if ($prev eq $s2) {
1277                                                 print STDERR "Warning: Symbol '",$s2,
1278                                                         "' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),
1279                                                         ", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n";
1280                                         }
1281                                         $prev = $s2;    # To warn about duplicates...
1282                                         if($linux) {
1283                                                 next if $symversion ne $thisversion;
1284                                                 if ($symversion ne $prevsymversion) {
1285                                                         if ($prevsymversion ne "") {
1286                                                                 if ($prevprevsymversion ne "") {
1287                                                                         print OUT "} OPENSSL${SO_VARIANT}_"
1288                                                                                                 ."$prevprevsymversion;\n\n";
1289                                                                 } else {
1290                                                                         print OUT "};\n\n";
1291                                                                 }
1292                                                         }
1293                                                         print OUT "OPENSSL${SO_VARIANT}_$symversion {\n    global:\n";
1294                                                         $prevprevsymversion = $prevsymversion;
1295                                                         $prevsymversion = $symversion;
1296                                                 }
1297                                                 print OUT "        $s2;\n";
1298                                         } elsif ($VMS) {
1299                                             while(++$prevnum < $n) {
1300                                                 my $symline=" ,SPARE -\n  ,SPARE -\n";
1301                                                 if ($symvtextcount + length($symline) - 2 > 1024) {
1302                                                     print OUT ")\nSYMBOL_VECTOR=(-\n";
1303                                                     $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-"
1304                                                 }
1305                                                 if ($symvtextcount == 16) {
1306                                                     # Take away first comma
1307                                                     $symline =~ s/,//;
1308                                                 }
1309                                                 print OUT $symline;
1310                                                 $symvtextcount += length($symline) - 2;
1311                                             }
1312                                             (my $s_uc = $s) =~ tr/a-z/A-Z/;
1313                                             my $symtype=
1314                                                 $v ? "DATA" : "PROCEDURE";
1315                                             my $symline=
1316                                                 ($s_uc ne $s
1317                                                  ? " ,$s_uc/$s=$symtype -\n  ,$s=$symtype -\n"
1318                                                  : " ,$s=$symtype -\n  ,SPARE -\n");
1319                                             if ($symvtextcount + length($symline) - 2 > 1024) {
1320                                                 print OUT ")\nSYMBOL_VECTOR=(-\n";
1321                                                 $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-"
1322                                             }
1323                                             if ($symvtextcount == 16) {
1324                                                 # Take away first comma
1325                                                 $symline =~ s/,//;
1326                                             }
1327                                             print OUT $symline;
1328                                             $symvtextcount += length($symline) - 2;
1329                                         } elsif($v) {
1330                                                 printf OUT "    %s%-39s DATA\n",
1331                                                                 ($W32)?"":"_",$s2;
1332                                         } else {
1333                                                 printf OUT "    %s%s\n",
1334                                                                 ($W32)?"":"_",$s2;
1335                                         }
1336                                 }
1337                         }
1338                 }
1339         } while ($linux && $thisversion ne $currversion);
1340         if ($linux) {
1341                 if ($prevprevsymversion ne "") {
1342                         print OUT "    local: *;\n} OPENSSL${SO_VARIANT}_$prevprevsymversion;\n\n";
1343                 } else {
1344                         print OUT "    local: *;\n};\n\n";
1345                 }
1346         } elsif ($VMS) {
1347             print OUT ")\n";
1348             (my $libvmaj, my $libvmin, my $libvedit) =
1349                 $currversion =~ /^(\d+)_(\d+)_(\d+)$/;
1350             # The reason to multiply the edit number with 100 is to make space
1351             # for the possibility that we want to encode the patch letters
1352             print OUT "GSMATCH=LEQUAL,",($libvmaj * 100 + $libvmin),",",($libvedit * 100),"\n";
1353         }
1354         printf OUT "\n";
1355 }
1356
1357 sub load_numbers
1358 {
1359         my($name)=@_;
1360         my(@a,%ret);
1361         my $prevversion;
1362
1363         $max_num = 0;
1364         $num_noinfo = 0;
1365         $prev = "";
1366         $prev_cnt = 0;
1367
1368         my ($baseversion, $currversion) = get_openssl_version();
1369
1370         open(IN,"<$name") || die "unable to open $name:$!\n";
1371         while (<IN>) {
1372                 s|\R$||;        # Better chomp
1373                 s/#.*$//;
1374                 next if /^\s*$/;
1375                 @a=split;
1376                 if (defined $ret{$a[0]}) {
1377                         # This is actually perfectly OK
1378                         #print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n";
1379                 }
1380                 if ($max_num > $a[1]) {
1381                         print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n";
1382                 }
1383                 elsif ($max_num == $a[1]) {
1384                         # This is actually perfectly OK
1385                         #print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n";
1386                         if ($a[0] eq $prev) {
1387                                 $prev_cnt++;
1388                                 $a[0] .= "{$prev_cnt}";
1389                         }
1390                 }
1391                 else {
1392                         $prev_cnt = 0;
1393                 }
1394                 if ($#a < 2) {
1395                         # Existence will be proven later, in do_defs
1396                         $ret{$a[0]}=$a[1];
1397                         $num_noinfo++;
1398                 } else {
1399                         #Sanity check the version number
1400                         if (defined $prevversion) {
1401                                 check_version_lte($prevversion, $a[2]);
1402                         }
1403                         check_version_lte($a[2], $currversion);
1404                         $prevversion = $a[2];
1405                         $ret{$a[0]}=$a[1]."\\".$a[2]."\\".$a[3]; # \\ is a special marker
1406                 }
1407                 $max_num = $a[1] if $a[1] > $max_num;
1408                 $prev=$a[0];
1409         }
1410         if ($num_noinfo) {
1411                 print STDERR "Warning: $num_noinfo symbols were without info." if $verbose || !$do_rewrite;
1412                 if ($do_rewrite) {
1413                         printf STDERR "  The rewrite will fix this.\n" if $verbose;
1414                 } else {
1415                         printf STDERR "  You should do a rewrite to fix this.\n";
1416                 }
1417         }
1418         close(IN);
1419         return(%ret);
1420 }
1421
1422 sub parse_number
1423 {
1424         (my $str, my $what) = @_;
1425         (my $n, my $v, my $i) = split(/\\/,$str);
1426         if ($what eq "n") {
1427                 return $n;
1428         } else {
1429                 return $i;
1430         }
1431 }
1432
1433 sub rewrite_numbers
1434 {
1435         (*OUT,$name,*nums,@symbols)=@_;
1436         my $thing;
1437
1438         my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols);
1439         my $r; my %r; my %rsyms;
1440         foreach $r (@r) {
1441                 (my $s, my $i) = split /\\/, $r;
1442                 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/;
1443                 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/;
1444                 $r{$a} = $s."\\".$i;
1445                 $rsyms{$s} = 1;
1446         }
1447
1448         my %syms = ();
1449         foreach $_ (@symbols) {
1450                 (my $n, my $i) = split /\\/;
1451                 $syms{$n} = 1;
1452         }
1453
1454         my @s=sort {
1455             &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n")
1456             || $a cmp $b
1457         } keys %nums;
1458         foreach $sym (@s) {
1459                 (my $n, my $vers, my $i) = split /\\/, $nums{$sym};
1460                 next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/;
1461                 next if defined($rsyms{$sym});
1462                 print STDERR "DEBUG: rewrite_numbers for sym = ",$sym,": i = ",$i,", n = ",$n,", rsym{sym} = ",$rsyms{$sym},"syms{sym} = ",$syms{$sym},"\n" if $debug;
1463                 $i="NOEXIST::FUNCTION:"
1464                         if !defined($i) || $i eq "" || !defined($syms{$sym});
1465                 my $s2 = $sym;
1466                 $s2 =~ s/\{[0-9]+\}$//;
1467                 printf OUT "%s%-39s %d\t%s\t%s\n","",$s2,$n,$vers,$i;
1468                 if (exists $r{$sym}) {
1469                         (my $s, $i) = split /\\/,$r{$sym};
1470                         my $s2 = $s;
1471                         $s2 =~ s/\{[0-9]+\}$//;
1472                         printf OUT "%s%-39s %d\t%s\t%s\n","",$s2,$n,$vers,$i;
1473                 }
1474         }
1475 }
1476
1477 sub update_numbers
1478 {
1479         (*OUT,$name,*nums,my $start_num, my @symbols)=@_;
1480         my $new_syms = 0;
1481         my $basevers;
1482         my $vers;
1483
1484         ($basevers, $vers) = get_openssl_version();
1485
1486         my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols);
1487         my $r; my %r; my %rsyms;
1488         foreach $r (@r) {
1489                 (my $s, my $i) = split /\\/, $r;
1490                 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/;
1491                 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/;
1492                 $r{$a} = $s."\\".$i;
1493                 $rsyms{$s} = 1;
1494         }
1495
1496         foreach $sym (@symbols) {
1497                 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
1498                 next if $i =~ /^.*?:.*?:\w+\(\w+\)/;
1499                 next if defined($rsyms{$sym});
1500                 die "ERROR: Symbol $sym had no info attached to it."
1501                     if $i eq "";
1502                 if (!exists $nums{$s}) {
1503                         $new_syms++;
1504                         my $s2 = $s;
1505                         $s2 =~ s/\{[0-9]+\}$//;
1506                         printf OUT "%s%-39s %d\t%s\t%s\n","",$s2, ++$start_num,$vers,$i;
1507                         if (exists $r{$s}) {
1508                                 ($s, $i) = split /\\/,$r{$s};
1509                                 $s =~ s/\{[0-9]+\}$//;
1510                                 printf OUT "%s%-39s %d\t%s\t%s\n","",$s, $start_num,$vers,$i;
1511                         }
1512                 }
1513         }
1514         if($new_syms) {
1515                 print STDERR "$name: Added $new_syms new symbols\n";
1516         } else {
1517                 print STDERR "$name: No new symbols added\n";
1518         }
1519 }
1520
1521 sub check_existing
1522 {
1523         (*nums, my @symbols)=@_;
1524         my %existing; my @remaining;
1525         @remaining=();
1526         foreach $sym (@symbols) {
1527                 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
1528                 $existing{$s}=1;
1529         }
1530         foreach $sym (keys %nums) {
1531                 if (!exists $existing{$sym}) {
1532                         push @remaining, $sym;
1533                 }
1534         }
1535         if(@remaining) {
1536                 print STDERR "The following symbols do not seem to exist:\n";
1537                 foreach $sym (@remaining) {
1538                         print STDERR "\t",$sym,"\n";
1539                 }
1540         }
1541 }
1542
1543 sub count_parens
1544 {
1545         my $line = shift(@_);
1546
1547         my $open = $line =~ tr/\(//;
1548         my $close = $line =~ tr/\)//;
1549
1550         return $open - $close;
1551 }
1552
1553 #Parse opensslv.h to get the current version number. Also work out the base
1554 #version, i.e. the lowest version number that is binary compatible with this
1555 #version
1556 sub get_openssl_version()
1557 {
1558         my $fn = catfile($config{sourcedir},"include","openssl","opensslv.h");
1559         open (IN, "$fn") || die "Can't open opensslv.h";
1560
1561         while(<IN>) {
1562                 if (/OPENSSL_VERSION_TEXT\s+"OpenSSL (\d\.\d\.)(\d[a-z]*)(-| )/) {
1563                         my $suffix = $2;
1564                         (my $baseversion = $1) =~ s/\./_/g;
1565                         close IN;
1566                         return ($baseversion."0", $baseversion.$suffix);
1567                 }
1568         }
1569         die "Can't find OpenSSL version number\n";
1570 }
1571
1572 #Given an OpenSSL version number, calculate the next version number. If the
1573 #version number gets to a.b.czz then we go to a.b.(c+1)
1574 sub get_next_version()
1575 {
1576         my $thisversion = shift;
1577
1578         my ($base, $letter) = $thisversion =~ /^(\d_\d_\d)([a-z]{0,2})$/;
1579
1580         if ($letter eq "zz") {
1581                 my $lastnum = substr($base, -1);
1582                 return substr($base, 0, length($base)-1).(++$lastnum);
1583         }
1584         return $base.get_next_letter($letter);
1585 }
1586
1587 #Given the letters off the end of an OpenSSL version string, calculate what
1588 #the letters for the next release would be.
1589 sub get_next_letter()
1590 {
1591         my $thisletter = shift;
1592         my $baseletter = "";
1593         my $endletter;
1594
1595         if ($thisletter eq "") {
1596                 return "a";
1597         }
1598         if ((length $thisletter) > 1) {
1599                 ($baseletter, $endletter) = $thisletter =~ /([a-z]+)([a-z])/;
1600         } else {
1601                 $endletter = $thisletter;
1602         }
1603
1604         if ($endletter eq "z") {
1605                 return $thisletter."a";
1606         } else {
1607                 return $baseletter.(++$endletter);
1608         }
1609 }
1610
1611 #Check if a version is less than or equal to the current version. Its a fatal
1612 #error if not. They must also only differ in letters, or the last number (i.e.
1613 #the first two numbers must be the same)
1614 sub check_version_lte()
1615 {
1616         my ($testversion, $currversion) = @_;
1617         my $lentv;
1618         my $lencv;
1619         my $cvbase;
1620
1621         my ($cvnums) = $currversion =~ /^(\d_\d_\d)[a-z]*$/;
1622         my ($tvnums) = $testversion =~ /^(\d_\d_\d)[a-z]*$/;
1623
1624         #Die if we can't parse the version numbers or they don't look sane
1625         die "Invalid version number: $testversion and $currversion\n"
1626                 if (!defined($cvnums) || !defined($tvnums)
1627                         || length($cvnums) != 5
1628                         || length($tvnums) != 5);
1629
1630         #If the base versions (without letters) don't match check they only differ
1631         #in the last number
1632         if ($cvnums ne $tvnums) {
1633                 die "Invalid version number: $testversion "
1634                         ."for current version $currversion\n"
1635                         if (substr($cvnums, 0, 4) ne substr($tvnums, 0, 4));
1636                 return;
1637         }
1638         #If we get here then the base version (i.e. the numbers) are the same - they
1639         #only differ in the letters
1640
1641         $lentv = length $testversion;
1642         $lencv = length $currversion;
1643
1644         #If the testversion has more letters than the current version then it must
1645         #be later (or malformed)
1646         if ($lentv > $lencv) {
1647                 die "Invalid version number: $testversion "
1648                         ."is greater than $currversion\n";
1649         }
1650
1651         #Get the last letter from the current version
1652         my ($cvletter) = $currversion =~ /([a-z])$/;
1653         if (defined $cvletter) {
1654                 ($cvbase) = $currversion =~ /(\d_\d_\d[a-z]*)$cvletter$/;
1655         } else {
1656                 $cvbase = $currversion;
1657         }
1658         die "Unable to parse version number $currversion" if (!defined $cvbase);
1659         my $tvbase;
1660         my ($tvletter) = $testversion =~ /([a-z])$/;
1661         if (defined $tvletter) {
1662                 ($tvbase) = $testversion =~ /(\d_\d_\d[a-z]*)$tvletter$/;
1663         } else {
1664                 $tvbase = $testversion;
1665         }
1666         die "Unable to parse version number $testversion" if (!defined $tvbase);
1667
1668         if ($lencv > $lentv) {
1669                 #If current version has more letters than testversion then testversion
1670                 #minus the final letter must be a substring of the current version
1671                 die "Invalid version number $testversion "
1672                         ."is greater than $currversion or is invalid\n"
1673                         if (index($cvbase, $tvbase) != 0);
1674         } else {
1675                 #If both versions have the same number of letters then they must be
1676                 #equal up to the last letter, and the last letter in testversion must
1677                 #be less than or equal to the last letter in current version.
1678                 die "Invalid version number $testversion "
1679                         ."is greater than $currversion\n"
1680                         if (($cvbase ne $tvbase) && ($tvletter gt $cvletter));
1681         }
1682 }
1683
1684 sub do_deprecated()
1685 {
1686         my ($decl, $plats, $algs) = @_;
1687         $decl =~ /^\s*(DEPRECATEDIN_\d+_\d+_\d+)\s*\((.*)\)\s*$/
1688             or die "Bad DEPRECATEDIN: $decl\n";
1689         my $info1 .= "#INFO:";
1690         $info1 .= join(',', @{$plats}) . ":";
1691         my $info2 = $info1;
1692         $info1 .= join(',',@{$algs}, $1) . ";";
1693         $info2 .= join(',',@{$algs}) . ";";
1694         return $info1 . $2 . ";" . $info2;
1695 }