mkdef.pl 12 KB

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