mkdef.pl 49 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637
  1. #! /usr/bin/env perl
  2. # Copyright 1995-2018 The OpenSSL Project Authors. All Rights Reserved.
  3. #
  4. # Licensed under the OpenSSL license (the "License"). You may not use
  5. # this file except in compliance with the License. You can obtain a copy
  6. # in the file LICENSE in the source distribution or at
  7. # https://www.openssl.org/source/license.html
  8. #
  9. # generate a .def file
  10. #
  11. # It does this by parsing the header files and looking for the
  12. # prototyped functions: it then prunes the output.
  13. #
  14. # Intermediary files are created, call libcrypto.num and libssl.num,
  15. # The format of these files is:
  16. #
  17. # routine-name nnnn vers info
  18. #
  19. # The "nnnn" and "vers" fields are the numeric id and version for the symbol
  20. # respectively. The "info" part is actually a colon-separated string of fields
  21. # with the following meaning:
  22. #
  23. # existence:platform:kind:algorithms
  24. #
  25. # - "existence" can be "EXIST" or "NOEXIST" depending on if the symbol is
  26. # found somewhere in the source,
  27. # - "platforms" is empty if it exists on all platforms, otherwise it contains
  28. # comma-separated list of the platform, just as they are if the symbol exists
  29. # for those platforms, or prepended with a "!" if not. This helps resolve
  30. # symbol name variants for platforms where the names are too long for the
  31. # compiler or linker, or if the systems is case insensitive and there is a
  32. # clash, or the symbol is implemented differently (see
  33. # EXPORT_VAR_AS_FUNCTION). This script assumes renaming of symbols is found
  34. # in the file crypto/symhacks.h.
  35. # The semantics for the platforms is that every item is checked against the
  36. # environment. For the negative items ("!FOO"), if any of them is false
  37. # (i.e. "FOO" is true) in the environment, the corresponding symbol can't be
  38. # used. For the positive items, if all of them are false in the environment,
  39. # the corresponding symbol can't be used. Any combination of positive and
  40. # negative items are possible, and of course leave room for some redundancy.
  41. # - "kind" is "FUNCTION" or "VARIABLE". The meaning of that is obvious.
  42. # - "algorithms" is a comma-separated list of algorithm names. This helps
  43. # exclude symbols that are part of an algorithm that some user wants to
  44. # exclude.
  45. #
  46. use lib ".";
  47. use configdata;
  48. use File::Spec::Functions;
  49. use File::Basename;
  50. use FindBin;
  51. use lib "$FindBin::Bin/perl";
  52. use OpenSSL::Glob;
  53. # When building a "variant" shared library, with a custom SONAME, also customize
  54. # all the symbol versions. This produces a shared object that can coexist
  55. # without conflict in the same address space as a default build, or an object
  56. # with a different variant tag.
  57. #
  58. # For example, with a target definition that includes:
  59. #
  60. # shlib_variant => "-opt",
  61. #
  62. # we build the following objects:
  63. #
  64. # $ perl -le '
  65. # for (@ARGV) {
  66. # if ($l = readlink) {
  67. # printf "%s -> %s\n", $_, $l
  68. # } else {
  69. # print
  70. # }
  71. # }' *.so*
  72. # libcrypto-opt.so.1.1
  73. # libcrypto.so -> libcrypto-opt.so.1.1
  74. # libssl-opt.so.1.1
  75. # libssl.so -> libssl-opt.so.1.1
  76. #
  77. # whose SONAMEs and dependencies are:
  78. #
  79. # $ for l in *.so; do
  80. # echo $l
  81. # readelf -d $l | egrep 'SONAME|NEEDED.*(ssl|crypto)'
  82. # done
  83. # libcrypto.so
  84. # 0x000000000000000e (SONAME) Library soname: [libcrypto-opt.so.1.1]
  85. # libssl.so
  86. # 0x0000000000000001 (NEEDED) Shared library: [libcrypto-opt.so.1.1]
  87. # 0x000000000000000e (SONAME) Library soname: [libssl-opt.so.1.1]
  88. #
  89. # We case-fold the variant tag to upper case and replace all non-alnum
  90. # characters with "_". This yields the following symbol versions:
  91. #
  92. # $ nm libcrypto.so | grep -w A
  93. # 0000000000000000 A OPENSSL_OPT_1_1_0
  94. # 0000000000000000 A OPENSSL_OPT_1_1_0a
  95. # 0000000000000000 A OPENSSL_OPT_1_1_0c
  96. # 0000000000000000 A OPENSSL_OPT_1_1_0d
  97. # 0000000000000000 A OPENSSL_OPT_1_1_0f
  98. # 0000000000000000 A OPENSSL_OPT_1_1_0g
  99. # $ nm libssl.so | grep -w A
  100. # 0000000000000000 A OPENSSL_OPT_1_1_0
  101. # 0000000000000000 A OPENSSL_OPT_1_1_0d
  102. #
  103. (my $SO_VARIANT = qq{\U$target{"shlib_variant"}}) =~ s/\W/_/g;
  104. my $debug=0;
  105. my $trace=0;
  106. my $verbose=0;
  107. my $crypto_num= catfile($config{sourcedir},"util","libcrypto.num");
  108. my $ssl_num= catfile($config{sourcedir},"util","libssl.num");
  109. my $libname;
  110. my $do_update = 0;
  111. my $do_rewrite = 1;
  112. my $do_crypto = 0;
  113. my $do_ssl = 0;
  114. my $do_ctest = 0;
  115. my $do_ctestall = 0;
  116. my $do_checkexist = 0;
  117. my $VMS=0;
  118. my $W32=0;
  119. my $NT=0;
  120. my $UNIX=0;
  121. my $linux=0;
  122. # Set this to make typesafe STACK definitions appear in DEF
  123. my $safe_stack_def = 0;
  124. my @known_platforms = ( "__FreeBSD__", "PERL5",
  125. "EXPORT_VAR_AS_FUNCTION", "ZLIB", "_WIN32"
  126. );
  127. my @known_ossl_platforms = ( "UNIX", "VMS", "WIN32", "WINNT", "OS2" );
  128. my @known_algorithms = ( # These are algorithms we know are guarded in relevant
  129. # header files, but aren't actually disablable.
  130. # Without these, this script will warn a lot.
  131. "RSA", "MD5",
  132. # @disablables comes from configdata.pm
  133. map { (my $x = uc $_) =~ s|-|_|g; $x; } @disablables,
  134. # Deprecated functions. Not really algorithmss, but
  135. # treated as such here for the sake of simplicity
  136. "DEPRECATEDIN_0_9_8",
  137. "DEPRECATEDIN_1_0_0",
  138. "DEPRECATEDIN_1_1_0",
  139. "DEPRECATEDIN_1_2_0",
  140. );
  141. # %disabled comes from configdata.pm
  142. my %disabled_algorithms =
  143. map { (my $x = uc $_) =~ s|-|_|g; $x => 1; } keys %disabled;
  144. my $apiv = sprintf "%x%02x%02x", split(/\./, $config{api});
  145. foreach (@known_algorithms) {
  146. if (/^DEPRECATEDIN_(\d+)_(\d+)_(\d+)$/) {
  147. my $depv = sprintf "%x%02x%02x", $1, $2, $3;
  148. $disabled_algorithms{$_} = 1 if $apiv ge $depv;
  149. }
  150. }
  151. my $zlib;
  152. foreach (@ARGV, split(/ /, $config{options}))
  153. {
  154. $debug=1 if $_ eq "debug";
  155. $trace=1 if $_ eq "trace";
  156. $verbose=1 if $_ eq "verbose";
  157. $W32=1 if $_ eq "32";
  158. die "win16 not supported" if $_ eq "16";
  159. if($_ eq "NT") {
  160. $W32 = 1;
  161. $NT = 1;
  162. }
  163. if ($_ eq "linux") {
  164. $linux=1;
  165. $UNIX=1;
  166. }
  167. $VMS=1 if $_ eq "VMS";
  168. if ($_ eq "zlib" || $_ eq "enable-zlib" || $_ eq "zlib-dynamic"
  169. || $_ eq "enable-zlib-dynamic") {
  170. $zlib = 1;
  171. }
  172. $do_crypto=1 if $_ eq "libcrypto" || $_ eq "crypto";
  173. $do_ssl=1 if $_ eq "libssl" || $_ eq "ssl";
  174. $do_update=1 if $_ eq "update";
  175. $do_rewrite=1 if $_ eq "rewrite";
  176. $do_ctest=1 if $_ eq "ctest";
  177. $do_ctestall=1 if $_ eq "ctestall";
  178. $do_checkexist=1 if $_ eq "exist";
  179. }
  180. $libname = $unified_info{sharednames}->{libcrypto} if $do_crypto;
  181. $libname = $unified_info{sharednames}->{libssl} if $do_ssl;
  182. if (!$libname) {
  183. if ($do_ssl) {
  184. $libname="LIBSSL";
  185. }
  186. if ($do_crypto) {
  187. $libname="LIBCRYPTO";
  188. }
  189. }
  190. # If no platform is given, assume WIN32
  191. if ($W32 + $VMS + $linux == 0) {
  192. $W32 = 1;
  193. }
  194. die "Please, only one platform at a time"
  195. if ($W32 + $VMS + $linux > 1);
  196. if (!$do_ssl && !$do_crypto)
  197. {
  198. print STDERR "usage: $0 ( ssl | crypto ) [ 16 | 32 | NT | OS2 | linux | VMS ]\n";
  199. exit(1);
  200. }
  201. %ssl_list=&load_numbers($ssl_num);
  202. $max_ssl = $max_num;
  203. %crypto_list=&load_numbers($crypto_num);
  204. $max_crypto = $max_num;
  205. my $ssl="include/openssl/ssl.h";
  206. $ssl.=" include/openssl/sslerr.h";
  207. $ssl.=" include/openssl/tls1.h";
  208. $ssl.=" include/openssl/srtp.h";
  209. # When scanning include/openssl, skip all SSL files and some internal ones.
  210. my %skipthese;
  211. foreach my $f ( split(/\s+/, $ssl) ) {
  212. $skipthese{$f} = 1;
  213. }
  214. $skipthese{'include/openssl/conf_api.h'} = 1;
  215. $skipthese{'include/openssl/ebcdic.h'} = 1;
  216. $skipthese{'include/openssl/opensslconf.h'} = 1;
  217. # We use headers found in include/openssl and include/internal only.
  218. # The latter is needed so libssl.so/.dll/.exe can link properly.
  219. my $crypto ="include/internal/dso.h";
  220. $crypto.=" include/internal/o_dir.h";
  221. $crypto.=" include/internal/o_str.h";
  222. $crypto.=" include/internal/err.h";
  223. $crypto.=" include/internal/sslconf.h";
  224. foreach my $f ( glob(catfile($config{sourcedir},'include/openssl/*.h')) ) {
  225. my $fn = "include/openssl/" . lc(basename($f));
  226. $crypto .= " $fn" if !defined $skipthese{$fn};
  227. }
  228. my $symhacks="include/openssl/symhacks.h";
  229. my @ssl_symbols = &do_defs("LIBSSL", $ssl, $symhacks);
  230. my @crypto_symbols = &do_defs("LIBCRYPTO", $crypto, $symhacks);
  231. if ($do_update) {
  232. if ($do_ssl == 1) {
  233. &maybe_add_info("LIBSSL",*ssl_list,@ssl_symbols);
  234. if ($do_rewrite == 1) {
  235. open(OUT, ">$ssl_num");
  236. &rewrite_numbers(*OUT,"LIBSSL",*ssl_list,@ssl_symbols);
  237. } else {
  238. open(OUT, ">>$ssl_num");
  239. }
  240. &update_numbers(*OUT,"LIBSSL",*ssl_list,$max_ssl,@ssl_symbols);
  241. close OUT;
  242. }
  243. if($do_crypto == 1) {
  244. &maybe_add_info("LIBCRYPTO",*crypto_list,@crypto_symbols);
  245. if ($do_rewrite == 1) {
  246. open(OUT, ">$crypto_num");
  247. &rewrite_numbers(*OUT,"LIBCRYPTO",*crypto_list,@crypto_symbols);
  248. } else {
  249. open(OUT, ">>$crypto_num");
  250. }
  251. &update_numbers(*OUT,"LIBCRYPTO",*crypto_list,$max_crypto,@crypto_symbols);
  252. close OUT;
  253. }
  254. } elsif ($do_checkexist) {
  255. &check_existing(*ssl_list, @ssl_symbols)
  256. if $do_ssl == 1;
  257. &check_existing(*crypto_list, @crypto_symbols)
  258. if $do_crypto == 1;
  259. } elsif ($do_ctest || $do_ctestall) {
  260. print <<"EOF";
  261. /* Test file to check all DEF file symbols are present by trying
  262. * to link to all of them. This is *not* intended to be run!
  263. */
  264. int main()
  265. {
  266. EOF
  267. &print_test_file(*STDOUT,"LIBSSL",*ssl_list,$do_ctestall,@ssl_symbols)
  268. if $do_ssl == 1;
  269. &print_test_file(*STDOUT,"LIBCRYPTO",*crypto_list,$do_ctestall,@crypto_symbols)
  270. if $do_crypto == 1;
  271. print "}\n";
  272. } else {
  273. &print_def_file(*STDOUT,$libname,*ssl_list,@ssl_symbols)
  274. if $do_ssl == 1;
  275. &print_def_file(*STDOUT,$libname,*crypto_list,@crypto_symbols)
  276. if $do_crypto == 1;
  277. }
  278. sub do_defs
  279. {
  280. my($name,$files,$symhacksfile)=@_;
  281. my $file;
  282. my @ret;
  283. my %syms;
  284. my %platform; # For anything undefined, we assume ""
  285. my %kind; # For anything undefined, we assume "FUNCTION"
  286. my %algorithm; # For anything undefined, we assume ""
  287. my %variant;
  288. my %variant_cnt; # To be able to allocate "name{n}" if "name"
  289. # is the same name as the original.
  290. my $cpp;
  291. my %unknown_algorithms = ();
  292. my $parens = 0;
  293. foreach $file (split(/\s+/,$symhacksfile." ".$files))
  294. {
  295. my $fn = catfile($config{sourcedir},$file);
  296. print STDERR "DEBUG: starting on $fn:\n" if $debug;
  297. print STDERR "TRACE: start reading $fn\n" if $trace;
  298. open(IN,"<$fn") || die "Can't open $fn, $!,";
  299. my $line = "", my $def= "";
  300. my %tag = (
  301. (map { $_ => 0 } @known_platforms),
  302. (map { "OPENSSL_SYS_".$_ => 0 } @known_ossl_platforms),
  303. (map { "OPENSSL_NO_".$_ => 0 } @known_algorithms),
  304. (map { "OPENSSL_USE_".$_ => 0 } @known_algorithms),
  305. (grep /^DEPRECATED_/, @known_algorithms),
  306. NOPROTO => 0,
  307. PERL5 => 0,
  308. _WINDLL => 0,
  309. CONST_STRICT => 0,
  310. TRUE => 1,
  311. );
  312. my $symhacking = $file eq $symhacksfile;
  313. my @current_platforms = ();
  314. my @current_algorithms = ();
  315. # params: symbol, alias, platforms, kind
  316. # The reason to put this subroutine in a variable is that
  317. # it will otherwise create it's own, unshared, version of
  318. # %tag and %variant...
  319. my $make_variant = sub
  320. {
  321. my ($s, $a, $p, $k) = @_;
  322. my ($a1, $a2);
  323. print STDERR "DEBUG: make_variant: Entered with ",$s,", ",$a,", ",(defined($p)?$p:""),", ",(defined($k)?$k:""),"\n" if $debug;
  324. if (defined($p))
  325. {
  326. $a1 = join(",",$p,
  327. grep(!/^$/,
  328. map { $tag{$_} == 1 ? $_ : "" }
  329. @known_platforms));
  330. }
  331. else
  332. {
  333. $a1 = join(",",
  334. grep(!/^$/,
  335. map { $tag{$_} == 1 ? $_ : "" }
  336. @known_platforms));
  337. }
  338. $a2 = join(",",
  339. grep(!/^$/,
  340. map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ : "" }
  341. @known_ossl_platforms));
  342. print STDERR "DEBUG: make_variant: a1 = $a1; a2 = $a2\n" if $debug;
  343. if ($a1 eq "") { $a1 = $a2; }
  344. elsif ($a1 ne "" && $a2 ne "") { $a1 .= ",".$a2; }
  345. if ($a eq $s)
  346. {
  347. if (!defined($variant_cnt{$s}))
  348. {
  349. $variant_cnt{$s} = 0;
  350. }
  351. $variant_cnt{$s}++;
  352. $a .= "{$variant_cnt{$s}}";
  353. }
  354. my $toadd = $a.":".$a1.(defined($k)?":".$k:"");
  355. my $togrep = $s.'(\{[0-9]+\})?:'.$a1.(defined($k)?":".$k:"");
  356. if (!grep(/^$togrep$/,
  357. split(/;/, defined($variant{$s})?$variant{$s}:""))) {
  358. if (defined($variant{$s})) { $variant{$s} .= ";"; }
  359. $variant{$s} .= $toadd;
  360. }
  361. print STDERR "DEBUG: make_variant: Exit with variant of ",$s," = ",$variant{$s},"\n" if $debug;
  362. };
  363. print STDERR "DEBUG: parsing ----------\n" if $debug;
  364. while(<IN>) {
  365. s|\R$||; # Better chomp
  366. if($parens > 0) {
  367. #Inside a DEPRECATEDIN
  368. $stored_multiline .= $_;
  369. print STDERR "DEBUG: Continuing multiline DEPRECATEDIN: $stored_multiline\n" if $debug;
  370. $parens = count_parens($stored_multiline);
  371. if ($parens == 0) {
  372. $def .= do_deprecated($stored_multiline,
  373. \@current_platforms,
  374. \@current_algorithms);
  375. }
  376. next;
  377. }
  378. if (/\/\* Error codes for the \w+ functions\. \*\//)
  379. {
  380. undef @tag;
  381. last;
  382. }
  383. if ($line ne '') {
  384. $_ = $line . $_;
  385. $line = '';
  386. }
  387. if (/\\$/) {
  388. $line = $`; # keep what was before the backslash
  389. next;
  390. }
  391. if(/\/\*/) {
  392. if (not /\*\//) { # multi-line comment...
  393. $line = $_; # ... just accumulate
  394. next;
  395. } else {
  396. s/\/\*.*?\*\///gs;# wipe it
  397. }
  398. }
  399. if ($cpp) {
  400. $cpp++ if /^#\s*if/;
  401. $cpp-- if /^#\s*endif/;
  402. next;
  403. }
  404. if (/^#.*ifdef.*cplusplus/) {
  405. $cpp = 1;
  406. next;
  407. }
  408. s/{[^{}]*}//gs; # ignore {} blocks
  409. print STDERR "DEBUG: \$def=\"$def\"\n" if $debug && $def ne "";
  410. print STDERR "DEBUG: \$_=\"$_\"\n" if $debug;
  411. if (/^\#\s*if\s+OPENSSL_API_COMPAT\s*(\S)\s*(0x[0-9a-fA-F]{8})L\s*$/) {
  412. my $op = $1;
  413. my $v = hex($2);
  414. if ($op ne '<' && $op ne '>=') {
  415. die "$file unacceptable operator $op: $_\n";
  416. }
  417. my ($one, $major, $minor) =
  418. ( ($v >> 28) & 0xf,
  419. ($v >> 20) & 0xff,
  420. ($v >> 12) & 0xff );
  421. my $t = "DEPRECATEDIN_${one}_${major}_${minor}";
  422. push(@tag,"-");
  423. push(@tag,$t);
  424. $tag{$t}=($op eq '<' ? 1 : -1);
  425. print STDERR "DEBUG: $file: found tag $t = $tag{$t}\n" if $debug;
  426. } elsif (/^\#\s*ifndef\s+(.*)/) {
  427. push(@tag,"-");
  428. push(@tag,$1);
  429. $tag{$1}=-1;
  430. print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
  431. } elsif (/^\#\s*if\s+!defined\s*\(([^\)]+)\)/) {
  432. push(@tag,"-");
  433. if (/^\#\s*if\s+(!defined\s*\(([^\)]+)\)(\s+\&\&\s+!defined\s*\(([^\)]+)\))*)$/) {
  434. my $tmp_1 = $1;
  435. my $tmp_;
  436. foreach $tmp_ (split '\&\&',$tmp_1) {
  437. $tmp_ =~ /!defined\s*\(([^\)]+)\)/;
  438. print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
  439. push(@tag,$1);
  440. $tag{$1}=-1;
  441. }
  442. } else {
  443. print STDERR "Warning: $file: taking only '!defined($1)' of complicated expression: $_" if $verbose; # because it is O...
  444. print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
  445. push(@tag,$1);
  446. $tag{$1}=-1;
  447. }
  448. } elsif (/^\#\s*ifdef\s+(\S*)/) {
  449. push(@tag,"-");
  450. push(@tag,$1);
  451. $tag{$1}=1;
  452. print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
  453. } elsif (/^\#\s*if\s+defined\s*\(([^\)]+)\)/) {
  454. push(@tag,"-");
  455. if (/^\#\s*if\s+(defined\s*\(([^\)]+)\)(\s+\|\|\s+defined\s*\(([^\)]+)\))*)$/) {
  456. my $tmp_1 = $1;
  457. my $tmp_;
  458. foreach $tmp_ (split '\|\|',$tmp_1) {
  459. $tmp_ =~ /defined\s*\(([^\)]+)\)/;
  460. print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
  461. push(@tag,$1);
  462. $tag{$1}=1;
  463. }
  464. } else {
  465. print STDERR "Warning: $file: taking only 'defined($1)' of complicated expression: $_\n" if $verbose; # because it is O...
  466. print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
  467. push(@tag,$1);
  468. $tag{$1}=1;
  469. }
  470. } elsif (/^\#\s*error\s+(\w+) is disabled\./) {
  471. my $tag_i = $#tag;
  472. while($tag[$tag_i] ne "-") {
  473. if ($tag[$tag_i] eq "OPENSSL_NO_".$1) {
  474. $tag{$tag[$tag_i]}=2;
  475. print STDERR "DEBUG: $file: changed tag $1 = 2\n" if $debug;
  476. }
  477. $tag_i--;
  478. }
  479. } elsif (/^\#\s*endif/) {
  480. my $tag_i = $#tag;
  481. while($tag_i > 0 && $tag[$tag_i] ne "-") {
  482. my $t=$tag[$tag_i];
  483. print STDERR "DEBUG: \$t=\"$t\"\n" if $debug;
  484. if ($tag{$t}==2) {
  485. $tag{$t}=-1;
  486. } else {
  487. $tag{$t}=0;
  488. }
  489. print STDERR "DEBUG: $file: changed tag ",$t," = ",$tag{$t},"\n" if $debug;
  490. pop(@tag);
  491. if ($t =~ /^OPENSSL_NO_([A-Z0-9_]+)$/) {
  492. $t=$1;
  493. } elsif($t =~ /^OPENSSL_USE_([A-Z0-9_]+)$/) {
  494. $t=$1;
  495. } else {
  496. $t="";
  497. }
  498. if ($t ne ""
  499. && !grep(/^$t$/, @known_algorithms)) {
  500. $unknown_algorithms{$t} = 1;
  501. #print STDERR "DEBUG: Added as unknown algorithm: $t\n" if $debug;
  502. }
  503. $tag_i--;
  504. }
  505. pop(@tag);
  506. } elsif (/^\#\s*else/) {
  507. my $tag_i = $#tag;
  508. die "$file unmatched else\n" if $tag_i < 0;
  509. while($tag[$tag_i] ne "-") {
  510. my $t=$tag[$tag_i];
  511. $tag{$t}= -$tag{$t};
  512. print STDERR "DEBUG: $file: changed tag ",$t," = ",$tag{$t},"\n" if $debug;
  513. $tag_i--;
  514. }
  515. } elsif (/^\#\s*if\s+1/) {
  516. push(@tag,"-");
  517. # Dummy tag
  518. push(@tag,"TRUE");
  519. $tag{"TRUE"}=1;
  520. print STDERR "DEBUG: $file: found 1\n" if $debug;
  521. } elsif (/^\#\s*if\s+0/) {
  522. push(@tag,"-");
  523. # Dummy tag
  524. push(@tag,"TRUE");
  525. $tag{"TRUE"}=-1;
  526. print STDERR "DEBUG: $file: found 0\n" if $debug;
  527. } elsif (/^\#\s*if\s+/) {
  528. #Some other unrecognized "if" style
  529. push(@tag,"-");
  530. print STDERR "Warning: $file: ignoring unrecognized expression: $_\n" if $verbose; # because it is O...
  531. } elsif (/^\#\s*define\s+(\w+)\s+(\w+)/
  532. && $symhacking && $tag{'TRUE'} != -1) {
  533. # This is for aliasing. When we find an alias,
  534. # we have to invert
  535. &$make_variant($1,$2);
  536. print STDERR "DEBUG: $file: defined $1 = $2\n" if $debug;
  537. }
  538. if (/^\#/) {
  539. @current_platforms =
  540. grep(!/^$/,
  541. map { $tag{$_} == 1 ? $_ :
  542. $tag{$_} == -1 ? "!".$_ : "" }
  543. @known_platforms);
  544. push @current_platforms
  545. , grep(!/^$/,
  546. map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ :
  547. $tag{"OPENSSL_SYS_".$_} == -1 ? "!".$_ : "" }
  548. @known_ossl_platforms);
  549. @current_algorithms = ();
  550. @current_algorithms =
  551. grep(!/^$/,
  552. map { $tag{"OPENSSL_NO_".$_} == -1 ? $_ : "" }
  553. @known_algorithms);
  554. push @current_algorithms
  555. , grep(!/^$/,
  556. map { $tag{"OPENSSL_USE_".$_} == 1 ? $_ : "" }
  557. @known_algorithms);
  558. push @current_algorithms,
  559. grep { /^DEPRECATEDIN_/ && $tag{$_} == 1 }
  560. @known_algorithms;
  561. $def .=
  562. "#INFO:"
  563. .join(',',@current_platforms).":"
  564. .join(',',@current_algorithms).";";
  565. next;
  566. }
  567. if ($tag{'TRUE'} != -1) {
  568. if (/^\s*DEFINE_STACK_OF\s*\(\s*(\w*)\s*\)/
  569. || /^\s*DEFINE_STACK_OF_CONST\s*\(\s*(\w*)\s*\)/) {
  570. next;
  571. } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) {
  572. $def .= "int d2i_$3(void);";
  573. $def .= "int i2d_$3(void);";
  574. # Variant for platforms that do not
  575. # have to access global variables
  576. # in shared libraries through functions
  577. $def .=
  578. "#INFO:"
  579. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  580. .join(',',@current_algorithms).";";
  581. $def .= "OPENSSL_EXTERN int $2_it;";
  582. $def .=
  583. "#INFO:"
  584. .join(',',@current_platforms).":"
  585. .join(',',@current_algorithms).";";
  586. # Variant for platforms that have to
  587. # access global variables in shared
  588. # libraries through functions
  589. &$make_variant("$2_it","$2_it",
  590. "EXPORT_VAR_AS_FUNCTION",
  591. "FUNCTION");
  592. next;
  593. } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_fname\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) {
  594. $def .= "int d2i_$3(void);";
  595. $def .= "int i2d_$3(void);";
  596. $def .= "int $3_free(void);";
  597. $def .= "int $3_new(void);";
  598. # Variant for platforms that do not
  599. # have to access global variables
  600. # in shared libraries through functions
  601. $def .=
  602. "#INFO:"
  603. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  604. .join(',',@current_algorithms).";";
  605. $def .= "OPENSSL_EXTERN int $2_it;";
  606. $def .=
  607. "#INFO:"
  608. .join(',',@current_platforms).":"
  609. .join(',',@current_algorithms).";";
  610. # Variant for platforms that have to
  611. # access global variables in shared
  612. # libraries through functions
  613. &$make_variant("$2_it","$2_it",
  614. "EXPORT_VAR_AS_FUNCTION",
  615. "FUNCTION");
  616. next;
  617. } elsif (/^\s*DECLARE_ASN1_FUNCTIONS\s*\(\s*(\w*)\s*\)/ ||
  618. /^\s*DECLARE_ASN1_FUNCTIONS_const\s*\(\s*(\w*)\s*\)/) {
  619. $def .= "int d2i_$1(void);";
  620. $def .= "int i2d_$1(void);";
  621. $def .= "int $1_free(void);";
  622. $def .= "int $1_new(void);";
  623. # Variant for platforms that do not
  624. # have to access global variables
  625. # in shared libraries through functions
  626. $def .=
  627. "#INFO:"
  628. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  629. .join(',',@current_algorithms).";";
  630. $def .= "OPENSSL_EXTERN int $1_it;";
  631. $def .=
  632. "#INFO:"
  633. .join(',',@current_platforms).":"
  634. .join(',',@current_algorithms).";";
  635. # Variant for platforms that have to
  636. # access global variables in shared
  637. # libraries through functions
  638. &$make_variant("$1_it","$1_it",
  639. "EXPORT_VAR_AS_FUNCTION",
  640. "FUNCTION");
  641. next;
  642. } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS_const\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
  643. $def .= "int d2i_$2(void);";
  644. $def .= "int i2d_$2(void);";
  645. # Variant for platforms that do not
  646. # have to access global variables
  647. # in shared libraries through functions
  648. $def .=
  649. "#INFO:"
  650. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  651. .join(',',@current_algorithms).";";
  652. $def .= "OPENSSL_EXTERN int $2_it;";
  653. $def .=
  654. "#INFO:"
  655. .join(',',@current_platforms).":"
  656. .join(',',@current_algorithms).";";
  657. # Variant for platforms that have to
  658. # access global variables in shared
  659. # libraries through functions
  660. &$make_variant("$2_it","$2_it",
  661. "EXPORT_VAR_AS_FUNCTION",
  662. "FUNCTION");
  663. next;
  664. } elsif (/^\s*DECLARE_ASN1_ALLOC_FUNCTIONS\s*\(\s*(\w*)\s*\)/) {
  665. $def .= "int $1_free(void);";
  666. $def .= "int $1_new(void);";
  667. next;
  668. } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
  669. $def .= "int d2i_$2(void);";
  670. $def .= "int i2d_$2(void);";
  671. $def .= "int $2_free(void);";
  672. $def .= "int $2_new(void);";
  673. # Variant for platforms that do not
  674. # have to access global variables
  675. # in shared libraries through functions
  676. $def .=
  677. "#INFO:"
  678. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  679. .join(',',@current_algorithms).";";
  680. $def .= "OPENSSL_EXTERN int $2_it;";
  681. $def .=
  682. "#INFO:"
  683. .join(',',@current_platforms).":"
  684. .join(',',@current_algorithms).";";
  685. # Variant for platforms that have to
  686. # access global variables in shared
  687. # libraries through functions
  688. &$make_variant("$2_it","$2_it",
  689. "EXPORT_VAR_AS_FUNCTION",
  690. "FUNCTION");
  691. next;
  692. } elsif (/^\s*DECLARE_ASN1_ITEM\s*\(\s*(\w*)\s*\)/) {
  693. # Variant for platforms that do not
  694. # have to access global variables
  695. # in shared libraries through functions
  696. $def .=
  697. "#INFO:"
  698. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  699. .join(',',@current_algorithms).";";
  700. $def .= "OPENSSL_EXTERN int $1_it;";
  701. $def .=
  702. "#INFO:"
  703. .join(',',@current_platforms).":"
  704. .join(',',@current_algorithms).";";
  705. # Variant for platforms that have to
  706. # access global variables in shared
  707. # libraries through functions
  708. &$make_variant("$1_it","$1_it",
  709. "EXPORT_VAR_AS_FUNCTION",
  710. "FUNCTION");
  711. next;
  712. } elsif (/^\s*DECLARE_ASN1_NDEF_FUNCTION\s*\(\s*(\w*)\s*\)/) {
  713. $def .= "int i2d_$1_NDEF(void);";
  714. } elsif (/^\s*DECLARE_ASN1_SET_OF\s*\(\s*(\w*)\s*\)/) {
  715. next;
  716. } elsif (/^\s*DECLARE_ASN1_PRINT_FUNCTION\s*\(\s*(\w*)\s*\)/) {
  717. $def .= "int $1_print_ctx(void);";
  718. next;
  719. } elsif (/^\s*DECLARE_ASN1_PRINT_FUNCTION_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
  720. $def .= "int $2_print_ctx(void);";
  721. next;
  722. } elsif (/^\s*DECLARE_PKCS12_STACK_OF\s*\(\s*(\w*)\s*\)/) {
  723. next;
  724. } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ ||
  725. /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ ||
  726. /^DECLARE_PEM_rw_const\s*\(\s*(\w*)\s*,/ ) {
  727. $def .=
  728. "#INFO:"
  729. .join(',',@current_platforms).":"
  730. .join(',',"STDIO",@current_algorithms).";";
  731. $def .= "int PEM_read_$1(void);";
  732. $def .= "int PEM_write_$1(void);";
  733. $def .=
  734. "#INFO:"
  735. .join(',',@current_platforms).":"
  736. .join(',',@current_algorithms).";";
  737. # Things that are everywhere
  738. $def .= "int PEM_read_bio_$1(void);";
  739. $def .= "int PEM_write_bio_$1(void);";
  740. next;
  741. } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ ||
  742. /^DECLARE_PEM_write_const\s*\(\s*(\w*)\s*,/ ||
  743. /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) {
  744. $def .=
  745. "#INFO:"
  746. .join(',',@current_platforms).":"
  747. .join(',',"STDIO",@current_algorithms).";";
  748. $def .= "int PEM_write_$1(void);";
  749. $def .=
  750. "#INFO:"
  751. .join(',',@current_platforms).":"
  752. .join(',',@current_algorithms).";";
  753. # Things that are everywhere
  754. $def .= "int PEM_write_bio_$1(void);";
  755. next;
  756. } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ ||
  757. /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) {
  758. $def .=
  759. "#INFO:"
  760. .join(',',@current_platforms).":"
  761. .join(',',"STDIO",@current_algorithms).";";
  762. $def .= "int PEM_read_$1(void);";
  763. $def .=
  764. "#INFO:"
  765. .join(',',@current_platforms).":"
  766. .join(',',"STDIO",@current_algorithms).";";
  767. # Things that are everywhere
  768. $def .= "int PEM_read_bio_$1(void);";
  769. next;
  770. } elsif (/^OPENSSL_DECLARE_GLOBAL\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
  771. # Variant for platforms that do not
  772. # have to access global variables
  773. # in shared libraries through functions
  774. $def .=
  775. "#INFO:"
  776. .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
  777. .join(',',@current_algorithms).";";
  778. $def .= "OPENSSL_EXTERN int _shadow_$2;";
  779. $def .=
  780. "#INFO:"
  781. .join(',',@current_platforms).":"
  782. .join(',',@current_algorithms).";";
  783. # Variant for platforms that have to
  784. # access global variables in shared
  785. # libraries through functions
  786. &$make_variant("_shadow_$2","_shadow_$2",
  787. "EXPORT_VAR_AS_FUNCTION",
  788. "FUNCTION");
  789. } elsif (/^\s*DEPRECATEDIN/) {
  790. $parens = count_parens($_);
  791. if ($parens == 0) {
  792. $def .= do_deprecated($_,
  793. \@current_platforms,
  794. \@current_algorithms);
  795. } else {
  796. $stored_multiline = $_;
  797. print STDERR "DEBUG: Found multiline DEPRECATEDIN starting with: $stored_multiline\n" if $debug;
  798. next;
  799. }
  800. } elsif ($tag{'CONST_STRICT'} != 1) {
  801. if (/\{|\/\*|\([^\)]*$/) {
  802. $line = $_;
  803. } else {
  804. $def .= $_;
  805. }
  806. }
  807. }
  808. }
  809. close(IN);
  810. die "$file: Unmatched tags\n" if $#tag >= 0;
  811. my $algs;
  812. my $plays;
  813. print STDERR "DEBUG: postprocessing ----------\n" if $debug;
  814. foreach (split /;/, $def) {
  815. my $s; my $k = "FUNCTION"; my $p; my $a;
  816. s/^[\n\s]*//g;
  817. s/[\n\s]*$//g;
  818. next if(/\#undef/);
  819. next if(/typedef\W/);
  820. next if(/\#define/);
  821. print STDERR "TRACE: processing $_\n" if $trace && !/^\#INFO:/;
  822. # Reduce argument lists to empty ()
  823. # fold round brackets recursively: (t(*v)(t),t) -> (t{}{},t) -> {}
  824. my $nsubst = 1; # prevent infinite loop, e.g., on int fn()
  825. while($nsubst && /\(.*\)/s) {
  826. $nsubst = s/\([^\(\)]+\)/\{\}/gs;
  827. $nsubst+= s/\(\s*\*\s*(\w+)\s*\{\}\s*\)/$1/gs; #(*f{}) -> f
  828. }
  829. # pretend as we didn't use curly braces: {} -> ()
  830. s/\{\}/\(\)/gs;
  831. s/STACK_OF\(\)/void/gs;
  832. s/LHASH_OF\(\)/void/gs;
  833. print STDERR "DEBUG: \$_ = \"$_\"\n" if $debug;
  834. if (/^\#INFO:([^:]*):(.*)$/) {
  835. $plats = $1;
  836. $algs = $2;
  837. print STDERR "DEBUG: found info on platforms ($plats) and algorithms ($algs)\n" if $debug;
  838. next;
  839. } elsif (/^\s*OPENSSL_EXTERN\s.*?(\w+(\{[0-9]+\})?)(\[[0-9]*\])*\s*$/) {
  840. $s = $1;
  841. $k = "VARIABLE";
  842. print STDERR "DEBUG: found external variable $s\n" if $debug;
  843. } elsif (/TYPEDEF_\w+_OF/s) {
  844. next;
  845. } elsif (/(\w+)\s*\(\).*/s) { # first token prior [first] () is
  846. $s = $1; # a function name!
  847. print STDERR "DEBUG: found function $s\n" if $debug;
  848. } elsif (/\(/ and not (/=/)) {
  849. print STDERR "File $file: cannot parse: $_;\n";
  850. next;
  851. } else {
  852. next;
  853. }
  854. $syms{$s} = 1;
  855. $kind{$s} = $k;
  856. $p = $plats;
  857. $a = $algs;
  858. $platform{$s} =
  859. &reduce_platforms((defined($platform{$s})?$platform{$s}.',':"").$p);
  860. $algorithm{$s} .= ','.$a;
  861. if (defined($variant{$s})) {
  862. foreach $v (split /;/,$variant{$s}) {
  863. (my $r, my $p, my $k) = split(/:/,$v);
  864. my $ip = join ',',map({ /^!(.*)$/ ? $1 : "!".$_ } split /,/, $p);
  865. $syms{$r} = 1;
  866. if (!defined($k)) { $k = $kind{$s}; }
  867. $kind{$r} = $k."(".$s.")";
  868. $algorithm{$r} = $algorithm{$s};
  869. $platform{$r} = &reduce_platforms($platform{$s}.",".$p.",".$p);
  870. $platform{$s} = &reduce_platforms($platform{$s}.','.$ip.','.$ip);
  871. print STDERR "DEBUG: \$variant{\"$s\"} = ",$v,"; \$r = $r; \$p = ",$platform{$r},"; \$a = ",$algorithm{$r},"; \$kind = ",$kind{$r},"\n" if $debug;
  872. }
  873. }
  874. print STDERR "DEBUG: \$s = $s; \$p = ",$platform{$s},"; \$a = ",$algorithm{$s},"; \$kind = ",$kind{$s},"\n" if $debug;
  875. }
  876. }
  877. # Prune the returned symbols
  878. delete $syms{"bn_dump1"};
  879. $platform{"BIO_s_log"} .= ",!WIN32,!macintosh";
  880. $platform{"PEM_read_NS_CERT_SEQ"} = "VMS";
  881. $platform{"PEM_write_NS_CERT_SEQ"} = "VMS";
  882. $platform{"PEM_read_P8_PRIV_KEY_INFO"} = "VMS";
  883. $platform{"PEM_write_P8_PRIV_KEY_INFO"} = "VMS";
  884. # Info we know about
  885. push @ret, map { $_."\\".&info_string($_,"EXIST",
  886. $platform{$_},
  887. $kind{$_},
  888. $algorithm{$_}) } keys %syms;
  889. if (keys %unknown_algorithms) {
  890. print STDERR "WARNING: mkdef.pl doesn't know the following algorithms:\n";
  891. print STDERR "\t",join("\n\t",keys %unknown_algorithms),"\n";
  892. }
  893. return(@ret);
  894. }
  895. # Param: string of comma-separated platform-specs.
  896. sub reduce_platforms
  897. {
  898. my ($platforms) = @_;
  899. my $pl = defined($platforms) ? $platforms : "";
  900. my %p = map { $_ => 0 } split /,/, $pl;
  901. my $ret;
  902. print STDERR "DEBUG: Entered reduce_platforms with \"$platforms\"\n"
  903. if $debug;
  904. # We do this, because if there's code like the following, it really
  905. # means the function exists in all cases and should therefore be
  906. # everywhere. By increasing and decreasing, we may attain 0:
  907. #
  908. # ifndef WIN16
  909. # int foo();
  910. # else
  911. # int _fat foo();
  912. # endif
  913. foreach $platform (split /,/, $pl) {
  914. if ($platform =~ /^!(.*)$/) {
  915. $p{$1}--;
  916. } else {
  917. $p{$platform}++;
  918. }
  919. }
  920. foreach $platform (keys %p) {
  921. if ($p{$platform} == 0) { delete $p{$platform}; }
  922. }
  923. delete $p{""};
  924. $ret = join(',',sort(map { $p{$_} < 0 ? "!".$_ : $_ } keys %p));
  925. print STDERR "DEBUG: Exiting reduce_platforms with \"$ret\"\n"
  926. if $debug;
  927. return $ret;
  928. }
  929. sub info_string
  930. {
  931. (my $symbol, my $exist, my $platforms, my $kind, my $algorithms) = @_;
  932. my %a = defined($algorithms) ?
  933. map { $_ => 1 } split /,/, $algorithms : ();
  934. my $k = defined($kind) ? $kind : "FUNCTION";
  935. my $ret;
  936. my $p = &reduce_platforms($platforms);
  937. delete $a{""};
  938. $ret = $exist;
  939. $ret .= ":".$p;
  940. $ret .= ":".$k;
  941. $ret .= ":".join(',',sort keys %a);
  942. return $ret;
  943. }
  944. sub maybe_add_info
  945. {
  946. (my $name, *nums, my @symbols) = @_;
  947. my $sym;
  948. my $new_info = 0;
  949. my %syms=();
  950. foreach $sym (@symbols) {
  951. (my $s, my $i) = split /\\/, $sym;
  952. if (defined($nums{$s})) {
  953. $i =~ s/^(.*?:.*?:\w+)(\(\w+\))?/$1/;
  954. (my $n, my $vers, my $dummy) = split /\\/, $nums{$s};
  955. if (!defined($dummy) || $i ne $dummy) {
  956. $nums{$s} = $n."\\".$vers."\\".$i;
  957. $new_info++;
  958. print STDERR "DEBUG: maybe_add_info for $s: \"$dummy\" => \"$i\"\n" if $debug;
  959. }
  960. }
  961. $syms{$s} = 1;
  962. }
  963. my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums;
  964. foreach $sym (@s) {
  965. (my $n, my $vers, my $i) = split /\\/, $nums{$sym};
  966. if (!defined($syms{$sym}) && $i !~ /^NOEXIST:/) {
  967. $new_info++;
  968. print STDERR "DEBUG: maybe_add_info for $sym: -> undefined\n" if $debug;
  969. }
  970. }
  971. if ($new_info) {
  972. print STDERR "$name: $new_info old symbols have updated info\n";
  973. if (!$do_rewrite) {
  974. print STDERR "You should do a rewrite to fix this.\n";
  975. }
  976. } else {
  977. }
  978. }
  979. # Param: string of comma-separated keywords, each possibly prefixed with a "!"
  980. sub is_valid
  981. {
  982. my ($keywords_txt,$platforms) = @_;
  983. my (@keywords) = split /,/,$keywords_txt;
  984. my ($falsesum, $truesum) = (0, 1);
  985. # Param: one keyword
  986. sub recognise
  987. {
  988. my ($keyword,$platforms) = @_;
  989. if ($platforms) {
  990. # platforms
  991. if ($keyword eq "UNIX" && $UNIX) { return 1; }
  992. if ($keyword eq "VMS" && $VMS) { return 1; }
  993. if ($keyword eq "WIN32" && $W32) { return 1; }
  994. if ($keyword eq "_WIN32" && $W32) { return 1; }
  995. if ($keyword eq "WINNT" && $NT) { return 1; }
  996. # Special platforms:
  997. # EXPORT_VAR_AS_FUNCTION means that global variables
  998. # will be represented as functions.
  999. if ($keyword eq "EXPORT_VAR_AS_FUNCTION" && $W32) {
  1000. return 1;
  1001. }
  1002. if ($keyword eq "ZLIB" && $zlib) { return 1; }
  1003. return 0;
  1004. } else {
  1005. # algorithms
  1006. if ($disabled_algorithms{$keyword}) { return 0;}
  1007. # Nothing recognise as true
  1008. return 1;
  1009. }
  1010. }
  1011. foreach $k (@keywords) {
  1012. if ($k =~ /^!(.*)$/) {
  1013. $falsesum += &recognise($1,$platforms);
  1014. } else {
  1015. $truesum *= &recognise($k,$platforms);
  1016. }
  1017. }
  1018. print STDERR "DEBUG: [",$#keywords,",",$#keywords < 0,"] is_valid($keywords_txt) => (\!$falsesum) && $truesum = ",(!$falsesum) && $truesum,"\n" if $debug;
  1019. return (!$falsesum) && $truesum;
  1020. }
  1021. sub print_test_file
  1022. {
  1023. (*OUT,my $name,*nums,my $testall,my @symbols)=@_;
  1024. my $n = 1; my @e; my @r;
  1025. my $sym; my $prev = ""; my $prefSSLeay;
  1026. (@e)=grep(/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols);
  1027. (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:.*/ && !/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols);
  1028. @symbols=((sort @e),(sort @r));
  1029. foreach $sym (@symbols) {
  1030. (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
  1031. my $v = 0;
  1032. $v = 1 if $i=~ /^.*?:.*?:VARIABLE/;
  1033. my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
  1034. my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
  1035. if (!defined($nums{$s})) {
  1036. print STDERR "Warning: $s does not have a number assigned\n"
  1037. if(!$do_update);
  1038. } elsif (is_valid($p,1) && is_valid($a,0)) {
  1039. my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1);
  1040. if ($prev eq $s2) {
  1041. print OUT "\t/* The following has already appeared previously */\n";
  1042. print STDERR "Warning: Symbol '",$s2,"' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n";
  1043. }
  1044. $prev = $s2; # To warn about duplicates...
  1045. (my $nn, my $vers, my $ni) = split /\\/, $nums{$s2};
  1046. if ($v) {
  1047. print OUT "\textern int $s2; /* type unknown */ /* $nn $ni */\n";
  1048. } else {
  1049. print OUT "\textern int $s2(); /* type unknown */ /* $nn $ni */\n";
  1050. }
  1051. }
  1052. }
  1053. }
  1054. sub get_version
  1055. {
  1056. return $config{version};
  1057. }
  1058. sub print_def_file
  1059. {
  1060. (*OUT,my $name,*nums,my @symbols)=@_;
  1061. my $n = 1; my @e; my @r; my @v; my $prev="";
  1062. my $liboptions="";
  1063. my $libname = $name;
  1064. my $http_vendor = 'www.openssl.org/';
  1065. my $version = get_version();
  1066. my $what = "OpenSSL: implementation of Secure Socket Layer";
  1067. my $description = "$what $version, $name - http://$http_vendor";
  1068. my $prevsymversion = "", $prevprevsymversion = "";
  1069. # For VMS
  1070. my $prevnum = 0;
  1071. my $symvtextcount = 0;
  1072. if ($W32)
  1073. {
  1074. print OUT <<"EOF";
  1075. ;
  1076. ; Definition file for the DLL version of the $name library from OpenSSL
  1077. ;
  1078. LIBRARY $libname $liboptions
  1079. EOF
  1080. print "EXPORTS\n";
  1081. }
  1082. elsif ($VMS)
  1083. {
  1084. print OUT <<"EOF";
  1085. IDENTIFICATION=$version
  1086. CASE_SENSITIVE=YES
  1087. SYMBOL_VECTOR=(-
  1088. EOF
  1089. $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-"
  1090. }
  1091. (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:FUNCTION/,@symbols);
  1092. (@v)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:VARIABLE/,@symbols);
  1093. if ($VMS) {
  1094. # VMS needs to have the symbols on slot number order
  1095. @symbols=(map { $_->[1] }
  1096. sort { $a->[0] <=> $b->[0] }
  1097. map { (my $s, my $i) = $_ =~ /^(.*?)\\(.*)$/;
  1098. die "Error: $s doesn't have a number assigned\n"
  1099. if !defined($nums{$s});
  1100. (my $n, my @rest) = split /\\/, $nums{$s};
  1101. [ $n, $_ ] } (@e, @r, @v));
  1102. } else {
  1103. @symbols=((sort @e),(sort @r), (sort @v));
  1104. }
  1105. my ($baseversion, $currversion) = get_openssl_version();
  1106. my $thisversion;
  1107. do {
  1108. if (!defined($thisversion)) {
  1109. $thisversion = $baseversion;
  1110. } else {
  1111. $thisversion = get_next_version($thisversion);
  1112. }
  1113. foreach $sym (@symbols) {
  1114. (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
  1115. my $v = 0;
  1116. $v = 1 if $i =~ /^.*?:.*?:VARIABLE/;
  1117. if (!defined($nums{$s})) {
  1118. die "Error: $s does not have a number assigned\n"
  1119. if(!$do_update);
  1120. } else {
  1121. (my $n, my $symversion, my $dummy) = split /\\/, $nums{$s};
  1122. my %pf = ();
  1123. my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
  1124. my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
  1125. if (is_valid($p,1) && is_valid($a,0)) {
  1126. my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1);
  1127. if ($prev eq $s2) {
  1128. print STDERR "Warning: Symbol '",$s2,
  1129. "' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),
  1130. ", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n";
  1131. }
  1132. $prev = $s2; # To warn about duplicates...
  1133. if($linux) {
  1134. next if $symversion ne $thisversion;
  1135. if ($symversion ne $prevsymversion) {
  1136. if ($prevsymversion ne "") {
  1137. if ($prevprevsymversion ne "") {
  1138. print OUT "} OPENSSL${SO_VARIANT}_"
  1139. ."$prevprevsymversion;\n\n";
  1140. } else {
  1141. print OUT "};\n\n";
  1142. }
  1143. }
  1144. print OUT "OPENSSL${SO_VARIANT}_$symversion {\n global:\n";
  1145. $prevprevsymversion = $prevsymversion;
  1146. $prevsymversion = $symversion;
  1147. }
  1148. print OUT " $s2;\n";
  1149. } elsif ($VMS) {
  1150. while(++$prevnum < $n) {
  1151. my $symline=" ,SPARE -\n ,SPARE -\n";
  1152. if ($symvtextcount + length($symline) - 2 > 1024) {
  1153. print OUT ")\nSYMBOL_VECTOR=(-\n";
  1154. $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-"
  1155. }
  1156. if ($symvtextcount == 16) {
  1157. # Take away first comma
  1158. $symline =~ s/,//;
  1159. }
  1160. print OUT $symline;
  1161. $symvtextcount += length($symline) - 2;
  1162. }
  1163. (my $s_uc = $s) =~ tr/a-z/A-Z/;
  1164. my $symtype=
  1165. $v ? "DATA" : "PROCEDURE";
  1166. my $symline=
  1167. ($s_uc ne $s
  1168. ? " ,$s_uc/$s=$symtype -\n ,$s=$symtype -\n"
  1169. : " ,$s=$symtype -\n ,SPARE -\n");
  1170. if ($symvtextcount + length($symline) - 2 > 1024) {
  1171. print OUT ")\nSYMBOL_VECTOR=(-\n";
  1172. $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-"
  1173. }
  1174. if ($symvtextcount == 16) {
  1175. # Take away first comma
  1176. $symline =~ s/,//;
  1177. }
  1178. print OUT $symline;
  1179. $symvtextcount += length($symline) - 2;
  1180. } elsif($v) {
  1181. printf OUT " %s%-39s DATA\n",
  1182. ($W32)?"":"_",$s2;
  1183. } else {
  1184. printf OUT " %s%s\n",
  1185. ($W32)?"":"_",$s2;
  1186. }
  1187. }
  1188. }
  1189. }
  1190. } while ($linux && $thisversion ne $currversion);
  1191. if ($linux) {
  1192. if ($prevprevsymversion ne "") {
  1193. print OUT " local: *;\n} OPENSSL${SO_VARIANT}_$prevprevsymversion;\n\n";
  1194. } else {
  1195. print OUT " local: *;\n};\n\n";
  1196. }
  1197. } elsif ($VMS) {
  1198. print OUT ")\n";
  1199. (my $libvmaj, my $libvmin, my $libvedit) =
  1200. $currversion =~ /^(\d+)_(\d+)_(\d+)$/;
  1201. # The reason to multiply the edit number with 100 is to make space
  1202. # for the possibility that we want to encode the patch letters
  1203. print OUT "GSMATCH=LEQUAL,",($libvmaj * 100 + $libvmin),",",($libvedit * 100),"\n";
  1204. }
  1205. printf OUT "\n";
  1206. }
  1207. sub load_numbers
  1208. {
  1209. my($name)=@_;
  1210. my(@a,%ret);
  1211. my $prevversion;
  1212. $max_num = 0;
  1213. $num_noinfo = 0;
  1214. $prev = "";
  1215. $prev_cnt = 0;
  1216. my ($baseversion, $currversion) = get_openssl_version();
  1217. open(IN,"<$name") || die "unable to open $name:$!\n";
  1218. while (<IN>) {
  1219. s|\R$||; # Better chomp
  1220. s/#.*$//;
  1221. next if /^\s*$/;
  1222. @a=split;
  1223. if (defined $ret{$a[0]}) {
  1224. # This is actually perfectly OK
  1225. #print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n";
  1226. }
  1227. if ($max_num > $a[1]) {
  1228. print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n";
  1229. }
  1230. elsif ($max_num == $a[1]) {
  1231. # This is actually perfectly OK
  1232. #print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n";
  1233. if ($a[0] eq $prev) {
  1234. $prev_cnt++;
  1235. $a[0] .= "{$prev_cnt}";
  1236. }
  1237. }
  1238. else {
  1239. $prev_cnt = 0;
  1240. }
  1241. if ($#a < 2) {
  1242. # Existence will be proven later, in do_defs
  1243. $ret{$a[0]}=$a[1];
  1244. $num_noinfo++;
  1245. } else {
  1246. #Sanity check the version number
  1247. if (defined $prevversion) {
  1248. check_version_lte($prevversion, $a[2]);
  1249. }
  1250. check_version_lte($a[2], $currversion);
  1251. $prevversion = $a[2];
  1252. $ret{$a[0]}=$a[1]."\\".$a[2]."\\".$a[3]; # \\ is a special marker
  1253. }
  1254. $max_num = $a[1] if $a[1] > $max_num;
  1255. $prev=$a[0];
  1256. }
  1257. if ($num_noinfo) {
  1258. print STDERR "Warning: $num_noinfo symbols were without info." if $verbose || !$do_rewrite;
  1259. if ($do_rewrite) {
  1260. printf STDERR " The rewrite will fix this.\n" if $verbose;
  1261. } else {
  1262. printf STDERR " You should do a rewrite to fix this.\n";
  1263. }
  1264. }
  1265. close(IN);
  1266. return(%ret);
  1267. }
  1268. sub parse_number
  1269. {
  1270. (my $str, my $what) = @_;
  1271. (my $n, my $v, my $i) = split(/\\/,$str);
  1272. if ($what eq "n") {
  1273. return $n;
  1274. } else {
  1275. return $i;
  1276. }
  1277. }
  1278. sub rewrite_numbers
  1279. {
  1280. (*OUT,$name,*nums,@symbols)=@_;
  1281. my $thing;
  1282. my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols);
  1283. my $r; my %r; my %rsyms;
  1284. foreach $r (@r) {
  1285. (my $s, my $i) = split /\\/, $r;
  1286. my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/;
  1287. $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/;
  1288. $r{$a} = $s."\\".$i;
  1289. $rsyms{$s} = 1;
  1290. }
  1291. my %syms = ();
  1292. foreach $_ (@symbols) {
  1293. (my $n, my $i) = split /\\/;
  1294. $syms{$n} = 1;
  1295. }
  1296. my @s=sort {
  1297. &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n")
  1298. || $a cmp $b
  1299. } keys %nums;
  1300. foreach $sym (@s) {
  1301. (my $n, my $vers, my $i) = split /\\/, $nums{$sym};
  1302. next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/;
  1303. next if defined($rsyms{$sym});
  1304. print STDERR "DEBUG: rewrite_numbers for sym = ",$sym,": i = ",$i,", n = ",$n,", rsym{sym} = ",$rsyms{$sym},"syms{sym} = ",$syms{$sym},"\n" if $debug;
  1305. $i="NOEXIST::FUNCTION:"
  1306. if !defined($i) || $i eq "" || !defined($syms{$sym});
  1307. my $s2 = $sym;
  1308. $s2 =~ s/\{[0-9]+\}$//;
  1309. printf OUT "%s%-39s %d\t%s\t%s\n","",$s2,$n,$vers,$i;
  1310. if (exists $r{$sym}) {
  1311. (my $s, $i) = split /\\/,$r{$sym};
  1312. my $s2 = $s;
  1313. $s2 =~ s/\{[0-9]+\}$//;
  1314. printf OUT "%s%-39s %d\t%s\t%s\n","",$s2,$n,$vers,$i;
  1315. }
  1316. }
  1317. }
  1318. sub update_numbers
  1319. {
  1320. (*OUT,$name,*nums,my $start_num, my @symbols)=@_;
  1321. my $new_syms = 0;
  1322. my $basevers;
  1323. my $vers;
  1324. ($basevers, $vers) = get_openssl_version();
  1325. my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols);
  1326. my $r; my %r; my %rsyms;
  1327. foreach $r (@r) {
  1328. (my $s, my $i) = split /\\/, $r;
  1329. my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/;
  1330. $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/;
  1331. $r{$a} = $s."\\".$i;
  1332. $rsyms{$s} = 1;
  1333. }
  1334. foreach $sym (@symbols) {
  1335. (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
  1336. next if $i =~ /^.*?:.*?:\w+\(\w+\)/;
  1337. next if defined($rsyms{$sym});
  1338. die "ERROR: Symbol $sym had no info attached to it."
  1339. if $i eq "";
  1340. if (!exists $nums{$s}) {
  1341. $new_syms++;
  1342. my $s2 = $s;
  1343. $s2 =~ s/\{[0-9]+\}$//;
  1344. printf OUT "%s%-39s %d\t%s\t%s\n","",$s2, ++$start_num,$vers,$i;
  1345. if (exists $r{$s}) {
  1346. ($s, $i) = split /\\/,$r{$s};
  1347. $s =~ s/\{[0-9]+\}$//;
  1348. printf OUT "%s%-39s %d\t%s\t%s\n","",$s, $start_num,$vers,$i;
  1349. }
  1350. }
  1351. }
  1352. if($new_syms) {
  1353. print STDERR "$name: Added $new_syms new symbols\n";
  1354. } else {
  1355. print STDERR "$name: No new symbols added\n";
  1356. }
  1357. }
  1358. sub check_existing
  1359. {
  1360. (*nums, my @symbols)=@_;
  1361. my %existing; my @remaining;
  1362. @remaining=();
  1363. foreach $sym (@symbols) {
  1364. (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
  1365. $existing{$s}=1;
  1366. }
  1367. foreach $sym (keys %nums) {
  1368. if (!exists $existing{$sym}) {
  1369. push @remaining, $sym;
  1370. }
  1371. }
  1372. if(@remaining) {
  1373. print STDERR "The following symbols do not seem to exist:\n";
  1374. foreach $sym (@remaining) {
  1375. print STDERR "\t",$sym,"\n";
  1376. }
  1377. }
  1378. }
  1379. sub count_parens
  1380. {
  1381. my $line = shift(@_);
  1382. my $open = $line =~ tr/\(//;
  1383. my $close = $line =~ tr/\)//;
  1384. return $open - $close;
  1385. }
  1386. #Parse opensslv.h to get the current version number. Also work out the base
  1387. #version, i.e. the lowest version number that is binary compatible with this
  1388. #version
  1389. sub get_openssl_version()
  1390. {
  1391. my $fn = catfile($config{sourcedir},"include","openssl","opensslv.h");
  1392. open (IN, "$fn") || die "Can't open opensslv.h";
  1393. while(<IN>) {
  1394. if (/OPENSSL_VERSION_TEXT\s+"OpenSSL (\d\.\d\.)(\d[a-z]*)(-| )/) {
  1395. my $suffix = $2;
  1396. (my $baseversion = $1) =~ s/\./_/g;
  1397. close IN;
  1398. return ($baseversion."0", $baseversion.$suffix);
  1399. }
  1400. }
  1401. die "Can't find OpenSSL version number\n";
  1402. }
  1403. #Given an OpenSSL version number, calculate the next version number. If the
  1404. #version number gets to a.b.czz then we go to a.b.(c+1)
  1405. sub get_next_version()
  1406. {
  1407. my $thisversion = shift;
  1408. my ($base, $letter) = $thisversion =~ /^(\d_\d_\d)([a-z]{0,2})$/;
  1409. if ($letter eq "zz") {
  1410. my $lastnum = substr($base, -1);
  1411. return substr($base, 0, length($base)-1).(++$lastnum);
  1412. }
  1413. return $base.get_next_letter($letter);
  1414. }
  1415. #Given the letters off the end of an OpenSSL version string, calculate what
  1416. #the letters for the next release would be.
  1417. sub get_next_letter()
  1418. {
  1419. my $thisletter = shift;
  1420. my $baseletter = "";
  1421. my $endletter;
  1422. if ($thisletter eq "") {
  1423. return "a";
  1424. }
  1425. if ((length $thisletter) > 1) {
  1426. ($baseletter, $endletter) = $thisletter =~ /([a-z]+)([a-z])/;
  1427. } else {
  1428. $endletter = $thisletter;
  1429. }
  1430. if ($endletter eq "z") {
  1431. return $thisletter."a";
  1432. } else {
  1433. return $baseletter.(++$endletter);
  1434. }
  1435. }
  1436. #Check if a version is less than or equal to the current version. Its a fatal
  1437. #error if not. They must also only differ in letters, or the last number (i.e.
  1438. #the first two numbers must be the same)
  1439. sub check_version_lte()
  1440. {
  1441. my ($testversion, $currversion) = @_;
  1442. my $lentv;
  1443. my $lencv;
  1444. my $cvbase;
  1445. my ($cvnums) = $currversion =~ /^(\d_\d_\d)[a-z]*$/;
  1446. my ($tvnums) = $testversion =~ /^(\d_\d_\d)[a-z]*$/;
  1447. #Die if we can't parse the version numbers or they don't look sane
  1448. die "Invalid version number: $testversion and $currversion\n"
  1449. if (!defined($cvnums) || !defined($tvnums)
  1450. || length($cvnums) != 5
  1451. || length($tvnums) != 5);
  1452. #If the base versions (without letters) don't match check they only differ
  1453. #in the last number
  1454. if ($cvnums ne $tvnums) {
  1455. die "Invalid version number: $testversion "
  1456. ."for current version $currversion\n"
  1457. if (substr($cvnums, 0, 4) ne substr($tvnums, 0, 4));
  1458. return;
  1459. }
  1460. #If we get here then the base version (i.e. the numbers) are the same - they
  1461. #only differ in the letters
  1462. $lentv = length $testversion;
  1463. $lencv = length $currversion;
  1464. #If the testversion has more letters than the current version then it must
  1465. #be later (or malformed)
  1466. if ($lentv > $lencv) {
  1467. die "Invalid version number: $testversion "
  1468. ."is greater than $currversion\n";
  1469. }
  1470. #Get the last letter from the current version
  1471. my ($cvletter) = $currversion =~ /([a-z])$/;
  1472. if (defined $cvletter) {
  1473. ($cvbase) = $currversion =~ /(\d_\d_\d[a-z]*)$cvletter$/;
  1474. } else {
  1475. $cvbase = $currversion;
  1476. }
  1477. die "Unable to parse version number $currversion" if (!defined $cvbase);
  1478. my $tvbase;
  1479. my ($tvletter) = $testversion =~ /([a-z])$/;
  1480. if (defined $tvletter) {
  1481. ($tvbase) = $testversion =~ /(\d_\d_\d[a-z]*)$tvletter$/;
  1482. } else {
  1483. $tvbase = $testversion;
  1484. }
  1485. die "Unable to parse version number $testversion" if (!defined $tvbase);
  1486. if ($lencv > $lentv) {
  1487. #If current version has more letters than testversion then testversion
  1488. #minus the final letter must be a substring of the current version
  1489. die "Invalid version number $testversion "
  1490. ."is greater than $currversion or is invalid\n"
  1491. if (index($cvbase, $tvbase) != 0);
  1492. } else {
  1493. #If both versions have the same number of letters then they must be
  1494. #equal up to the last letter, and the last letter in testversion must
  1495. #be less than or equal to the last letter in current version.
  1496. die "Invalid version number $testversion "
  1497. ."is greater than $currversion\n"
  1498. if (($cvbase ne $tvbase) && ($tvletter gt $cvletter));
  1499. }
  1500. }
  1501. sub do_deprecated()
  1502. {
  1503. my ($decl, $plats, $algs) = @_;
  1504. $decl =~ /^\s*(DEPRECATEDIN_\d+_\d+_\d+)\s*\((.*)\)\s*$/
  1505. or die "Bad DEPRECATEDIN: $decl\n";
  1506. my $info1 .= "#INFO:";
  1507. $info1 .= join(',', @{$plats}) . ":";
  1508. my $info2 = $info1;
  1509. $info1 .= join(',',@{$algs}, $1) . ";";
  1510. $info2 .= join(',',@{$algs}) . ";";
  1511. return $info1 . $2 . ";" . $info2;
  1512. }