mkdef.pl 49 KB

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