Home | History | Annotate | Line # | Download | only in util 
      1 #! /usr/bin/env perl
      2 # Copyright 2021-2026 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 # All variables are supposed to come from Makefile, in environment variable
     10 # form, or passed as variable assignments on the command line.
     11 # The result is a Perl module creating the package OpenSSL::safe::installdata.
     12 
     13 use 5.10.0;
     14 use strict;
     15 use warnings;
     16 use Carp;
     17 
     18 use File::Spec;
     19 #use List::Util qw(pairs);
     20 sub _pairs (@);
     21 
     22 # These are expected to be set up as absolute directories
     23 my @absolutes = qw(PREFIX libdir);
     24 # These may be absolute directories, and if not, they are expected to be set up
     25 # as subdirectories to PREFIX or LIBDIR.  The order of the pairs is important,
     26 # since the LIBDIR subdirectories depend on the calculation of LIBDIR from
     27 # PREFIX.
     28 my @subdirs = _pairs (PREFIX => [ qw(BINDIR LIBDIR INCLUDEDIR APPLINKDIR) ],
     29                       LIBDIR => [ qw(ENGINESDIR MODULESDIR PKGCONFIGDIR
     30                                      CMAKECONFIGDIR) ]);
     31 # For completeness, other expected variables
     32 my @others = qw(VERSION LDLIBS);
     33 
     34 my %all = ( );
     35 foreach (@absolutes) { $all{$_} = 1 }
     36 foreach (@subdirs) { foreach (@{$_->[1]}) { $all{$_} = 1 } }
     37 foreach (@others) { $all{$_} = 1 }
     38 print STDERR "DEBUG: all keys: ", join(", ", sort keys %all), "\n";
     39 
     40 my %keys = ();
     41 my %values = ();
     42 foreach (@ARGV) {
     43     (my $k, my $v) = m|^([^=]*)=(.*)$|;
     44     $keys{$k} = 1;
     45     push @{$values{$k}}, $v;
     46 }
     47 
     48 # special case for LIBDIR vs libdir.
     49 # For installations, They both get their value from ./Configure's --libdir or
     50 # corresponding config target attribute, but LIBDIR only gets a value if the
     51 # configuration is a relative path, while libdir always gets a value, so if
     52 # the former doesn't have a value, we give it the latter's value, and rely
     53 # on mechanisms further down to do the rest of the processing.
     54 # If they're both empty, it's still fine.
     55 print STDERR "DEBUG: LIBDIR = $values{LIBDIR}->[0], libdir = $values{libdir}->[0] => ";
     56 $values{LIBDIR}->[0] = $values{libdir}->[0] unless $values{LIBDIR}->[0];
     57 print STDERR "LIBDIR = $values{LIBDIR}->[0]\n";
     58 
     59 # warn if there are missing values, and also if there are unexpected values
     60 foreach my $k (sort keys %all) {
     61     warn "No value given for $k\n" unless $keys{$k};
     62 }
     63 foreach my $k (sort keys %keys) {
     64     warn "Unknown variable $k\n" unless $all{$k};
     65 }
     66 
     67 # This shouldn't be needed, but just in case we get relative paths that
     68 # should be absolute, make sure they actually are.
     69 foreach my $k (@absolutes) {
     70     my $v = $values{$k} || [ '.' ];
     71     die "Can't have more than one $k\n" if scalar @$v > 1;
     72     print STDERR "DEBUG: $k = $v->[0] => ";
     73     $v = [ map { File::Spec->rel2abs($_) } @$v ];
     74     $values{$k} = $v;
     75     print STDERR "$k = $v->[0]\n";
     76 }
     77 
     78 # Absolute paths for the subdir variables are computed.  This provides
     79 # the usual form of values for names that have become norm, known as GNU
     80 # installation paths.
     81 # For the benefit of those that need it, the subdirectories are preserved
     82 # as they are, using the same variable names, suffixed with '_REL_{var}',
     83 # if they are indeed subdirectories.  The '{var}' part of the name tells
     84 # which other variable value they are relative to.
     85 foreach my $pair (@subdirs) {
     86     my ($var, $subdir_vars) = @$pair;
     87     foreach my $k (@$subdir_vars) {
     88         my $kr = "${k}_REL_${var}";
     89         my $v2 = $values{$k} || [ '.' ];
     90         $values{$k} = [];       # We're rebuilding it
     91         print STDERR "DEBUG: $k = ",
     92             (scalar @$v2 > 1 ? "[ " . join(", ", @$v2) . " ]" : $v2->[0]),
     93             " => ";
     94         foreach my $v (@$v2) {
     95             if (File::Spec->file_name_is_absolute($v)) {
     96                 push @{$values{$k}}, $v;
     97                 push @{$values{$kr}},
     98                     File::Spec->abs2rel($v, $values{$var}->[0]);
     99             } else {
    100                 push @{$values{$kr}}, $v;
    101                 push @{$values{$k}},
    102                     File::Spec->rel2abs($v, $values{$var}->[0]);
    103             }
    104         }
    105         print STDERR join(", ",
    106                           map {
    107                               my $v = $values{$_};
    108                               "$_ = " . (scalar @$v > 1
    109                                          ? "[ " . join(", ", @$v) . " ]"
    110                                          : $v->[0]);
    111                           } ($k, $kr)),
    112             "\n";
    113     }
    114 }
    115 
    116 print <<_____;
    117 package OpenSSL::safe::installdata;
    118 
    119 use strict;
    120 use warnings;
    121 use Exporter;
    122 our \@ISA = qw(Exporter);
    123 our \@EXPORT = qw(
    124 _____
    125 
    126 foreach my $k (@absolutes) {
    127     print "    \@$k\n";
    128 }
    129 foreach my $pair (@subdirs) {
    130     my ($var, $subdir_vars) = @$pair;
    131     foreach my $k (@$subdir_vars) {
    132         my $k2 = "${k}_REL_${var}";
    133         print "    \@$k \@$k2\n";
    134     }
    135 }
    136 
    137 print <<_____;
    138     \$VERSION \@LDLIBS
    139 );
    140 
    141 _____
    142 
    143 foreach my $k (@absolutes) {
    144     print "our \@$k" . ' ' x (27 - length($k)) . "= ( '",
    145         join("', '", @{$values{$k}}),
    146         "' );\n";
    147 }
    148 foreach my $pair (@subdirs) {
    149     my ($var, $subdir_vars) = @$pair;
    150     foreach my $k (@$subdir_vars) {
    151         my $k2 = "${k}_REL_${var}";
    152         print "our \@$k" . ' ' x (27 - length($k)) . "= ( '",
    153             join("', '", @{$values{$k}}),
    154             "' );\n";
    155         print "our \@$k2" . ' ' x (27 - length($k2)) . "= ( '",
    156             join("', '", @{$values{$k2}}),
    157             "' );\n";
    158     }
    159 }
    160 
    161 print <<_____;
    162 our \$VERSION                    = '$values{VERSION}->[0]';
    163 our \@LDLIBS                     =
    164     # Unix and Windows use space separation, VMS uses comma separation
    165     \$^O eq 'VMS'
    166     ? split(/ *, */, '$values{LDLIBS}->[0]')
    167     : split(/ +/, '$values{LDLIBS}->[0]');
    168 
    169 1;
    170 _____
    171 
    172 ######## Helpers
    173 
    174 # _pairs LIST
    175 #
    176 # This operates on an even-sized list, and returns a list of "ARRAY"
    177 # references, each containing two items from the given LIST.
    178 #
    179 # It is a quick cheap reimplementation of List::Util::pairs(), a function
    180 # we cannot use, because it only appeared in perl v5.19.3, and we claim to
    181 # support perl versions all the way back to v5.10.
    182 
    183 sub _pairs (@) {
    184     croak "Odd number of arguments" if @_ & 1;
    185 
    186     my @pairlist = ();
    187 
    188     while (@_) {
    189         my $x = [ shift, shift ];
    190         push @pairlist, $x;
    191     }
    192     return @pairlist;
    193 }
    194