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