mkdef.pl 47 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561
  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 variants 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, or the symbol is implemented differently (see
  43. # EXPORT_VAR_AS_FUNCTION). This script assumes renaming of symbols is found
  44. # in the file crypto/symhacks.h.
  45. # The semantics for the platforms is that every item is checked against the
  46. # environment. For the negative items ("!FOO"), if any of them is false
  47. # (i.e. "FOO" is true) in the environment, the corresponding symbol can't be
  48. # used. For the positive itms, if all of them are false in the environment,
  49. # the corresponding symbol can't be used. Any combination of positive and
  50. # negative items are possible, and of course leave room for some redundancy.
  51. # - "kind" is "FUNCTION" or "VARIABLE". The meaning of that is obvious.
  52. # - "algorithms" is a comma-separated list of algorithm names. This helps
  53. # exclude symbols that are part of an algorithm that some user wants to
  54. # exclude.
  55. #
  56. my $debug=0;
  57. my $crypto_num= "util/libeay.num";
  58. my $ssl_num= "util/ssleay.num";
  59. my $libname;
  60. my $do_update = 0;
  61. my $do_rewrite = 1;
  62. my $do_crypto = 0;
  63. my $do_ssl = 0;
  64. my $do_ctest = 0;
  65. my $do_ctestall = 0;
  66. my $do_checkexist = 0;
  67. my $VMSVAX=0;
  68. my $VMSNonVAX=0;
  69. my $VMS=0;
  70. my $W32=0;
  71. my $W16=0;
  72. my $NT=0;
  73. my $OS2=0;
  74. # Set this to make typesafe STACK definitions appear in DEF
  75. my $safe_stack_def = 0;
  76. my @known_platforms = ( "__FreeBSD__", "PERL5", "NeXT",
  77. "EXPORT_VAR_AS_FUNCTION", "ZLIB", "OPENSSL_FIPS" );
  78. my @known_ossl_platforms = ( "VMS", "WIN16", "WIN32", "WINNT", "OS2" );
  79. my @known_algorithms = ( "RC2", "RC4", "RC5", "IDEA", "DES", "BF",
  80. "CAST", "MD2", "MD4", "MD5", "SHA", "SHA0", "SHA1",
  81. "SHA256", "SHA512", "RIPEMD",
  82. "MDC2", "WHIRLPOOL", "RSA", "DSA", "DH", "EC", "ECDH", "ECDSA", "EC2M",
  83. "HMAC", "AES", "CAMELLIA", "SEED", "GOST",
  84. # EC_NISTP_64_GCC_128
  85. "EC_NISTP_64_GCC_128",
  86. # Envelope "algorithms"
  87. "EVP", "X509", "ASN1_TYPEDEFS",
  88. # Helper "algorithms"
  89. "BIO", "COMP", "BUFFER", "LHASH", "STACK", "ERR",
  90. "LOCKING",
  91. # External "algorithms"
  92. "FP_API", "STDIO", "SOCK", "KRB5", "DGRAM",
  93. # Engines
  94. "STATIC_ENGINE", "ENGINE", "HW", "GMP",
  95. # RFC3779
  96. "RFC3779",
  97. # TLS
  98. "TLSEXT", "PSK", "SRP", "HEARTBEATS",
  99. # CMS
  100. "CMS",
  101. # CryptoAPI Engine
  102. "CAPIENG",
  103. # SSL v2
  104. "SSL2",
  105. # SSL v2 method
  106. "SSL2_METHOD",
  107. # SSL v3 method
  108. "SSL3_METHOD",
  109. # JPAKE
  110. "JPAKE",
  111. # NEXTPROTONEG
  112. "NEXTPROTONEG",
  113. # Deprecated functions
  114. "DEPRECATED",
  115. # Hide SSL internals
  116. "SSL_INTERN",
  117. # SCTP
  118. "SCTP",
  119. # SRTP
  120. "SRTP",
  121. # SSL TRACE
  122. "SSL_TRACE",
  123. # Unit testing
  124. "UNIT_TEST");
  125. my $options="";
  126. open(IN,"<Makefile") || die "unable to open Makefile!\n";
  127. while(<IN>) {
  128. $options=$1 if (/^OPTIONS=(.*)$/);
  129. }
  130. close(IN);
  131. # The following ciphers may be excluded (by Configure). This means functions
  132. # defined with ifndef(NO_XXX) are not included in the .def file, and everything
  133. # in directory xxx is ignored.
  134. my $no_rc2; my $no_rc4; my $no_rc5; my $no_idea; my $no_des; my $no_bf;
  135. my $no_cast; my $no_whirlpool; my $no_camellia; my $no_seed;
  136. my $no_md2; my $no_md4; my $no_md5; my $no_sha; my $no_ripemd; my $no_mdc2;
  137. my $no_rsa; my $no_dsa; my $no_dh; my $no_hmac=0; my $no_aes; my $no_krb5;
  138. my $no_ec; my $no_ecdsa; my $no_ecdh; my $no_engine; my $no_hw;
  139. my $no_fp_api; my $no_static_engine=1; my $no_gmp; my $no_deprecated;
  140. my $no_rfc3779; my $no_psk; my $no_tlsext; my $no_cms; my $no_capieng;
  141. my $no_jpake; my $no_srp; my $no_ssl2; my $no_ec2m; my $no_nistp_gcc;
  142. my $no_nextprotoneg; my $no_sctp; my $no_srtp; my $no_ssl_trace;
  143. my $no_unit_test; my $no_ssl3_method; my $no_ssl2_method;
  144. my $fips;
  145. my $zlib;
  146. foreach (@ARGV, split(/ /, $options))
  147. {
  148. $debug=1 if $_ eq "debug";
  149. $W32=1 if $_ eq "32";
  150. $W16=1 if $_ eq "16";
  151. if($_ eq "NT") {
  152. $W32 = 1;
  153. $NT = 1;
  154. }
  155. if ($_ eq "VMS-VAX") {
  156. $VMS=1;
  157. $VMSVAX=1;
  158. }
  159. if ($_ eq "VMS-NonVAX") {
  160. $VMS=1;
  161. $VMSNonVAX=1;
  162. }
  163. $VMS=1 if $_ eq "VMS";
  164. $OS2=1 if $_ eq "OS2";
  165. $fips=1 if /^fips/;
  166. if ($_ eq "zlib" || $_ eq "enable-zlib" || $_ eq "zlib-dynamic"
  167. || $_ eq "enable-zlib-dynamic") {
  168. $zlib = 1;
  169. }
  170. $do_ssl=1 if $_ eq "ssleay";
  171. if ($_ eq "ssl") {
  172. $do_ssl=1;
  173. $libname=$_
  174. }
  175. $do_crypto=1 if $_ eq "libeay";
  176. if ($_ eq "crypto") {
  177. $do_crypto=1;
  178. $libname=$_;
  179. }
  180. $no_static_engine=1 if $_ eq "no-static-engine";
  181. $no_static_engine=0 if $_ eq "enable-static-engine";
  182. $do_update=1 if $_ eq "update";
  183. $do_rewrite=1 if $_ eq "rewrite";
  184. $do_ctest=1 if $_ eq "ctest";
  185. $do_ctestall=1 if $_ eq "ctestall";
  186. $do_checkexist=1 if $_ eq "exist";
  187. #$safe_stack_def=1 if $_ eq "-DDEBUG_SAFESTACK";
  188. if (/^no-rc2$/) { $no_rc2=1; }
  189. elsif (/^no-rc4$/) { $no_rc4=1; }
  190. elsif (/^no-rc5$/) { $no_rc5=1; }
  191. elsif (/^no-idea$/) { $no_idea=1; }
  192. elsif (/^no-des$/) { $no_des=1; $no_mdc2=1; }
  193. elsif (/^no-bf$/) { $no_bf=1; }
  194. elsif (/^no-cast$/) { $no_cast=1; }
  195. elsif (/^no-whirlpool$/) { $no_whirlpool=1; }
  196. elsif (/^no-md2$/) { $no_md2=1; }
  197. elsif (/^no-md4$/) { $no_md4=1; }
  198. elsif (/^no-md5$/) { $no_md5=1; }
  199. elsif (/^no-sha$/) { $no_sha=1; }
  200. elsif (/^no-ripemd$/) { $no_ripemd=1; }
  201. elsif (/^no-mdc2$/) { $no_mdc2=1; }
  202. elsif (/^no-rsa$/) { $no_rsa=1; }
  203. elsif (/^no-dsa$/) { $no_dsa=1; }
  204. elsif (/^no-dh$/) { $no_dh=1; }
  205. elsif (/^no-ec$/) { $no_ec=1; }
  206. elsif (/^no-ecdsa$/) { $no_ecdsa=1; }
  207. elsif (/^no-ecdh$/) { $no_ecdh=1; }
  208. elsif (/^no-hmac$/) { $no_hmac=1; }
  209. elsif (/^no-aes$/) { $no_aes=1; }
  210. elsif (/^no-camellia$/) { $no_camellia=1; }
  211. elsif (/^no-seed$/) { $no_seed=1; }
  212. elsif (/^no-evp$/) { $no_evp=1; }
  213. elsif (/^no-lhash$/) { $no_lhash=1; }
  214. elsif (/^no-stack$/) { $no_stack=1; }
  215. elsif (/^no-err$/) { $no_err=1; }
  216. elsif (/^no-buffer$/) { $no_buffer=1; }
  217. elsif (/^no-bio$/) { $no_bio=1; }
  218. #elsif (/^no-locking$/) { $no_locking=1; }
  219. elsif (/^no-comp$/) { $no_comp=1; }
  220. elsif (/^no-dso$/) { $no_dso=1; }
  221. elsif (/^no-krb5$/) { $no_krb5=1; }
  222. elsif (/^no-engine$/) { $no_engine=1; }
  223. elsif (/^no-hw$/) { $no_hw=1; }
  224. elsif (/^no-gmp$/) { $no_gmp=1; }
  225. elsif (/^no-rfc3779$/) { $no_rfc3779=1; }
  226. elsif (/^no-tlsext$/) { $no_tlsext=1; }
  227. elsif (/^no-cms$/) { $no_cms=1; }
  228. elsif (/^no-ec2m$/) { $no_ec2m=1; }
  229. elsif (/^no-ec_nistp_64_gcc_128$/) { $no_nistp_gcc=1; }
  230. elsif (/^no-nextprotoneg$/) { $no_nextprotoneg=1; }
  231. elsif (/^no-ssl2$/) { $no_ssl2=1; }
  232. elsif (/^no-ssl2-method$/) { $no_ssl2_method=1; }
  233. elsif (/^no-ssl3-method$/) { $no_ssl3_method=1; }
  234. elsif (/^no-ssl-trace$/) { $no_ssl_trace=1; }
  235. elsif (/^no-capieng$/) { $no_capieng=1; }
  236. elsif (/^no-jpake$/) { $no_jpake=1; }
  237. elsif (/^no-srp$/) { $no_srp=1; }
  238. elsif (/^no-sctp$/) { $no_sctp=1; }
  239. elsif (/^no-srtp$/) { $no_srtp=1; }
  240. elsif (/^no-unit-test$/){ $no_unit_test=1; }
  241. }
  242. if (!$libname) {
  243. if ($do_ssl) {
  244. $libname="SSLEAY";
  245. }
  246. if ($do_crypto) {
  247. $libname="LIBEAY";
  248. }
  249. }
  250. # If no platform is given, assume WIN32
  251. if ($W32 + $W16 + $VMS + $OS2 == 0) {
  252. $W32 = 1;
  253. }
  254. # Add extra knowledge
  255. if ($W16) {
  256. $no_fp_api=1;
  257. }
  258. if (!$do_ssl && !$do_crypto)
  259. {
  260. print STDERR "usage: $0 ( ssl | crypto ) [ 16 | 32 | NT | OS2 ]\n";
  261. exit(1);
  262. }
  263. %ssl_list=&load_numbers($ssl_num);
  264. $max_ssl = $max_num;
  265. %crypto_list=&load_numbers($crypto_num);
  266. $max_crypto = $max_num;
  267. my $ssl="ssl/ssl.h";
  268. $ssl.=" ssl/kssl.h";
  269. $ssl.=" ssl/tls1.h";
  270. $ssl.=" ssl/srtp.h";
  271. my $crypto ="crypto/crypto.h";
  272. $crypto.=" crypto/cryptlib.h";
  273. $crypto.=" crypto/o_dir.h";
  274. $crypto.=" crypto/o_str.h";
  275. $crypto.=" crypto/o_time.h";
  276. $crypto.=" crypto/des/des.h crypto/des/des_old.h" ; # unless $no_des;
  277. $crypto.=" crypto/idea/idea.h" ; # unless $no_idea;
  278. $crypto.=" crypto/rc4/rc4.h" ; # unless $no_rc4;
  279. $crypto.=" crypto/rc5/rc5.h" ; # unless $no_rc5;
  280. $crypto.=" crypto/rc2/rc2.h" ; # unless $no_rc2;
  281. $crypto.=" crypto/bf/blowfish.h" ; # unless $no_bf;
  282. $crypto.=" crypto/cast/cast.h" ; # unless $no_cast;
  283. $crypto.=" crypto/whrlpool/whrlpool.h" ;
  284. $crypto.=" crypto/md2/md2.h" ; # unless $no_md2;
  285. $crypto.=" crypto/md4/md4.h" ; # unless $no_md4;
  286. $crypto.=" crypto/md5/md5.h" ; # unless $no_md5;
  287. $crypto.=" crypto/mdc2/mdc2.h" ; # unless $no_mdc2;
  288. $crypto.=" crypto/sha/sha.h" ; # unless $no_sha;
  289. $crypto.=" crypto/ripemd/ripemd.h" ; # unless $no_ripemd;
  290. $crypto.=" crypto/aes/aes.h" ; # unless $no_aes;
  291. $crypto.=" crypto/camellia/camellia.h" ; # unless $no_camellia;
  292. $crypto.=" crypto/seed/seed.h"; # unless $no_seed;
  293. $crypto.=" crypto/bn/bn.h";
  294. $crypto.=" crypto/rsa/rsa.h" ; # unless $no_rsa;
  295. $crypto.=" crypto/dsa/dsa.h" ; # unless $no_dsa;
  296. $crypto.=" crypto/dh/dh.h" ; # unless $no_dh;
  297. $crypto.=" crypto/ec/ec.h" ; # unless $no_ec;
  298. $crypto.=" crypto/ecdsa/ecdsa.h" ; # unless $no_ecdsa;
  299. $crypto.=" crypto/ecdh/ecdh.h" ; # unless $no_ecdh;
  300. $crypto.=" crypto/hmac/hmac.h" ; # unless $no_hmac;
  301. $crypto.=" crypto/cmac/cmac.h" ; # unless $no_hmac;
  302. $crypto.=" crypto/engine/engine.h"; # unless $no_engine;
  303. $crypto.=" crypto/stack/stack.h" ; # unless $no_stack;
  304. $crypto.=" crypto/buffer/buffer.h" ; # unless $no_buffer;
  305. $crypto.=" crypto/bio/bio.h" ; # unless $no_bio;
  306. $crypto.=" crypto/dso/dso.h" ; # unless $no_dso;
  307. $crypto.=" crypto/lhash/lhash.h" ; # unless $no_lhash;
  308. $crypto.=" crypto/conf/conf.h";
  309. $crypto.=" crypto/txt_db/txt_db.h";
  310. $crypto.=" crypto/evp/evp.h" ; # unless $no_evp;
  311. $crypto.=" crypto/objects/objects.h";
  312. $crypto.=" crypto/pem/pem.h";
  313. #$crypto.=" crypto/meth/meth.h";
  314. $crypto.=" crypto/asn1/asn1.h";
  315. $crypto.=" crypto/asn1/asn1t.h";
  316. $crypto.=" crypto/asn1/asn1_mac.h";
  317. $crypto.=" crypto/err/err.h" ; # unless $no_err;
  318. $crypto.=" crypto/pkcs7/pkcs7.h";
  319. $crypto.=" crypto/pkcs12/pkcs12.h";
  320. $crypto.=" crypto/x509/x509.h";
  321. $crypto.=" crypto/x509/x509_vfy.h";
  322. $crypto.=" crypto/x509v3/x509v3.h";
  323. $crypto.=" crypto/ts/ts.h";
  324. $crypto.=" crypto/rand/rand.h";
  325. $crypto.=" crypto/comp/comp.h" ; # unless $no_comp;
  326. $crypto.=" crypto/ocsp/ocsp.h";
  327. $crypto.=" crypto/ui/ui.h crypto/ui/ui_compat.h";
  328. $crypto.=" crypto/krb5/krb5_asn.h";
  329. #$crypto.=" crypto/store/store.h";
  330. $crypto.=" crypto/pqueue/pqueue.h";
  331. $crypto.=" crypto/cms/cms.h";
  332. $crypto.=" crypto/jpake/jpake.h";
  333. $crypto.=" crypto/modes/modes.h";
  334. $crypto.=" crypto/srp/srp.h";
  335. my $symhacks="crypto/symhacks.h";
  336. my @ssl_symbols = &do_defs("SSLEAY", $ssl, $symhacks);
  337. my @crypto_symbols = &do_defs("LIBEAY", $crypto, $symhacks);
  338. if ($do_update) {
  339. if ($do_ssl == 1) {
  340. &maybe_add_info("SSLEAY",*ssl_list,@ssl_symbols);
  341. if ($do_rewrite == 1) {
  342. open(OUT, ">$ssl_num");
  343. &rewrite_numbers(*OUT,"SSLEAY",*ssl_list,@ssl_symbols);
  344. } else {
  345. open(OUT, ">>$ssl_num");
  346. }
  347. &update_numbers(*OUT,"SSLEAY",*ssl_list,$max_ssl,@ssl_symbols);
  348. close OUT;
  349. }
  350. if($do_crypto == 1) {
  351. &maybe_add_info("LIBEAY",*crypto_list,@crypto_symbols);
  352. if ($do_rewrite == 1) {
  353. open(OUT, ">$crypto_num");
  354. &rewrite_numbers(*OUT,"LIBEAY",*crypto_list,@crypto_symbols);
  355. } else {
  356. open(OUT, ">>$crypto_num");
  357. }
  358. &update_numbers(*OUT,"LIBEAY",*crypto_list,$max_crypto,@crypto_symbols);
  359. close OUT;
  360. }
  361. } elsif ($do_checkexist) {
  362. &check_existing(*ssl_list, @ssl_symbols)
  363. if $do_ssl == 1;
  364. &check_existing(*crypto_list, @crypto_symbols)
  365. if $do_crypto == 1;
  366. } elsif ($do_ctest || $do_ctestall) {
  367. print <<"EOF";
  368. /* Test file to check all DEF file symbols are present by trying
  369. * to link to all of them. This is *not* intended to be run!
  370. */
  371. int main()
  372. {
  373. EOF
  374. &print_test_file(*STDOUT,"SSLEAY",*ssl_list,$do_ctestall,@ssl_symbols)
  375. if $do_ssl == 1;
  376. &print_test_file(*STDOUT,"LIBEAY",*crypto_list,$do_ctestall,@crypto_symbols)
  377. if $do_crypto == 1;
  378. print "}\n";
  379. } else {
  380. &print_def_file(*STDOUT,$libname,*ssl_list,@ssl_symbols)
  381. if $do_ssl == 1;
  382. &print_def_file(*STDOUT,$libname,*crypto_list,@crypto_symbols)
  383. if $do_crypto == 1;
  384. }
  385. sub do_defs
  386. {
  387. my($name,$files,$symhacksfile)=@_;
  388. my $file;
  389. my @ret;
  390. my %syms;
  391. my %platform; # For anything undefined, we assume ""
  392. my %kind; # For anything undefined, we assume "FUNCTION"
  393. my %algorithm; # For anything undefined, we assume ""
  394. my %variant;
  395. my %variant_cnt; # To be able to allocate "name{n}" if "name"
  396. # is the same name as the original.
  397. my $cpp;
  398. my %unknown_algorithms = ();
  399. foreach $file (split(/\s+/,$symhacksfile." ".$files))
  400. {
  401. print STDERR "DEBUG: starting on $file:\n" if $debug;
  402. open(IN,"<$file") || die "unable to open $file:$!\n";
  403. my $line = "", my $def= "";
  404. my %tag = (
  405. (map { $_ => 0 } @known_platforms),
  406. (map { "OPENSSL_SYS_".$_ => 0 } @known_ossl_platforms),
  407. (map { "OPENSSL_NO_".$_ => 0 } @known_algorithms),
  408. NOPROTO => 0,
  409. PERL5 => 0,
  410. _WINDLL => 0,
  411. CONST_STRICT => 0,
  412. TRUE => 1,
  413. );
  414. my $symhacking = $file eq $symhacksfile;
  415. my @current_platforms = ();
  416. my @current_algorithms = ();
  417. # params: symbol, alias, platforms, kind
  418. # The reason to put this subroutine in a variable is that
  419. # it will otherwise create it's own, unshared, version of
  420. # %tag and %variant...
  421. my $make_variant = sub
  422. {
  423. my ($s, $a, $p, $k) = @_;
  424. my ($a1, $a2);
  425. print STDERR "DEBUG: make_variant: Entered with ",$s,", ",$a,", ",(defined($p)?$p:""),", ",(defined($k)?$k:""),"\n" if $debug;
  426. if (defined($p))
  427. {
  428. $a1 = join(",",$p,
  429. grep(!/^$/,
  430. map { $tag{$_} == 1 ? $_ : "" }
  431. @known_platforms));
  432. }
  433. else
  434. {
  435. $a1 = join(",",
  436. grep(!/^$/,
  437. map { $tag{$_} == 1 ? $_ : "" }
  438. @known_platforms));
  439. }
  440. $a2 = join(",",
  441. grep(!/^$/,
  442. map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ : "" }
  443. @known_ossl_platforms));
  444. print STDERR "DEBUG: make_variant: a1 = $a1; a2 = $a2\n" if $debug;
  445. if ($a1 eq "") { $a1 = $a2; }
  446. elsif ($a1 ne "" && $a2 ne "") { $a1 .= ",".$a2; }
  447. if ($a eq $s)
  448. {
  449. if (!defined($variant_cnt{$s}))
  450. {
  451. $variant_cnt{$s} = 0;
  452. }
  453. $variant_cnt{$s}++;
  454. $a .= "{$variant_cnt{$s}}";
  455. }
  456. my $toadd = $a.":".$a1.(defined($k)?":".$k:"");
  457. my $togrep = $s.'(\{[0-9]+\})?:'.$a1.(defined($k)?":".$k:"");
  458. if (!grep(/^$togrep$/,
  459. split(/;/, defined($variant{$s})?$variant{$s}:""))) {
  460. if (defined($variant{$s})) { $variant{$s} .= ";"; }
  461. $variant{$s} .= $toadd;
  462. }
  463. print STDERR "DEBUG: make_variant: Exit with variant of ",$s," = ",$variant{$s},"\n" if $debug;
  464. };
  465. print STDERR "DEBUG: parsing ----------\n" if $debug;
  466. while(<IN>) {
  467. if (/\/\* Error codes for the \w+ functions\. \*\//)
  468. {
  469. undef @tag;
  470. last;
  471. }
  472. if ($line ne '') {
  473. $_ = $line . $_;
  474. $line = '';
  475. }
  476. if (/\\$/) {
  477. chomp; # remove eol
  478. chop; # remove ending backslash
  479. $line = $_;
  480. next;
  481. }
  482. if(/\/\*/) {
  483. if (not /\*\//) { # multiline comment...
  484. $line = $_; # ... just accumulate
  485. next;
  486. } else {
  487. s/\/\*.*?\*\///gs;# wipe it
  488. }
  489. }
  490. if ($cpp) {
  491. $cpp++ if /^#\s*if/;
  492. $cpp-- if /^#\s*endif/;
  493. next;
  494. }
  495. $cpp = 1 if /^#.*ifdef.*cplusplus/;
  496. s/{[^{}]*}//gs; # ignore {} blocks
  497. print STDERR "DEBUG: \$def=\"$def\"\n" if $debug && $def ne "";
  498. print STDERR "DEBUG: \$_=\"$_\"\n" if $debug;
  499. if (/^\#\s*ifndef\s+(.*)/) {
  500. push(@tag,"-");
  501. push(@tag,$1);
  502. $tag{$1}=-1;
  503. print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
  504. } elsif (/^\#\s*if\s+!defined\(([^\)]+)\)/) {
  505. push(@tag,"-");
  506. if (/^\#\s*if\s+(!defined\(([^\)]+)\)(\s+\&\&\s+!defined\(([^\)]+)\))*)$/) {
  507. my $tmp_1 = $1;
  508. my $tmp_;
  509. foreach $tmp_ (split '\&\&',$tmp_1) {
  510. $tmp_ =~ /!defined\(([^\)]+)\)/;
  511. print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
  512. push(@tag,$1);
  513. $tag{$1}=-1;
  514. }
  515. } else {
  516. print STDERR "Warning: $file: complicated expression: $_" if $debug; # because it is O...
  517. print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
  518. push(@tag,$1);
  519. $tag{$1}=-1;
  520. }
  521. } elsif (/^\#\s*ifdef\s+(\S*)/) {
  522. push(@tag,"-");
  523. push(@tag,$1);
  524. $tag{$1}=1;
  525. print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
  526. } elsif (/^\#\s*if\s+defined\(([^\)]+)\)/) {
  527. push(@tag,"-");
  528. if (/^\#\s*if\s+(defined\(([^\)]+)\)(\s+\|\|\s+defined\(([^\)]+)\))*)$/) {
  529. my $tmp_1 = $1;
  530. my $tmp_;
  531. foreach $tmp_ (split '\|\|',$tmp_1) {
  532. $tmp_ =~ /defined\(([^\)]+)\)/;
  533. print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
  534. push(@tag,$1);
  535. $tag{$1}=1;
  536. }
  537. } else {
  538. print STDERR "Warning: $file: complicated expression: $_\n" if $debug; # because it is O...
  539. print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
  540. push(@tag,$1);
  541. $tag{$1}=1;
  542. }
  543. } elsif (/^\#\s*error\s+(\w+) is disabled\./) {
  544. my $tag_i = $#tag;
  545. while($tag[$tag_i] ne "-") {
  546. if ($tag[$tag_i] eq "OPENSSL_NO_".$1) {
  547. $tag{$tag[$tag_i]}=2;
  548. print STDERR "DEBUG: $file: chaged tag $1 = 2\n" if $debug;
  549. }
  550. $tag_i--;
  551. }
  552. } elsif (/^\#\s*endif/) {
  553. my $tag_i = $#tag;
  554. while($tag_i > 0 && $tag[$tag_i] ne "-") {
  555. my $t=$tag[$tag_i];
  556. print STDERR "DEBUG: \$t=\"$t\"\n" if $debug;
  557. if ($tag{$t}==2) {
  558. $tag{$t}=-1;
  559. } else {
  560. $tag{$t}=0;
  561. }
  562. print STDERR "DEBUG: $file: changed tag ",$t," = ",$tag{$t},"\n" if $debug;
  563. pop(@tag);
  564. if ($t =~ /^OPENSSL_NO_([A-Z0-9_]+)$/) {
  565. $t=$1;
  566. } else {
  567. $t="";
  568. }
  569. if ($t ne ""
  570. && !grep(/^$t$/, @known_algorithms)) {
  571. $unknown_algorithms{$t} = 1;
  572. #print STDERR "DEBUG: Added as unknown algorithm: $t\n" if $debug;
  573. }
  574. $tag_i--;
  575. }
  576. pop(@tag);
  577. } elsif (/^\#\s*else/) {
  578. my $tag_i = $#tag;
  579. while($tag[$tag_i] ne "-") {
  580. my $t=$tag[$tag_i];
  581. $tag{$t}= -$tag{$t};
  582. print STDERR "DEBUG: $file: changed tag ",$t," = ",$tag{$t},"\n" if $debug;
  583. $tag_i--;
  584. }
  585. } elsif (/^\#\s*if\s+1/) {
  586. push(@tag,"-");
  587. # Dummy tag
  588. push(@tag,"TRUE");
  589. $tag{"TRUE"}=1;
  590. print STDERR "DEBUG: $file: found 1\n" if $debug;
  591. } elsif (/^\#\s*if\s+0/) {
  592. push(@tag,"-");
  593. # Dummy tag
  594. push(@tag,"TRUE");
  595. $tag{"TRUE"}=-1;
  596. print STDERR "DEBUG: $file: found 0\n" if $debug;
  597. } elsif (/^\#\s*define\s+(\w+)\s+(\w+)/
  598. && $symhacking && $tag{'TRUE'} != -1) {
  599. # This is for aliasing. When we find an alias,
  600. # we have to invert
  601. &$make_variant($1,$2);
  602. print STDERR "DEBUG: $file: defined $1 = $2\n" if $debug;
  603. }
  604. if (/^\#/) {
  605. @current_platforms =
  606. grep(!/^$/,
  607. map { $tag{$_} == 1 ? $_ :
  608. $tag{$_} == -1 ? "!".$_ : "" }
  609. @known_platforms);
  610. push @current_platforms
  611. , grep(!/^$/,
  612. map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ :
  613. $tag{"OPENSSL_SYS_".$_} == -1 ? "!".$_ : "" }
  614. @known_ossl_platforms);
  615. @current_algorithms =
  616. grep(!/^$/,
  617. map { $tag{"OPENSSL_NO_".$_} == -1 ? $_ : "" }
  618. @known_algorithms);
  619. $def .=
  620. "#INFO:"
  621. .join(',',@current_platforms).":"
  622. .join(',',@current_algorithms).";";
  623. next;
  624. }
  625. if ($tag{'TRUE'} != -1) {
  626. if (/^\s*DECLARE_STACK_OF\s*\(\s*(\w*)\s*\)/) {
  627. next;
  628. } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) {
  629. $def .= "int d2i_$3(void);";
  630. $def .= "int i2d_$3(void);";
  631. # Variant for platforms that do not
  632. # have to access globale variables
  633. # in shared libraries through functions
  634. $def .=
  635. "#INFO:"
  636. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  637. .join(',',@current_algorithms).";";
  638. $def .= "OPENSSL_EXTERN int $2_it;";
  639. $def .=
  640. "#INFO:"
  641. .join(',',@current_platforms).":"
  642. .join(',',@current_algorithms).";";
  643. # Variant for platforms that have to
  644. # access globale variables in shared
  645. # libraries through functions
  646. &$make_variant("$2_it","$2_it",
  647. "EXPORT_VAR_AS_FUNCTION",
  648. "FUNCTION");
  649. next;
  650. } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_fname\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) {
  651. $def .= "int d2i_$3(void);";
  652. $def .= "int i2d_$3(void);";
  653. $def .= "int $3_free(void);";
  654. $def .= "int $3_new(void);";
  655. # Variant for platforms that do not
  656. # have to access globale variables
  657. # in shared libraries through functions
  658. $def .=
  659. "#INFO:"
  660. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  661. .join(',',@current_algorithms).";";
  662. $def .= "OPENSSL_EXTERN int $2_it;";
  663. $def .=
  664. "#INFO:"
  665. .join(',',@current_platforms).":"
  666. .join(',',@current_algorithms).";";
  667. # Variant for platforms that have to
  668. # access globale variables in shared
  669. # libraries through functions
  670. &$make_variant("$2_it","$2_it",
  671. "EXPORT_VAR_AS_FUNCTION",
  672. "FUNCTION");
  673. next;
  674. } elsif (/^\s*DECLARE_ASN1_FUNCTIONS\s*\(\s*(\w*)\s*\)/ ||
  675. /^\s*DECLARE_ASN1_FUNCTIONS_const\s*\(\s*(\w*)\s*\)/) {
  676. $def .= "int d2i_$1(void);";
  677. $def .= "int i2d_$1(void);";
  678. $def .= "int $1_free(void);";
  679. $def .= "int $1_new(void);";
  680. # Variant for platforms that do not
  681. # have to access globale variables
  682. # in shared libraries through functions
  683. $def .=
  684. "#INFO:"
  685. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  686. .join(',',@current_algorithms).";";
  687. $def .= "OPENSSL_EXTERN int $1_it;";
  688. $def .=
  689. "#INFO:"
  690. .join(',',@current_platforms).":"
  691. .join(',',@current_algorithms).";";
  692. # Variant for platforms that have to
  693. # access globale variables in shared
  694. # libraries through functions
  695. &$make_variant("$1_it","$1_it",
  696. "EXPORT_VAR_AS_FUNCTION",
  697. "FUNCTION");
  698. next;
  699. } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS_const\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
  700. $def .= "int d2i_$2(void);";
  701. $def .= "int i2d_$2(void);";
  702. # Variant for platforms that do not
  703. # have to access globale variables
  704. # in shared libraries through functions
  705. $def .=
  706. "#INFO:"
  707. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  708. .join(',',@current_algorithms).";";
  709. $def .= "OPENSSL_EXTERN int $2_it;";
  710. $def .=
  711. "#INFO:"
  712. .join(',',@current_platforms).":"
  713. .join(',',@current_algorithms).";";
  714. # Variant for platforms that have to
  715. # access globale variables in shared
  716. # libraries through functions
  717. &$make_variant("$2_it","$2_it",
  718. "EXPORT_VAR_AS_FUNCTION",
  719. "FUNCTION");
  720. next;
  721. } elsif (/^\s*DECLARE_ASN1_ALLOC_FUNCTIONS\s*\(\s*(\w*)\s*\)/) {
  722. $def .= "int $1_free(void);";
  723. $def .= "int $1_new(void);";
  724. next;
  725. } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
  726. $def .= "int d2i_$2(void);";
  727. $def .= "int i2d_$2(void);";
  728. $def .= "int $2_free(void);";
  729. $def .= "int $2_new(void);";
  730. # Variant for platforms that do not
  731. # have to access globale variables
  732. # in shared libraries through functions
  733. $def .=
  734. "#INFO:"
  735. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  736. .join(',',@current_algorithms).";";
  737. $def .= "OPENSSL_EXTERN int $2_it;";
  738. $def .=
  739. "#INFO:"
  740. .join(',',@current_platforms).":"
  741. .join(',',@current_algorithms).";";
  742. # Variant for platforms that have to
  743. # access globale variables in shared
  744. # libraries through functions
  745. &$make_variant("$2_it","$2_it",
  746. "EXPORT_VAR_AS_FUNCTION",
  747. "FUNCTION");
  748. next;
  749. } elsif (/^\s*DECLARE_ASN1_ITEM\s*\(\s*(\w*)\s*\)/) {
  750. # Variant for platforms that do not
  751. # have to access globale variables
  752. # in shared libraries through functions
  753. $def .=
  754. "#INFO:"
  755. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  756. .join(',',@current_algorithms).";";
  757. $def .= "OPENSSL_EXTERN int $1_it;";
  758. $def .=
  759. "#INFO:"
  760. .join(',',@current_platforms).":"
  761. .join(',',@current_algorithms).";";
  762. # Variant for platforms that have to
  763. # access globale variables in shared
  764. # libraries through functions
  765. &$make_variant("$1_it","$1_it",
  766. "EXPORT_VAR_AS_FUNCTION",
  767. "FUNCTION");
  768. next;
  769. } elsif (/^\s*DECLARE_ASN1_NDEF_FUNCTION\s*\(\s*(\w*)\s*\)/) {
  770. $def .= "int i2d_$1_NDEF(void);";
  771. } elsif (/^\s*DECLARE_ASN1_SET_OF\s*\(\s*(\w*)\s*\)/) {
  772. next;
  773. } elsif (/^\s*DECLARE_ASN1_PRINT_FUNCTION\s*\(\s*(\w*)\s*\)/) {
  774. $def .= "int $1_print_ctx(void);";
  775. next;
  776. } elsif (/^\s*DECLARE_ASN1_PRINT_FUNCTION_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
  777. $def .= "int $2_print_ctx(void);";
  778. next;
  779. } elsif (/^\s*DECLARE_PKCS12_STACK_OF\s*\(\s*(\w*)\s*\)/) {
  780. next;
  781. } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ ||
  782. /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ ||
  783. /^DECLARE_PEM_rw_const\s*\(\s*(\w*)\s*,/ ) {
  784. # Things not in Win16
  785. $def .=
  786. "#INFO:"
  787. .join(',',"!WIN16",@current_platforms).":"
  788. .join(',',@current_algorithms).";";
  789. $def .= "int PEM_read_$1(void);";
  790. $def .= "int PEM_write_$1(void);";
  791. $def .=
  792. "#INFO:"
  793. .join(',',@current_platforms).":"
  794. .join(',',@current_algorithms).";";
  795. # Things that are everywhere
  796. $def .= "int PEM_read_bio_$1(void);";
  797. $def .= "int PEM_write_bio_$1(void);";
  798. next;
  799. } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ ||
  800. /^DECLARE_PEM_write_const\s*\(\s*(\w*)\s*,/ ||
  801. /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) {
  802. # Things not in Win16
  803. $def .=
  804. "#INFO:"
  805. .join(',',"!WIN16",@current_platforms).":"
  806. .join(',',@current_algorithms).";";
  807. $def .= "int PEM_write_$1(void);";
  808. $def .=
  809. "#INFO:"
  810. .join(',',@current_platforms).":"
  811. .join(',',@current_algorithms).";";
  812. # Things that are everywhere
  813. $def .= "int PEM_write_bio_$1(void);";
  814. next;
  815. } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ ||
  816. /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) {
  817. # Things not in Win16
  818. $def .=
  819. "#INFO:"
  820. .join(',',"!WIN16",@current_platforms).":"
  821. .join(',',@current_algorithms).";";
  822. $def .= "int PEM_read_$1(void);";
  823. $def .=
  824. "#INFO:"
  825. .join(',',@current_platforms).":"
  826. .join(',',@current_algorithms).";";
  827. # Things that are everywhere
  828. $def .= "int PEM_read_bio_$1(void);";
  829. next;
  830. } elsif (/^OPENSSL_DECLARE_GLOBAL\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
  831. # Variant for platforms that do not
  832. # have to access globale variables
  833. # in shared libraries through functions
  834. $def .=
  835. "#INFO:"
  836. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  837. .join(',',@current_algorithms).";";
  838. $def .= "OPENSSL_EXTERN int _shadow_$2;";
  839. $def .=
  840. "#INFO:"
  841. .join(',',@current_platforms).":"
  842. .join(',',@current_algorithms).";";
  843. # Variant for platforms that have to
  844. # access globale variables in shared
  845. # libraries through functions
  846. &$make_variant("_shadow_$2","_shadow_$2",
  847. "EXPORT_VAR_AS_FUNCTION",
  848. "FUNCTION");
  849. } elsif ($tag{'CONST_STRICT'} != 1) {
  850. if (/\{|\/\*|\([^\)]*$/) {
  851. $line = $_;
  852. } else {
  853. $def .= $_;
  854. }
  855. }
  856. }
  857. }
  858. close(IN);
  859. my $algs;
  860. my $plays;
  861. print STDERR "DEBUG: postprocessing ----------\n" if $debug;
  862. foreach (split /;/, $def) {
  863. my $s; my $k = "FUNCTION"; my $p; my $a;
  864. s/^[\n\s]*//g;
  865. s/[\n\s]*$//g;
  866. next if(/\#undef/);
  867. next if(/typedef\W/);
  868. next if(/\#define/);
  869. # Reduce argument lists to empty ()
  870. # fold round brackets recursively: (t(*v)(t),t) -> (t{}{},t) -> {}
  871. while(/\(.*\)/s) {
  872. s/\([^\(\)]+\)/\{\}/gs;
  873. s/\(\s*\*\s*(\w+)\s*\{\}\s*\)/$1/gs; #(*f{}) -> f
  874. }
  875. # pretend as we didn't use curly braces: {} -> ()
  876. s/\{\}/\(\)/gs;
  877. s/STACK_OF\(\)/void/gs;
  878. s/LHASH_OF\(\)/void/gs;
  879. print STDERR "DEBUG: \$_ = \"$_\"\n" if $debug;
  880. if (/^\#INFO:([^:]*):(.*)$/) {
  881. $plats = $1;
  882. $algs = $2;
  883. print STDERR "DEBUG: found info on platforms ($plats) and algorithms ($algs)\n" if $debug;
  884. next;
  885. } elsif (/^\s*OPENSSL_EXTERN\s.*?(\w+(\{[0-9]+\})?)(\[[0-9]*\])*\s*$/) {
  886. $s = $1;
  887. $k = "VARIABLE";
  888. print STDERR "DEBUG: found external variable $s\n" if $debug;
  889. } elsif (/TYPEDEF_\w+_OF/s) {
  890. next;
  891. } elsif (/(\w+)\s*\(\).*/s) { # first token prior [first] () is
  892. $s = $1; # a function name!
  893. print STDERR "DEBUG: found function $s\n" if $debug;
  894. } elsif (/\(/ and not (/=/)) {
  895. print STDERR "File $file: cannot parse: $_;\n";
  896. next;
  897. } else {
  898. next;
  899. }
  900. $syms{$s} = 1;
  901. $kind{$s} = $k;
  902. $p = $plats;
  903. $a = $algs;
  904. $a .= ",BF" if($s =~ /EVP_bf/);
  905. $a .= ",CAST" if($s =~ /EVP_cast/);
  906. $a .= ",DES" if($s =~ /EVP_des/);
  907. $a .= ",DSA" if($s =~ /EVP_dss/);
  908. $a .= ",IDEA" if($s =~ /EVP_idea/);
  909. $a .= ",MD2" if($s =~ /EVP_md2/);
  910. $a .= ",MD4" if($s =~ /EVP_md4/);
  911. $a .= ",MD5" if($s =~ /EVP_md5/);
  912. $a .= ",RC2" if($s =~ /EVP_rc2/);
  913. $a .= ",RC4" if($s =~ /EVP_rc4/);
  914. $a .= ",RC5" if($s =~ /EVP_rc5/);
  915. $a .= ",RIPEMD" if($s =~ /EVP_ripemd/);
  916. $a .= ",SHA" if($s =~ /EVP_sha/);
  917. $a .= ",RSA" if($s =~ /EVP_(Open|Seal)(Final|Init)/);
  918. $a .= ",RSA" if($s =~ /PEM_Seal(Final|Init|Update)/);
  919. $a .= ",RSA" if($s =~ /RSAPrivateKey/);
  920. $a .= ",RSA" if($s =~ /SSLv23?_((client|server)_)?method/);
  921. $platform{$s} =
  922. &reduce_platforms((defined($platform{$s})?$platform{$s}.',':"").$p);
  923. $algorithm{$s} .= ','.$a;
  924. if (defined($variant{$s})) {
  925. foreach $v (split /;/,$variant{$s}) {
  926. (my $r, my $p, my $k) = split(/:/,$v);
  927. my $ip = join ',',map({ /^!(.*)$/ ? $1 : "!".$_ } split /,/, $p);
  928. $syms{$r} = 1;
  929. if (!defined($k)) { $k = $kind{$s}; }
  930. $kind{$r} = $k."(".$s.")";
  931. $algorithm{$r} = $algorithm{$s};
  932. $platform{$r} = &reduce_platforms($platform{$s}.",".$p.",".$p);
  933. $platform{$s} = &reduce_platforms($platform{$s}.','.$ip.','.$ip);
  934. print STDERR "DEBUG: \$variant{\"$s\"} = ",$v,"; \$r = $r; \$p = ",$platform{$r},"; \$a = ",$algorithm{$r},"; \$kind = ",$kind{$r},"\n" if $debug;
  935. }
  936. }
  937. print STDERR "DEBUG: \$s = $s; \$p = ",$platform{$s},"; \$a = ",$algorithm{$s},"; \$kind = ",$kind{$s},"\n" if $debug;
  938. }
  939. }
  940. # Prune the returned symbols
  941. delete $syms{"bn_dump1"};
  942. $platform{"BIO_s_log"} .= ",!WIN32,!WIN16,!macintosh";
  943. $platform{"PEM_read_NS_CERT_SEQ"} = "VMS";
  944. $platform{"PEM_write_NS_CERT_SEQ"} = "VMS";
  945. $platform{"PEM_read_P8_PRIV_KEY_INFO"} = "VMS";
  946. $platform{"PEM_write_P8_PRIV_KEY_INFO"} = "VMS";
  947. $platform{"EVP_sha384"} = "!VMSVAX";
  948. $platform{"EVP_sha512"} = "!VMSVAX";
  949. $platform{"SHA384_Init"} = "!VMSVAX";
  950. $platform{"SHA384_Transform"} = "!VMSVAX";
  951. $platform{"SHA384_Update"} = "!VMSVAX";
  952. $platform{"SHA384_Final"} = "!VMSVAX";
  953. $platform{"SHA384"} = "!VMSVAX";
  954. $platform{"SHA512_Init"} = "!VMSVAX";
  955. $platform{"SHA512_Transform"} = "!VMSVAX";
  956. $platform{"SHA512_Update"} = "!VMSVAX";
  957. $platform{"SHA512_Final"} = "!VMSVAX";
  958. $platform{"SHA512"} = "!VMSVAX";
  959. $platform{"WHIRLPOOL_Init"} = "!VMSVAX";
  960. $platform{"WHIRLPOOL"} = "!VMSVAX";
  961. $platform{"WHIRLPOOL_BitUpdate"} = "!VMSVAX";
  962. $platform{"EVP_whirlpool"} = "!VMSVAX";
  963. $platform{"WHIRLPOOL_Final"} = "!VMSVAX";
  964. $platform{"WHIRLPOOL_Update"} = "!VMSVAX";
  965. # Info we know about
  966. push @ret, map { $_."\\".&info_string($_,"EXIST",
  967. $platform{$_},
  968. $kind{$_},
  969. $algorithm{$_}) } keys %syms;
  970. if (keys %unknown_algorithms) {
  971. print STDERR "WARNING: mkdef.pl doesn't know the following algorithms:\n";
  972. print STDERR "\t",join("\n\t",keys %unknown_algorithms),"\n";
  973. }
  974. return(@ret);
  975. }
  976. # Param: string of comma-separated platform-specs.
  977. sub reduce_platforms
  978. {
  979. my ($platforms) = @_;
  980. my $pl = defined($platforms) ? $platforms : "";
  981. my %p = map { $_ => 0 } split /,/, $pl;
  982. my $ret;
  983. print STDERR "DEBUG: Entered reduce_platforms with \"$platforms\"\n"
  984. if $debug;
  985. # We do this, because if there's code like the following, it really
  986. # means the function exists in all cases and should therefore be
  987. # everywhere. By increasing and decreasing, we may attain 0:
  988. #
  989. # ifndef WIN16
  990. # int foo();
  991. # else
  992. # int _fat foo();
  993. # endif
  994. foreach $platform (split /,/, $pl) {
  995. if ($platform =~ /^!(.*)$/) {
  996. $p{$1}--;
  997. } else {
  998. $p{$platform}++;
  999. }
  1000. }
  1001. foreach $platform (keys %p) {
  1002. if ($p{$platform} == 0) { delete $p{$platform}; }
  1003. }
  1004. delete $p{""};
  1005. $ret = join(',',sort(map { $p{$_} < 0 ? "!".$_ : $_ } keys %p));
  1006. print STDERR "DEBUG: Exiting reduce_platforms with \"$ret\"\n"
  1007. if $debug;
  1008. return $ret;
  1009. }
  1010. sub info_string {
  1011. (my $symbol, my $exist, my $platforms, my $kind, my $algorithms) = @_;
  1012. my %a = defined($algorithms) ?
  1013. map { $_ => 1 } split /,/, $algorithms : ();
  1014. my $k = defined($kind) ? $kind : "FUNCTION";
  1015. my $ret;
  1016. my $p = &reduce_platforms($platforms);
  1017. delete $a{""};
  1018. $ret = $exist;
  1019. $ret .= ":".$p;
  1020. $ret .= ":".$k;
  1021. $ret .= ":".join(',',sort keys %a);
  1022. return $ret;
  1023. }
  1024. sub maybe_add_info {
  1025. (my $name, *nums, my @symbols) = @_;
  1026. my $sym;
  1027. my $new_info = 0;
  1028. my %syms=();
  1029. print STDERR "Updating $name info\n";
  1030. foreach $sym (@symbols) {
  1031. (my $s, my $i) = split /\\/, $sym;
  1032. if (defined($nums{$s})) {
  1033. $i =~ s/^(.*?:.*?:\w+)(\(\w+\))?/$1/;
  1034. (my $n, my $dummy) = split /\\/, $nums{$s};
  1035. if (!defined($dummy) || $i ne $dummy) {
  1036. $nums{$s} = $n."\\".$i;
  1037. $new_info++;
  1038. print STDERR "DEBUG: maybe_add_info for $s: \"$dummy\" => \"$i\"\n" if $debug;
  1039. }
  1040. }
  1041. $syms{$s} = 1;
  1042. }
  1043. my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums;
  1044. foreach $sym (@s) {
  1045. (my $n, my $i) = split /\\/, $nums{$sym};
  1046. if (!defined($syms{$sym}) && $i !~ /^NOEXIST:/) {
  1047. $new_info++;
  1048. print STDERR "DEBUG: maybe_add_info for $sym: -> undefined\n" if $debug;
  1049. }
  1050. }
  1051. if ($new_info) {
  1052. print STDERR "$new_info old symbols got an info update\n";
  1053. if (!$do_rewrite) {
  1054. print STDERR "You should do a rewrite to fix this.\n";
  1055. }
  1056. } else {
  1057. print STDERR "No old symbols needed info update\n";
  1058. }
  1059. }
  1060. # Param: string of comma-separated keywords, each possibly prefixed with a "!"
  1061. sub is_valid
  1062. {
  1063. my ($keywords_txt,$platforms) = @_;
  1064. my (@keywords) = split /,/,$keywords_txt;
  1065. my ($falsesum, $truesum) = (0, 1);
  1066. # Param: one keyword
  1067. sub recognise
  1068. {
  1069. my ($keyword,$platforms) = @_;
  1070. if ($platforms) {
  1071. # platforms
  1072. if ($keyword eq "VMSVAX" && $VMSVAX) { return 1; }
  1073. if ($keyword eq "VMSNonVAX" && $VMSNonVAX) { return 1; }
  1074. if ($keyword eq "VMS" && $VMS) { return 1; }
  1075. if ($keyword eq "WIN32" && $W32) { return 1; }
  1076. if ($keyword eq "WIN16" && $W16) { return 1; }
  1077. if ($keyword eq "WINNT" && $NT) { return 1; }
  1078. if ($keyword eq "OS2" && $OS2) { return 1; }
  1079. # Special platforms:
  1080. # EXPORT_VAR_AS_FUNCTION means that global variables
  1081. # will be represented as functions. This currently
  1082. # only happens on VMS-VAX.
  1083. if ($keyword eq "EXPORT_VAR_AS_FUNCTION" && ($VMSVAX || $W32 || $W16)) {
  1084. return 1;
  1085. }
  1086. if ($keyword eq "OPENSSL_FIPS" && $fips) {
  1087. return 1;
  1088. }
  1089. if ($keyword eq "ZLIB" && $zlib) { return 1; }
  1090. return 0;
  1091. } else {
  1092. # algorithms
  1093. if ($keyword eq "RC2" && $no_rc2) { return 0; }
  1094. if ($keyword eq "RC4" && $no_rc4) { return 0; }
  1095. if ($keyword eq "RC5" && $no_rc5) { return 0; }
  1096. if ($keyword eq "IDEA" && $no_idea) { return 0; }
  1097. if ($keyword eq "DES" && $no_des) { return 0; }
  1098. if ($keyword eq "BF" && $no_bf) { return 0; }
  1099. if ($keyword eq "CAST" && $no_cast) { return 0; }
  1100. if ($keyword eq "MD2" && $no_md2) { return 0; }
  1101. if ($keyword eq "MD4" && $no_md4) { return 0; }
  1102. if ($keyword eq "MD5" && $no_md5) { return 0; }
  1103. if ($keyword eq "SHA" && $no_sha) { return 0; }
  1104. if ($keyword eq "RIPEMD" && $no_ripemd) { return 0; }
  1105. if ($keyword eq "MDC2" && $no_mdc2) { return 0; }
  1106. if ($keyword eq "WHIRLPOOL" && $no_whirlpool) { return 0; }
  1107. if ($keyword eq "RSA" && $no_rsa) { return 0; }
  1108. if ($keyword eq "DSA" && $no_dsa) { return 0; }
  1109. if ($keyword eq "DH" && $no_dh) { return 0; }
  1110. if ($keyword eq "EC" && $no_ec) { return 0; }
  1111. if ($keyword eq "ECDSA" && $no_ecdsa) { return 0; }
  1112. if ($keyword eq "ECDH" && $no_ecdh) { return 0; }
  1113. if ($keyword eq "HMAC" && $no_hmac) { return 0; }
  1114. if ($keyword eq "AES" && $no_aes) { return 0; }
  1115. if ($keyword eq "CAMELLIA" && $no_camellia) { return 0; }
  1116. if ($keyword eq "SEED" && $no_seed) { return 0; }
  1117. if ($keyword eq "EVP" && $no_evp) { return 0; }
  1118. if ($keyword eq "LHASH" && $no_lhash) { return 0; }
  1119. if ($keyword eq "STACK" && $no_stack) { return 0; }
  1120. if ($keyword eq "ERR" && $no_err) { return 0; }
  1121. if ($keyword eq "BUFFER" && $no_buffer) { return 0; }
  1122. if ($keyword eq "BIO" && $no_bio) { return 0; }
  1123. if ($keyword eq "COMP" && $no_comp) { return 0; }
  1124. if ($keyword eq "DSO" && $no_dso) { return 0; }
  1125. if ($keyword eq "KRB5" && $no_krb5) { return 0; }
  1126. if ($keyword eq "ENGINE" && $no_engine) { return 0; }
  1127. if ($keyword eq "HW" && $no_hw) { return 0; }
  1128. if ($keyword eq "FP_API" && $no_fp_api) { return 0; }
  1129. if ($keyword eq "STATIC_ENGINE" && $no_static_engine) { return 0; }
  1130. if ($keyword eq "GMP" && $no_gmp) { return 0; }
  1131. if ($keyword eq "RFC3779" && $no_rfc3779) { return 0; }
  1132. if ($keyword eq "TLSEXT" && $no_tlsext) { return 0; }
  1133. if ($keyword eq "PSK" && $no_psk) { return 0; }
  1134. if ($keyword eq "CMS" && $no_cms) { return 0; }
  1135. if ($keyword eq "EC2M" && $no_ec2m) { return 0; }
  1136. if ($keyword eq "NEXTPROTONEG" && $no_nextprotoneg) { return 0; }
  1137. if ($keyword eq "EC_NISTP_64_GCC_128" && $no_nistp_gcc)
  1138. { return 0; }
  1139. if ($keyword eq "SSL2" && $no_ssl2) { return 0; }
  1140. if ($keyword eq "SSL2_METHOD" && $no_ssl2_method) { return 0; }
  1141. if ($keyword eq "SSL3_METHOD" && $no_ssl3_method) { return 0; }
  1142. if ($keyword eq "SSL_TRACE" && $no_ssl_trace) { return 0; }
  1143. if ($keyword eq "CAPIENG" && $no_capieng) { return 0; }
  1144. if ($keyword eq "JPAKE" && $no_jpake) { return 0; }
  1145. if ($keyword eq "SRP" && $no_srp) { return 0; }
  1146. if ($keyword eq "SCTP" && $no_sctp) { return 0; }
  1147. if ($keyword eq "SRTP" && $no_srtp) { return 0; }
  1148. if ($keyword eq "UNIT_TEST" && $no_unit_test) { return 0; }
  1149. if ($keyword eq "DEPRECATED" && $no_deprecated) { return 0; }
  1150. # Nothing recognise as true
  1151. return 1;
  1152. }
  1153. }
  1154. foreach $k (@keywords) {
  1155. if ($k =~ /^!(.*)$/) {
  1156. $falsesum += &recognise($1,$platforms);
  1157. } else {
  1158. $truesum *= &recognise($k,$platforms);
  1159. }
  1160. }
  1161. print STDERR "DEBUG: [",$#keywords,",",$#keywords < 0,"] is_valid($keywords_txt) => (\!$falsesum) && $truesum = ",(!$falsesum) && $truesum,"\n" if $debug;
  1162. return (!$falsesum) && $truesum;
  1163. }
  1164. sub print_test_file
  1165. {
  1166. (*OUT,my $name,*nums,my $testall,my @symbols)=@_;
  1167. my $n = 1; my @e; my @r;
  1168. my $sym; my $prev = ""; my $prefSSLeay;
  1169. (@e)=grep(/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols);
  1170. (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:.*/ && !/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols);
  1171. @symbols=((sort @e),(sort @r));
  1172. foreach $sym (@symbols) {
  1173. (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
  1174. my $v = 0;
  1175. $v = 1 if $i=~ /^.*?:.*?:VARIABLE/;
  1176. my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
  1177. my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
  1178. if (!defined($nums{$s})) {
  1179. print STDERR "Warning: $s does not have a number assigned\n"
  1180. if(!$do_update);
  1181. } elsif (is_valid($p,1) && is_valid($a,0)) {
  1182. my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1);
  1183. if ($prev eq $s2) {
  1184. print OUT "\t/* The following has already appeared previously */\n";
  1185. print STDERR "Warning: Symbol '",$s2,"' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n";
  1186. }
  1187. $prev = $s2; # To warn about duplicates...
  1188. ($nn,$ni)=($nums{$s2} =~ /^(.*?)\\(.*)$/);
  1189. if ($v) {
  1190. print OUT "\textern int $s2; /* type unknown */ /* $nn $ni */\n";
  1191. } else {
  1192. print OUT "\textern int $s2(); /* type unknown */ /* $nn $ni */\n";
  1193. }
  1194. }
  1195. }
  1196. }
  1197. sub get_version {
  1198. local *MF;
  1199. my $v = '?';
  1200. open MF, 'Makefile' or return $v;
  1201. while (<MF>) {
  1202. $v = $1, last if /^VERSION=(.*?)\s*$/;
  1203. }
  1204. close MF;
  1205. return $v;
  1206. }
  1207. sub print_def_file
  1208. {
  1209. (*OUT,my $name,*nums,my @symbols)=@_;
  1210. my $n = 1; my @e; my @r; my @v; my $prev="";
  1211. my $liboptions="";
  1212. my $libname = $name;
  1213. my $http_vendor = 'www.openssl.org/';
  1214. my $version = get_version();
  1215. my $what = "OpenSSL: implementation of Secure Socket Layer";
  1216. my $description = "$what $version, $name - http://$http_vendor";
  1217. if ($W32)
  1218. { $libname.="32"; }
  1219. elsif ($W16)
  1220. { $libname.="16"; }
  1221. elsif ($OS2)
  1222. { # DLL names should not clash on the whole system.
  1223. # However, they should not have any particular relationship
  1224. # to the name of the static library. Chose descriptive names
  1225. # (must be at most 8 chars).
  1226. my %translate = (ssl => 'open_ssl', crypto => 'cryptssl');
  1227. $libname = $translate{$name} || $name;
  1228. $liboptions = <<EOO;
  1229. INITINSTANCE
  1230. DATA MULTIPLE NONSHARED
  1231. EOO
  1232. # Vendor field can't contain colon, drat; so we omit http://
  1233. $description = "\@#$http_vendor:$version#\@$what; DLL for library $name. Build for EMX -Zmtd";
  1234. }
  1235. print OUT <<"EOF";
  1236. ;
  1237. ; Definition file for the DLL version of the $name library from OpenSSL
  1238. ;
  1239. LIBRARY $libname $liboptions
  1240. EOF
  1241. if ($W16) {
  1242. print <<"EOF";
  1243. CODE PRELOAD MOVEABLE
  1244. DATA PRELOAD MOVEABLE SINGLE
  1245. EXETYPE WINDOWS
  1246. HEAPSIZE 4096
  1247. STACKSIZE 8192
  1248. EOF
  1249. }
  1250. print "EXPORTS\n";
  1251. (@e)=grep(/^SSLeay(\{[0-9]+\})?\\.*?:.*?:FUNCTION/,@symbols);
  1252. (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:FUNCTION/ && !/^SSLeay(\{[0-9]+\})?\\.*?:.*?:FUNCTION/,@symbols);
  1253. (@v)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:VARIABLE/,@symbols);
  1254. @symbols=((sort @e),(sort @r), (sort @v));
  1255. foreach $sym (@symbols) {
  1256. (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
  1257. my $v = 0;
  1258. $v = 1 if $i =~ /^.*?:.*?:VARIABLE/;
  1259. if (!defined($nums{$s})) {
  1260. printf STDERR "Warning: $s does not have a number assigned\n"
  1261. if(!$do_update);
  1262. } else {
  1263. (my $n, my $dummy) = split /\\/, $nums{$s};
  1264. my %pf = ();
  1265. my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
  1266. my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
  1267. if (is_valid($p,1) && is_valid($a,0)) {
  1268. my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1);
  1269. if ($prev eq $s2) {
  1270. print STDERR "Warning: Symbol '",$s2,"' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n";
  1271. }
  1272. $prev = $s2; # To warn about duplicates...
  1273. if($v && !$OS2) {
  1274. printf OUT " %s%-39s @%-8d DATA\n",($W32)?"":"_",$s2,$n;
  1275. } else {
  1276. printf OUT " %s%-39s @%d\n",($W32||$OS2)?"":"_",$s2,$n;
  1277. }
  1278. }
  1279. }
  1280. }
  1281. printf OUT "\n";
  1282. }
  1283. sub load_numbers
  1284. {
  1285. my($name)=@_;
  1286. my(@a,%ret);
  1287. $max_num = 0;
  1288. $num_noinfo = 0;
  1289. $prev = "";
  1290. $prev_cnt = 0;
  1291. open(IN,"<$name") || die "unable to open $name:$!\n";
  1292. while (<IN>) {
  1293. chop;
  1294. s/#.*$//;
  1295. next if /^\s*$/;
  1296. @a=split;
  1297. if (defined $ret{$a[0]}) {
  1298. # This is actually perfectly OK
  1299. #print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n";
  1300. }
  1301. if ($max_num > $a[1]) {
  1302. print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n";
  1303. }
  1304. elsif ($max_num == $a[1]) {
  1305. # This is actually perfectly OK
  1306. #print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n";
  1307. if ($a[0] eq $prev) {
  1308. $prev_cnt++;
  1309. $a[0] .= "{$prev_cnt}";
  1310. }
  1311. }
  1312. else {
  1313. $prev_cnt = 0;
  1314. }
  1315. if ($#a < 2) {
  1316. # Existence will be proven later, in do_defs
  1317. $ret{$a[0]}=$a[1];
  1318. $num_noinfo++;
  1319. } else {
  1320. $ret{$a[0]}=$a[1]."\\".$a[2]; # \\ is a special marker
  1321. }
  1322. $max_num = $a[1] if $a[1] > $max_num;
  1323. $prev=$a[0];
  1324. }
  1325. if ($num_noinfo) {
  1326. print STDERR "Warning: $num_noinfo symbols were without info.";
  1327. if ($do_rewrite) {
  1328. printf STDERR " The rewrite will fix this.\n";
  1329. } else {
  1330. printf STDERR " You should do a rewrite to fix this.\n";
  1331. }
  1332. }
  1333. close(IN);
  1334. return(%ret);
  1335. }
  1336. sub parse_number
  1337. {
  1338. (my $str, my $what) = @_;
  1339. (my $n, my $i) = split(/\\/,$str);
  1340. if ($what eq "n") {
  1341. return $n;
  1342. } else {
  1343. return $i;
  1344. }
  1345. }
  1346. sub rewrite_numbers
  1347. {
  1348. (*OUT,$name,*nums,@symbols)=@_;
  1349. my $thing;
  1350. print STDERR "Rewriting $name\n";
  1351. my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols);
  1352. my $r; my %r; my %rsyms;
  1353. foreach $r (@r) {
  1354. (my $s, my $i) = split /\\/, $r;
  1355. my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/;
  1356. $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/;
  1357. $r{$a} = $s."\\".$i;
  1358. $rsyms{$s} = 1;
  1359. }
  1360. my %syms = ();
  1361. foreach $_ (@symbols) {
  1362. (my $n, my $i) = split /\\/;
  1363. $syms{$n} = 1;
  1364. }
  1365. my @s=sort {
  1366. &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n")
  1367. || $a cmp $b
  1368. } keys %nums;
  1369. foreach $sym (@s) {
  1370. (my $n, my $i) = split /\\/, $nums{$sym};
  1371. next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/;
  1372. next if defined($rsyms{$sym});
  1373. print STDERR "DEBUG: rewrite_numbers for sym = ",$sym,": i = ",$i,", n = ",$n,", rsym{sym} = ",$rsyms{$sym},"syms{sym} = ",$syms{$sym},"\n" if $debug;
  1374. $i="NOEXIST::FUNCTION:"
  1375. if !defined($i) || $i eq "" || !defined($syms{$sym});
  1376. my $s2 = $sym;
  1377. $s2 =~ s/\{[0-9]+\}$//;
  1378. printf OUT "%s%-39s %d\t%s\n","",$s2,$n,$i;
  1379. if (exists $r{$sym}) {
  1380. (my $s, $i) = split /\\/,$r{$sym};
  1381. my $s2 = $s;
  1382. $s2 =~ s/\{[0-9]+\}$//;
  1383. printf OUT "%s%-39s %d\t%s\n","",$s2,$n,$i;
  1384. }
  1385. }
  1386. }
  1387. sub update_numbers
  1388. {
  1389. (*OUT,$name,*nums,my $start_num, my @symbols)=@_;
  1390. my $new_syms = 0;
  1391. print STDERR "Updating $name numbers\n";
  1392. my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols);
  1393. my $r; my %r; my %rsyms;
  1394. foreach $r (@r) {
  1395. (my $s, my $i) = split /\\/, $r;
  1396. my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/;
  1397. $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/;
  1398. $r{$a} = $s."\\".$i;
  1399. $rsyms{$s} = 1;
  1400. }
  1401. foreach $sym (@symbols) {
  1402. (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
  1403. next if $i =~ /^.*?:.*?:\w+\(\w+\)/;
  1404. next if defined($rsyms{$sym});
  1405. die "ERROR: Symbol $sym had no info attached to it."
  1406. if $i eq "";
  1407. if (!exists $nums{$s}) {
  1408. $new_syms++;
  1409. my $s2 = $s;
  1410. $s2 =~ s/\{[0-9]+\}$//;
  1411. printf OUT "%s%-39s %d\t%s\n","",$s2, ++$start_num,$i;
  1412. if (exists $r{$s}) {
  1413. ($s, $i) = split /\\/,$r{$s};
  1414. $s =~ s/\{[0-9]+\}$//;
  1415. printf OUT "%s%-39s %d\t%s\n","",$s, $start_num,$i;
  1416. }
  1417. }
  1418. }
  1419. if($new_syms) {
  1420. print STDERR "$new_syms New symbols added\n";
  1421. } else {
  1422. print STDERR "No New symbols Added\n";
  1423. }
  1424. }
  1425. sub check_existing
  1426. {
  1427. (*nums, my @symbols)=@_;
  1428. my %existing; my @remaining;
  1429. @remaining=();
  1430. foreach $sym (@symbols) {
  1431. (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
  1432. $existing{$s}=1;
  1433. }
  1434. foreach $sym (keys %nums) {
  1435. if (!exists $existing{$sym}) {
  1436. push @remaining, $sym;
  1437. }
  1438. }
  1439. if(@remaining) {
  1440. print STDERR "The following symbols do not seem to exist:\n";
  1441. foreach $sym (@remaining) {
  1442. print STDERR "\t",$sym,"\n";
  1443. }
  1444. }
  1445. }