2
0

mkdef.pl 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430
  1. #! /usr/bin/env perl
  2. # Copyright 2018-2020 The OpenSSL Project Authors. All Rights Reserved.
  3. #
  4. # Licensed under the Apache License 2.0 (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. # Generate a linker version script suitable for the given platform
  9. # from a given ordinals file.
  10. use strict;
  11. use warnings;
  12. use Getopt::Long;
  13. use FindBin;
  14. use lib "$FindBin::Bin/perl";
  15. use OpenSSL::Ordinals;
  16. use lib '.';
  17. use configdata;
  18. use File::Spec::Functions;
  19. use lib catdir($config{sourcedir}, 'Configurations');
  20. use platform;
  21. my $name = undef; # internal library/module name
  22. my $ordinals_file = undef; # the ordinals file to use
  23. my $version = undef; # the version to use for the library
  24. my $OS = undef; # the operating system family
  25. my $verbose = 0;
  26. my $ctest = 0;
  27. my $debug = 0;
  28. # For VMS, some modules may have case insensitive names
  29. my $case_insensitive = 0;
  30. GetOptions('name=s' => \$name,
  31. 'ordinals=s' => \$ordinals_file,
  32. 'version=s' => \$version,
  33. 'OS=s' => \$OS,
  34. 'ctest' => \$ctest,
  35. 'verbose' => \$verbose,
  36. # For VMS
  37. 'case-insensitive' => \$case_insensitive)
  38. or die "Error in command line arguments\n";
  39. die "Please supply arguments\n"
  40. unless $name && $ordinals_file && $OS;
  41. # When building a "variant" shared library, with a custom SONAME, also customize
  42. # all the symbol versions. This produces a shared object that can coexist
  43. # without conflict in the same address space as a default build, or an object
  44. # with a different variant tag.
  45. #
  46. # For example, with a target definition that includes:
  47. #
  48. # shlib_variant => "-opt",
  49. #
  50. # we build the following objects:
  51. #
  52. # $ perl -le '
  53. # for (@ARGV) {
  54. # if ($l = readlink) {
  55. # printf "%s -> %s\n", $_, $l
  56. # } else {
  57. # print
  58. # }
  59. # }' *.so*
  60. # libcrypto-opt.so.1.1
  61. # libcrypto.so -> libcrypto-opt.so.1.1
  62. # libssl-opt.so.1.1
  63. # libssl.so -> libssl-opt.so.1.1
  64. #
  65. # whose SONAMEs and dependencies are:
  66. #
  67. # $ for l in *.so; do
  68. # echo $l
  69. # readelf -d $l | egrep 'SONAME|NEEDED.*(ssl|crypto)'
  70. # done
  71. # libcrypto.so
  72. # 0x000000000000000e (SONAME) Library soname: [libcrypto-opt.so.1.1]
  73. # libssl.so
  74. # 0x0000000000000001 (NEEDED) Shared library: [libcrypto-opt.so.1.1]
  75. # 0x000000000000000e (SONAME) Library soname: [libssl-opt.so.1.1]
  76. #
  77. # We case-fold the variant tag to upper case and replace all non-alnum
  78. # characters with "_". This yields the following symbol versions:
  79. #
  80. # $ nm libcrypto.so | grep -w A
  81. # 0000000000000000 A OPENSSL_OPT_1_1_0
  82. # 0000000000000000 A OPENSSL_OPT_1_1_0a
  83. # 0000000000000000 A OPENSSL_OPT_1_1_0c
  84. # 0000000000000000 A OPENSSL_OPT_1_1_0d
  85. # 0000000000000000 A OPENSSL_OPT_1_1_0f
  86. # 0000000000000000 A OPENSSL_OPT_1_1_0g
  87. # $ nm libssl.so | grep -w A
  88. # 0000000000000000 A OPENSSL_OPT_1_1_0
  89. # 0000000000000000 A OPENSSL_OPT_1_1_0d
  90. #
  91. (my $SO_VARIANT = uc($target{"shlib_variant"} // '')) =~ s/\W/_/g;
  92. my $libname = platform->sharedname($name);
  93. my %OS_data = (
  94. solaris => { writer => \&writer_linux,
  95. sort => sorter_linux(),
  96. platforms => { UNIX => 1 } },
  97. "solaris-gcc" => 'solaris', # alias
  98. linux => 'solaris', # alias
  99. "bsd-gcc" => 'solaris', # alias
  100. aix => { writer => \&writer_aix,
  101. sort => sorter_unix(),
  102. platforms => { UNIX => 1 } },
  103. VMS => { writer => \&writer_VMS,
  104. sort => OpenSSL::Ordinals::by_number(),
  105. platforms => { VMS => 1 } },
  106. vms => 'VMS', # alias
  107. WINDOWS => { writer => \&writer_windows,
  108. sort => OpenSSL::Ordinals::by_name(),
  109. platforms => { WIN32 => 1,
  110. _WIN32 => 1 } },
  111. windows => 'WINDOWS', # alias
  112. WIN32 => 'WINDOWS', # alias
  113. win32 => 'WIN32', # alias
  114. 32 => 'WIN32', # alias
  115. NT => 'WIN32', # alias
  116. nt => 'WIN32', # alias
  117. mingw => 'WINDOWS', # alias
  118. );
  119. do {
  120. die "Unknown operating system family $OS\n"
  121. unless exists $OS_data{$OS};
  122. $OS = $OS_data{$OS};
  123. } while(ref($OS) eq '');
  124. my %disabled_uc = map { my $x = uc $_; $x =~ s|-|_|g; $x => 1 } keys %disabled;
  125. my %ordinal_opts = ();
  126. $ordinal_opts{sort} = $OS->{sort} if $OS->{sort};
  127. $ordinal_opts{filter} =
  128. sub {
  129. my $item = shift;
  130. return
  131. $item->exists()
  132. && platform_filter($item)
  133. && feature_filter($item);
  134. };
  135. my $ordinals = OpenSSL::Ordinals->new(from => $ordinals_file);
  136. my $writer = $OS->{writer};
  137. $writer = \&writer_ctest if $ctest;
  138. $writer->($ordinals->items(%ordinal_opts));
  139. exit 0;
  140. sub platform_filter {
  141. my $item = shift;
  142. my %platforms = ( $item->platforms() );
  143. # True if no platforms are defined
  144. return 1 if scalar keys %platforms == 0;
  145. # For any item platform tag, return the equivalence with the
  146. # current platform settings if it exists there, return 0 otherwise
  147. # if the item platform tag is true
  148. for (keys %platforms) {
  149. if (exists $OS->{platforms}->{$_}) {
  150. return $platforms{$_} == $OS->{platforms}->{$_};
  151. }
  152. if ($platforms{$_}) {
  153. return 0;
  154. }
  155. }
  156. # Found no match? Then it's a go
  157. return 1;
  158. }
  159. sub feature_filter {
  160. my $item = shift;
  161. my @features = ( $item->features() );
  162. # True if no features are defined
  163. return 1 if scalar @features == 0;
  164. my $verdict = ! grep { $disabled_uc{$_} } @features;
  165. if ($disabled{deprecated}) {
  166. foreach (@features) {
  167. next unless /^DEPRECATEDIN_(\d+)_(\d+)(?:_(\d+))?$/;
  168. my $symdep = $1 * 10000 + $2 * 100 + ($3 // 0);
  169. $verdict = 0 if $config{api} >= $symdep;
  170. print STDERR "DEBUG: \$symdep = $symdep, \$verdict = $verdict\n"
  171. if $debug && $1 == 0;
  172. }
  173. }
  174. return $verdict;
  175. }
  176. sub sorter_unix {
  177. my $by_name = OpenSSL::Ordinals::by_name();
  178. my %weight = (
  179. 'FUNCTION' => 1,
  180. 'VARIABLE' => 2
  181. );
  182. return sub {
  183. my $item1 = shift;
  184. my $item2 = shift;
  185. my $verdict = $weight{$item1->type()} <=> $weight{$item2->type()};
  186. if ($verdict == 0) {
  187. $verdict = $by_name->($item1, $item2);
  188. }
  189. return $verdict;
  190. };
  191. }
  192. sub sorter_linux {
  193. my $by_version = OpenSSL::Ordinals::by_version();
  194. my $by_unix = sorter_unix();
  195. return sub {
  196. my $item1 = shift;
  197. my $item2 = shift;
  198. my $verdict = $by_version->($item1, $item2);
  199. if ($verdict == 0) {
  200. $verdict = $by_unix->($item1, $item2);
  201. }
  202. return $verdict;
  203. };
  204. }
  205. sub writer_linux {
  206. my $thisversion = '';
  207. my $currversion_s = '';
  208. my $prevversion_s = '';
  209. my $indent = 0;
  210. for (@_) {
  211. if ($thisversion && $_->version() ne $thisversion) {
  212. die "$ordinals_file: It doesn't make sense to have both versioned ",
  213. "and unversioned symbols"
  214. if $thisversion eq '*';
  215. print <<"_____";
  216. }${prevversion_s};
  217. _____
  218. $prevversion_s = " OPENSSL${SO_VARIANT}_$thisversion";
  219. $thisversion = ''; # Trigger start of next section
  220. }
  221. unless ($thisversion) {
  222. $indent = 0;
  223. $thisversion = $_->version();
  224. $currversion_s = '';
  225. $currversion_s = "OPENSSL${SO_VARIANT}_$thisversion "
  226. if $thisversion ne '*';
  227. print <<"_____";
  228. ${currversion_s}{
  229. global:
  230. _____
  231. }
  232. print ' ', $_->name(), ";\n";
  233. }
  234. print <<"_____";
  235. local: *;
  236. }${prevversion_s};
  237. _____
  238. }
  239. sub writer_aix {
  240. for (@_) {
  241. print $_->name(),"\n";
  242. }
  243. }
  244. sub writer_windows {
  245. print <<"_____";
  246. ;
  247. ; Definition file for the DLL version of the $libname library from OpenSSL
  248. ;
  249. LIBRARY $libname
  250. EXPORTS
  251. _____
  252. for (@_) {
  253. print " ",$_->name(),"\n";
  254. }
  255. }
  256. sub collect_VMS_mixedcase {
  257. return [ 'SPARE', 'SPARE' ] unless @_;
  258. my $s = shift;
  259. my $s_uc = uc($s);
  260. my $type = shift;
  261. return [ "$s=$type", 'SPARE' ] if $s_uc eq $s;
  262. return [ "$s_uc/$s=$type", "$s=$type" ];
  263. }
  264. sub collect_VMS_uppercase {
  265. return [ 'SPARE' ] unless @_;
  266. my $s = shift;
  267. my $s_uc = uc($s);
  268. my $type = shift;
  269. return [ "$s_uc=$type" ];
  270. }
  271. sub writer_VMS {
  272. my @slot_collection = ();
  273. my $collector =
  274. $case_insensitive ? \&collect_VMS_uppercase : \&collect_VMS_mixedcase;
  275. my $last_num = 0;
  276. foreach (@_) {
  277. my $this_num = $_->number();
  278. $this_num = $last_num + 1 if $this_num =~ m|^\?|;
  279. while (++$last_num < $this_num) {
  280. push @slot_collection, $collector->(); # Just occupy a slot
  281. }
  282. my $type = {
  283. FUNCTION => 'PROCEDURE',
  284. VARIABLE => 'DATA'
  285. } -> {$_->type()};
  286. push @slot_collection, $collector->($_->name(), $type);
  287. }
  288. print <<"_____" if defined $version;
  289. IDENTIFICATION=$version
  290. _____
  291. print <<"_____" unless $case_insensitive;
  292. CASE_SENSITIVE=YES
  293. _____
  294. print <<"_____";
  295. SYMBOL_VECTOR=(-
  296. _____
  297. # It's uncertain how long aggregated lines the linker can handle,
  298. # but it has been observed that at least 1024 characters is ok.
  299. # Either way, this means that we need to keep track of the total
  300. # line length of each "SYMBOL_VECTOR" statement. Fortunately, we
  301. # can have more than one of those...
  302. my $symvtextcount = 16; # The length of "SYMBOL_VECTOR=("
  303. while (@slot_collection) {
  304. my $set = shift @slot_collection;
  305. my $settextlength = 0;
  306. foreach (@$set) {
  307. $settextlength +=
  308. + 3 # two space indentation and comma
  309. + length($_)
  310. + 1 # postdent
  311. ;
  312. }
  313. $settextlength--; # only one space indentation on the first one
  314. my $firstcomma = ',';
  315. if ($symvtextcount + $settextlength > 1024) {
  316. print <<"_____";
  317. )
  318. SYMBOL_VECTOR=(-
  319. _____
  320. $symvtextcount = 16; # The length of "SYMBOL_VECTOR=("
  321. }
  322. if ($symvtextcount == 16) {
  323. $firstcomma = '';
  324. }
  325. my $indent = ' '.$firstcomma;
  326. foreach (@$set) {
  327. print <<"_____";
  328. $indent$_ -
  329. _____
  330. $symvtextcount += length($indent) + length($_) + 1;
  331. $indent = ' ,';
  332. }
  333. }
  334. print <<"_____";
  335. )
  336. _____
  337. if (defined $version) {
  338. $version =~ /^(\d+)\.(\d+)\.(\d+)/;
  339. my $libvmajor = $1;
  340. my $libvminor = $2 * 100 + $3;
  341. print <<"_____";
  342. GSMATCH=LEQUAL,$libvmajor,$libvminor
  343. _____
  344. }
  345. }
  346. sub writer_ctest {
  347. print <<'_____';
  348. /*
  349. * Test file to check all DEF file symbols are present by trying
  350. * to link to all of them. This is *not* intended to be run!
  351. */
  352. int main()
  353. {
  354. _____
  355. my $last_num = 0;
  356. for (@_) {
  357. my $this_num = $_->number();
  358. $this_num = $last_num + 1 if $this_num =~ m|^\?|;
  359. if ($_->type() eq 'VARIABLE') {
  360. print "\textern int ", $_->name(), '; /* type unknown */ /* ',
  361. $this_num, ' ', $_->version(), " */\n";
  362. } else {
  363. print "\textern int ", $_->name(), '(); /* type unknown */ /* ',
  364. $this_num, ' ', $_->version(), " */\n";
  365. }
  366. $last_num = $this_num;
  367. }
  368. print <<'_____';
  369. }
  370. _____
  371. }