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 my $begin_error_codes = 0; 297 while(<IN>) { 298 $begin_error_codes = 1 if (/BEGIN ERROR CODES/); 299 last if ($begin_error_codes && /Error codes for /); 300 if ($line ne '') { 301 $_ = $line . $_; 302 $line = ''; 303 } 304 305 if (/\\$/) { 306 $line = $_; 307 next; 308 } 309 310 $cpp = 1 if /^\#.*ifdef.*cplusplus/; 311 if ($cpp) { 312 $cpp = 0 if /^\#.*endif/; 313 next; 314 } 315 316 s/\/\*.*?\*\///gs; # ignore comments 317 s/{[^{}]*}//gs; # ignore {} blocks 318 if (/^\#\s*ifndef (.*)/) { 319 push(@tag,$1); 320 $tag{$1}=-1; 321 } elsif (/^\#\s*if !defined\(([^\)]+)\)/) { 322 push(@tag,$1); 323 $tag{$1}=-1; 324 } elsif (/^\#\s*ifdef (.*)/) { 325 push(@tag,$1); 326 $tag{$1}=1; 327 } elsif (/^\#\s*if defined\(([^\)]+)\)/) { 328 push(@tag,$1); 329 $tag{$1}=1; 330 } elsif (/^\#\s*error\s+(\w+) is disabled\./) { 331 if ($tag[$#tag] eq "NO_".$1) { 332 $tag{$tag[$#tag]}=2; 333 } 334 } elsif (/^\#\s*endif/) { 335 if ($tag{$tag[$#tag]}==2) { 336 $tag{$tag[$#tag]}=-1; 337 } else { 338 $tag{$tag[$#tag]}=0; 339 } 340 pop(@tag); 341 } elsif (/^\#\s*else/) { 342 my $t=$tag[$#tag]; 343 $tag{$t}= -$tag{$t}; 344 } elsif (/^\#\s*if\s+1/) { 345 # Dummy tag 346 push(@tag,"TRUE"); 347 $tag{"TRUE"}=1; 348 } elsif (/^\#\s*if\s+0/) { 349 # Dummy tag 350 push(@tag,"TRUE"); 351 $tag{"TRUE"}=-1; 352 } elsif (/^\#\s*define\s+(\w+)\s+(\w+)/ 353 && $symhacking) { 354 my $s = $1; 355 my $a = 356 $2.":".join(",", grep(!/^$/, 357 map { $tag{$_} == 1 ? 358 $_ : "" } 359 @known_platforms)); 360 $rename{$s} = $a; 361 } 362 if (/^\#/) { 363 my @p = grep(!/^$/, 364 map { $tag{$_} == 1 ? $_ : 365 $tag{$_} == -1 ? "!".$_ : "" } 366 @known_platforms); 367 my @a = grep(!/^$/, 368 map { $tag{"NO_".$_} == -1 ? $_ : "" } 369 @known_algorithms); 370 $def .= "#INFO:".join(',',@p).":".join(',',@a).";"; 371 next; 372 } 373 if (/^\s*DECLARE_STACK_OF\s*\(\s*(\w*)\s*\)/) { 374 next; 375 } elsif (/^\s*DECLARE_PKCS12_STACK_OF\s*\(\s*(\w*)\s*\)/) { 376 next; 377 } elsif (/^\s*DECLARE_ASN1_SET_OF\s*\(\s*(\w*)\s*\)/) { 378 next; 379 } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ || 380 /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ ) { 381 # Things not in Win16 382 $syms{"PEM_read_${1}"} = 1; 383 $platform{"PEM_read_${1}"} = "!WIN16"; 384 $syms{"PEM_write_${1}"} = 1; 385 $platform{"PEM_write_${1}"} = "!WIN16"; 386 # Things that are everywhere 387 $syms{"PEM_read_bio_${1}"} = 1; 388 $syms{"PEM_write_bio_${1}"} = 1; 389 if ($1 eq "RSAPrivateKey" || 390 $1 eq "RSAPublicKey" || 391 $1 eq "RSA_PUBKEY") { 392 $algorithm{"PEM_read_${1}"} = "RSA"; 393 $algorithm{"PEM_write_${1}"} = "RSA"; 394 $algorithm{"PEM_read_bio_${1}"} = "RSA"; 395 $algorithm{"PEM_write_bio_${1}"} = "RSA"; 396 } 397 elsif ($1 eq "DSAPrivateKey" || 398 $1 eq "DSAparams" || 399 $1 eq "RSA_PUBKEY") { 400 $algorithm{"PEM_read_${1}"} = "DSA"; 401 $algorithm{"PEM_write_${1}"} = "DSA"; 402 $algorithm{"PEM_read_bio_${1}"} = "DSA"; 403 $algorithm{"PEM_write_bio_${1}"} = "DSA"; 404 } 405 elsif ($1 eq "DHparams") { 406 $algorithm{"PEM_read_${1}"} = "DH"; 407 $algorithm{"PEM_write_${1}"} = "DH"; 408 $algorithm{"PEM_read_bio_${1}"} = "DH"; 409 $algorithm{"PEM_write_bio_${1}"} = "DH"; 410 } 411 } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ || 412 /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) { 413 # Things not in Win16 414 $syms{"PEM_write_${1}"} = 1; 415 $platform{"PEM_write_${1}"} .= ",!WIN16"; 416 # Things that are everywhere 417 $syms{"PEM_write_bio_${1}"} = 1; 418 if ($1 eq "RSAPrivateKey" || 419 $1 eq "RSAPublicKey" || 420 $1 eq "RSA_PUBKEY") { 421 $algorithm{"PEM_write_${1}"} = "RSA"; 422 $algorithm{"PEM_write_bio_${1}"} = "RSA"; 423 } 424 elsif ($1 eq "DSAPrivateKey" || 425 $1 eq "DSAparams" || 426 $1 eq "RSA_PUBKEY") { 427 $algorithm{"PEM_write_${1}"} = "DSA"; 428 $algorithm{"PEM_write_bio_${1}"} = "DSA"; 429 } 430 elsif ($1 eq "DHparams") { 431 $algorithm{"PEM_write_${1}"} = "DH"; 432 $algorithm{"PEM_write_bio_${1}"} = "DH"; 433 } 434 } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ || 435 /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) { 436 # Things not in Win16 437 $syms{"PEM_read_${1}"} = 1; 438 $platform{"PEM_read_${1}"} .= ",!WIN16"; 439 # Things that are everywhere 440 $syms{"PEM_read_bio_${1}"} = 1; 441 } elsif ( 442 ($tag{'TRUE'} != -1) 443 && ($tag{'CONST_STRICT'} != 1) 444 ) 445 { 446 if (/\{|\/\*|\([^\)]*$/) { 447 $line = $_; 448 } else { 449 $def .= $_; 450 } 451 } 452 } 453 close(IN); 454 455 my $algs; 456 my $plays; 457 458 foreach (split /;/, $def) { 459 my $s; my $k = "FUNCTION"; my $p; my $a; 460 s/^[\n\s]*//g; 461 s/[\n\s]*$//g; 462 next if(/\#undef/); 463 next if(/typedef\W/); 464 next if(/\#define/); 465 466 if (/^\#INFO:([^:]*):(.*)$/) { 467 $plats = $1; 468 $algs = $2; 469 next; 470 } elsif (/^\s*OPENSSL_EXTERN\s.*?(\w+)(\[[0-9]*\])*\s*$/) { 471 $s = $1; 472 $k = "VARIABLE"; 473 } elsif (/\(\*(\w*)\([^\)]+/) { 474 $s = $1; 475 } elsif (/\w+\W+(\w+)\W*\(\s*\)$/s) { 476 # K&R C 477 next; 478 } elsif (/\w+\W+\w+\W*\(.*\)$/s) { 479 while (not /\(\)$/s) { 480 s/[^\(\)]*\)$/\)/s; 481 s/\([^\(\)]*\)\)$/\)/s; 482 } 483 s/\(void\)//; 484 /(\w+)\W*\(\)/s; 485 $s = $1; 486 } elsif (/\(/ and not (/=/)) { 487 print STDERR "File $file: cannot parse: $_;\n"; 488 next; 489 } else { 490 next; 491 } 492 493 $syms{$s} = 1; 494 $kind{$s} = $k; 495 496 $p = $plats; 497 $a = $algs; 498 $a .= ",BF" if($s =~ /EVP_bf/); 499 $a .= ",CAST" if($s =~ /EVP_cast/); 500 $a .= ",DES" if($s =~ /EVP_des/); 501 $a .= ",DSA" if($s =~ /EVP_dss/); 502 $a .= ",IDEA" if($s =~ /EVP_idea/); 503 $a .= ",MD2" if($s =~ /EVP_md2/); 504 $a .= ",MD4" if($s =~ /EVP_md4/); 505 $a .= ",MD5" if($s =~ /EVP_md5/); 506 $a .= ",RC2" if($s =~ /EVP_rc2/); 507 $a .= ",RC4" if($s =~ /EVP_rc4/); 508 $a .= ",RC5" if($s =~ /EVP_rc5/); 509 $a .= ",RIPEMD" if($s =~ /EVP_ripemd/); 510 $a .= ",SHA" if($s =~ /EVP_sha/); 511 $a .= ",RSA" if($s =~ /EVP_(Open|Seal)(Final|Init)/); 512 $a .= ",RSA" if($s =~ /PEM_Seal(Final|Init|Update)/); 513 $a .= ",RSA" if($s =~ /RSAPrivateKey/); 514 $a .= ",RSA" if($s =~ /SSLv23?_((client|server)_)?method/); 515 516 $platform{$s} .= ','.$p; 517 $algorithm{$s} .= ','.$a; 518 519 if (defined($rename{$s})) { 520 (my $r, my $p) = split(/:/,$rename{$s}); 521 my @ip = map { /^!(.*)$/ ? $1 : "!".$_ } split /,/, $p; 522 $syms{$r} = 1; 523 $kind{$r} = $kind{$s}."(".$s.")"; 524 $algorithm{$r} = $algorithm{$s}; 525 $platform{$r} = $platform{$s}.",".$p; 526 $platform{$s} .= ','.join(',', @ip).','.join(',', @ip); 527 } 528 } 529 } 530 531 # Prune the returned symbols 532 533 $platform{"crypt"} .= ",!PERL5,!__FreeBSD__,!NeXT"; 534 535 delete $syms{"SSL_add_dir_cert_subjects_to_stack"}; 536 delete $syms{"bn_dump1"}; 537 538 $platform{"BIO_s_file_internal"} .= ",WIN16"; 539 $platform{"BIO_new_file_internal"} .= ",WIN16"; 540 $platform{"BIO_new_fp_internal"} .= ",WIN16"; 541 542 $platform{"BIO_s_file"} .= ",!WIN16"; 543 $platform{"BIO_new_file"} .= ",!WIN16"; 544 $platform{"BIO_new_fp"} .= ",!WIN16"; 545 546 $platform{"BIO_s_log"} .= ",!WIN32,!WIN16,!macintosh"; 547 548 if(exists $syms{"ERR_load_CRYPTO_strings"}) { 549 $platform{"ERR_load_CRYPTO_strings"} .= ",!VMS,!WIN16"; 550 $syms{"ERR_load_CRYPTOlib_strings"} = 1; 551 $platform{"ERR_load_CRYPTOlib_strings"} .= ",VMS,WIN16"; 552 } 553 554 # Info we know about 555 556 $platform{"RSA_PKCS1_RSAref"} = "RSAREF"; 557 $algorithm{"RSA_PKCS1_RSAref"} = "RSA"; 558 559 push @ret, map { $_."\\".&info_string($_,"EXIST", 560 $platform{$_}, 561 $kind{$_}, 562 $algorithm{$_}) } keys %syms; 563 564 return(@ret); 565} 566 567sub info_string { 568 (my $symbol, my $exist, my $platforms, my $kind, my $algorithms) = @_; 569 570 my %a = defined($algorithms) ? 571 map { $_ => 1 } split /,/, $algorithms : (); 572 my $pl = defined($platforms) ? $platforms : ""; 573 my %p = map { $_ => 0 } split /,/, $pl; 574 my $k = defined($kind) ? $kind : "FUNCTION"; 575 my $ret; 576 577 # We do this, because if there's code like the following, it really 578 # means the function exists in all cases and should therefore be 579 # everywhere. By increasing and decreasing, we may attain 0: 580 # 581 # ifndef WIN16 582 # int foo(); 583 # else 584 # int _fat foo(); 585 # endif 586 foreach $platform (split /,/, $pl) { 587 if ($platform =~ /^!(.*)$/) { 588 $p{$1}--; 589 } else { 590 $p{$platform}++; 591 } 592 } 593 foreach $platform (keys %p) { 594 if ($p{$platform} == 0) { delete $p{$platform}; } 595 } 596 597 delete $p{""}; 598 delete $a{""}; 599 600 $ret = $exist; 601 $ret .= ":".join(',',map { $p{$_} < 0 ? "!".$_ : $_ } keys %p); 602 $ret .= ":".$k; 603 $ret .= ":".join(',',keys %a); 604 return $ret; 605} 606 607sub maybe_add_info { 608 (my $name, *nums, my @symbols) = @_; 609 my $sym; 610 my $new_info = 0; 611 612 print STDERR "Updating $name info\n"; 613 foreach $sym (@symbols) { 614 (my $s, my $i) = split /\\/, $sym; 615 $i =~ s/^(.*?:.*?:\w+)(\(\w+\))?/$1/; 616 if (defined($nums{$s})) { 617 (my $n, my $dummy) = split /\\/, $nums{$s}; 618 if (!defined($dummy) || $i ne $dummy) { 619 $nums{$s} = $n."\\".$i; 620 $new_info++; 621 #print STDERR "DEBUG: maybe_add_info for $s: \"$dummy\" => \"$i\"\n"; 622 } 623 } 624 } 625 if ($new_info) { 626 print STDERR "$new_info old symbols got an info update\n"; 627 if (!$do_rewrite) { 628 print STDERR "You should do a rewrite to fix this.\n"; 629 } 630 } else { 631 print STDERR "No old symbols needed info update\n"; 632 } 633} 634 635sub print_test_file 636{ 637 (*OUT,my $name,*nums,my @symbols)=@_; 638 my $n = 1; my @e; my @r; 639 my $sym; my $prev = ""; my $prefSSLeay; 640 641 (@e)=grep(/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); 642 (@r)=grep(/^\w+\\.*?:.*?:FUNCTION/ && !/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); 643 @symbols=((sort @e),(sort @r)); 644 645 foreach $sym (@symbols) { 646 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 647 if ($s ne $prev) { 648 if (!defined($nums{$sym})) { 649 printf STDERR "Warning: $sym does not have a number assigned\n" 650 if(!$do_update); 651 } else { 652 $n=$nums{$s}; 653 print OUT "\t$s();\n"; 654 } 655 } 656 $prev = $s; # To avoid duplicates... 657 } 658} 659 660sub print_def_file 661{ 662 (*OUT,my $name,*nums,my @symbols)=@_; 663 my $n = 1; my @e; my @r; 664 665 if ($W32) 666 { $name.="32"; } 667 else 668 { $name.="16"; } 669 670 print OUT <<"EOF"; 671; 672; Definition file for the DLL version of the $name library from OpenSSL 673; 674 675LIBRARY $name 676 677DESCRIPTION 'OpenSSL $name - http://www.openssl.org/' 678 679EOF 680 681 if (!$W32) { 682 print <<"EOF"; 683CODE PRELOAD MOVEABLE 684DATA PRELOAD MOVEABLE SINGLE 685 686EXETYPE WINDOWS 687 688HEAPSIZE 4096 689STACKSIZE 8192 690 691EOF 692 } 693 694 print "EXPORTS\n"; 695 696 (@e)=grep(/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); 697 (@r)=grep(/^\w+\\.*?:.*?:FUNCTION/ && !/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); 698 @symbols=((sort @e),(sort @r)); 699 700 701 foreach $sym (@symbols) { 702 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 703 if (!defined($nums{$s})) { 704 printf STDERR "Warning: $s does not have a number assigned\n" 705 if(!$do_update); 706 } else { 707 (my $n, my $i) = split /\\/, $nums{$s}; 708 my %pf = (); 709 my @p = split(/,/, ($i =~ /^[^:]*:([^:]*):/,$1)); 710 my @a = split(/,/, ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1)); 711 # @p_purged must contain hardware platforms only 712 my @p_purged = (); 713 foreach $ptmp (@p) { 714 next if $ptmp =~ /^!?RSAREF$/; 715 push @p_purged, $ptmp; 716 } 717 my $negatives = !!grep(/^!/,@p); 718 # It is very important to check NT before W32 719 if ((($NT && (!@p_purged 720 || (!$negatives && grep(/^WINNT$/,@p)) 721 || ($negatives && !grep(/^!WINNT$/,@p)))) 722 || ($W32 && (!@p_purged 723 || (!$negatives && grep(/^WIN32$/,@p)) 724 || ($negatives && !grep(/^!WIN32$/,@p)))) 725 || ($W16 && (!@p_purged 726 || (!$negatives && grep(/^WIN16$/,@p)) 727 || ($negatives && !grep(/^!WIN16$/,@p))))) 728 && (!@p 729 || (!$negatives 730 && ($rsaref || !grep(/^RSAREF$/,@p))) 731 || ($negatives 732 && (!$rsaref || !grep(/^!RSAREF$/,@p)))) 733 && (!@a || (!$no_rc2 || !grep(/^RC2$/,@a))) 734 && (!@a || (!$no_rc4 || !grep(/^RC4$/,@a))) 735 && (!@a || (!$no_rc5 || !grep(/^RC5$/,@a))) 736 && (!@a || (!$no_idea || !grep(/^IDEA$/,@a))) 737 && (!@a || (!$no_des || !grep(/^DES$/,@a))) 738 && (!@a || (!$no_bf || !grep(/^BF$/,@a))) 739 && (!@a || (!$no_cast || !grep(/^CAST$/,@a))) 740 && (!@a || (!$no_md2 || !grep(/^MD2$/,@a))) 741 && (!@a || (!$no_md4 || !grep(/^MD4$/,@a))) 742 && (!@a || (!$no_md5 || !grep(/^MD5$/,@a))) 743 && (!@a || (!$no_sha || !grep(/^SHA$/,@a))) 744 && (!@a || (!$no_ripemd || !grep(/^RIPEMD$/,@a))) 745 && (!@a || (!$no_mdc2 || !grep(/^MDC2$/,@a))) 746 && (!@a || (!$no_rsa || !grep(/^RSA$/,@a))) 747 && (!@a || (!$no_dsa || !grep(/^DSA$/,@a))) 748 && (!@a || (!$no_dh || !grep(/^DH$/,@a))) 749 && (!@a || (!$no_hmac || !grep(/^HMAC$/,@a))) 750 && (!@a || (!$no_fp_api || !grep(/^FP_API$/,@a))) 751 ) { 752 printf OUT " %s%-40s@%d\n",($W32)?"":"_",$s,$n; 753# } else { 754# print STDERR "DEBUG: \"$sym\" (@p):", 755# " rsaref:", !!(!@p 756# || (!$negatives 757# && ($rsaref || !grep(/^RSAREF$/,@p))) 758# || ($negatives 759# && (!$rsaref || !grep(/^!RSAREF$/,@p))))?1:0, 760# " 16:", !!($W16 && (!@p_purged 761# || (!$negatives && grep(/^WIN16$/,@p)) 762# || ($negatives && !grep(/^!WIN16$/,@p)))), 763# " 32:", !!($W32 && (!@p_purged 764# || (!$negatives && grep(/^WIN32$/,@p)) 765# || ($negatives && !grep(/^!WIN32$/,@p)))), 766# " NT:", !!($NT && (!@p_purged 767# || (!$negatives && grep(/^WINNT$/,@p)) 768# || ($negatives && !grep(/^!WINNT$/,@p)))), 769# "\n"; 770 } 771 } 772 } 773 printf OUT "\n"; 774} 775 776sub load_numbers 777{ 778 my($name)=@_; 779 my(@a,%ret); 780 781 $max_num = 0; 782 $num_noinfo = 0; 783 $prev = ""; 784 785 open(IN,"<$name") || die "unable to open $name:$!\n"; 786 while (<IN>) { 787 chop; 788 s/#.*$//; 789 next if /^\s*$/; 790 @a=split; 791 if (defined $ret{$a[0]}) { 792 print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n"; 793 } 794 if ($max_num > $a[1]) { 795 print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n"; 796 } 797 if ($max_num == $a[1]) { 798 # This is actually perfectly OK 799 #print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n"; 800 } 801 if ($#a < 2) { 802 # Existence will be proven later, in do_defs 803 $ret{$a[0]}=$a[1]; 804 $num_noinfo++; 805 } else { 806 $ret{$a[0]}=$a[1]."\\".$a[2]; # \\ is a special marker 807 } 808 $max_num = $a[1] if $a[1] > $max_num; 809 $prev=$a[0]; 810 } 811 if ($num_noinfo) { 812 print STDERR "Warning: $num_noinfo symbols were without info."; 813 if ($do_rewrite) { 814 printf STDERR " The rewrite will fix this.\n"; 815 } else { 816 printf STDERR " You should do a rewrite to fix this.\n"; 817 } 818 } 819 close(IN); 820 return(%ret); 821} 822 823sub parse_number 824{ 825 (my $str, my $what) = @_; 826 (my $n, my $i) = split(/\\/,$str); 827 if ($what eq "n") { 828 return $n; 829 } else { 830 return $i; 831 } 832} 833 834sub rewrite_numbers 835{ 836 (*OUT,$name,*nums,@symbols)=@_; 837 my $thing; 838 839 print STDERR "Rewriting $name\n"; 840 841 my @r = grep(/^\w+\\.*?:.*?:\w+\(\w+\)/,@symbols); 842 my $r; my %r; my %rsyms; 843 foreach $r (@r) { 844 (my $s, my $i) = split /\\/, $r; 845 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/; 846 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/; 847 $r{$a} = $s."\\".$i; 848 $rsyms{$s} = 1; 849 } 850 851 my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums; 852 foreach $sym (@s) { 853 (my $n, my $i) = split /\\/, $nums{$sym}; 854 next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/; 855 next if defined($rsyms{$sym}); 856 $i="NOEXIST::FUNCTION:" if !defined($i) || $i eq ""; 857 printf OUT "%s%-40s%d\t%s\n","",$sym,$n,$i; 858 if (exists $r{$sym}) { 859 (my $s, $i) = split /\\/,$r{$sym}; 860 printf OUT "%s%-40s%d\t%s\n","",$s,$n,$i; 861 } 862 } 863} 864 865sub update_numbers 866{ 867 (*OUT,$name,*nums,my $start_num, my @symbols)=@_; 868 my $new_syms = 0; 869 870 print STDERR "Updating $name numbers\n"; 871 872 my @r = grep(/^\w+\\.*?:.*?:\w+\(\w+\)/,@symbols); 873 my $r; my %r; my %rsyms; 874 foreach $r (@r) { 875 (my $s, my $i) = split /\\/, $r; 876 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/; 877 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/; 878 $r{$a} = $s."\\".$i; 879 $rsyms{$s} = 1; 880 } 881 882 foreach $sym (@symbols) { 883 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 884 next if $i =~ /^.*?:.*?:\w+\(\w+\)/; 885 next if defined($rsyms{$sym}); 886 die "ERROR: Symbol $sym had no info attached to it." 887 if $i eq ""; 888 if (!exists $nums{$s}) { 889 $new_syms++; 890 printf OUT "%s%-40s%d\t%s\n","",$s, ++$start_num,$i; 891 if (exists $r{$s}) { 892 ($s, $i) = split /\\/,$r{$s}; 893 printf OUT "%s%-40s%d\t%s\n","",$s, $start_num,$i; 894 } 895 } 896 } 897 if($new_syms) { 898 print STDERR "$new_syms New symbols added\n"; 899 } else { 900 print STDERR "No New symbols Added\n"; 901 } 902} 903 904sub check_existing 905{ 906 (*nums, my @symbols)=@_; 907 my %existing; my @remaining; 908 @remaining=(); 909 foreach $sym (@symbols) { 910 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 911 $existing{$s}=1; 912 } 913 foreach $sym (keys %nums) { 914 if (!exists $existing{$sym}) { 915 push @remaining, $sym; 916 } 917 } 918 if(@remaining) { 919 print STDERR "The following symbols do not seem to exist:\n"; 920 foreach $sym (@remaining) { 921 print STDERR "\t",$sym,"\n"; 922 } 923 } 924} 925 926