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