mkdef.pl 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439
  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. nonstop => { writer => \&writer_nonstop,
  119. sort => OpenSSL::Ordinals::by_name(),
  120. platforms => { TANDEM => 1 } },
  121. );
  122. do {
  123. die "Unknown operating system family $OS\n"
  124. unless exists $OS_data{$OS};
  125. $OS = $OS_data{$OS};
  126. } while(ref($OS) eq '');
  127. my %disabled_uc = map { my $x = uc $_; $x =~ s|-|_|g; $x => 1 } keys %disabled;
  128. my %ordinal_opts = ();
  129. $ordinal_opts{sort} = $OS->{sort} if $OS->{sort};
  130. $ordinal_opts{filter} =
  131. sub {
  132. my $item = shift;
  133. return
  134. $item->exists()
  135. && platform_filter($item)
  136. && feature_filter($item);
  137. };
  138. my $ordinals = OpenSSL::Ordinals->new(from => $ordinals_file);
  139. my $writer = $OS->{writer};
  140. $writer = \&writer_ctest if $ctest;
  141. $writer->($ordinals->items(%ordinal_opts));
  142. exit 0;
  143. sub platform_filter {
  144. my $item = shift;
  145. my %platforms = ( $item->platforms() );
  146. # True if no platforms are defined
  147. return 1 if scalar keys %platforms == 0;
  148. # For any item platform tag, return the equivalence with the
  149. # current platform settings if it exists there, return 0 otherwise
  150. # if the item platform tag is true
  151. for (keys %platforms) {
  152. if (exists $OS->{platforms}->{$_}) {
  153. return $platforms{$_} == $OS->{platforms}->{$_};
  154. }
  155. if ($platforms{$_}) {
  156. return 0;
  157. }
  158. }
  159. # Found no match? Then it's a go
  160. return 1;
  161. }
  162. sub feature_filter {
  163. my $item = shift;
  164. my @features = ( $item->features() );
  165. # True if no features are defined
  166. return 1 if scalar @features == 0;
  167. my $verdict = ! grep { $disabled_uc{$_} } @features;
  168. if ($disabled{deprecated}) {
  169. foreach (@features) {
  170. next unless /^DEPRECATEDIN_(\d+)_(\d+)(?:_(\d+))?$/;
  171. my $symdep = $1 * 10000 + $2 * 100 + ($3 // 0);
  172. $verdict = 0 if $config{api} >= $symdep;
  173. print STDERR "DEBUG: \$symdep = $symdep, \$verdict = $verdict\n"
  174. if $debug && $1 == 0;
  175. }
  176. }
  177. return $verdict;
  178. }
  179. sub sorter_unix {
  180. my $by_name = OpenSSL::Ordinals::by_name();
  181. my %weight = (
  182. 'FUNCTION' => 1,
  183. 'VARIABLE' => 2
  184. );
  185. return sub {
  186. my $item1 = shift;
  187. my $item2 = shift;
  188. my $verdict = $weight{$item1->type()} <=> $weight{$item2->type()};
  189. if ($verdict == 0) {
  190. $verdict = $by_name->($item1, $item2);
  191. }
  192. return $verdict;
  193. };
  194. }
  195. sub sorter_linux {
  196. my $by_version = OpenSSL::Ordinals::by_version();
  197. my $by_unix = sorter_unix();
  198. return sub {
  199. my $item1 = shift;
  200. my $item2 = shift;
  201. my $verdict = $by_version->($item1, $item2);
  202. if ($verdict == 0) {
  203. $verdict = $by_unix->($item1, $item2);
  204. }
  205. return $verdict;
  206. };
  207. }
  208. sub writer_linux {
  209. my $thisversion = '';
  210. my $currversion_s = '';
  211. my $prevversion_s = '';
  212. my $indent = 0;
  213. for (@_) {
  214. if ($thisversion && $_->version() ne $thisversion) {
  215. die "$ordinals_file: It doesn't make sense to have both versioned ",
  216. "and unversioned symbols"
  217. if $thisversion eq '*';
  218. print <<"_____";
  219. }${prevversion_s};
  220. _____
  221. $prevversion_s = " OPENSSL${SO_VARIANT}_$thisversion";
  222. $thisversion = ''; # Trigger start of next section
  223. }
  224. unless ($thisversion) {
  225. $indent = 0;
  226. $thisversion = $_->version();
  227. $currversion_s = '';
  228. $currversion_s = "OPENSSL${SO_VARIANT}_$thisversion "
  229. if $thisversion ne '*';
  230. print <<"_____";
  231. ${currversion_s}{
  232. global:
  233. _____
  234. }
  235. print ' ', $_->name(), ";\n";
  236. }
  237. print <<"_____";
  238. local: *;
  239. }${prevversion_s};
  240. _____
  241. }
  242. sub writer_aix {
  243. for (@_) {
  244. print $_->name(),"\n";
  245. }
  246. }
  247. sub writer_nonstop {
  248. for (@_) {
  249. print "-export ",$_->name(),"\n";
  250. }
  251. }
  252. sub writer_windows {
  253. print <<"_____";
  254. ;
  255. ; Definition file for the DLL version of the $libname library from OpenSSL
  256. ;
  257. LIBRARY $libname
  258. EXPORTS
  259. _____
  260. for (@_) {
  261. print " ",$_->name(),"\n";
  262. }
  263. }
  264. sub collect_VMS_mixedcase {
  265. return [ 'SPARE', 'SPARE' ] unless @_;
  266. my $s = shift;
  267. my $s_uc = uc($s);
  268. my $type = shift;
  269. return [ "$s=$type", 'SPARE' ] if $s_uc eq $s;
  270. return [ "$s_uc/$s=$type", "$s=$type" ];
  271. }
  272. sub collect_VMS_uppercase {
  273. return [ 'SPARE' ] unless @_;
  274. my $s = shift;
  275. my $s_uc = uc($s);
  276. my $type = shift;
  277. return [ "$s_uc=$type" ];
  278. }
  279. sub writer_VMS {
  280. my @slot_collection = ();
  281. my $collector =
  282. $case_insensitive ? \&collect_VMS_uppercase : \&collect_VMS_mixedcase;
  283. my $last_num = 0;
  284. foreach (@_) {
  285. my $this_num = $_->number();
  286. $this_num = $last_num + 1 if $this_num =~ m|^\?|;
  287. while (++$last_num < $this_num) {
  288. push @slot_collection, $collector->(); # Just occupy a slot
  289. }
  290. my $type = {
  291. FUNCTION => 'PROCEDURE',
  292. VARIABLE => 'DATA'
  293. } -> {$_->type()};
  294. push @slot_collection, $collector->($_->name(), $type);
  295. }
  296. print <<"_____" if defined $version;
  297. IDENTIFICATION=$version
  298. _____
  299. print <<"_____" unless $case_insensitive;
  300. CASE_SENSITIVE=YES
  301. _____
  302. print <<"_____";
  303. SYMBOL_VECTOR=(-
  304. _____
  305. # It's uncertain how long aggregated lines the linker can handle,
  306. # but it has been observed that at least 1024 characters is ok.
  307. # Either way, this means that we need to keep track of the total
  308. # line length of each "SYMBOL_VECTOR" statement. Fortunately, we
  309. # can have more than one of those...
  310. my $symvtextcount = 16; # The length of "SYMBOL_VECTOR=("
  311. while (@slot_collection) {
  312. my $set = shift @slot_collection;
  313. my $settextlength = 0;
  314. foreach (@$set) {
  315. $settextlength +=
  316. + 3 # two space indentation and comma
  317. + length($_)
  318. + 1 # postdent
  319. ;
  320. }
  321. $settextlength--; # only one space indentation on the first one
  322. my $firstcomma = ',';
  323. if ($symvtextcount + $settextlength > 1024) {
  324. print <<"_____";
  325. )
  326. SYMBOL_VECTOR=(-
  327. _____
  328. $symvtextcount = 16; # The length of "SYMBOL_VECTOR=("
  329. }
  330. if ($symvtextcount == 16) {
  331. $firstcomma = '';
  332. }
  333. my $indent = ' '.$firstcomma;
  334. foreach (@$set) {
  335. print <<"_____";
  336. $indent$_ -
  337. _____
  338. $symvtextcount += length($indent) + length($_) + 1;
  339. $indent = ' ,';
  340. }
  341. }
  342. print <<"_____";
  343. )
  344. _____
  345. if (defined $version) {
  346. $version =~ /^(\d+)\.(\d+)\.(\d+)/;
  347. my $libvmajor = $1;
  348. my $libvminor = $2 * 100 + $3;
  349. print <<"_____";
  350. GSMATCH=LEQUAL,$libvmajor,$libvminor
  351. _____
  352. }
  353. }
  354. sub writer_ctest {
  355. print <<'_____';
  356. /*
  357. * Test file to check all DEF file symbols are present by trying
  358. * to link to all of them. This is *not* intended to be run!
  359. */
  360. int main()
  361. {
  362. _____
  363. my $last_num = 0;
  364. for (@_) {
  365. my $this_num = $_->number();
  366. $this_num = $last_num + 1 if $this_num =~ m|^\?|;
  367. if ($_->type() eq 'VARIABLE') {
  368. print "\textern int ", $_->name(), '; /* type unknown */ /* ',
  369. $this_num, ' ', $_->version(), " */\n";
  370. } else {
  371. print "\textern int ", $_->name(), '(); /* type unknown */ /* ',
  372. $this_num, ' ', $_->version(), " */\n";
  373. }
  374. $last_num = $this_num;
  375. }
  376. print <<'_____';
  377. }
  378. _____
  379. }