diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lib/libcrypto/util/mkdef.pl | 751 |
1 files changed, 564 insertions, 187 deletions
diff --git a/src/lib/libcrypto/util/mkdef.pl b/src/lib/libcrypto/util/mkdef.pl index 4e2845a4e1..cc41a1813e 100644 --- a/src/lib/libcrypto/util/mkdef.pl +++ b/src/lib/libcrypto/util/mkdef.pl | |||
| @@ -5,20 +5,78 @@ | |||
| 5 | # It does this by parsing the header files and looking for the | 5 | # It does this by parsing the header files and looking for the |
| 6 | # prototyped functions: it then prunes the output. | 6 | # prototyped functions: it then prunes the output. |
| 7 | # | 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 | # | ||
| 8 | 56 | ||
| 9 | my $crypto_num="util/libeay.num"; | 57 | my $crypto_num= "util/libeay.num"; |
| 10 | my $ssl_num= "util/ssleay.num"; | 58 | my $ssl_num= "util/ssleay.num"; |
| 11 | 59 | ||
| 12 | my $do_update = 0; | 60 | my $do_update = 0; |
| 61 | my $do_rewrite = 0; | ||
| 13 | my $do_crypto = 0; | 62 | my $do_crypto = 0; |
| 14 | my $do_ssl = 0; | 63 | my $do_ssl = 0; |
| 15 | my $do_ctest = 0; | 64 | my $do_ctest = 0; |
| 65 | my $do_ctestall = 0; | ||
| 16 | my $rsaref = 0; | 66 | my $rsaref = 0; |
| 17 | 67 | ||
| 18 | my $W32=1; | 68 | my $VMS=0; |
| 69 | my $W32=0; | ||
| 70 | my $W16=0; | ||
| 19 | my $NT=0; | 71 | my $NT=0; |
| 20 | # Set this to make typesafe STACK definitions appear in DEF | 72 | # Set this to make typesafe STACK definitions appear in DEF |
| 21 | my $safe_stack_def = 1; | 73 | my $safe_stack_def = 0; |
| 74 | |||
| 75 | my @known_platforms = ( "__FreeBSD__", "VMS", "WIN16", "WIN32", | ||
| 76 | "WINNT", "PERL5", "NeXT" ); | ||
| 77 | my @known_algorithms = ( "RC2", "RC4", "RC5", "IDEA", "DES", "BF", | ||
| 78 | "CAST", "MD2", "MD4", "MD5", "SHA", "RIPEMD", | ||
| 79 | "MDC2", "RSA", "DSA", "DH", "HMAC", "FP_API" ); | ||
| 22 | 80 | ||
| 23 | my $options=""; | 81 | my $options=""; |
| 24 | open(IN,"<Makefile.ssl") || die "unable to open Makefile.ssl!\n"; | 82 | open(IN,"<Makefile.ssl") || die "unable to open Makefile.ssl!\n"; |
| @@ -31,24 +89,31 @@ close(IN); | |||
| 31 | # defined with ifndef(NO_XXX) are not included in the .def file, and everything | 89 | # defined with ifndef(NO_XXX) are not included in the .def file, and everything |
| 32 | # in directory xxx is ignored. | 90 | # in directory xxx is ignored. |
| 33 | my $no_rc2; my $no_rc4; my $no_rc5; my $no_idea; my $no_des; my $no_bf; | 91 | my $no_rc2; my $no_rc4; my $no_rc5; my $no_idea; my $no_des; my $no_bf; |
| 34 | my $no_cast; my $no_md2; my $no_md5; my $no_sha; my $no_ripemd; my $no_mdc2; | 92 | my $no_cast; |
| 93 | my $no_md2; my $no_md4; my $no_md5; my $no_sha; my $no_ripemd; my $no_mdc2; | ||
| 35 | my $no_rsa; my $no_dsa; my $no_dh; my $no_hmac=0; | 94 | my $no_rsa; my $no_dsa; my $no_dh; my $no_hmac=0; |
| 95 | my $no_fp_api; | ||
| 36 | 96 | ||
| 37 | foreach (@ARGV, split(/ /, $options)) | 97 | foreach (@ARGV, split(/ /, $options)) |
| 38 | { | 98 | { |
| 39 | $W32=1 if $_ eq "32"; | 99 | $W32=1 if $_ eq "32"; |
| 40 | $W32=0 if $_ eq "16"; | 100 | $W16=1 if $_ eq "16"; |
| 41 | if($_ eq "NT") { | 101 | if($_ eq "NT") { |
| 42 | $W32 = 1; | 102 | $W32 = 1; |
| 43 | $NT = 1; | 103 | $NT = 1; |
| 44 | } | 104 | } |
| 105 | $VMS=1 if $_ eq "VMS"; | ||
| 106 | $rsaref=1 if $_ eq "rsaref"; | ||
| 107 | |||
| 45 | $do_ssl=1 if $_ eq "ssleay"; | 108 | $do_ssl=1 if $_ eq "ssleay"; |
| 46 | $do_ssl=1 if $_ eq "ssl"; | 109 | $do_ssl=1 if $_ eq "ssl"; |
| 47 | $do_crypto=1 if $_ eq "libeay"; | 110 | $do_crypto=1 if $_ eq "libeay"; |
| 48 | $do_crypto=1 if $_ eq "crypto"; | 111 | $do_crypto=1 if $_ eq "crypto"; |
| 49 | $do_update=1 if $_ eq "update"; | 112 | $do_update=1 if $_ eq "update"; |
| 113 | $do_rewrite=1 if $_ eq "rewrite"; | ||
| 50 | $do_ctest=1 if $_ eq "ctest"; | 114 | $do_ctest=1 if $_ eq "ctest"; |
| 51 | $rsaref=1 if $_ eq "rsaref"; | 115 | $do_ctestall=1 if $_ eq "ctestall"; |
| 116 | #$safe_stack_def=1 if $_ eq "-DDEBUG_SAFESTACK"; | ||
| 52 | 117 | ||
| 53 | if (/^no-rc2$/) { $no_rc2=1; } | 118 | if (/^no-rc2$/) { $no_rc2=1; } |
| 54 | elsif (/^no-rc4$/) { $no_rc4=1; } | 119 | elsif (/^no-rc4$/) { $no_rc4=1; } |
| @@ -58,6 +123,7 @@ foreach (@ARGV, split(/ /, $options)) | |||
| 58 | elsif (/^no-bf$/) { $no_bf=1; } | 123 | elsif (/^no-bf$/) { $no_bf=1; } |
| 59 | elsif (/^no-cast$/) { $no_cast=1; } | 124 | elsif (/^no-cast$/) { $no_cast=1; } |
| 60 | elsif (/^no-md2$/) { $no_md2=1; } | 125 | elsif (/^no-md2$/) { $no_md2=1; } |
| 126 | elsif (/^no-md4$/) { $no_md4=1; } | ||
| 61 | elsif (/^no-md5$/) { $no_md5=1; } | 127 | elsif (/^no-md5$/) { $no_md5=1; } |
| 62 | elsif (/^no-sha$/) { $no_sha=1; } | 128 | elsif (/^no-sha$/) { $no_sha=1; } |
| 63 | elsif (/^no-ripemd$/) { $no_ripemd=1; } | 129 | elsif (/^no-ripemd$/) { $no_ripemd=1; } |
| @@ -69,6 +135,16 @@ foreach (@ARGV, split(/ /, $options)) | |||
| 69 | } | 135 | } |
| 70 | 136 | ||
| 71 | 137 | ||
| 138 | # If no platform is given, assume WIN32 | ||
| 139 | if ($W32 + $W16 + $VMS == 0) { | ||
| 140 | $W32 = 1; | ||
| 141 | } | ||
| 142 | |||
| 143 | # Add extra knowledge | ||
| 144 | if ($W16) { | ||
| 145 | $no_fp_api=1; | ||
| 146 | } | ||
| 147 | |||
| 72 | if (!$do_ssl && !$do_crypto) | 148 | if (!$do_ssl && !$do_crypto) |
| 73 | { | 149 | { |
| 74 | print STDERR "usage: $0 ( ssl | crypto ) [ 16 | 32 | NT ] [rsaref]\n"; | 150 | print STDERR "usage: $0 ( ssl | crypto ) [ 16 | 32 | NT ] [rsaref]\n"; |
| @@ -91,6 +167,7 @@ $crypto.=" crypto/rc2/rc2.h" unless $no_rc2; | |||
| 91 | $crypto.=" crypto/bf/blowfish.h" unless $no_bf; | 167 | $crypto.=" crypto/bf/blowfish.h" unless $no_bf; |
| 92 | $crypto.=" crypto/cast/cast.h" unless $no_cast; | 168 | $crypto.=" crypto/cast/cast.h" unless $no_cast; |
| 93 | $crypto.=" crypto/md2/md2.h" unless $no_md2; | 169 | $crypto.=" crypto/md2/md2.h" unless $no_md2; |
| 170 | $crypto.=" crypto/md4/md4.h" unless $no_md4; | ||
| 94 | $crypto.=" crypto/md5/md5.h" unless $no_md5; | 171 | $crypto.=" crypto/md5/md5.h" unless $no_md5; |
| 95 | $crypto.=" crypto/mdc2/mdc2.h" unless $no_mdc2; | 172 | $crypto.=" crypto/mdc2/mdc2.h" unless $no_mdc2; |
| 96 | $crypto.=" crypto/sha/sha.h" unless $no_sha; | 173 | $crypto.=" crypto/sha/sha.h" unless $no_sha; |
| @@ -102,9 +179,11 @@ $crypto.=" crypto/dsa/dsa.h" unless $no_dsa; | |||
| 102 | $crypto.=" crypto/dh/dh.h" unless $no_dh; | 179 | $crypto.=" crypto/dh/dh.h" unless $no_dh; |
| 103 | $crypto.=" crypto/hmac/hmac.h" unless $no_hmac; | 180 | $crypto.=" crypto/hmac/hmac.h" unless $no_hmac; |
| 104 | 181 | ||
| 182 | $crypto.=" crypto/engine/engine.h"; | ||
| 105 | $crypto.=" crypto/stack/stack.h"; | 183 | $crypto.=" crypto/stack/stack.h"; |
| 106 | $crypto.=" crypto/buffer/buffer.h"; | 184 | $crypto.=" crypto/buffer/buffer.h"; |
| 107 | $crypto.=" crypto/bio/bio.h"; | 185 | $crypto.=" crypto/bio/bio.h"; |
| 186 | $crypto.=" crypto/dso/dso.h"; | ||
| 108 | $crypto.=" crypto/lhash/lhash.h"; | 187 | $crypto.=" crypto/lhash/lhash.h"; |
| 109 | $crypto.=" crypto/conf/conf.h"; | 188 | $crypto.=" crypto/conf/conf.h"; |
| 110 | $crypto.=" crypto/txt_db/txt_db.h"; | 189 | $crypto.=" crypto/txt_db/txt_db.h"; |
| @@ -125,25 +204,41 @@ $crypto.=" crypto/rand/rand.h"; | |||
| 125 | $crypto.=" crypto/comp/comp.h"; | 204 | $crypto.=" crypto/comp/comp.h"; |
| 126 | $crypto.=" crypto/tmdiff.h"; | 205 | $crypto.=" crypto/tmdiff.h"; |
| 127 | 206 | ||
| 128 | my @ssl_func = &do_defs("SSLEAY", $ssl); | 207 | my $symhacks="crypto/symhacks.h"; |
| 129 | my @crypto_func = &do_defs("LIBEAY", $crypto); | ||
| 130 | 208 | ||
| 209 | my @ssl_symbols = &do_defs("SSLEAY", $ssl, $symhacks); | ||
| 210 | my @crypto_symbols = &do_defs("LIBEAY", $crypto, $symhacks); | ||
| 131 | 211 | ||
| 132 | if ($do_update) { | 212 | if ($do_update) { |
| 133 | 213 | ||
| 134 | if ($do_ssl == 1) { | 214 | if ($do_ssl == 1) { |
| 135 | open(OUT, ">>$ssl_num"); | 215 | |
| 136 | &update_numbers(*OUT,"SSLEAY",*ssl_list,$max_ssl, @ssl_func); | 216 | &maybe_add_info("SSLEAY",*ssl_list,@ssl_symbols); |
| 217 | if ($do_rewrite == 1) { | ||
| 218 | open(OUT, ">$ssl_num"); | ||
| 219 | &rewrite_numbers(*OUT,"SSLEAY",*ssl_list,@ssl_symbols); | ||
| 220 | close OUT; | ||
| 221 | } else { | ||
| 222 | open(OUT, ">>$ssl_num"); | ||
| 223 | } | ||
| 224 | &update_numbers(*OUT,"SSLEAY",*ssl_list,$max_ssl,@ssl_symbols); | ||
| 137 | close OUT; | 225 | close OUT; |
| 138 | } | 226 | } |
| 139 | 227 | ||
| 140 | if($do_crypto == 1) { | 228 | if($do_crypto == 1) { |
| 141 | open(OUT, ">>$crypto_num"); | 229 | |
| 142 | &update_numbers(*OUT,"LIBEAY",*crypto_list,$max_crypto, @crypto_func); | 230 | &maybe_add_info("LIBEAY",*crypto_list,@crypto_symbols); |
| 231 | if ($do_rewrite == 1) { | ||
| 232 | open(OUT, ">$crypto_num"); | ||
| 233 | &rewrite_numbers(*OUT,"LIBEAY",*crypto_list,@crypto_symbols); | ||
| 234 | } else { | ||
| 235 | open(OUT, ">>$crypto_num"); | ||
| 236 | } | ||
| 237 | &update_numbers(*OUT,"LIBEAY",*crypto_list,$max_crypto,@crypto_symbols); | ||
| 143 | close OUT; | 238 | close OUT; |
| 144 | } | 239 | } |
| 145 | 240 | ||
| 146 | } elsif ($do_ctest) { | 241 | } elsif ($do_ctest || $do_ctestall) { |
| 147 | 242 | ||
| 148 | print <<"EOF"; | 243 | print <<"EOF"; |
| 149 | 244 | ||
| @@ -154,20 +249,20 @@ if($do_crypto == 1) { | |||
| 154 | int main() | 249 | int main() |
| 155 | { | 250 | { |
| 156 | EOF | 251 | EOF |
| 157 | &print_test_file(*STDOUT,"SSLEAY",*ssl_list,@ssl_func) | 252 | &print_test_file(*STDOUT,"SSLEAY",*ssl_list,$do_ctestall,@ssl_symbols) |
| 158 | if $do_ssl == 1; | 253 | if $do_ssl == 1; |
| 159 | 254 | ||
| 160 | &print_test_file(*STDOUT,"LIBEAY",*crypto_list,@crypto_func) | 255 | &print_test_file(*STDOUT,"LIBEAY",*crypto_list,$do_ctestall,@crypto_symbols) |
| 161 | if $do_crypto == 1; | 256 | if $do_crypto == 1; |
| 162 | 257 | ||
| 163 | print "}\n"; | 258 | print "}\n"; |
| 164 | 259 | ||
| 165 | } else { | 260 | } else { |
| 166 | 261 | ||
| 167 | &print_def_file(*STDOUT,"SSLEAY",*ssl_list,@ssl_func) | 262 | &print_def_file(*STDOUT,"SSLEAY",*ssl_list,@ssl_symbols) |
| 168 | if $do_ssl == 1; | 263 | if $do_ssl == 1; |
| 169 | 264 | ||
| 170 | &print_def_file(*STDOUT,"LIBEAY",*crypto_list,@crypto_func) | 265 | &print_def_file(*STDOUT,"LIBEAY",*crypto_list,@crypto_symbols) |
| 171 | if $do_crypto == 1; | 266 | if $do_crypto == 1; |
| 172 | 267 | ||
| 173 | } | 268 | } |
| @@ -175,42 +270,30 @@ EOF | |||
| 175 | 270 | ||
| 176 | sub do_defs | 271 | sub do_defs |
| 177 | { | 272 | { |
| 178 | my($name,$files)=@_; | 273 | my($name,$files,$symhacksfile)=@_; |
| 179 | my $file; | 274 | my $file; |
| 180 | my @ret; | 275 | my @ret; |
| 181 | my %funcs; | 276 | my %syms; |
| 277 | my %platform; # For anything undefined, we assume "" | ||
| 278 | my %kind; # For anything undefined, we assume "FUNCTION" | ||
| 279 | my %algorithm; # For anything undefined, we assume "" | ||
| 280 | my %rename; | ||
| 182 | my $cpp; | 281 | my $cpp; |
| 183 | 282 | ||
| 184 | foreach $file (split(/\s+/,$files)) | 283 | foreach $file (split(/\s+/,$symhacksfile." ".$files)) |
| 185 | { | 284 | { |
| 186 | open(IN,"<$file") || die "unable to open $file:$!\n"; | 285 | open(IN,"<$file") || die "unable to open $file:$!\n"; |
| 187 | my $line = "", my $def= ""; | 286 | my $line = "", my $def= ""; |
| 188 | my %tag = ( | 287 | my %tag = ( |
| 189 | FreeBSD => 0, | 288 | (map { $_ => 0 } @known_platforms), |
| 289 | (map { "NO_".$_ => 0 } @known_algorithms), | ||
| 190 | NOPROTO => 0, | 290 | NOPROTO => 0, |
| 191 | WIN16 => 0, | ||
| 192 | PERL5 => 0, | 291 | PERL5 => 0, |
| 193 | _WINDLL => 0, | 292 | _WINDLL => 0, |
| 194 | NO_FP_API => 0, | ||
| 195 | CONST_STRICT => 0, | 293 | CONST_STRICT => 0, |
| 196 | TRUE => 1, | 294 | TRUE => 1, |
| 197 | NO_RC2 => 0, | ||
| 198 | NO_RC4 => 0, | ||
| 199 | NO_RC5 => 0, | ||
| 200 | NO_IDEA => 0, | ||
| 201 | NO_DES => 0, | ||
| 202 | NO_BF => 0, | ||
| 203 | NO_CAST => 0, | ||
| 204 | NO_MD2 => 0, | ||
| 205 | NO_MD5 => 0, | ||
| 206 | NO_SHA => 0, | ||
| 207 | NO_RIPEMD => 0, | ||
| 208 | NO_MDC2 => 0, | ||
| 209 | NO_RSA => 0, | ||
| 210 | NO_DSA => 0, | ||
| 211 | NO_DH => 0, | ||
| 212 | NO_HMAC => 0, | ||
| 213 | ); | 295 | ); |
| 296 | my $symhacking = $file eq $symhacksfile; | ||
| 214 | while(<IN>) { | 297 | while(<IN>) { |
| 215 | last if (/BEGIN ERROR CODES/); | 298 | last if (/BEGIN ERROR CODES/); |
| 216 | if ($line ne '') { | 299 | if ($line ne '') { |
| @@ -223,9 +306,9 @@ sub do_defs | |||
| 223 | next; | 306 | next; |
| 224 | } | 307 | } |
| 225 | 308 | ||
| 226 | $cpp = 1 if /^#.*ifdef.*cplusplus/; | 309 | $cpp = 1 if /^\#.*ifdef.*cplusplus/; |
| 227 | if ($cpp) { | 310 | if ($cpp) { |
| 228 | $cpp = 0 if /^#.*endif/; | 311 | $cpp = 0 if /^\#.*endif/; |
| 229 | next; | 312 | next; |
| 230 | } | 313 | } |
| 231 | 314 | ||
| @@ -234,115 +317,132 @@ sub do_defs | |||
| 234 | if (/^\#\s*ifndef (.*)/) { | 317 | if (/^\#\s*ifndef (.*)/) { |
| 235 | push(@tag,$1); | 318 | push(@tag,$1); |
| 236 | $tag{$1}=-1; | 319 | $tag{$1}=-1; |
| 237 | next; | ||
| 238 | } elsif (/^\#\s*if !defined\(([^\)]+)\)/) { | 320 | } elsif (/^\#\s*if !defined\(([^\)]+)\)/) { |
| 239 | push(@tag,$1); | 321 | push(@tag,$1); |
| 240 | $tag{$1}=-1; | 322 | $tag{$1}=-1; |
| 241 | next; | ||
| 242 | } elsif (/^\#\s*ifdef (.*)/) { | 323 | } elsif (/^\#\s*ifdef (.*)/) { |
| 243 | push(@tag,$1); | 324 | push(@tag,$1); |
| 244 | $tag{$1}=1; | 325 | $tag{$1}=1; |
| 245 | next; | 326 | } elsif (/^\#\s*if defined\(([^\)]+)\)/) { |
| 246 | } elsif (/^\#\s*if defined(.*)/) { | ||
| 247 | push(@tag,$1); | 327 | push(@tag,$1); |
| 248 | $tag{$1}=1; | 328 | $tag{$1}=1; |
| 249 | next; | 329 | } elsif (/^\#\s*error\s+(\w+) is disabled\./) { |
| 330 | if ($tag[$#tag] eq "NO_".$1) { | ||
| 331 | $tag{$tag[$#tag]}=2; | ||
| 332 | } | ||
| 250 | } elsif (/^\#\s*endif/) { | 333 | } elsif (/^\#\s*endif/) { |
| 251 | $tag{$tag[$#tag]}=0; | 334 | if ($tag{$tag[$#tag]}==2) { |
| 335 | $tag{$tag[$#tag]}=-1; | ||
| 336 | } else { | ||
| 337 | $tag{$tag[$#tag]}=0; | ||
| 338 | } | ||
| 252 | pop(@tag); | 339 | pop(@tag); |
| 253 | next; | ||
| 254 | } elsif (/^\#\s*else/) { | 340 | } elsif (/^\#\s*else/) { |
| 255 | my $t=$tag[$#tag]; | 341 | my $t=$tag[$#tag]; |
| 256 | $tag{$t}= -$tag{$t}; | 342 | $tag{$t}= -$tag{$t}; |
| 257 | next; | ||
| 258 | } elsif (/^\#\s*if\s+1/) { | 343 | } elsif (/^\#\s*if\s+1/) { |
| 259 | # Dummy tag | 344 | # Dummy tag |
| 260 | push(@tag,"TRUE"); | 345 | push(@tag,"TRUE"); |
| 261 | $tag{"TRUE"}=1; | 346 | $tag{"TRUE"}=1; |
| 262 | next; | ||
| 263 | } elsif (/^\#\s*if\s+0/) { | 347 | } elsif (/^\#\s*if\s+0/) { |
| 264 | # Dummy tag | 348 | # Dummy tag |
| 265 | push(@tag,"TRUE"); | 349 | push(@tag,"TRUE"); |
| 266 | $tag{"TRUE"}=-1; | 350 | $tag{"TRUE"}=-1; |
| 267 | next; | 351 | } elsif (/^\#\s*define\s+(\w+)\s+(\w+)/ |
| 268 | } elsif (/^\#/) { | 352 | && $symhacking) { |
| 353 | my $s = $1; | ||
| 354 | my $a = | ||
| 355 | $2.":".join(",", grep(!/^$/, | ||
| 356 | map { $tag{$_} == 1 ? | ||
| 357 | $_ : "" } | ||
| 358 | @known_platforms)); | ||
| 359 | $rename{$s} = $a; | ||
| 360 | } | ||
| 361 | if (/^\#/) { | ||
| 362 | my @p = grep(!/^$/, | ||
| 363 | map { $tag{$_} == 1 ? $_ : | ||
| 364 | $tag{$_} == -1 ? "!".$_ : "" } | ||
| 365 | @known_platforms); | ||
| 366 | my @a = grep(!/^$/, | ||
| 367 | map { $tag{"NO_".$_} == -1 ? $_ : "" } | ||
| 368 | @known_algorithms); | ||
| 369 | $def .= "#INFO:".join(',',@p).":".join(',',@a).";"; | ||
| 269 | next; | 370 | next; |
| 270 | } | 371 | } |
| 271 | if ($safe_stack_def && | 372 | if (/^\s*DECLARE_STACK_OF\s*\(\s*(\w*)\s*\)/) { |
| 272 | /^\s*DECLARE_STACK_OF\s*\(\s*(\w*)\s*\)/) { | 373 | next; |
| 273 | $funcs{"sk_${1}_new"} = 1; | 374 | } elsif (/^\s*DECLARE_PKCS12_STACK_OF\s*\(\s*(\w*)\s*\)/) { |
| 274 | $funcs{"sk_${1}_new_null"} = 1; | 375 | next; |
| 275 | $funcs{"sk_${1}_free"} = 1; | 376 | } elsif (/^\s*DECLARE_ASN1_SET_OF\s*\(\s*(\w*)\s*\)/) { |
| 276 | $funcs{"sk_${1}_num"} = 1; | 377 | next; |
| 277 | $funcs{"sk_${1}_value"} = 1; | ||
| 278 | $funcs{"sk_${1}_set"} = 1; | ||
| 279 | $funcs{"sk_${1}_zero"} = 1; | ||
| 280 | $funcs{"sk_${1}_push"} = 1; | ||
| 281 | $funcs{"sk_${1}_unshift"} = 1; | ||
| 282 | $funcs{"sk_${1}_find"} = 1; | ||
| 283 | $funcs{"sk_${1}_delete"} = 1; | ||
| 284 | $funcs{"sk_${1}_delete_ptr"} = 1; | ||
| 285 | $funcs{"sk_${1}_insert"} = 1; | ||
| 286 | $funcs{"sk_${1}_set_cmp_func"} = 1; | ||
| 287 | $funcs{"sk_${1}_dup"} = 1; | ||
| 288 | $funcs{"sk_${1}_pop_free"} = 1; | ||
| 289 | $funcs{"sk_${1}_shift"} = 1; | ||
| 290 | $funcs{"sk_${1}_pop"} = 1; | ||
| 291 | $funcs{"sk_${1}_sort"} = 1; | ||
| 292 | } elsif ($safe_stack_def && | ||
| 293 | /^\s*DECLARE_ASN1_SET_OF\s*\(\s*(\w*)\s*\)/) { | ||
| 294 | $funcs{"d2i_ASN1_SET_OF_${1}"} = 1; | ||
| 295 | $funcs{"i2d_ASN1_SET_OF_${1}"} = 1; | ||
| 296 | } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ || | 378 | } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ || |
| 297 | /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ ) { | 379 | /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ ) { |
| 298 | if($W32) { | 380 | # Things not in Win16 |
| 299 | $funcs{"PEM_read_${1}"} = 1; | 381 | $syms{"PEM_read_${1}"} = 1; |
| 300 | $funcs{"PEM_write_${1}"} = 1; | 382 | $platform{"PEM_read_${1}"} = "!WIN16"; |
| 383 | $syms{"PEM_write_${1}"} = 1; | ||
| 384 | $platform{"PEM_write_${1}"} = "!WIN16"; | ||
| 385 | # Things that are everywhere | ||
| 386 | $syms{"PEM_read_bio_${1}"} = 1; | ||
| 387 | $syms{"PEM_write_bio_${1}"} = 1; | ||
| 388 | if ($1 eq "RSAPrivateKey" || | ||
| 389 | $1 eq "RSAPublicKey" || | ||
| 390 | $1 eq "RSA_PUBKEY") { | ||
| 391 | $algorithm{"PEM_read_${1}"} = "RSA"; | ||
| 392 | $algorithm{"PEM_write_${1}"} = "RSA"; | ||
| 393 | $algorithm{"PEM_read_bio_${1}"} = "RSA"; | ||
| 394 | $algorithm{"PEM_write_bio_${1}"} = "RSA"; | ||
| 395 | } | ||
| 396 | elsif ($1 eq "DSAPrivateKey" || | ||
| 397 | $1 eq "DSAparams" || | ||
| 398 | $1 eq "RSA_PUBKEY") { | ||
| 399 | $algorithm{"PEM_read_${1}"} = "DSA"; | ||
| 400 | $algorithm{"PEM_write_${1}"} = "DSA"; | ||
| 401 | $algorithm{"PEM_read_bio_${1}"} = "DSA"; | ||
| 402 | $algorithm{"PEM_write_bio_${1}"} = "DSA"; | ||
| 403 | } | ||
| 404 | elsif ($1 eq "DHparams") { | ||
| 405 | $algorithm{"PEM_read_${1}"} = "DH"; | ||
| 406 | $algorithm{"PEM_write_${1}"} = "DH"; | ||
| 407 | $algorithm{"PEM_read_bio_${1}"} = "DH"; | ||
| 408 | $algorithm{"PEM_write_bio_${1}"} = "DH"; | ||
| 301 | } | 409 | } |
| 302 | $funcs{"PEM_read_bio_${1}"} = 1; | ||
| 303 | $funcs{"PEM_write_bio_${1}"} = 1; | ||
| 304 | } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ || | 410 | } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ || |
| 305 | /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) { | 411 | /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) { |
| 306 | if($W32) { | 412 | # Things not in Win16 |
| 307 | $funcs{"PEM_write_${1}"} = 1; | 413 | $syms{"PEM_write_${1}"} = 1; |
| 414 | $platform{"PEM_write_${1}"} .= ",!WIN16"; | ||
| 415 | # Things that are everywhere | ||
| 416 | $syms{"PEM_write_bio_${1}"} = 1; | ||
| 417 | if ($1 eq "RSAPrivateKey" || | ||
| 418 | $1 eq "RSAPublicKey" || | ||
| 419 | $1 eq "RSA_PUBKEY") { | ||
| 420 | $algorithm{"PEM_write_${1}"} = "RSA"; | ||
| 421 | $algorithm{"PEM_write_bio_${1}"} = "RSA"; | ||
| 422 | } | ||
| 423 | elsif ($1 eq "DSAPrivateKey" || | ||
| 424 | $1 eq "DSAparams" || | ||
| 425 | $1 eq "RSA_PUBKEY") { | ||
| 426 | $algorithm{"PEM_write_${1}"} = "DSA"; | ||
| 427 | $algorithm{"PEM_write_bio_${1}"} = "DSA"; | ||
| 428 | } | ||
| 429 | elsif ($1 eq "DHparams") { | ||
| 430 | $algorithm{"PEM_write_${1}"} = "DH"; | ||
| 431 | $algorithm{"PEM_write_bio_${1}"} = "DH"; | ||
| 308 | } | 432 | } |
| 309 | $funcs{"PEM_write_bio_${1}"} = 1; | ||
| 310 | } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ || | 433 | } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ || |
| 311 | /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) { | 434 | /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) { |
| 312 | if($W32) { | 435 | # Things not in Win16 |
| 313 | $funcs{"PEM_read_${1}"} = 1; | 436 | $syms{"PEM_read_${1}"} = 1; |
| 314 | } | 437 | $platform{"PEM_read_${1}"} .= ",!WIN16"; |
| 315 | $funcs{"PEM_read_bio_${1}"} = 1; | 438 | # Things that are everywhere |
| 439 | $syms{"PEM_read_bio_${1}"} = 1; | ||
| 316 | } elsif ( | 440 | } elsif ( |
| 317 | ($tag{'TRUE'} != -1) && | 441 | ($tag{'TRUE'} != -1) |
| 318 | ($tag{'FreeBSD'} != 1) && | 442 | && ($tag{'CONST_STRICT'} != 1) |
| 319 | ($tag{'CONST_STRICT'} != 1) && | 443 | ) |
| 320 | (($W32 && ($tag{'WIN16'} != 1)) || | ||
| 321 | (!$W32 && ($tag{'WIN16'} != -1))) && | ||
| 322 | ($tag{'PERL5'} != 1) && | ||
| 323 | # ($tag{'_WINDLL'} != -1) && | ||
| 324 | ((!$W32 && $tag{'_WINDLL'} != -1) || | ||
| 325 | ($W32 && $tag{'_WINDLL'} != 1)) && | ||
| 326 | ((($tag{'NO_FP_API'} != 1) && $W32) || | ||
| 327 | (($tag{'NO_FP_API'} != -1) && !$W32)) && | ||
| 328 | ($tag{'NO_RC2'} == 0 || !$no_rc2) && | ||
| 329 | ($tag{'NO_RC4'} == 0 || !$no_rc4) && | ||
| 330 | ($tag{'NO_RC5'} == 0 || !$no_rc5) && | ||
| 331 | ($tag{'NO_IDEA'} == 0 || !$no_idea) && | ||
| 332 | ($tag{'NO_DES'} == 0 || !$no_des) && | ||
| 333 | ($tag{'NO_BF'} == 0 || !$no_bf) && | ||
| 334 | ($tag{'NO_CAST'} == 0 || !$no_cast) && | ||
| 335 | ($tag{'NO_MD2'} == 0 || !$no_md2) && | ||
| 336 | ($tag{'NO_MD5'} == 0 || !$no_md5) && | ||
| 337 | ($tag{'NO_SHA'} == 0 || !$no_sha) && | ||
| 338 | ($tag{'NO_RIPEMD'} == 0 || !$no_ripemd) && | ||
| 339 | ($tag{'NO_MDC2'} == 0 || !$no_mdc2) && | ||
| 340 | ($tag{'NO_RSA'} == 0 || !$no_rsa) && | ||
| 341 | ($tag{'NO_DSA'} == 0 || !$no_dsa) && | ||
| 342 | ($tag{'NO_DH'} == 0 || !$no_dh) && | ||
| 343 | ($tag{'NO_HMAC'} == 0 || !$no_hmac)) | ||
| 344 | { | 444 | { |
| 345 | if (/{|\/\*/) { # } | 445 | if (/\{|\/\*|\([^\)]*$/) { |
| 346 | $line = $_; | 446 | $line = $_; |
| 347 | } else { | 447 | } else { |
| 348 | $def .= $_; | 448 | $def .= $_; |
| @@ -351,24 +451,26 @@ sub do_defs | |||
| 351 | } | 451 | } |
| 352 | close(IN); | 452 | close(IN); |
| 353 | 453 | ||
| 454 | my $algs; | ||
| 455 | my $plays; | ||
| 456 | |||
| 354 | foreach (split /;/, $def) { | 457 | foreach (split /;/, $def) { |
| 458 | my $s; my $k = "FUNCTION"; my $p; my $a; | ||
| 355 | s/^[\n\s]*//g; | 459 | s/^[\n\s]*//g; |
| 356 | s/[\n\s]*$//g; | 460 | s/[\n\s]*$//g; |
| 461 | next if(/\#undef/); | ||
| 357 | next if(/typedef\W/); | 462 | next if(/typedef\W/); |
| 358 | next if(/EVP_bf/ and $no_bf); | 463 | next if(/\#define/); |
| 359 | next if(/EVP_cast/ and $no_cast); | 464 | |
| 360 | next if(/EVP_des/ and $no_des); | 465 | if (/^\#INFO:([^:]*):(.*)$/) { |
| 361 | next if(/EVP_dss/ and $no_dsa); | 466 | $plats = $1; |
| 362 | next if(/EVP_idea/ and $no_idea); | 467 | $algs = $2; |
| 363 | next if(/EVP_md2/ and $no_md2); | 468 | next; |
| 364 | next if(/EVP_md5/ and $no_md5); | 469 | } elsif (/^\s*OPENSSL_EXTERN\s.*?(\w+)(\[[0-9]*\])*\s*$/) { |
| 365 | next if(/EVP_rc2/ and $no_rc2); | 470 | $s = $1; |
| 366 | next if(/EVP_rc4/ and $no_rc4); | 471 | $k = "VARIABLE"; |
| 367 | next if(/EVP_rc5/ and $no_rc5); | 472 | } elsif (/\(\*(\w*)\([^\)]+/) { |
| 368 | next if(/EVP_ripemd/ and $no_ripemd); | 473 | $s = $1; |
| 369 | next if(/EVP_sha/ and $no_sha); | ||
| 370 | if (/\(\*(\w*)\([^\)]+/) { | ||
| 371 | $funcs{$1} = 1; | ||
| 372 | } elsif (/\w+\W+(\w+)\W*\(\s*\)$/s) { | 474 | } elsif (/\w+\W+(\w+)\W*\(\s*\)$/s) { |
| 373 | # K&R C | 475 | # K&R C |
| 374 | next; | 476 | next; |
| @@ -379,65 +481,184 @@ sub do_defs | |||
| 379 | } | 481 | } |
| 380 | s/\(void\)//; | 482 | s/\(void\)//; |
| 381 | /(\w+)\W*\(\)/s; | 483 | /(\w+)\W*\(\)/s; |
| 382 | $funcs{$1} = 1; | 484 | $s = $1; |
| 383 | } elsif (/\(/ and not (/=/)) { | 485 | } elsif (/\(/ and not (/=/)) { |
| 384 | print STDERR "File $file: cannot parse: $_;\n"; | 486 | print STDERR "File $file: cannot parse: $_;\n"; |
| 487 | next; | ||
| 488 | } else { | ||
| 489 | next; | ||
| 490 | } | ||
| 491 | |||
| 492 | $syms{$s} = 1; | ||
| 493 | $kind{$s} = $k; | ||
| 494 | |||
| 495 | $p = $plats; | ||
| 496 | $a = $algs; | ||
| 497 | $a .= ",BF" if($s =~ /EVP_bf/); | ||
| 498 | $a .= ",CAST" if($s =~ /EVP_cast/); | ||
| 499 | $a .= ",DES" if($s =~ /EVP_des/); | ||
| 500 | $a .= ",DSA" if($s =~ /EVP_dss/); | ||
| 501 | $a .= ",IDEA" if($s =~ /EVP_idea/); | ||
| 502 | $a .= ",MD2" if($s =~ /EVP_md2/); | ||
| 503 | $a .= ",MD4" if($s =~ /EVP_md4/); | ||
| 504 | $a .= ",MD5" if($s =~ /EVP_md5/); | ||
| 505 | $a .= ",RC2" if($s =~ /EVP_rc2/); | ||
| 506 | $a .= ",RC4" if($s =~ /EVP_rc4/); | ||
| 507 | $a .= ",RC5" if($s =~ /EVP_rc5/); | ||
| 508 | $a .= ",RIPEMD" if($s =~ /EVP_ripemd/); | ||
| 509 | $a .= ",SHA" if($s =~ /EVP_sha/); | ||
| 510 | $a .= ",RSA" if($s =~ /EVP_(Open|Seal)(Final|Init)/); | ||
| 511 | $a .= ",RSA" if($s =~ /PEM_Seal(Final|Init|Update)/); | ||
| 512 | $a .= ",RSA" if($s =~ /RSAPrivateKey/); | ||
| 513 | $a .= ",RSA" if($s =~ /SSLv23?_((client|server)_)?method/); | ||
| 514 | |||
| 515 | $platform{$s} .= ','.$p; | ||
| 516 | $algorithm{$s} .= ','.$a; | ||
| 517 | |||
| 518 | if (defined($rename{$s})) { | ||
| 519 | (my $r, my $p) = split(/:/,$rename{$s}); | ||
| 520 | my @ip = map { /^!(.*)$/ ? $1 : "!".$_ } split /,/, $p; | ||
| 521 | $syms{$r} = 1; | ||
| 522 | $kind{$r} = $kind{$s}."(".$s.")"; | ||
| 523 | $algorithm{$r} = $algorithm{$s}; | ||
| 524 | $platform{$r} = $platform{$s}.",".$p; | ||
| 525 | $platform{$s} .= ','.join(',', @ip).','.join(',', @ip); | ||
| 385 | } | 526 | } |
| 386 | } | 527 | } |
| 387 | } | 528 | } |
| 388 | 529 | ||
| 389 | # Prune the returned functions | 530 | # Prune the returned symbols |
| 390 | 531 | ||
| 391 | delete $funcs{"SSL_add_dir_cert_subjects_to_stack"}; | 532 | $platform{"crypt"} .= ",!PERL5,!__FreeBSD__,!NeXT"; |
| 392 | delete $funcs{"RSA_PKCS1_RSAref"} unless $rsaref; | ||
| 393 | delete $funcs{"bn_dump1"}; | ||
| 394 | 533 | ||
| 395 | if($W32) { | 534 | delete $syms{"SSL_add_dir_cert_subjects_to_stack"}; |
| 396 | delete $funcs{"BIO_s_file_internal"}; | 535 | delete $syms{"bn_dump1"}; |
| 397 | delete $funcs{"BIO_new_file_internal"}; | 536 | |
| 398 | delete $funcs{"BIO_new_fp_internal"}; | 537 | $platform{"BIO_s_file_internal"} .= ",WIN16"; |
| 399 | } else { | 538 | $platform{"BIO_new_file_internal"} .= ",WIN16"; |
| 400 | if(exists $funcs{"ERR_load_CRYPTO_strings"}) { | 539 | $platform{"BIO_new_fp_internal"} .= ",WIN16"; |
| 401 | delete $funcs{"ERR_load_CRYPTO_strings"}; | 540 | |
| 402 | $funcs{"ERR_load_CRYPTOlib_strings"} = 1; | 541 | $platform{"BIO_s_file"} .= ",!WIN16"; |
| 542 | $platform{"BIO_new_file"} .= ",!WIN16"; | ||
| 543 | $platform{"BIO_new_fp"} .= ",!WIN16"; | ||
| 544 | |||
| 545 | $platform{"BIO_s_log"} .= ",!WIN32,!WIN16,!macintosh"; | ||
| 546 | |||
| 547 | if(exists $syms{"ERR_load_CRYPTO_strings"}) { | ||
| 548 | $platform{"ERR_load_CRYPTO_strings"} .= ",!VMS,!WIN16"; | ||
| 549 | $syms{"ERR_load_CRYPTOlib_strings"} = 1; | ||
| 550 | $platform{"ERR_load_CRYPTOlib_strings"} .= ",VMS,WIN16"; | ||
| 551 | } | ||
| 552 | |||
| 553 | # Info we know about | ||
| 554 | |||
| 555 | $platform{"RSA_PKCS1_RSAref"} = "RSAREF"; | ||
| 556 | $algorithm{"RSA_PKCS1_RSAref"} = "RSA"; | ||
| 557 | |||
| 558 | push @ret, map { $_."\\".&info_string($_,"EXIST", | ||
| 559 | $platform{$_}, | ||
| 560 | $kind{$_}, | ||
| 561 | $algorithm{$_}) } keys %syms; | ||
| 562 | |||
| 563 | return(@ret); | ||
| 564 | } | ||
| 565 | |||
| 566 | sub info_string { | ||
| 567 | (my $symbol, my $exist, my $platforms, my $kind, my $algorithms) = @_; | ||
| 568 | |||
| 569 | my %a = defined($algorithms) ? | ||
| 570 | map { $_ => 1 } split /,/, $algorithms : (); | ||
| 571 | my $pl = defined($platforms) ? $platforms : ""; | ||
| 572 | my %p = map { $_ => 0 } split /,/, $pl; | ||
| 573 | my $k = defined($kind) ? $kind : "FUNCTION"; | ||
| 574 | my $ret; | ||
| 575 | |||
| 576 | # We do this, because if there's code like the following, it really | ||
| 577 | # means the function exists in all cases and should therefore be | ||
| 578 | # everywhere. By increasing and decreasing, we may attain 0: | ||
| 579 | # | ||
| 580 | # ifndef WIN16 | ||
| 581 | # int foo(); | ||
| 582 | # else | ||
| 583 | # int _fat foo(); | ||
| 584 | # endif | ||
| 585 | foreach $platform (split /,/, $pl) { | ||
| 586 | if ($platform =~ /^!(.*)$/) { | ||
| 587 | $p{$1}--; | ||
| 588 | } else { | ||
| 589 | $p{$platform}++; | ||
| 403 | } | 590 | } |
| 404 | delete $funcs{"BIO_s_file"}; | ||
| 405 | delete $funcs{"BIO_new_file"}; | ||
| 406 | delete $funcs{"BIO_new_fp"}; | ||
| 407 | } | 591 | } |
| 408 | if (!$NT) { | 592 | foreach $platform (keys %p) { |
| 409 | delete $funcs{"BIO_s_log"}; | 593 | if ($p{$platform} == 0) { delete $p{$platform}; } |
| 410 | } | 594 | } |
| 411 | 595 | ||
| 412 | push @ret, keys %funcs; | 596 | delete $p{""}; |
| 597 | delete $a{""}; | ||
| 413 | 598 | ||
| 414 | return(@ret); | 599 | $ret = $exist; |
| 600 | $ret .= ":".join(',',map { $p{$_} < 0 ? "!".$_ : $_ } keys %p); | ||
| 601 | $ret .= ":".$k; | ||
| 602 | $ret .= ":".join(',',keys %a); | ||
| 603 | return $ret; | ||
| 604 | } | ||
| 605 | |||
| 606 | sub maybe_add_info { | ||
| 607 | (my $name, *nums, my @symbols) = @_; | ||
| 608 | my $sym; | ||
| 609 | my $new_info = 0; | ||
| 610 | |||
| 611 | print STDERR "Updating $name info\n"; | ||
| 612 | foreach $sym (@symbols) { | ||
| 613 | (my $s, my $i) = split /\\/, $sym; | ||
| 614 | $i =~ s/^(.*?:.*?:\w+)(\(\w+\))?/$1/; | ||
| 615 | if (defined($nums{$s})) { | ||
| 616 | (my $n, my $dummy) = split /\\/, $nums{$s}; | ||
| 617 | if (!defined($dummy) || $i ne $dummy) { | ||
| 618 | $nums{$s} = $n."\\".$i; | ||
| 619 | $new_info++; | ||
| 620 | #print STDERR "DEBUG: maybe_add_info for $s: \"$dummy\" => \"$i\"\n"; | ||
| 621 | } | ||
| 622 | } | ||
| 623 | } | ||
| 624 | if ($new_info) { | ||
| 625 | print STDERR "$new_info old symbols got an info update\n"; | ||
| 626 | if (!$do_rewrite) { | ||
| 627 | print STDERR "You should do a rewrite to fix this.\n"; | ||
| 628 | } | ||
| 629 | } else { | ||
| 630 | print STDERR "No old symbols needed info update\n"; | ||
| 631 | } | ||
| 415 | } | 632 | } |
| 416 | 633 | ||
| 417 | sub print_test_file | 634 | sub print_test_file |
| 418 | { | 635 | { |
| 419 | (*OUT,my $name,*nums,my @functions)=@_; | 636 | (*OUT,my $name,*nums,my @symbols)=@_; |
| 420 | my $n = 1; my @e; my @r; | 637 | my $n = 1; my @e; my @r; |
| 421 | my $func; | 638 | my $sym; my $prev = ""; my $prefSSLeay; |
| 422 | 639 | ||
| 423 | (@e)=grep(/^SSLeay/,@functions); | 640 | (@e)=grep(/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); |
| 424 | (@r)=grep(!/^SSLeay/,@functions); | 641 | (@r)=grep(/^\w+\\.*?:.*?:FUNCTION/ && !/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); |
| 425 | @functions=((sort @e),(sort @r)); | 642 | @symbols=((sort @e),(sort @r)); |
| 426 | 643 | ||
| 427 | foreach $func (@functions) { | 644 | foreach $sym (@symbols) { |
| 428 | if (!defined($nums{$func})) { | 645 | (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; |
| 429 | printf STDERR "$func does not have a number assigned\n" | 646 | if ($s ne $prev) { |
| 430 | if(!$do_update); | 647 | if (!defined($nums{$sym})) { |
| 431 | } else { | 648 | printf STDERR "Warning: $sym does not have a number assigned\n" |
| 432 | $n=$nums{$func}; | 649 | if(!$do_update); |
| 433 | print OUT "\t$func();\n"; | 650 | } else { |
| 651 | $n=$nums{$s}; | ||
| 652 | print OUT "\t$s();\n"; | ||
| 653 | } | ||
| 434 | } | 654 | } |
| 655 | $prev = $s; # To avoid duplicates... | ||
| 435 | } | 656 | } |
| 436 | } | 657 | } |
| 437 | 658 | ||
| 438 | sub print_def_file | 659 | sub print_def_file |
| 439 | { | 660 | { |
| 440 | (*OUT,my $name,*nums,my @functions)=@_; | 661 | (*OUT,my $name,*nums,my @symbols)=@_; |
| 441 | my $n = 1; my @e; my @r; | 662 | my $n = 1; my @e; my @r; |
| 442 | 663 | ||
| 443 | if ($W32) | 664 | if ($W32) |
| @@ -471,18 +692,61 @@ EOF | |||
| 471 | 692 | ||
| 472 | print "EXPORTS\n"; | 693 | print "EXPORTS\n"; |
| 473 | 694 | ||
| 695 | (@e)=grep(/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); | ||
| 696 | (@r)=grep(/^\w+\\.*?:.*?:FUNCTION/ && !/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); | ||
| 697 | @symbols=((sort @e),(sort @r)); | ||
| 474 | 698 | ||
| 475 | (@e)=grep(/^SSLeay/,@functions); | ||
| 476 | (@r)=grep(!/^SSLeay/,@functions); | ||
| 477 | @functions=((sort @e),(sort @r)); | ||
| 478 | 699 | ||
| 479 | foreach $func (@functions) { | 700 | foreach $sym (@symbols) { |
| 480 | if (!defined($nums{$func})) { | 701 | (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; |
| 481 | printf STDERR "$func does not have a number assigned\n" | 702 | if (!defined($nums{$s})) { |
| 703 | printf STDERR "Warning: $s does not have a number assigned\n" | ||
| 482 | if(!$do_update); | 704 | if(!$do_update); |
| 483 | } else { | 705 | } else { |
| 484 | $n=$nums{$func}; | 706 | (my $n, my $i) = split /\\/, $nums{$s}; |
| 485 | printf OUT " %s%-40s@%d\n",($W32)?"":"_",$func,$n; | 707 | my %pf = (); |
| 708 | my @p = 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 | printf OUT " %s%-40s@%d\n",($W32)?"":"_",$s,$n; | ||
| 732 | # } else { | ||
| 733 | # print STDERR "DEBUG: \"$sym\" (@p):", | ||
| 734 | # " rsaref:", !!(!@p | ||
| 735 | # || (!$negatives | ||
| 736 | # && ($rsaref || !grep(/^RSAREF$/,@p))) | ||
| 737 | # || ($negatives | ||
| 738 | # && (!$rsaref || !grep(/^!RSAREF$/,@p))))?1:0, | ||
| 739 | # " 16:", !!($W16 && (!@p_purged | ||
| 740 | # || (!$negatives && grep(/^WIN16$/,@p)) | ||
| 741 | # || ($negatives && !grep(/^!WIN16$/,@p)))), | ||
| 742 | # " 32:", !!($W32 && (!@p_purged | ||
| 743 | # || (!$negatives && grep(/^WIN32$/,@p)) | ||
| 744 | # || ($negatives && !grep(/^!WIN32$/,@p)))), | ||
| 745 | # " NT:", !!($NT && (!@p_purged | ||
| 746 | # || (!$negatives && grep(/^WINNT$/,@p)) | ||
| 747 | # || ($negatives && !grep(/^!WINNT$/,@p)))), | ||
| 748 | # "\n"; | ||
| 749 | } | ||
| 486 | } | 750 | } |
| 487 | } | 751 | } |
| 488 | printf OUT "\n"; | 752 | printf OUT "\n"; |
| @@ -494,6 +758,8 @@ sub load_numbers | |||
| 494 | my(@a,%ret); | 758 | my(@a,%ret); |
| 495 | 759 | ||
| 496 | $max_num = 0; | 760 | $max_num = 0; |
| 761 | $num_noinfo = 0; | ||
| 762 | $prev = ""; | ||
| 497 | 763 | ||
| 498 | open(IN,"<$name") || die "unable to open $name:$!\n"; | 764 | open(IN,"<$name") || die "unable to open $name:$!\n"; |
| 499 | while (<IN>) { | 765 | while (<IN>) { |
| @@ -501,27 +767,138 @@ sub load_numbers | |||
| 501 | s/#.*$//; | 767 | s/#.*$//; |
| 502 | next if /^\s*$/; | 768 | next if /^\s*$/; |
| 503 | @a=split; | 769 | @a=split; |
| 504 | $ret{$a[0]}=$a[1]; | 770 | if (defined $ret{$a[0]}) { |
| 771 | print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n"; | ||
| 772 | } | ||
| 773 | if ($max_num > $a[1]) { | ||
| 774 | print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n"; | ||
| 775 | } | ||
| 776 | if ($max_num == $a[1]) { | ||
| 777 | # This is actually perfectly OK | ||
| 778 | #print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n"; | ||
| 779 | } | ||
| 780 | if ($#a < 2) { | ||
| 781 | # Existence will be proven later, in do_defs | ||
| 782 | $ret{$a[0]}=$a[1]; | ||
| 783 | $num_noinfo++; | ||
| 784 | } else { | ||
| 785 | $ret{$a[0]}=$a[1]."\\".$a[2]; # \\ is a special marker | ||
| 786 | } | ||
| 505 | $max_num = $a[1] if $a[1] > $max_num; | 787 | $max_num = $a[1] if $a[1] > $max_num; |
| 788 | $prev=$a[0]; | ||
| 789 | } | ||
| 790 | if ($num_noinfo) { | ||
| 791 | print STDERR "Warning: $num_noinfo symbols were without info."; | ||
| 792 | if ($do_rewrite) { | ||
| 793 | printf STDERR " The rewrite will fix this.\n"; | ||
| 794 | } else { | ||
| 795 | printf STDERR " You should do a rewrite to fix this.\n"; | ||
| 796 | } | ||
| 506 | } | 797 | } |
| 507 | close(IN); | 798 | close(IN); |
| 508 | return(%ret); | 799 | return(%ret); |
| 509 | } | 800 | } |
| 510 | 801 | ||
| 802 | sub parse_number | ||
| 803 | { | ||
| 804 | (my $str, my $what) = @_; | ||
| 805 | (my $n, my $i) = split(/\\/,$str); | ||
| 806 | if ($what eq "n") { | ||
| 807 | return $n; | ||
| 808 | } else { | ||
| 809 | return $i; | ||
| 810 | } | ||
| 811 | } | ||
| 812 | |||
| 813 | sub rewrite_numbers | ||
| 814 | { | ||
| 815 | (*OUT,$name,*nums,@symbols)=@_; | ||
| 816 | my $thing; | ||
| 817 | |||
| 818 | print STDERR "Rewriting $name\n"; | ||
| 819 | |||
| 820 | my @r = grep(/^\w+\\.*?:.*?:\w+\(\w+\)/,@symbols); | ||
| 821 | my $r; my %r; my %rsyms; | ||
| 822 | foreach $r (@r) { | ||
| 823 | (my $s, my $i) = split /\\/, $r; | ||
| 824 | my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/; | ||
| 825 | $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/; | ||
| 826 | $r{$a} = $s."\\".$i; | ||
| 827 | $rsyms{$s} = 1; | ||
| 828 | } | ||
| 829 | |||
| 830 | my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums; | ||
| 831 | foreach $sym (@s) { | ||
| 832 | (my $n, my $i) = split /\\/, $nums{$sym}; | ||
| 833 | next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/; | ||
| 834 | next if defined($rsyms{$sym}); | ||
| 835 | $i="NOEXIST::FUNCTION:" if !defined($i) || $i eq ""; | ||
| 836 | printf OUT "%s%-40s%d\t%s\n","",$sym,$n,$i; | ||
| 837 | if (exists $r{$sym}) { | ||
| 838 | (my $s, $i) = split /\\/,$r{$sym}; | ||
| 839 | printf OUT "%s%-40s%d\t%s\n","",$s,$n,$i; | ||
| 840 | } | ||
| 841 | } | ||
| 842 | } | ||
| 843 | |||
| 511 | sub update_numbers | 844 | sub update_numbers |
| 512 | { | 845 | { |
| 513 | (*OUT,$name,*nums,my $start_num, my @functions)=@_; | 846 | (*OUT,$name,*nums,my $start_num, my @symbols)=@_; |
| 514 | my $new_funcs = 0; | 847 | my $new_syms = 0; |
| 515 | print STDERR "Updating $name\n"; | 848 | |
| 516 | foreach $func (@functions) { | 849 | print STDERR "Updating $name numbers\n"; |
| 517 | if (!exists $nums{$func}) { | 850 | |
| 518 | $new_funcs++; | 851 | my @r = grep(/^\w+\\.*?:.*?:\w+\(\w+\)/,@symbols); |
| 519 | printf OUT "%s%-40s%d\n","",$func, ++$start_num; | 852 | my $r; my %r; my %rsyms; |
| 853 | foreach $r (@r) { | ||
| 854 | (my $s, my $i) = split /\\/, $r; | ||
| 855 | my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/; | ||
| 856 | $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/; | ||
| 857 | $r{$a} = $s."\\".$i; | ||
| 858 | $rsyms{$s} = 1; | ||
| 859 | } | ||
| 860 | |||
| 861 | foreach $sym (@symbols) { | ||
| 862 | (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; | ||
| 863 | next if $i =~ /^.*?:.*?:\w+\(\w+\)/; | ||
| 864 | next if defined($rsyms{$sym}); | ||
| 865 | die "ERROR: Symbol $sym had no info attached to it." | ||
| 866 | if $i eq ""; | ||
| 867 | if (!exists $nums{$s}) { | ||
| 868 | $new_syms++; | ||
| 869 | printf OUT "%s%-40s%d\t%s\n","",$s, ++$start_num,$i; | ||
| 870 | if (exists $r{$s}) { | ||
| 871 | ($s, $i) = split /\\/,$r{$s}; | ||
| 872 | printf OUT "%s%-40s%d\t%s\n","",$s, $start_num,$i; | ||
| 873 | } | ||
| 520 | } | 874 | } |
| 521 | } | 875 | } |
| 522 | if($new_funcs) { | 876 | if($new_syms) { |
| 523 | print STDERR "$new_funcs New Functions added\n"; | 877 | print STDERR "$new_syms New symbols added\n"; |
| 524 | } else { | 878 | } else { |
| 525 | print STDERR "No New Functions Added\n"; | 879 | print STDERR "No New symbols Added\n"; |
| 526 | } | 880 | } |
| 527 | } | 881 | } |
| 882 | |||
| 883 | sub check_existing | ||
| 884 | { | ||
| 885 | (*nums, my @symbols)=@_; | ||
| 886 | my %existing; my @remaining; | ||
| 887 | @remaining=(); | ||
| 888 | foreach $sym (@symbols) { | ||
| 889 | (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; | ||
| 890 | $existing{$s}=1; | ||
| 891 | } | ||
| 892 | foreach $sym (keys %nums) { | ||
| 893 | if (!exists $existing{$sym}) { | ||
| 894 | push @remaining, $sym; | ||
| 895 | } | ||
| 896 | } | ||
| 897 | if(@remaining) { | ||
| 898 | print STDERR "The following symbols do not seem to exist:\n"; | ||
| 899 | foreach $sym (@remaining) { | ||
| 900 | print STDERR "\t",$sym,"\n"; | ||
| 901 | } | ||
| 902 | } | ||
| 903 | } | ||
| 904 | |||
