xref: /openssl/util/mkinstallvars.pl (revision 7ed6de99)
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