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