util/mkdef.pl

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