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