mkdef.pl 45 KB

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