mkdef.pl 47 KB

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