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