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 48use lib "."; 49use configdata; 50use File::Spec::Functions; 51use File::Basename; 52use FindBin; 53use lib "$FindBin::Bin/perl"; 54use 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 108my $debug=0; 109my $trace=0; 110my $verbose=0; 111 112my $crypto_num= catfile($config{sourcedir},"util","libcrypto.num"); 113my $ssl_num= catfile($config{sourcedir},"util","libssl.num"); 114my $libname; 115 116my $do_update = 0; 117my $do_rewrite = 1; 118my $do_crypto = 0; 119my $do_ssl = 0; 120my $do_ctest = 0; 121my $do_ctestall = 0; 122my $do_checkexist = 0; 123 124my $VMS=0; 125my $W32=0; 126my $NT=0; 127my $UNIX=0; 128my $linux=0; 129my $aix=0; 130# Set this to make typesafe STACK definitions appear in DEF 131my $safe_stack_def = 0; 132 133my @known_platforms = ( "__FreeBSD__", "PERL5", 134 "EXPORT_VAR_AS_FUNCTION", "ZLIB", "_WIN32" 135 ); 136my @known_ossl_platforms = ( "UNIX", "VMS", "WIN32", "WINNT", "OS2" ); 137my @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 152my %disabled_algorithms = 153 map { (my $x = uc $_) =~ s|-|_|g; $x => 1; } keys %disabled; 154 155my $apiv = sprintf "%x%02x%02x", split(/\./, $config{api}); 156foreach (@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 163my $zlib; 164 165foreach (@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 201if (!$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 211if ($W32 + $VMS + $linux + $aix == 0) { 212 $W32 = 1; 213} 214die "Please, only one platform at a time" 215 if ($W32 + $VMS + $linux + $aix > 1); 216 217if (!$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 228my $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. 234my %skipthese; 235foreach 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. 244my $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"; 249foreach 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 254my $symhacks="include/openssl/symhacks.h"; 255 256my @ssl_symbols = &do_defs("LIBSSL", $ssl, $symhacks); 257my @crypto_symbols = &do_defs("LIBCRYPTO", $crypto, $symhacks); 258 259if ($do_update) { 260 261if ($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 274if($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 300int main() 301{ 302EOF 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 322sub 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. 954sub 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 991sub 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 1010sub 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 "!" 1049sub 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 1095sub 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 1132sub get_version 1133{ 1134 return $config{version}; 1135} 1136 1137sub 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 1159LIBRARY $libname $liboptions 1160 1161EOF 1162 1163 print "EXPORTS\n"; 1164 } 1165 elsif ($VMS) 1166 { 1167 print OUT <<"EOF"; 1168IDENTIFICATION=$version 1169CASE_SENSITIVE=YES 1170SYMBOL_VECTOR=(- 1171EOF 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 1295sub 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 1360sub 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 1371sub 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 1415sub 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 1459sub 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 1481sub 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 1494sub 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) 1512sub 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. 1527sub 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) 1552sub 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 1622sub 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} 1634