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