2
0

mkdef.pl 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427
  1. #! /usr/bin/env perl
  2. # Copyright 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. # 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. my $name = undef; # internal library/module name
  19. my $ordinals_file = undef; # the ordinals file to use
  20. my $version = undef; # the version to use for the library
  21. my $OS = undef; # the operating system family
  22. my $verbose = 0;
  23. my $ctest = 0;
  24. # For VMS, some modules may have case insensitive names
  25. my $case_insensitive = 0;
  26. GetOptions('name=s' => \$name,
  27. 'ordinals=s' => \$ordinals_file,
  28. 'version=s' => \$version,
  29. 'OS=s' => \$OS,
  30. 'ctest' => \$ctest,
  31. 'verbose' => \$verbose,
  32. # For VMS
  33. 'case-insensitive' => \$case_insensitive)
  34. or die "Error in command line arguments\n";
  35. die "Please supply arguments\n"
  36. unless $name && $ordinals_file && $OS;
  37. # When building a "variant" shared library, with a custom SONAME, also customize
  38. # all the symbol versions. This produces a shared object that can coexist
  39. # without conflict in the same address space as a default build, or an object
  40. # with a different variant tag.
  41. #
  42. # For example, with a target definition that includes:
  43. #
  44. # shlib_variant => "-opt",
  45. #
  46. # we build the following objects:
  47. #
  48. # $ perl -le '
  49. # for (@ARGV) {
  50. # if ($l = readlink) {
  51. # printf "%s -> %s\n", $_, $l
  52. # } else {
  53. # print
  54. # }
  55. # }' *.so*
  56. # libcrypto-opt.so.1.1
  57. # libcrypto.so -> libcrypto-opt.so.1.1
  58. # libssl-opt.so.1.1
  59. # libssl.so -> libssl-opt.so.1.1
  60. #
  61. # whose SONAMEs and dependencies are:
  62. #
  63. # $ for l in *.so; do
  64. # echo $l
  65. # readelf -d $l | egrep 'SONAME|NEEDED.*(ssl|crypto)'
  66. # done
  67. # libcrypto.so
  68. # 0x000000000000000e (SONAME) Library soname: [libcrypto-opt.so.1.1]
  69. # libssl.so
  70. # 0x0000000000000001 (NEEDED) Shared library: [libcrypto-opt.so.1.1]
  71. # 0x000000000000000e (SONAME) Library soname: [libssl-opt.so.1.1]
  72. #
  73. # We case-fold the variant tag to upper case and replace all non-alnum
  74. # characters with "_". This yields the following symbol versions:
  75. #
  76. # $ nm libcrypto.so | grep -w A
  77. # 0000000000000000 A OPENSSL_OPT_1_1_0
  78. # 0000000000000000 A OPENSSL_OPT_1_1_0a
  79. # 0000000000000000 A OPENSSL_OPT_1_1_0c
  80. # 0000000000000000 A OPENSSL_OPT_1_1_0d
  81. # 0000000000000000 A OPENSSL_OPT_1_1_0f
  82. # 0000000000000000 A OPENSSL_OPT_1_1_0g
  83. # $ nm libssl.so | grep -w A
  84. # 0000000000000000 A OPENSSL_OPT_1_1_0
  85. # 0000000000000000 A OPENSSL_OPT_1_1_0d
  86. #
  87. (my $SO_VARIANT = uc($target{"shlib_variant"} // '')) =~ s/\W/_/g;
  88. my $apiv = undef;
  89. $apiv = sprintf "%x%02x%02x", split(/\./, $config{api})
  90. if $config{api};
  91. my $libname = $unified_info{sharednames}->{$name} // $name;
  92. my %OS_data = (
  93. solaris => { writer => \&writer_linux,
  94. sort => sorter_linux(),
  95. platforms => { UNIX => 1,
  96. EXPORT_VAR_AS_FUNCTION => 0 } },
  97. linux => 'solaris', # alias
  98. "bsd-gcc" => 'solaris', # alias
  99. aix => { writer => \&writer_aix,
  100. sort => sorter_unix(),
  101. platforms => { UNIX => 1,
  102. EXPORT_VAR_AS_FUNCTION => 0 } },
  103. VMS => { writer => \&writer_VMS,
  104. sort => OpenSSL::Ordinals::by_number(),
  105. platforms => { VMS => 1,
  106. EXPORT_VAR_AS_FUNCTION => 0 } },
  107. vms => 'VMS', # alias
  108. WINDOWS => { writer => \&writer_windows,
  109. sort => OpenSSL::Ordinals::by_name(),
  110. platforms => { WIN32 => 1,
  111. _WIN32 => 1,
  112. EXPORT_VAR_AS_FUNCTION => 1 } },
  113. windows => 'WINDOWS', # alias
  114. WIN32 => 'WINDOWS', # alias
  115. win32 => 'WIN32', # alias
  116. 32 => 'WIN32', # alias
  117. NT => 'WIN32', # alias
  118. nt => 'WIN32', # alias
  119. mingw => 'WINDOWS', # alias
  120. );
  121. do {
  122. die "Unknown operating system family $OS\n"
  123. unless exists $OS_data{$OS};
  124. $OS = $OS_data{$OS};
  125. } while(ref($OS) eq '');
  126. my %disabled_uc = map { my $x = uc $_; $x =~ s|-|_|g; $x => 1 } keys %disabled;
  127. my %ordinal_opts = ();
  128. $ordinal_opts{sort} = $OS->{sort} if $OS->{sort};
  129. $ordinal_opts{filter} =
  130. sub {
  131. my $item = shift;
  132. return
  133. $item->exists()
  134. && platform_filter($item)
  135. && feature_filter($item);
  136. };
  137. my $ordinals = OpenSSL::Ordinals->new(from => $ordinals_file);
  138. my $writer = $OS->{writer};
  139. $writer = \&writer_ctest if $ctest;
  140. $writer->($ordinals->items(%ordinal_opts));
  141. exit 0;
  142. sub platform_filter {
  143. my $item = shift;
  144. my %platforms = ( $item->platforms() );
  145. # True if no platforms are defined
  146. return 1 if scalar keys %platforms == 0;
  147. # For any item platform tag, return the equivalence with the
  148. # current platform settings if it exists there, return 0 otherwise
  149. # if the item platform tag is true
  150. for (keys %platforms) {
  151. if (exists $OS->{platforms}->{$_}) {
  152. return $platforms{$_} == $OS->{platforms}->{$_};
  153. }
  154. if ($platforms{$_}) {
  155. return 0;
  156. }
  157. }
  158. # Found no match? Then it's a go
  159. return 1;
  160. }
  161. sub feature_filter {
  162. my $item = shift;
  163. my @features = ( $item->features() );
  164. # True if no features are defined
  165. return 1 if scalar @features == 0;
  166. my $verdict = ! grep { $disabled_uc{$_} } @features;
  167. if ($apiv) {
  168. foreach (@features) {
  169. next unless /^DEPRECATEDIN_(\d+)_(\d+)_(\d+)$/;
  170. my $symdep = sprintf "%x%02x%02x", $1, $2, $3;
  171. $verdict = 0 if $apiv ge $symdep;
  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. while (++$last_num < $_->number()) {
  278. push @slot_collection, $collector->(); # Just occupy a slot
  279. }
  280. my $type = {
  281. FUNCTION => 'PROCEDURE',
  282. VARIABLE => 'DATA'
  283. } -> {$_->type()};
  284. push @slot_collection, $collector->($_->name(), $type);
  285. }
  286. print <<"_____" if defined $version;
  287. IDENTIFICATION=$version
  288. _____
  289. print <<"_____" unless $case_insensitive;
  290. CASE_SENSITIVE=YES
  291. _____
  292. print <<"_____";
  293. SYMBOL_VECTOR=(-
  294. _____
  295. # It's uncertain how long aggregated lines the linker can handle,
  296. # but it has been observed that at least 1024 characters is ok.
  297. # Either way, this means that we need to keep track of the total
  298. # line length of each "SYMBOL_VECTOR" statement. Fortunately, we
  299. # can have more than one of those...
  300. my $symvtextcount = 16; # The length of "SYMBOL_VECTOR=("
  301. while (@slot_collection) {
  302. my $set = shift @slot_collection;
  303. my $settextlength = 0;
  304. foreach (@$set) {
  305. $settextlength +=
  306. + 3 # two space indentation and comma
  307. + length($_)
  308. + 1 # postdent
  309. ;
  310. }
  311. $settextlength--; # only one space indentation on the first one
  312. my $firstcomma = ',';
  313. if ($symvtextcount + $settextlength > 1024) {
  314. print <<"_____";
  315. )
  316. SYMBOL_VECTOR=(-
  317. _____
  318. $symvtextcount = 16; # The length of "SYMBOL_VECTOR=("
  319. }
  320. if ($symvtextcount == 16) {
  321. $firstcomma = '';
  322. }
  323. my $indent = ' '.$firstcomma;
  324. foreach (@$set) {
  325. print <<"_____";
  326. $indent$_ -
  327. _____
  328. $symvtextcount += length($indent) + length($_) + 1;
  329. $indent = ' ,';
  330. }
  331. }
  332. print <<"_____";
  333. )
  334. _____
  335. if (defined $version) {
  336. my ($libvmajor, $libvminor, $libvedit, $libvpatch) =
  337. $version =~ /^(\d+)_(\d+)_(\d+)([a-z]{0,2})(?:-.*)?$/;
  338. my $libvpatchnum = 0;
  339. for (split '', $libvpatch // '') {
  340. $libvpatchnum += ord(lc($_)) - 96;
  341. # To compensate because the letter 'z' is always followed by
  342. # another, i.e. doesn't add any value on its own
  343. $libvpatchnum-- if lc($_) eq 'z';
  344. }
  345. my $match1 = $libvmajor * 100 + $libvminor;
  346. my $match2 = $libvedit * 100 + $libvpatchnum;
  347. print <<"_____";
  348. GSMATCH=LEQUAL,$match1,$match2
  349. _____
  350. }
  351. }
  352. sub writer_ctest {
  353. print <<'_____';
  354. /*
  355. * Test file to check all DEF file symbols are present by trying
  356. * to link to all of them. This is *not* intended to be run!
  357. */
  358. int main()
  359. {
  360. _____
  361. for (@_) {
  362. if ($_->type() eq 'VARIABLE') {
  363. print "\textern int ", $_->name(), '; /* type unknown */ /* ', $_->number(), ' ', $_->version(), " */\n";
  364. } else {
  365. print "\textern int ", $_->name(), '(); /* type unknown */ /* ', $_->number(), ' ', $_->version(), " */\n";
  366. }
  367. }
  368. print <<'_____';
  369. }
  370. _____
  371. }