1#!/usr/local/bin/perl -w 2# 3# generate a .def file 4# 5# It does this by parsing the header files and looking for the 6# prototyped functions: it then prunes the output. 7# 8# Intermediary files are created, call libeay.num and ssleay.num,... 9# Previously, they had the following format: 10# 11# routine-name nnnn 12# 13# But that isn't enough for a number of reasons, the first on being that 14# this format is (needlessly) very Win32-centric, and even then... 15# One of the biggest problems is that there's no information about what 16# routines should actually be used, which varies with what crypto algorithms 17# are disabled. Also, some operating systems (for example VMS with VAX C) 18# need to keep track of the global variables as well as the functions. 19# 20# So, a remake of this script is done so as to include information on the 21# kind of symbol it is (function or variable) and what algorithms they're 22# part of. This will allow easy translating to .def files or the corresponding 23# file in other operating systems (a .opt file for VMS, possibly with a .mar 24# file). 25# 26# The format now becomes: 27# 28# routine-name nnnn info 29# 30# and the "info" part is actually a colon-separated string of fields with 31# the following meaning: 32# 33# existence:platform:kind:algorithms 34# 35# - "existence" can be "EXIST" or "NOEXIST" depending on if the symbol is 36# found somewhere in the source, 37# - "platforms" is empty if it exists on all platforms, otherwise it contains 38# comma-separated list of the platform, just as they are if the symbol exists 39# for those platforms, or prepended with a "!" if not. This helps resolve 40# symbol name replacements for platforms where the names are too long for the 41# compiler or linker, or if the systems is case insensitive and there is a 42# clash. This script assumes those redefinitions are place in the file 43# crypto/symhacks.h. 44# The semantics for the platforms list is a bit complicated. The rule of 45# thumb is that the list is exclusive, but it seems to mean different things. 46# So, if the list is all negatives (like "!VMS,!WIN16"), the symbol exists 47# on all platforms except those listed. If the list is all positives (like 48# "VMS,WIN16"), the symbol exists only on those platforms and nowhere else. 49# The combination of positives and negatives will act as if the positives 50# weren't there. 51# - "kind" is "FUNCTION" or "VARIABLE". The meaning of that is obvious. 52# - "algorithms" is a comma-separated list of algorithm names. This helps 53# exclude symbols that are part of an algorithm that some user wants to 54# exclude. 55# 56 57my $crypto_num= "util/libeay.num"; 58my $ssl_num= "util/ssleay.num"; 59 60my $do_update = 0; 61my $do_rewrite = 0; 62my $do_crypto = 0; 63my $do_ssl = 0; 64my $do_ctest = 0; 65my $do_ctestall = 0; 66my $rsaref = 0; 67 68my $VMS=0; 69my $W32=0; 70my $W16=0; 71my $NT=0; 72# Set this to make typesafe STACK definitions appear in DEF 73my $safe_stack_def = 0; 74 75my @known_platforms = ( "__FreeBSD__", "VMS", "WIN16", "WIN32", 76 "WINNT", "PERL5", "NeXT" ); 77my @known_algorithms = ( "RC2", "RC4", "RC5", "IDEA", "DES", "BF", 78 "CAST", "MD2", "MD4", "MD5", "SHA", "RIPEMD", 79 "MDC2", "RSA", "DSA", "DH", "HMAC", "FP_API" ); 80 81my $options=""; 82open(IN,"<Makefile.ssl") || die "unable to open Makefile.ssl!\n"; 83while(<IN>) { 84 $options=$1 if (/^OPTIONS=(.*)$/); 85} 86close(IN); 87 88# The following ciphers may be excluded (by Configure). This means functions 89# defined with ifndef(NO_XXX) are not included in the .def file, and everything 90# in directory xxx is ignored. 91my $no_rc2; my $no_rc4; my $no_rc5; my $no_idea; my $no_des; my $no_bf; 92my $no_cast; 93my $no_md2; my $no_md4; my $no_md5; my $no_sha; my $no_ripemd; my $no_mdc2; 94my $no_rsa; my $no_dsa; my $no_dh; my $no_hmac=0; 95my $no_fp_api; 96 97foreach (@ARGV, split(/ /, $options)) 98 { 99 $W32=1 if $_ eq "32"; 100 $W16=1 if $_ eq "16"; 101 if($_ eq "NT") { 102 $W32 = 1; 103 $NT = 1; 104 } 105 $VMS=1 if $_ eq "VMS"; 106 $rsaref=1 if $_ eq "rsaref"; 107 108 $do_ssl=1 if $_ eq "ssleay"; 109 $do_ssl=1 if $_ eq "ssl"; 110 $do_crypto=1 if $_ eq "libeay"; 111 $do_crypto=1 if $_ eq "crypto"; 112 $do_update=1 if $_ eq "update"; 113 $do_rewrite=1 if $_ eq "rewrite"; 114 $do_ctest=1 if $_ eq "ctest"; 115 $do_ctestall=1 if $_ eq "ctestall"; 116 #$safe_stack_def=1 if $_ eq "-DDEBUG_SAFESTACK"; 117 118 if (/^no-rc2$/) { $no_rc2=1; } 119 elsif (/^no-rc4$/) { $no_rc4=1; } 120 elsif (/^no-rc5$/) { $no_rc5=1; } 121 elsif (/^no-idea$/) { $no_idea=1; } 122 elsif (/^no-des$/) { $no_des=1; } 123 elsif (/^no-bf$/) { $no_bf=1; } 124 elsif (/^no-cast$/) { $no_cast=1; } 125 elsif (/^no-md2$/) { $no_md2=1; } 126 elsif (/^no-md4$/) { $no_md4=1; } 127 elsif (/^no-md5$/) { $no_md5=1; } 128 elsif (/^no-sha$/) { $no_sha=1; } 129 elsif (/^no-ripemd$/) { $no_ripemd=1; } 130 elsif (/^no-mdc2$/) { $no_mdc2=1; } 131 elsif (/^no-rsa$/) { $no_rsa=1; } 132 elsif (/^no-dsa$/) { $no_dsa=1; } 133 elsif (/^no-dh$/) { $no_dh=1; } 134 elsif (/^no-hmac$/) { $no_hmac=1; } 135 } 136 137 138# If no platform is given, assume WIN32 139if ($W32 + $W16 + $VMS == 0) { 140 $W32 = 1; 141} 142 143# Add extra knowledge 144if ($W16) { 145 $no_fp_api=1; 146} 147 148if (!$do_ssl && !$do_crypto) 149 { 150 print STDERR "usage: $0 ( ssl | crypto ) [ 16 | 32 | NT ] [rsaref]\n"; 151 exit(1); 152 } 153 154%ssl_list=&load_numbers($ssl_num); 155$max_ssl = $max_num; 156%crypto_list=&load_numbers($crypto_num); 157$max_crypto = $max_num; 158 159my $ssl="ssl/ssl.h"; 160 161my $crypto ="crypto/crypto.h"; 162$crypto.=" crypto/des/des.h" unless $no_des; 163$crypto.=" crypto/idea/idea.h" unless $no_idea; 164$crypto.=" crypto/rc4/rc4.h" unless $no_rc4; 165$crypto.=" crypto/rc5/rc5.h" unless $no_rc5; 166$crypto.=" crypto/rc2/rc2.h" unless $no_rc2; 167$crypto.=" crypto/bf/blowfish.h" unless $no_bf; 168$crypto.=" crypto/cast/cast.h" unless $no_cast; 169$crypto.=" crypto/md2/md2.h" unless $no_md2; 170$crypto.=" crypto/md4/md4.h" unless $no_md4; 171$crypto.=" crypto/md5/md5.h" unless $no_md5; 172$crypto.=" crypto/mdc2/mdc2.h" unless $no_mdc2; 173$crypto.=" crypto/sha/sha.h" unless $no_sha; 174$crypto.=" crypto/ripemd/ripemd.h" unless $no_ripemd; 175 176$crypto.=" crypto/bn/bn.h"; 177$crypto.=" crypto/rsa/rsa.h" unless $no_rsa; 178$crypto.=" crypto/dsa/dsa.h" unless $no_dsa; 179$crypto.=" crypto/dh/dh.h" unless $no_dh; 180$crypto.=" crypto/hmac/hmac.h" unless $no_hmac; 181 182$crypto.=" crypto/stack/stack.h"; 183$crypto.=" crypto/buffer/buffer.h"; 184$crypto.=" crypto/bio/bio.h"; 185$crypto.=" crypto/dso/dso.h"; 186$crypto.=" crypto/lhash/lhash.h"; 187$crypto.=" crypto/conf/conf.h"; 188$crypto.=" crypto/txt_db/txt_db.h"; 189 190$crypto.=" crypto/evp/evp.h"; 191$crypto.=" crypto/objects/objects.h"; 192$crypto.=" crypto/pem/pem.h"; 193#$crypto.=" crypto/meth/meth.h"; 194$crypto.=" crypto/asn1/asn1.h"; 195$crypto.=" crypto/asn1/asn1_mac.h"; 196$crypto.=" crypto/err/err.h"; 197$crypto.=" crypto/pkcs7/pkcs7.h"; 198$crypto.=" crypto/pkcs12/pkcs12.h"; 199$crypto.=" crypto/x509/x509.h"; 200$crypto.=" crypto/x509/x509_vfy.h"; 201$crypto.=" crypto/x509v3/x509v3.h"; 202$crypto.=" crypto/rand/rand.h"; 203$crypto.=" crypto/comp/comp.h"; 204$crypto.=" crypto/tmdiff.h"; 205 206my $symhacks="crypto/symhacks.h"; 207 208my @ssl_symbols = &do_defs("SSLEAY", $ssl, $symhacks); 209my @crypto_symbols = &do_defs("LIBEAY", $crypto, $symhacks); 210 211if ($do_update) { 212 213if ($do_ssl == 1) { 214 215 &maybe_add_info("SSLEAY",*ssl_list,@ssl_symbols); 216 if ($do_rewrite == 1) { 217 open(OUT, ">$ssl_num"); 218 &rewrite_numbers(*OUT,"SSLEAY",*ssl_list,@ssl_symbols); 219 close OUT; 220 } else { 221 open(OUT, ">>$ssl_num"); 222 } 223 &update_numbers(*OUT,"SSLEAY",*ssl_list,$max_ssl,@ssl_symbols); 224 close OUT; 225} 226 227if($do_crypto == 1) { 228 229 &maybe_add_info("LIBEAY",*crypto_list,@crypto_symbols); 230 if ($do_rewrite == 1) { 231 open(OUT, ">$crypto_num"); 232 &rewrite_numbers(*OUT,"LIBEAY",*crypto_list,@crypto_symbols); 233 } else { 234 open(OUT, ">>$crypto_num"); 235 } 236 &update_numbers(*OUT,"LIBEAY",*crypto_list,$max_crypto,@crypto_symbols); 237 close OUT; 238} 239 240} elsif ($do_ctest || $do_ctestall) { 241 242 print <<"EOF"; 243 244/* Test file to check all DEF file symbols are present by trying 245 * to link to all of them. This is *not* intended to be run! 246 */ 247 248int main() 249{ 250EOF 251 &print_test_file(*STDOUT,"SSLEAY",*ssl_list,$do_ctestall,@ssl_symbols) 252 if $do_ssl == 1; 253 254 &print_test_file(*STDOUT,"LIBEAY",*crypto_list,$do_ctestall,@crypto_symbols) 255 if $do_crypto == 1; 256 257 print "}\n"; 258 259} else { 260 261 &print_def_file(*STDOUT,"SSLEAY",*ssl_list,@ssl_symbols) 262 if $do_ssl == 1; 263 264 &print_def_file(*STDOUT,"LIBEAY",*crypto_list,@crypto_symbols) 265 if $do_crypto == 1; 266 267} 268 269 270sub do_defs 271{ 272 my($name,$files,$symhacksfile)=@_; 273 my $file; 274 my @ret; 275 my %syms; 276 my %platform; # For anything undefined, we assume "" 277 my %kind; # For anything undefined, we assume "FUNCTION" 278 my %algorithm; # For anything undefined, we assume "" 279 my %rename; 280 my $cpp; 281 282 foreach $file (split(/\s+/,$symhacksfile." ".$files)) 283 { 284 open(IN,"<$file") || die "unable to open $file:$!\n"; 285 my $line = "", my $def= ""; 286 my %tag = ( 287 (map { $_ => 0 } @known_platforms), 288 (map { "NO_".$_ => 0 } @known_algorithms), 289 NOPROTO => 0, 290 PERL5 => 0, 291 _WINDLL => 0, 292 CONST_STRICT => 0, 293 TRUE => 1, 294 ); 295 my $symhacking = $file eq $symhacksfile; 296 while(<IN>) { 297 last if (/BEGIN ERROR CODES/); 298 if ($line ne '') { 299 $_ = $line . $_; 300 $line = ''; 301 } 302 303 if (/\\$/) { 304 $line = $_; 305 next; 306 } 307 308 $cpp = 1 if /^\#.*ifdef.*cplusplus/; 309 if ($cpp) { 310 $cpp = 0 if /^\#.*endif/; 311 next; 312 } 313 314 s/\/\*.*?\*\///gs; # ignore comments 315 s/{[^{}]*}//gs; # ignore {} blocks 316 if (/^\#\s*ifndef (.*)/) { 317 push(@tag,$1); 318 $tag{$1}=-1; 319 } elsif (/^\#\s*if !defined\(([^\)]+)\)/) { 320 push(@tag,$1); 321 $tag{$1}=-1; 322 } elsif (/^\#\s*ifdef (.*)/) { 323 push(@tag,$1); 324 $tag{$1}=1; 325 } elsif (/^\#\s*if defined\(([^\)]+)\)/) { 326 push(@tag,$1); 327 $tag{$1}=1; 328 } elsif (/^\#\s*error\s+(\w+) is disabled\./) { 329 if ($tag[$#tag] eq "NO_".$1) { 330 $tag{$tag[$#tag]}=2; 331 } 332 } elsif (/^\#\s*endif/) { 333 if ($tag{$tag[$#tag]}==2) { 334 $tag{$tag[$#tag]}=-1; 335 } else { 336 $tag{$tag[$#tag]}=0; 337 } 338 pop(@tag); 339 } elsif (/^\#\s*else/) { 340 my $t=$tag[$#tag]; 341 $tag{$t}= -$tag{$t}; 342 } elsif (/^\#\s*if\s+1/) { 343 # Dummy tag 344 push(@tag,"TRUE"); 345 $tag{"TRUE"}=1; 346 } elsif (/^\#\s*if\s+0/) { 347 # Dummy tag 348 push(@tag,"TRUE"); 349 $tag{"TRUE"}=-1; 350 } elsif (/^\#\s*define\s+(\w+)\s+(\w+)/ 351 && $symhacking) { 352 my $s = $1; 353 my $a = 354 $2.":".join(",", grep(!/^$/, 355 map { $tag{$_} == 1 ? 356 $_ : "" } 357 @known_platforms)); 358 $rename{$s} = $a; 359 } 360 if (/^\#/) { 361 my @p = grep(!/^$/, 362 map { $tag{$_} == 1 ? $_ : 363 $tag{$_} == -1 ? "!".$_ : "" } 364 @known_platforms); 365 my @a = grep(!/^$/, 366 map { $tag{"NO_".$_} == -1 ? $_ : "" } 367 @known_algorithms); 368 $def .= "#INFO:".join(',',@p).":".join(',',@a).";"; 369 next; 370 } 371 if (/^\s*DECLARE_STACK_OF\s*\(\s*(\w*)\s*\)/) { 372 next; 373 } elsif (/^\s*DECLARE_PKCS12_STACK_OF\s*\(\s*(\w*)\s*\)/) { 374 next; 375 } elsif (/^\s*DECLARE_ASN1_SET_OF\s*\(\s*(\w*)\s*\)/) { 376 next; 377 } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ || 378 /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ ) { 379 # Things not in Win16 380 $syms{"PEM_read_${1}"} = 1; 381 $platform{"PEM_read_${1}"} = "!WIN16"; 382 $syms{"PEM_write_${1}"} = 1; 383 $platform{"PEM_write_${1}"} = "!WIN16"; 384 # Things that are everywhere 385 $syms{"PEM_read_bio_${1}"} = 1; 386 $syms{"PEM_write_bio_${1}"} = 1; 387 if ($1 eq "RSAPrivateKey" || 388 $1 eq "RSAPublicKey" || 389 $1 eq "RSA_PUBKEY") { 390 $algorithm{"PEM_read_${1}"} = "RSA"; 391 $algorithm{"PEM_write_${1}"} = "RSA"; 392 $algorithm{"PEM_read_bio_${1}"} = "RSA"; 393 $algorithm{"PEM_write_bio_${1}"} = "RSA"; 394 } 395 elsif ($1 eq "DSAPrivateKey" || 396 $1 eq "DSAparams" || 397 $1 eq "RSA_PUBKEY") { 398 $algorithm{"PEM_read_${1}"} = "DSA"; 399 $algorithm{"PEM_write_${1}"} = "DSA"; 400 $algorithm{"PEM_read_bio_${1}"} = "DSA"; 401 $algorithm{"PEM_write_bio_${1}"} = "DSA"; 402 } 403 elsif ($1 eq "DHparams") { 404 $algorithm{"PEM_read_${1}"} = "DH"; 405 $algorithm{"PEM_write_${1}"} = "DH"; 406 $algorithm{"PEM_read_bio_${1}"} = "DH"; 407 $algorithm{"PEM_write_bio_${1}"} = "DH"; 408 } 409 } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ || 410 /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) { 411 # Things not in Win16 412 $syms{"PEM_write_${1}"} = 1; 413 $platform{"PEM_write_${1}"} .= ",!WIN16"; 414 # Things that are everywhere 415 $syms{"PEM_write_bio_${1}"} = 1; 416 if ($1 eq "RSAPrivateKey" || 417 $1 eq "RSAPublicKey" || 418 $1 eq "RSA_PUBKEY") { 419 $algorithm{"PEM_write_${1}"} = "RSA"; 420 $algorithm{"PEM_write_bio_${1}"} = "RSA"; 421 } 422 elsif ($1 eq "DSAPrivateKey" || 423 $1 eq "DSAparams" || 424 $1 eq "RSA_PUBKEY") { 425 $algorithm{"PEM_write_${1}"} = "DSA"; 426 $algorithm{"PEM_write_bio_${1}"} = "DSA"; 427 } 428 elsif ($1 eq "DHparams") { 429 $algorithm{"PEM_write_${1}"} = "DH"; 430 $algorithm{"PEM_write_bio_${1}"} = "DH"; 431 } 432 } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ || 433 /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) { 434 # Things not in Win16 435 $syms{"PEM_read_${1}"} = 1; 436 $platform{"PEM_read_${1}"} .= ",!WIN16"; 437 # Things that are everywhere 438 $syms{"PEM_read_bio_${1}"} = 1; 439 } elsif ( 440 ($tag{'TRUE'} != -1) 441 && ($tag{'CONST_STRICT'} != 1) 442 ) 443 { 444 if (/\{|\/\*|\([^\)]*$/) { 445 $line = $_; 446 } else { 447 $def .= $_; 448 } 449 } 450 } 451 close(IN); 452 453 my $algs; 454 my $plays; 455 456 foreach (split /;/, $def) { 457 my $s; my $k = "FUNCTION"; my $p; my $a; 458 s/^[\n\s]*//g; 459 s/[\n\s]*$//g; 460 next if(/\#undef/); 461 next if(/typedef\W/); 462 next if(/\#define/); 463 464 if (/^\#INFO:([^:]*):(.*)$/) { 465 $plats = $1; 466 $algs = $2; 467 next; 468 } elsif (/^\s*OPENSSL_EXTERN\s.*?(\w+)(\[[0-9]*\])*\s*$/) { 469 $s = $1; 470 $k = "VARIABLE"; 471 } elsif (/\(\*(\w*)\([^\)]+/) { 472 $s = $1; 473 } elsif (/\w+\W+(\w+)\W*\(\s*\)$/s) { 474 # K&R C 475 next; 476 } elsif (/\w+\W+\w+\W*\(.*\)$/s) { 477 while (not /\(\)$/s) { 478 s/[^\(\)]*\)$/\)/s; 479 s/\([^\(\)]*\)\)$/\)/s; 480 } 481 s/\(void\)//; 482 /(\w+)\W*\(\)/s; 483 $s = $1; 484 } elsif (/\(/ and not (/=/)) { 485 print STDERR "File $file: cannot parse: $_;\n"; 486 next; 487 } else { 488 next; 489 } 490 491 $syms{$s} = 1; 492 $kind{$s} = $k; 493 494 $p = $plats; 495 $a = $algs; 496 $a .= ",BF" if($s =~ /EVP_bf/); 497 $a .= ",CAST" if($s =~ /EVP_cast/); 498 $a .= ",DES" if($s =~ /EVP_des/); 499 $a .= ",DSA" if($s =~ /EVP_dss/); 500 $a .= ",IDEA" if($s =~ /EVP_idea/); 501 $a .= ",MD2" if($s =~ /EVP_md2/); 502 $a .= ",MD4" if($s =~ /EVP_md4/); 503 $a .= ",MD5" if($s =~ /EVP_md5/); 504 $a .= ",RC2" if($s =~ /EVP_rc2/); 505 $a .= ",RC4" if($s =~ /EVP_rc4/); 506 $a .= ",RC5" if($s =~ /EVP_rc5/); 507 $a .= ",RIPEMD" if($s =~ /EVP_ripemd/); 508 $a .= ",SHA" if($s =~ /EVP_sha/); 509 $a .= ",RSA" if($s =~ /EVP_(Open|Seal)(Final|Init)/); 510 $a .= ",RSA" if($s =~ /PEM_Seal(Final|Init|Update)/); 511 $a .= ",RSA" if($s =~ /RSAPrivateKey/); 512 $a .= ",RSA" if($s =~ /SSLv23?_((client|server)_)?method/); 513 514 $platform{$s} .= ','.$p; 515 $algorithm{$s} .= ','.$a; 516 517 if (defined($rename{$s})) { 518 (my $r, my $p) = split(/:/,$rename{$s}); 519 my @ip = map { /^!(.*)$/ ? $1 : "!".$_ } split /,/, $p; 520 $syms{$r} = 1; 521 $kind{$r} = $kind{$s}."(".$s.")"; 522 $algorithm{$r} = $algorithm{$s}; 523 $platform{$r} = $platform{$s}.",".$p; 524 $platform{$s} .= ','.join(',', @ip).','.join(',', @ip); 525 } 526 } 527 } 528 529 # Prune the returned symbols 530 531 $platform{"crypt"} .= ",!PERL5,!__FreeBSD__,!NeXT"; 532 533 delete $syms{"SSL_add_dir_cert_subjects_to_stack"}; 534 delete $syms{"bn_dump1"}; 535 536 $platform{"BIO_s_file_internal"} .= ",WIN16"; 537 $platform{"BIO_new_file_internal"} .= ",WIN16"; 538 $platform{"BIO_new_fp_internal"} .= ",WIN16"; 539 540 $platform{"BIO_s_file"} .= ",!WIN16"; 541 $platform{"BIO_new_file"} .= ",!WIN16"; 542 $platform{"BIO_new_fp"} .= ",!WIN16"; 543 544 $platform{"BIO_s_log"} .= ",!WIN32,!WIN16,!macintosh"; 545 546 if(exists $syms{"ERR_load_CRYPTO_strings"}) { 547 $platform{"ERR_load_CRYPTO_strings"} .= ",!VMS,!WIN16"; 548 $syms{"ERR_load_CRYPTOlib_strings"} = 1; 549 $platform{"ERR_load_CRYPTOlib_strings"} .= ",VMS,WIN16"; 550 } 551 552 # Info we know about 553 554 $platform{"RSA_PKCS1_RSAref"} = "RSAREF"; 555 $algorithm{"RSA_PKCS1_RSAref"} = "RSA"; 556 557 push @ret, map { $_."\\".&info_string($_,"EXIST", 558 $platform{$_}, 559 $kind{$_}, 560 $algorithm{$_}) } keys %syms; 561 562 return(@ret); 563} 564 565sub info_string { 566 (my $symbol, my $exist, my $platforms, my $kind, my $algorithms) = @_; 567 568 my %a = defined($algorithms) ? 569 map { $_ => 1 } split /,/, $algorithms : (); 570 my $pl = defined($platforms) ? $platforms : ""; 571 my %p = map { $_ => 0 } split /,/, $pl; 572 my $k = defined($kind) ? $kind : "FUNCTION"; 573 my $ret; 574 575 # We do this, because if there's code like the following, it really 576 # means the function exists in all cases and should therefore be 577 # everywhere. By increasing and decreasing, we may attain 0: 578 # 579 # ifndef WIN16 580 # int foo(); 581 # else 582 # int _fat foo(); 583 # endif 584 foreach $platform (split /,/, $pl) { 585 if ($platform =~ /^!(.*)$/) { 586 $p{$1}--; 587 } else { 588 $p{$platform}++; 589 } 590 } 591 foreach $platform (keys %p) { 592 if ($p{$platform} == 0) { delete $p{$platform}; } 593 } 594 595 delete $p{""}; 596 delete $a{""}; 597 598 $ret = $exist; 599 $ret .= ":".join(',',map { $p{$_} < 0 ? "!".$_ : $_ } keys %p); 600 $ret .= ":".$k; 601 $ret .= ":".join(',',keys %a); 602 return $ret; 603} 604 605sub maybe_add_info { 606 (my $name, *nums, my @symbols) = @_; 607 my $sym; 608 my $new_info = 0; 609 610 print STDERR "Updating $name info\n"; 611 foreach $sym (@symbols) { 612 (my $s, my $i) = split /\\/, $sym; 613 $i =~ s/^(.*?:.*?:\w+)(\(\w+\))?/$1/; 614 if (defined($nums{$s})) { 615 (my $n, my $dummy) = split /\\/, $nums{$s}; 616 if (!defined($dummy) || $i ne $dummy) { 617 $nums{$s} = $n."\\".$i; 618 $new_info++; 619 #print STDERR "DEBUG: maybe_add_info for $s: \"$dummy\" => \"$i\"\n"; 620 } 621 } 622 } 623 if ($new_info) { 624 print STDERR "$new_info old symbols got an info update\n"; 625 if (!$do_rewrite) { 626 print STDERR "You should do a rewrite to fix this.\n"; 627 } 628 } else { 629 print STDERR "No old symbols needed info update\n"; 630 } 631} 632 633sub print_test_file 634{ 635 (*OUT,my $name,*nums,my @symbols)=@_; 636 my $n = 1; my @e; my @r; 637 my $sym; my $prev = ""; my $prefSSLeay; 638 639 (@e)=grep(/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); 640 (@r)=grep(/^\w+\\.*?:.*?:FUNCTION/ && !/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); 641 @symbols=((sort @e),(sort @r)); 642 643 foreach $sym (@symbols) { 644 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 645 if ($s ne $prev) { 646 if (!defined($nums{$sym})) { 647 printf STDERR "Warning: $sym does not have a number assigned\n" 648 if(!$do_update); 649 } else { 650 $n=$nums{$s}; 651 print OUT "\t$s();\n"; 652 } 653 } 654 $prev = $s; # To avoid duplicates... 655 } 656} 657 658sub print_def_file 659{ 660 (*OUT,my $name,*nums,my @symbols)=@_; 661 my $n = 1; my @e; my @r; 662 663 if ($W32) 664 { $name.="32"; } 665 else 666 { $name.="16"; } 667 668 print OUT <<"EOF"; 669; 670; Definition file for the DLL version of the $name library from OpenSSL 671; 672 673LIBRARY $name 674 675DESCRIPTION 'OpenSSL $name - http://www.openssl.org/' 676 677EOF 678 679 if (!$W32) { 680 print <<"EOF"; 681CODE PRELOAD MOVEABLE 682DATA PRELOAD MOVEABLE SINGLE 683 684EXETYPE WINDOWS 685 686HEAPSIZE 4096 687STACKSIZE 8192 688 689EOF 690 } 691 692 print "EXPORTS\n"; 693 694 (@e)=grep(/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); 695 (@r)=grep(/^\w+\\.*?:.*?:FUNCTION/ && !/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); 696 @symbols=((sort @e),(sort @r)); 697 698 699 foreach $sym (@symbols) { 700 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 701 if (!defined($nums{$s})) { 702 printf STDERR "Warning: $s does not have a number assigned\n" 703 if(!$do_update); 704 } else { 705 (my $n, my $i) = split /\\/, $nums{$s}; 706 my %pf = (); 707 my @p = split(/,/, ($i =~ /^.*?:(.*?):/,$1)); 708 # @p_purged must contain hardware platforms only 709 my @p_purged = (); 710 foreach $ptmp (@p) { 711 next if $ptmp =~ /^!?RSAREF$/; 712 push @p_purged, $ptmp; 713 } 714 my $negatives = !!grep(/^!/,@p); 715 # It is very important to check NT before W32 716 if ((($NT && (!@p_purged 717 || (!$negatives && grep(/^WINNT$/,@p)) 718 || ($negatives && !grep(/^!WINNT$/,@p)))) 719 || ($W32 && (!@p_purged 720 || (!$negatives && grep(/^WIN32$/,@p)) 721 || ($negatives && !grep(/^!WIN32$/,@p)))) 722 || ($W16 && (!@p_purged 723 || (!$negatives && grep(/^WIN16$/,@p)) 724 || ($negatives && !grep(/^!WIN16$/,@p))))) 725 && (!@p 726 || (!$negatives 727 && ($rsaref || !grep(/^RSAREF$/,@p))) 728 || ($negatives 729 && (!$rsaref || !grep(/^!RSAREF$/,@p))))) { 730 printf OUT " %s%-40s@%d\n",($W32)?"":"_",$s,$n; 731# } else { 732# print STDERR "DEBUG: \"$sym\" (@p):", 733# " rsaref:", !!(!@p 734# || (!$negatives 735# && ($rsaref || !grep(/^RSAREF$/,@p))) 736# || ($negatives 737# && (!$rsaref || !grep(/^!RSAREF$/,@p))))?1:0, 738# " 16:", !!($W16 && (!@p_purged 739# || (!$negatives && grep(/^WIN16$/,@p)) 740# || ($negatives && !grep(/^!WIN16$/,@p)))), 741# " 32:", !!($W32 && (!@p_purged 742# || (!$negatives && grep(/^WIN32$/,@p)) 743# || ($negatives && !grep(/^!WIN32$/,@p)))), 744# " NT:", !!($NT && (!@p_purged 745# || (!$negatives && grep(/^WINNT$/,@p)) 746# || ($negatives && !grep(/^!WINNT$/,@p)))), 747# "\n"; 748 } 749 } 750 } 751 printf OUT "\n"; 752} 753 754sub load_numbers 755{ 756 my($name)=@_; 757 my(@a,%ret); 758 759 $max_num = 0; 760 $num_noinfo = 0; 761 $prev = ""; 762 763 open(IN,"<$name") || die "unable to open $name:$!\n"; 764 while (<IN>) { 765 chop; 766 s/#.*$//; 767 next if /^\s*$/; 768 @a=split; 769 if (defined $ret{$a[0]}) { 770 print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n"; 771 } 772 if ($max_num > $a[1]) { 773 print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n"; 774 } 775 if ($max_num == $a[1]) { 776 # This is actually perfectly OK 777 #print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n"; 778 } 779 if ($#a < 2) { 780 # Existence will be proven later, in do_defs 781 $ret{$a[0]}=$a[1]; 782 $num_noinfo++; 783 } else { 784 $ret{$a[0]}=$a[1]."\\".$a[2]; # \\ is a special marker 785 } 786 $max_num = $a[1] if $a[1] > $max_num; 787 $prev=$a[0]; 788 } 789 if ($num_noinfo) { 790 print STDERR "Warning: $num_noinfo symbols were without info."; 791 if ($do_rewrite) { 792 printf STDERR " The rewrite will fix this.\n"; 793 } else { 794 printf STDERR " You should do a rewrite to fix this.\n"; 795 } 796 } 797 close(IN); 798 return(%ret); 799} 800 801sub parse_number 802{ 803 (my $str, my $what) = @_; 804 (my $n, my $i) = split(/\\/,$str); 805 if ($what eq "n") { 806 return $n; 807 } else { 808 return $i; 809 } 810} 811 812sub rewrite_numbers 813{ 814 (*OUT,$name,*nums,@symbols)=@_; 815 my $thing; 816 817 print STDERR "Rewriting $name\n"; 818 819 my @r = grep(/^\w+\\.*?:.*?:\w+\(\w+\)/,@symbols); 820 my $r; my %r; my %rsyms; 821 foreach $r (@r) { 822 (my $s, my $i) = split /\\/, $r; 823 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/; 824 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/; 825 $r{$a} = $s."\\".$i; 826 $rsyms{$s} = 1; 827 } 828 829 my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums; 830 foreach $sym (@s) { 831 (my $n, my $i) = split /\\/, $nums{$sym}; 832 next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/; 833 next if defined($rsyms{$sym}); 834 $i="NOEXIST::FUNCTION:" if !defined($i) || $i eq ""; 835 printf OUT "%s%-40s%d\t%s\n","",$sym,$n,$i; 836 if (exists $r{$sym}) { 837 (my $s, $i) = split /\\/,$r{$sym}; 838 printf OUT "%s%-40s%d\t%s\n","",$s,$n,$i; 839 } 840 } 841} 842 843sub update_numbers 844{ 845 (*OUT,$name,*nums,my $start_num, my @symbols)=@_; 846 my $new_syms = 0; 847 848 print STDERR "Updating $name numbers\n"; 849 850 my @r = grep(/^\w+\\.*?:.*?:\w+\(\w+\)/,@symbols); 851 my $r; my %r; my %rsyms; 852 foreach $r (@r) { 853 (my $s, my $i) = split /\\/, $r; 854 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/; 855 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/; 856 $r{$a} = $s."\\".$i; 857 $rsyms{$s} = 1; 858 } 859 860 foreach $sym (@symbols) { 861 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 862 next if $i =~ /^.*?:.*?:\w+\(\w+\)/; 863 next if defined($rsyms{$sym}); 864 die "ERROR: Symbol $sym had no info attached to it." 865 if $i eq ""; 866 if (!exists $nums{$s}) { 867 $new_syms++; 868 printf OUT "%s%-40s%d\t%s\n","",$s, ++$start_num,$i; 869 if (exists $r{$s}) { 870 ($s, $i) = split /\\/,$r{$s}; 871 printf OUT "%s%-40s%d\t%s\n","",$s, $start_num,$i; 872 } 873 } 874 } 875 if($new_syms) { 876 print STDERR "$new_syms New symbols added\n"; 877 } else { 878 print STDERR "No New symbols Added\n"; 879 } 880} 881 882sub check_existing 883{ 884 (*nums, my @symbols)=@_; 885 my %existing; my @remaining; 886 @remaining=(); 887 foreach $sym (@symbols) { 888 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 889 $existing{$s}=1; 890 } 891 foreach $sym (keys %nums) { 892 if (!exists $existing{$sym}) { 893 push @remaining, $sym; 894 } 895 } 896 if(@remaining) { 897 print STDERR "The following symbols do not seem to exist:\n"; 898 foreach $sym (@remaining) { 899 print STDERR "\t",$sym,"\n"; 900 } 901 } 902} 903 904