mkdef.pl (59191) | mkdef.pl (68651) |
---|---|
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# | 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# |
|
8 | 56 |
9my $crypto_num="util/libeay.num"; 10my $ssl_num= "util/ssleay.num"; | 57my $crypto_num= "util/libeay.num"; 58my $ssl_num= "util/ssleay.num"; |
11 12my $do_update = 0; | 59 60my $do_update = 0; |
61my $do_rewrite = 0; |
|
13my $do_crypto = 0; 14my $do_ssl = 0; 15my $do_ctest = 0; | 62my $do_crypto = 0; 63my $do_ssl = 0; 64my $do_ctest = 0; |
65my $do_ctestall = 0; |
|
16my $rsaref = 0; 17 | 66my $rsaref = 0; 67 |
18my $W32=1; | 68my $VMS=0; 69my $W32=0; 70my $W16=0; |
19my $NT=0; 20# Set this to make typesafe STACK definitions appear in DEF | 71my $NT=0; 72# Set this to make typesafe STACK definitions appear in DEF |
21my $safe_stack_def = 1; | 73my $safe_stack_def = 0; |
22 | 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 |
|
23my $options=""; 24open(IN,"<Makefile.ssl") || die "unable to open Makefile.ssl!\n"; 25while(<IN>) { 26 $options=$1 if (/^OPTIONS=(.*)$/); 27} 28close(IN); 29 30# The following ciphers may be excluded (by Configure). This means functions 31# defined with ifndef(NO_XXX) are not included in the .def file, and everything 32# in directory xxx is ignored. 33my $no_rc2; my $no_rc4; my $no_rc5; my $no_idea; my $no_des; my $no_bf; | 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; |
34my $no_cast; my $no_md2; my $no_md5; my $no_sha; my $no_ripemd; my $no_mdc2; | 92my $no_cast; 93my $no_md2; my $no_md4; my $no_md5; my $no_sha; my $no_ripemd; my $no_mdc2; |
35my $no_rsa; my $no_dsa; my $no_dh; my $no_hmac=0; | 94my $no_rsa; my $no_dsa; my $no_dh; my $no_hmac=0; |
95my $no_fp_api; |
|
36 37foreach (@ARGV, split(/ /, $options)) 38 { 39 $W32=1 if $_ eq "32"; | 96 97foreach (@ARGV, split(/ /, $options)) 98 { 99 $W32=1 if $_ eq "32"; |
40 $W32=0 if $_ eq "16"; | 100 $W16=1 if $_ eq "16"; |
41 if($_ eq "NT") { 42 $W32 = 1; 43 $NT = 1; 44 } | 101 if($_ eq "NT") { 102 $W32 = 1; 103 $NT = 1; 104 } |
105 $VMS=1 if $_ eq "VMS"; 106 $rsaref=1 if $_ eq "rsaref"; 107 |
|
45 $do_ssl=1 if $_ eq "ssleay"; 46 $do_ssl=1 if $_ eq "ssl"; 47 $do_crypto=1 if $_ eq "libeay"; 48 $do_crypto=1 if $_ eq "crypto"; 49 $do_update=1 if $_ eq "update"; | 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"; |
|
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 53 if (/^no-rc2$/) { $no_rc2=1; } 54 elsif (/^no-rc4$/) { $no_rc4=1; } 55 elsif (/^no-rc5$/) { $no_rc5=1; } 56 elsif (/^no-idea$/) { $no_idea=1; } 57 elsif (/^no-des$/) { $no_des=1; } 58 elsif (/^no-bf$/) { $no_bf=1; } 59 elsif (/^no-cast$/) { $no_cast=1; } 60 elsif (/^no-md2$/) { $no_md2=1; } | 117 118 if (/^no-rc2$/) { $no_rc2=1; } 119 elsif (/^no-rc4$/) { $no_rc4=1; } 120 elsif (/^no-rc5$/) { $no_rc5=1; } 121 elsif (/^no-idea$/) { $no_idea=1; } 122 elsif (/^no-des$/) { $no_des=1; } 123 elsif (/^no-bf$/) { $no_bf=1; } 124 elsif (/^no-cast$/) { $no_cast=1; } 125 elsif (/^no-md2$/) { $no_md2=1; } |
126 elsif (/^no-md4$/) { $no_md4=1; } |
|
61 elsif (/^no-md5$/) { $no_md5=1; } 62 elsif (/^no-sha$/) { $no_sha=1; } 63 elsif (/^no-ripemd$/) { $no_ripemd=1; } 64 elsif (/^no-mdc2$/) { $no_mdc2=1; } 65 elsif (/^no-rsa$/) { $no_rsa=1; } 66 elsif (/^no-dsa$/) { $no_dsa=1; } 67 elsif (/^no-dh$/) { $no_dh=1; } 68 elsif (/^no-hmac$/) { $no_hmac=1; } 69 } 70 71 | 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 |
|
72if (!$do_ssl && !$do_crypto) 73 { 74 print STDERR "usage: $0 ( ssl | crypto ) [ 16 | 32 | NT ] [rsaref]\n"; 75 exit(1); 76 } 77 78%ssl_list=&load_numbers($ssl_num); 79$max_ssl = $max_num; --- 6 unchanged lines hidden (view full) --- 86$crypto.=" crypto/des/des.h" unless $no_des; 87$crypto.=" crypto/idea/idea.h" unless $no_idea; 88$crypto.=" crypto/rc4/rc4.h" unless $no_rc4; 89$crypto.=" crypto/rc5/rc5.h" unless $no_rc5; 90$crypto.=" crypto/rc2/rc2.h" unless $no_rc2; 91$crypto.=" crypto/bf/blowfish.h" unless $no_bf; 92$crypto.=" crypto/cast/cast.h" unless $no_cast; 93$crypto.=" crypto/md2/md2.h" unless $no_md2; | 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; --- 6 unchanged lines hidden (view full) --- 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; |
|
94$crypto.=" crypto/md5/md5.h" unless $no_md5; 95$crypto.=" crypto/mdc2/mdc2.h" unless $no_mdc2; 96$crypto.=" crypto/sha/sha.h" unless $no_sha; 97$crypto.=" crypto/ripemd/ripemd.h" unless $no_ripemd; 98 99$crypto.=" crypto/bn/bn.h"; 100$crypto.=" crypto/rsa/rsa.h" unless $no_rsa; 101$crypto.=" crypto/dsa/dsa.h" unless $no_dsa; 102$crypto.=" crypto/dh/dh.h" unless $no_dh; 103$crypto.=" crypto/hmac/hmac.h" unless $no_hmac; 104 105$crypto.=" crypto/stack/stack.h"; 106$crypto.=" crypto/buffer/buffer.h"; 107$crypto.=" crypto/bio/bio.h"; | 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"; |
|
108$crypto.=" crypto/lhash/lhash.h"; 109$crypto.=" crypto/conf/conf.h"; 110$crypto.=" crypto/txt_db/txt_db.h"; 111 112$crypto.=" crypto/evp/evp.h"; 113$crypto.=" crypto/objects/objects.h"; 114$crypto.=" crypto/pem/pem.h"; 115#$crypto.=" crypto/meth/meth.h"; --- 4 unchanged lines hidden (view full) --- 120$crypto.=" crypto/pkcs12/pkcs12.h"; 121$crypto.=" crypto/x509/x509.h"; 122$crypto.=" crypto/x509/x509_vfy.h"; 123$crypto.=" crypto/x509v3/x509v3.h"; 124$crypto.=" crypto/rand/rand.h"; 125$crypto.=" crypto/comp/comp.h"; 126$crypto.=" crypto/tmdiff.h"; 127 | 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"; --- 4 unchanged lines hidden (view full) --- 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 |
128my @ssl_func = &do_defs("SSLEAY", $ssl); 129my @crypto_func = &do_defs("LIBEAY", $crypto); | 206my $symhacks="crypto/symhacks.h"; |
130 | 207 |
208my @ssl_symbols = &do_defs("SSLEAY", $ssl, $symhacks); 209my @crypto_symbols = &do_defs("LIBEAY", $crypto, $symhacks); |
|
131 132if ($do_update) { 133 134if ($do_ssl == 1) { | 210 211if ($do_update) { 212 213if ($do_ssl == 1) { |
135 open(OUT, ">>$ssl_num"); 136 &update_numbers(*OUT,"SSLEAY",*ssl_list,$max_ssl, @ssl_func); | 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); |
137 close OUT; 138} 139 140if($do_crypto == 1) { | 224 close OUT; 225} 226 227if($do_crypto == 1) { |
141 open(OUT, ">>$crypto_num"); 142 &update_numbers(*OUT,"LIBEAY",*crypto_list,$max_crypto, @crypto_func); | 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); |
143 close OUT; 144} 145 | 237 close OUT; 238} 239 |
146} elsif ($do_ctest) { | 240} elsif ($do_ctest || $do_ctestall) { |
147 148 print <<"EOF"; 149 150/* Test file to check all DEF file symbols are present by trying 151 * to link to all of them. This is *not* intended to be run! 152 */ 153 154int main() 155{ 156EOF | 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 |
157 &print_test_file(*STDOUT,"SSLEAY",*ssl_list,@ssl_func) | 251 &print_test_file(*STDOUT,"SSLEAY",*ssl_list,$do_ctestall,@ssl_symbols) |
158 if $do_ssl == 1; 159 | 252 if $do_ssl == 1; 253 |
160 &print_test_file(*STDOUT,"LIBEAY",*crypto_list,@crypto_func) | 254 &print_test_file(*STDOUT,"LIBEAY",*crypto_list,$do_ctestall,@crypto_symbols) |
161 if $do_crypto == 1; 162 163 print "}\n"; 164 165} else { 166 | 255 if $do_crypto == 1; 256 257 print "}\n"; 258 259} else { 260 |
167 &print_def_file(*STDOUT,"SSLEAY",*ssl_list,@ssl_func) | 261 &print_def_file(*STDOUT,"SSLEAY",*ssl_list,@ssl_symbols) |
168 if $do_ssl == 1; 169 | 262 if $do_ssl == 1; 263 |
170 &print_def_file(*STDOUT,"LIBEAY",*crypto_list,@crypto_func) | 264 &print_def_file(*STDOUT,"LIBEAY",*crypto_list,@crypto_symbols) |
171 if $do_crypto == 1; 172 173} 174 175 176sub do_defs 177{ | 265 if $do_crypto == 1; 266 267} 268 269 270sub do_defs 271{ |
178 my($name,$files)=@_; | 272 my($name,$files,$symhacksfile)=@_; |
179 my $file; 180 my @ret; | 273 my $file; 274 my @ret; |
181 my %funcs; | 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; |
182 my $cpp; 183 | 280 my $cpp; 281 |
184 foreach $file (split(/\s+/,$files)) | 282 foreach $file (split(/\s+/,$symhacksfile." ".$files)) |
185 { 186 open(IN,"<$file") || die "unable to open $file:$!\n"; 187 my $line = "", my $def= ""; 188 my %tag = ( | 283 { 284 open(IN,"<$file") || die "unable to open $file:$!\n"; 285 my $line = "", my $def= ""; 286 my %tag = ( |
189 FreeBSD => 0, | 287 (map { $_ => 0 } @known_platforms), 288 (map { "NO_".$_ => 0 } @known_algorithms), |
190 NOPROTO => 0, | 289 NOPROTO => 0, |
191 WIN16 => 0, | |
192 PERL5 => 0, 193 _WINDLL => 0, | 290 PERL5 => 0, 291 _WINDLL => 0, |
194 NO_FP_API => 0, | |
195 CONST_STRICT => 0, 196 TRUE => 1, | 292 CONST_STRICT => 0, 293 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 ); | 294 ); |
295 my $symhacking = $file eq $symhacksfile; |
|
214 while(<IN>) { 215 last if (/BEGIN ERROR CODES/); 216 if ($line ne '') { 217 $_ = $line . $_; 218 $line = ''; 219 } 220 221 if (/\\$/) { 222 $line = $_; 223 next; 224 } 225 | 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 |
226 $cpp = 1 if /^#.*ifdef.*cplusplus/; | 308 $cpp = 1 if /^\#.*ifdef.*cplusplus/; |
227 if ($cpp) { | 309 if ($cpp) { |
228 $cpp = 0 if /^#.*endif/; | 310 $cpp = 0 if /^\#.*endif/; |
229 next; 230 } 231 232 s/\/\*.*?\*\///gs; # ignore comments 233 s/{[^{}]*}//gs; # ignore {} blocks 234 if (/^\#\s*ifndef (.*)/) { 235 push(@tag,$1); 236 $tag{$1}=-1; | 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; |
237 next; | |
238 } elsif (/^\#\s*if !defined\(([^\)]+)\)/) { 239 push(@tag,$1); 240 $tag{$1}=-1; | 319 } elsif (/^\#\s*if !defined\(([^\)]+)\)/) { 320 push(@tag,$1); 321 $tag{$1}=-1; |
241 next; | |
242 } elsif (/^\#\s*ifdef (.*)/) { 243 push(@tag,$1); 244 $tag{$1}=1; | 322 } elsif (/^\#\s*ifdef (.*)/) { 323 push(@tag,$1); 324 $tag{$1}=1; |
245 next; 246 } elsif (/^\#\s*if defined(.*)/) { | 325 } elsif (/^\#\s*if defined\(([^\)]+)\)/) { |
247 push(@tag,$1); 248 $tag{$1}=1; | 326 push(@tag,$1); 327 $tag{$1}=1; |
249 next; | 328 } elsif (/^\#\s*error\s+(\w+) is disabled\./) { 329 if ($tag[$#tag] eq "NO_".$1) { 330 $tag{$tag[$#tag]}=2; 331 } |
250 } elsif (/^\#\s*endif/) { | 332 } elsif (/^\#\s*endif/) { |
251 $tag{$tag[$#tag]}=0; | 333 if ($tag{$tag[$#tag]}==2) { 334 $tag{$tag[$#tag]}=-1; 335 } else { 336 $tag{$tag[$#tag]}=0; 337 } |
252 pop(@tag); | 338 pop(@tag); |
253 next; | |
254 } elsif (/^\#\s*else/) { 255 my $t=$tag[$#tag]; 256 $tag{$t}= -$tag{$t}; | 339 } elsif (/^\#\s*else/) { 340 my $t=$tag[$#tag]; 341 $tag{$t}= -$tag{$t}; |
257 next; | |
258 } elsif (/^\#\s*if\s+1/) { 259 # Dummy tag 260 push(@tag,"TRUE"); 261 $tag{"TRUE"}=1; | 342 } elsif (/^\#\s*if\s+1/) { 343 # Dummy tag 344 push(@tag,"TRUE"); 345 $tag{"TRUE"}=1; |
262 next; | |
263 } elsif (/^\#\s*if\s+0/) { 264 # Dummy tag 265 push(@tag,"TRUE"); 266 $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).";"; |
|
267 next; | 369 next; |
268 } elsif (/^\#/) { 269 next; | |
270 } | 370 } |
271 if ($safe_stack_def && 272 /^\s*DECLARE_STACK_OF\s*\(\s*(\w*)\s*\)/) { 273 $funcs{"sk_${1}_new"} = 1; 274 $funcs{"sk_${1}_new_null"} = 1; 275 $funcs{"sk_${1}_free"} = 1; 276 $funcs{"sk_${1}_num"} = 1; 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; | 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; |
296 } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ || | 377 } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ || |
297 /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ ) { 298 if($W32) { 299 $funcs{"PEM_read_${1}"} = 1; 300 $funcs{"PEM_write_${1}"} = 1; | 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"; |
301 } | 394 } |
302 $funcs{"PEM_read_bio_${1}"} = 1; 303 $funcs{"PEM_write_bio_${1}"} = 1; | 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 } |
304 } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ || 305 /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) { | 409 } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ || 410 /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) { |
306 if($W32) { 307 $funcs{"PEM_write_${1}"} = 1; | 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"; |
308 } | 421 } |
309 $funcs{"PEM_write_bio_${1}"} = 1; | 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 } |
310 } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ || 311 /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) { | 432 } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ || 433 /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) { |
312 if($W32) { 313 $funcs{"PEM_read_${1}"} = 1; 314 } 315 $funcs{"PEM_read_bio_${1}"} = 1; | 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; |
316 } elsif ( | 439 } elsif ( |
317 ($tag{'TRUE'} != -1) && 318 ($tag{'FreeBSD'} != 1) && 319 ($tag{'CONST_STRICT'} != 1) && 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)) | 440 ($tag{'TRUE'} != -1) 441 && ($tag{'CONST_STRICT'} != 1) 442 ) |
344 { | 443 { |
345 if (/{|\/\*/) { # } | 444 if (/\{|\/\*|\([^\)]*$/) { |
346 $line = $_; 347 } else { 348 $def .= $_; 349 } 350 } 351 } 352 close(IN); 353 | 445 $line = $_; 446 } else { 447 $def .= $_; 448 } 449 } 450 } 451 close(IN); 452 |
453 my $algs; 454 my $plays; 455 |
|
354 foreach (split /;/, $def) { | 456 foreach (split /;/, $def) { |
457 my $s; my $k = "FUNCTION"; my $p; my $a; |
|
355 s/^[\n\s]*//g; 356 s/[\n\s]*$//g; | 458 s/^[\n\s]*//g; 459 s/[\n\s]*$//g; |
460 next if(/\#undef/); |
|
357 next if(/typedef\W/); | 461 next if(/typedef\W/); |
358 next if(/EVP_bf/ and $no_bf); 359 next if(/EVP_cast/ and $no_cast); 360 next if(/EVP_des/ and $no_des); 361 next if(/EVP_dss/ and $no_dsa); 362 next if(/EVP_idea/ and $no_idea); 363 next if(/EVP_md2/ and $no_md2); 364 next if(/EVP_md5/ and $no_md5); 365 next if(/EVP_rc2/ and $no_rc2); 366 next if(/EVP_rc4/ and $no_rc4); 367 next if(/EVP_rc5/ and $no_rc5); 368 next if(/EVP_ripemd/ and $no_ripemd); 369 next if(/EVP_sha/ and $no_sha); 370 if (/\(\*(\w*)\([^\)]+/) { 371 $funcs{$1} = 1; | 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; |
372 } elsif (/\w+\W+(\w+)\W*\(\s*\)$/s) { 373 # K&R C 374 next; 375 } elsif (/\w+\W+\w+\W*\(.*\)$/s) { 376 while (not /\(\)$/s) { 377 s/[^\(\)]*\)$/\)/s; 378 s/\([^\(\)]*\)\)$/\)/s; 379 } 380 s/\(void\)//; 381 /(\w+)\W*\(\)/s; | 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; |
382 $funcs{$1} = 1; | 483 $s = $1; |
383 } elsif (/\(/ and not (/=/)) { 384 print STDERR "File $file: cannot parse: $_;\n"; | 484 } elsif (/\(/ and not (/=/)) { 485 print STDERR "File $file: cannot parse: $_;\n"; |
486 next; 487 } else { 488 next; |
|
385 } | 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 } |
|
386 } 387 } 388 | 526 } 527 } 528 |
389 # Prune the returned functions | 529 # Prune the returned symbols |
390 | 530 |
391 delete $funcs{"SSL_add_dir_cert_subjects_to_stack"}; 392 delete $funcs{"RSA_PKCS1_RSAref"} unless $rsaref; 393 delete $funcs{"bn_dump1"}; | 531 $platform{"crypt"} .= ",!PERL5,!__FreeBSD__,!NeXT"; |
394 | 532 |
395 if($W32) { 396 delete $funcs{"BIO_s_file_internal"}; 397 delete $funcs{"BIO_new_file_internal"}; 398 delete $funcs{"BIO_new_fp_internal"}; 399 } else { 400 if(exists $funcs{"ERR_load_CRYPTO_strings"}) { 401 delete $funcs{"ERR_load_CRYPTO_strings"}; 402 $funcs{"ERR_load_CRYPTOlib_strings"} = 1; | 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}++; |
403 } | 589 } |
404 delete $funcs{"BIO_s_file"}; 405 delete $funcs{"BIO_new_file"}; 406 delete $funcs{"BIO_new_fp"}; | |
407 } | 590 } |
408 if (!$NT) { 409 delete $funcs{"BIO_s_log"}; | 591 foreach $platform (keys %p) { 592 if ($p{$platform} == 0) { delete $p{$platform}; } |
410 } 411 | 593 } 594 |
412 push @ret, keys %funcs; | 595 delete $p{""}; 596 delete $a{""}; |
413 | 597 |
414 return(@ret); | 598 $ret = $exist; 599 $ret .= ":".join(',',map { $p{$_} < 0 ? "!".$_ : $_ } keys %p); 600 $ret .= ":".$k; 601 $ret .= ":".join(',',keys %a); 602 return $ret; |
415} 416 | 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 |
|
417sub print_test_file 418{ | 633sub print_test_file 634{ |
419 (*OUT,my $name,*nums,my @functions)=@_; | 635 (*OUT,my $name,*nums,my @symbols)=@_; |
420 my $n = 1; my @e; my @r; | 636 my $n = 1; my @e; my @r; |
421 my $func; | 637 my $sym; my $prev = ""; my $prefSSLeay; |
422 | 638 |
423 (@e)=grep(/^SSLeay/,@functions); 424 (@r)=grep(!/^SSLeay/,@functions); 425 @functions=((sort @e),(sort @r)); | 639 (@e)=grep(/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); 640 (@r)=grep(/^\w+\\.*?:.*?:FUNCTION/ && !/^SSLeay\\.*?:.*?:FUNCTION/,@symbols); 641 @symbols=((sort @e),(sort @r)); |
426 | 642 |
427 foreach $func (@functions) { 428 if (!defined($nums{$func})) { 429 printf STDERR "$func does not have a number assigned\n" 430 if(!$do_update); 431 } else { 432 $n=$nums{$func}; 433 print OUT "\t$func();\n"; | 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 } |
434 } | 653 } |
654 $prev = $s; # To avoid duplicates... |
|
435 } 436} 437 438sub print_def_file 439{ | 655 } 656} 657 658sub print_def_file 659{ |
440 (*OUT,my $name,*nums,my @functions)=@_; | 660 (*OUT,my $name,*nums,my @symbols)=@_; |
441 my $n = 1; my @e; my @r; 442 443 if ($W32) 444 { $name.="32"; } 445 else 446 { $name.="16"; } 447 448 print OUT <<"EOF"; --- 17 unchanged lines hidden (view full) --- 466HEAPSIZE 4096 467STACKSIZE 8192 468 469EOF 470 } 471 472 print "EXPORTS\n"; 473 | 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"; --- 17 unchanged lines hidden (view full) --- 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)); |
|
474 | 697 |
475 (@e)=grep(/^SSLeay/,@functions); 476 (@r)=grep(!/^SSLeay/,@functions); 477 @functions=((sort @e),(sort @r)); | |
478 | 698 |
479 foreach $func (@functions) { 480 if (!defined($nums{$func})) { 481 printf STDERR "$func does not have a number assigned\n" | 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" |
482 if(!$do_update); 483 } else { | 703 if(!$do_update); 704 } else { |
484 $n=$nums{$func}; 485 printf OUT " %s%-40s@%d\n",($W32)?"":"_",$func,$n; | 705 (my $n, my $i) = split /\\/, $nums{$s}; 706 my %pf = (); 707 my @p = split(/,/, ($i =~ /^.*?:(.*?):/,$1)); 708 # @p_purged must contain hardware platforms only 709 my @p_purged = (); 710 foreach $ptmp (@p) { 711 next if $ptmp =~ /^!?RSAREF$/; 712 push @p_purged, $ptmp; 713 } 714 my $negatives = !!grep(/^!/,@p); 715 # It is very important to check NT before W32 716 if ((($NT && (!@p_purged 717 || (!$negatives && grep(/^WINNT$/,@p)) 718 || ($negatives && !grep(/^!WINNT$/,@p)))) 719 || ($W32 && (!@p_purged 720 || (!$negatives && grep(/^WIN32$/,@p)) 721 || ($negatives && !grep(/^!WIN32$/,@p)))) 722 || ($W16 && (!@p_purged 723 || (!$negatives && grep(/^WIN16$/,@p)) 724 || ($negatives && !grep(/^!WIN16$/,@p))))) 725 && (!@p 726 || (!$negatives 727 && ($rsaref || !grep(/^RSAREF$/,@p))) 728 || ($negatives 729 && (!$rsaref || !grep(/^!RSAREF$/,@p))))) { 730 printf OUT " %s%-40s@%d\n",($W32)?"":"_",$s,$n; 731# } else { 732# print STDERR "DEBUG: \"$sym\" (@p):", 733# " rsaref:", !!(!@p 734# || (!$negatives 735# && ($rsaref || !grep(/^RSAREF$/,@p))) 736# || ($negatives 737# && (!$rsaref || !grep(/^!RSAREF$/,@p))))?1:0, 738# " 16:", !!($W16 && (!@p_purged 739# || (!$negatives && grep(/^WIN16$/,@p)) 740# || ($negatives && !grep(/^!WIN16$/,@p)))), 741# " 32:", !!($W32 && (!@p_purged 742# || (!$negatives && grep(/^WIN32$/,@p)) 743# || ($negatives && !grep(/^!WIN32$/,@p)))), 744# " NT:", !!($NT && (!@p_purged 745# || (!$negatives && grep(/^WINNT$/,@p)) 746# || ($negatives && !grep(/^!WINNT$/,@p)))), 747# "\n"; 748 } |
486 } 487 } 488 printf OUT "\n"; 489} 490 491sub load_numbers 492{ 493 my($name)=@_; 494 my(@a,%ret); 495 496 $max_num = 0; | 749 } 750 } 751 printf OUT "\n"; 752} 753 754sub load_numbers 755{ 756 my($name)=@_; 757 my(@a,%ret); 758 759 $max_num = 0; |
760 $num_noinfo = 0; 761 $prev = ""; |
|
497 498 open(IN,"<$name") || die "unable to open $name:$!\n"; 499 while (<IN>) { 500 chop; 501 s/#.*$//; 502 next if /^\s*$/; 503 @a=split; | 762 763 open(IN,"<$name") || die "unable to open $name:$!\n"; 764 while (<IN>) { 765 chop; 766 s/#.*$//; 767 next if /^\s*$/; 768 @a=split; |
504 $ret{$a[0]}=$a[1]; | 769 if (defined $ret{$a[0]}) { 770 print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n"; 771 } 772 if ($max_num > $a[1]) { 773 print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n"; 774 } 775 if ($max_num == $a[1]) { 776 # This is actually perfectly OK 777 #print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n"; 778 } 779 if ($#a < 2) { 780 # Existence will be proven later, in do_defs 781 $ret{$a[0]}=$a[1]; 782 $num_noinfo++; 783 } else { 784 $ret{$a[0]}=$a[1]."\\".$a[2]; # \\ is a special marker 785 } |
505 $max_num = $a[1] if $a[1] > $max_num; | 786 $max_num = $a[1] if $a[1] > $max_num; |
787 $prev=$a[0]; |
|
506 } | 788 } |
789 if ($num_noinfo) { 790 print STDERR "Warning: $num_noinfo symbols were without info."; 791 if ($do_rewrite) { 792 printf STDERR " The rewrite will fix this.\n"; 793 } else { 794 printf STDERR " You should do a rewrite to fix this.\n"; 795 } 796 } |
|
507 close(IN); 508 return(%ret); 509} 510 | 797 close(IN); 798 return(%ret); 799} 800 |
801sub parse_number 802{ 803 (my $str, my $what) = @_; 804 (my $n, my $i) = split(/\\/,$str); 805 if ($what eq "n") { 806 return $n; 807 } else { 808 return $i; 809 } 810} 811 812sub rewrite_numbers 813{ 814 (*OUT,$name,*nums,@symbols)=@_; 815 my $thing; 816 817 print STDERR "Rewriting $name\n"; 818 819 my @r = grep(/^\w+\\.*?:.*?:\w+\(\w+\)/,@symbols); 820 my $r; my %r; my %rsyms; 821 foreach $r (@r) { 822 (my $s, my $i) = split /\\/, $r; 823 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/; 824 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/; 825 $r{$a} = $s."\\".$i; 826 $rsyms{$s} = 1; 827 } 828 829 my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums; 830 foreach $sym (@s) { 831 (my $n, my $i) = split /\\/, $nums{$sym}; 832 next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/; 833 next if defined($rsyms{$sym}); 834 $i="NOEXIST::FUNCTION:" if !defined($i) || $i eq ""; 835 printf OUT "%s%-40s%d\t%s\n","",$sym,$n,$i; 836 if (exists $r{$sym}) { 837 (my $s, $i) = split /\\/,$r{$sym}; 838 printf OUT "%s%-40s%d\t%s\n","",$s,$n,$i; 839 } 840 } 841} 842 |
|
511sub update_numbers 512{ | 843sub update_numbers 844{ |
513 (*OUT,$name,*nums,my $start_num, my @functions)=@_; 514 my $new_funcs = 0; 515 print STDERR "Updating $name\n"; 516 foreach $func (@functions) { 517 if (!exists $nums{$func}) { 518 $new_funcs++; 519 printf OUT "%s%-40s%d\n","",$func, ++$start_num; | 845 (*OUT,$name,*nums,my $start_num, my @symbols)=@_; 846 my $new_syms = 0; 847 848 print STDERR "Updating $name numbers\n"; 849 850 my @r = grep(/^\w+\\.*?:.*?:\w+\(\w+\)/,@symbols); 851 my $r; my %r; my %rsyms; 852 foreach $r (@r) { 853 (my $s, my $i) = split /\\/, $r; 854 my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/; 855 $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/; 856 $r{$a} = $s."\\".$i; 857 $rsyms{$s} = 1; 858 } 859 860 foreach $sym (@symbols) { 861 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 862 next if $i =~ /^.*?:.*?:\w+\(\w+\)/; 863 next if defined($rsyms{$sym}); 864 die "ERROR: Symbol $sym had no info attached to it." 865 if $i eq ""; 866 if (!exists $nums{$s}) { 867 $new_syms++; 868 printf OUT "%s%-40s%d\t%s\n","",$s, ++$start_num,$i; 869 if (exists $r{$s}) { 870 ($s, $i) = split /\\/,$r{$s}; 871 printf OUT "%s%-40s%d\t%s\n","",$s, $start_num,$i; 872 } |
520 } 521 } | 873 } 874 } |
522 if($new_funcs) { 523 print STDERR "$new_funcs New Functions added\n"; | 875 if($new_syms) { 876 print STDERR "$new_syms New symbols added\n"; |
524 } else { | 877 } else { |
525 print STDERR "No New Functions Added\n"; | 878 print STDERR "No New symbols Added\n"; |
526 } 527} | 879 } 880} |
881 882sub check_existing 883{ 884 (*nums, my @symbols)=@_; 885 my %existing; my @remaining; 886 @remaining=(); 887 foreach $sym (@symbols) { 888 (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/; 889 $existing{$s}=1; 890 } 891 foreach $sym (keys %nums) { 892 if (!exists $existing{$sym}) { 893 push @remaining, $sym; 894 } 895 } 896 if(@remaining) { 897 print STDERR "The following symbols do not seem to exist:\n"; 898 foreach $sym (@remaining) { 899 print STDERR "\t",$sym,"\n"; 900 } 901 } 902} 903 |
|