diff options
Diffstat (limited to 'src/lib/libcrypto/util/mkdef.pl')
-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 | |||