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; $no_mdc2=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 my @a = split(/,/, ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1)); 709 # @p_purged must contain hardware platforms only 710 my @p_purged = (); 711 foreach $ptmp (@p) { 712 next if $ptmp =~ /^!?RSAREF$/; 713 push @p_purged, $ptmp; 714 } 715 my $negatives = !!grep(/^!/,@p); 716 # It is very important to check NT before W32 717 if ((($NT && (!@p_purged 718 || (!$negatives && grep(/^WINNT$/,@p)) 719 || ($negatives && !grep(/^!WINNT$/,@p)))) 720 || ($W32 && (!@p_purged 721 || (!$negatives && grep(/^WIN32$/,@p)) 722 || ($negatives && !grep(/^!WIN32$/,@p)))) 723 || ($W16 && (!@p_purged 724 || (!$negatives && grep(/^WIN16$/,@p)) 725 || ($negatives && !grep(/^!WIN16$/,@p))))) 726 && (!@p 727 || (!$negatives 728 && ($rsaref || !grep(/^RSAREF$/,@p))) 729 || ($negatives 730 && (!$rsaref || !grep(/^!RSAREF$/,@p)))) 731 && (!@a || (!$no_rc2 || !grep(/^RC2$/,@a))) 732 && (!@a || (!$no_rc4 || !grep(/^RC4$/,@a))) 733 && (!@a || (!$no_rc5 || !grep(/^RC5$/,@a))) 734 && (!@a || (!$no_idea || !grep(/^IDEA$/,@a))) 735 && (!@a || (!$no_des || !grep(/^DES$/,@a))) 736 && (!@a || (!$no_bf || !grep(/^BF$/,@a))) 737 && (!@a || (!$no_cast || !grep(/^CAST$/,@a))) 738 && (!@a || (!$no_md2 || !grep(/^MD2$/,@a))) 739 && (!@a || (!$no_md4 || !grep(/^MD4$/,@a))) 740 && (!@a || (!$no_md5 || !grep(/^MD5$/,@a))) 741 && (!@a || (!$no_sha || !grep(/^SHA$/,@a))) 742 && (!@a || (!$no_ripemd || !grep(/^RIPEMD$/,@a))) 743 && (!@a || (!$no_mdc2 || !grep(/^MDC2$/,@a))) 744 && (!@a || (!$no_rsa || !grep(/^RSA$/,@a))) 745 && (!@a || (!$no_dsa || !grep(/^DSA$/,@a))) 746 && (!@a || (!$no_dh || !grep(/^DH$/,@a))) 747 && (!@a || (!$no_hmac || !grep(/^HMAC$/,@a))) 748 && (!@a || (!$no_fp_api || !grep(/^FP_API$/,@a))) 749 ) { 750 printf OUT " %s%-40s@%d\n",($W32)?"":"_",$s,$n; 751# } else { 752# print STDERR "DEBUG: \"$sym\" (@p):", 753# " rsaref:", !!(!@p 754# || (!$negatives 755# && ($rsaref || !grep(/^RSAREF$/,@p))) 756# || ($negatives 757# && (!$rsaref || !grep(/^!RSAREF$/,@p))))?1:0, 758# " 16:", !!($W16 && (!@p_purged 759# || (!$negatives && grep(/^WIN16$/,@p)) 760# || ($negatives && !grep(/^!WIN16$/,@p)))), 761# " 32:", !!($W32 && (!@p_purged 762# || (!$negatives && grep(/^WIN32$/,@p)) 763# || ($negatives && !grep(/^!WIN32$/,@p)))), 764# " NT:", !!($NT && (!@p_purged 765# || (!$negatives && grep(/^WINNT$/,@p)) 766# || ($negatives && !grep(/^!WINNT$/,@p)))), 767# "\n"; 768 } 769 } 770 } 771 printf OUT "\n"; 772} 773 774sub load_numbers 775{ 776 my($name)=@_; 777 my(@a,%ret); 778 779 $max_num = 0; 780 $num_noinfo = 0; 781 $prev = ""; 782 783 open(IN,"<$name") || die "unable to open $name:$!\n"; 784 while (<IN>) { 785 chop; 786 s/#.*$//; 787 next if /^\s*$/; 788 @a=split; 789 if (defined $ret{$a[0]}) { 790 print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n"; 791 } 792 if ($max_num > $a[1]) { 793 print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n"; 794 } 795 if ($max_num == $a[1]) { 796 # This is actually perfectly OK 797 #print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n"; 798 } 799 if ($#a < 2) { 800 # Existence will be proven later, in do_defs 801 $ret{$a[0]}=$a[1]; 802 $num_noinfo++; 803 } else { 804 $ret{$a[0]}=$a[1]."\\".$a[2]; # \\ is a special marker 805 } 806 $max_num = $a[1] if $a[1] > $max_num; 807 $prev=$a[0]; 808 } 809 if ($num_noinfo) { 810 print STDERR "Warning: $num_noinfo symbols were without info."; 811 if ($do_rewrite) { 812 printf STDERR " The rewrite will fix this.\n"; 813 } else { 814 printf STDERR " You should do a rewrite to fix this.\n"; 815 } 816 } 817 close(IN); 818 return(%ret); 819} 820 821sub parse_number 822{ 823 (my $str, my $what) = @_; 824 (my $n, my $i) = split(/\\/,$str); 825 if ($what eq "n") { 826 return $n; 827 } else { 828 return $i; 829 } 830} 831 832sub rewrite_numbers 833{ 834 (*OUT,$name,*nums,@symbols)=@_; 835 my $thing; 836 837 print STDERR "Rewriting $name\n"; 838 839 my @r = grep(/^\w+\\.*?:.*?:\w+\(\w+\)/,@symbols); 840 my $r; my %r; my %rsyms; 841 foreach $r (@r) { 842 (my $s, my $i) = split /\\/, $r; 843 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/; 844 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/; 845 $r{$a} = $s."\\".$i; 846 $rsyms{$s} = 1; 847 } 848 849 my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums; 850 foreach $sym (@s) { 851 (my $n, my $i) = split /\\/, $nums{$sym}; 852 next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/; 853 next if defined($rsyms{$sym}); 854 $i="NOEXIST::FUNCTION:" if !defined($i) || $i eq ""; 855 printf OUT "%s%-40s%d\t%s\n","",$sym,$n,$i; 856 if (exists $r{$sym}) { 857 (my $s, $i) = split /\\/,$r{$sym}; 858 printf OUT "%s%-40s%d\t%s\n","",$s,$n,$i; 859 } 860 } 861} 862 863sub update_numbers 864{ 865 (*OUT,$name,*nums,my $start_num, my @symbols)=@_; 866 my $new_syms = 0; 867 868 print STDERR "Updating $name numbers\n"; 869 870 my @r = grep(/^\w+\\.*?:.*?:\w+\(\w+\)/,@symbols); 871 my $r; my %r; my %rsyms; 872 foreach $r (@r) { 873 (my $s, my $i) = split /\\/, $r; 874 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/; 875 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/; 876 $r{$a} = $s."\\".$i; 877 $rsyms{$s} = 1; 878 } 879 880 foreach $sym (@symbols) { 881 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 882 next if $i =~ /^.*?:.*?:\w+\(\w+\)/; 883 next if defined($rsyms{$sym}); 884 die "ERROR: Symbol $sym had no info attached to it." 885 if $i eq ""; 886 if (!exists $nums{$s}) { 887 $new_syms++; 888 printf OUT "%s%-40s%d\t%s\n","",$s, ++$start_num,$i; 889 if (exists $r{$s}) { 890 ($s, $i) = split /\\/,$r{$s}; 891 printf OUT "%s%-40s%d\t%s\n","",$s, $start_num,$i; 892 } 893 } 894 } 895 if($new_syms) { 896 print STDERR "$new_syms New symbols added\n"; 897 } else { 898 print STDERR "No New symbols Added\n"; 899 } 900} 901 902sub check_existing 903{ 904 (*nums, my @symbols)=@_; 905 my %existing; my @remaining; 906 @remaining=(); 907 foreach $sym (@symbols) { 908 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 909 $existing{$s}=1; 910 } 911 foreach $sym (keys %nums) { 912 if (!exists $existing{$sym}) { 913 push @remaining, $sym; 914 } 915 } 916 if(@remaining) { 917 print STDERR "The following symbols do not seem to exist:\n"; 918 foreach $sym (@remaining) { 919 print STDERR "\t",$sym,"\n"; 920 } 921 } 922} 923 924