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