xref: /freebsd/crypto/openssl/util/perl/OpenSSL/Config/Query.pm (revision 96190b4fef3b4a0cc3ca0606b0c4e3e69a5e6717) 
1# Copyright 2021 The OpenSSL Project Authors. All Rights Reserved.
2#
3# Licensed under the Apache License 2.0 (the "License").  You may not use
4# this file except in compliance with the License.  You can obtain a copy
5# in the file LICENSE in the source distribution or at
6# https://www.openssl.org/source/license.html
7
8package OpenSSL::Config::Query;
9
10use 5.10.0;
11use strict;
12use warnings;
13use Carp;
14
15=head1 NAME
16
17OpenSSL::Config::Query - Query OpenSSL configuration info
18
19=head1 SYNOPSIS
20
21    use OpenSSL::Config::Info;
22
23    my $query = OpenSSL::Config::Query->new(info => \%unified_info);
24
25    # Query for something that's expected to give a scalar back
26    my $variable = $query->method(... args ...);
27
28    # Query for something that's expected to give a list back
29    my @variable = $query->method(... args ...);
30
31=head1 DESCRIPTION
32
33The unified info structure, commonly known as the %unified_info table, has
34become quite complex, and a bit overwhelming to look through directly.  This
35module makes querying this structure simpler, through diverse methods.
36
37=head2 Constructor
38
39=over 4
40
41=item B<new> I<%options>
42
43Creates an instance of the B<OpenSSL::Config::Query> class.  It takes options
44in keyed pair form, i.e. a series of C<< key => value >> pairs.  Available
45options are:
46
47=over 4
48
49=item B<info> =E<gt> I<HASHREF>
50
51A reference to a unified information hash table, most commonly known as
52%unified_info.
53
54=item B<config> =E<gt> I<HASHREF>
55
56A reference to a config information hash table, most commonly known as
57%config.
58
59=back
60
61Example:
62
63    my $info = OpenSSL::Config::Info->new(info => \%unified_info);
64
65=back
66
67=cut
68
69sub new {
70    my $class = shift;
71    my %opts = @_;
72
73    my @messages = _check_accepted_options(\%opts,
74                                           info => 'HASH',
75                                           config => 'HASH');
76    croak $messages[0] if @messages;
77
78    # We make a shallow copy of the input structure.  We might make
79    # a different choice in the future...
80    my $instance = { info => $opts{info} // {},
81                     config => $opts{config} // {} };
82    bless $instance, $class;
83
84    return $instance;
85}
86
87=head2 Query methods
88
89=over 4
90
91=item B<get_sources> I<LIST>
92
93LIST is expected to be the collection of names of end products, such as
94programs, modules, libraries.
95
96The returned result is a hash table reference, with each key being one of
97these end product names, and its value being a reference to an array of
98source file names that constitutes everything that will or may become part
99of that end product.
100
101=cut
102
103sub get_sources {
104    my $self = shift;
105
106    my $result = {};
107    foreach (@_) {
108        my @sources = @{$self->{info}->{sources}->{$_} // []};
109        my @staticlibs =
110            grep { $_ =~ m|\.a$| } @{$self->{info}->{depends}->{$_} // []};
111
112        my %parts = ( %{$self->get_sources(@sources)},
113                      %{$self->get_sources(@staticlibs)} );
114        my @parts = map { @{$_} } values %parts;
115
116        my @generator =
117            ( ( $self->{info}->{generate}->{$_} // [] ) -> [0] // () );
118        my %generator_parts = %{$self->get_sources(@generator)};
119        # if there are any generator parts, we ignore it, because that means
120        # it's a compiled program and thus NOT part of the source that's
121        # queried.
122        @generator = () if %generator_parts;
123
124        my @partial_result =
125            ( ( map { @{$_} } values %parts ),
126              ( grep { !defined($parts{$_}) } @sources, @generator ) );
127
128        # Push conditionally, to avoid creating $result->{$_} with an empty
129        # value
130        push @{$result->{$_}}, @partial_result if @partial_result;
131    }
132
133    return $result;
134}
135
136=item B<get_config> I<LIST>
137
138LIST is expected to be the collection of names of configuration data, such
139as build_infos, sourcedir, ...
140
141The returned result is a hash table reference, with each key being one of
142these configuration data names, and its value being a reference to the value
143corresponding to that name.
144
145=cut
146
147sub get_config {
148    my $self = shift;
149
150    return { map { $_ => $self->{config}->{$_} } @_ };
151}
152
153########
154#
155#  Helper functions
156#
157
158sub _check_accepted_options {
159    my $opts = shift;           # HASH reference (hopefully)
160    my %conds = @_;             # key => type
161
162    my @messages;
163    my %optnames = map { $_ => 1 } keys %$opts;
164    foreach (keys %conds) {
165        delete $optnames{$_};
166    }
167    push @messages, "Unknown options: " . join(', ', sort keys %optnames)
168        if keys %optnames;
169    foreach (sort keys %conds) {
170        push @messages, "'$_' value not a $conds{$_} reference"
171            if (defined $conds{$_} && defined $opts->{$_}
172                && ref $opts->{$_} ne $conds{$_});
173    }
174    return @messages;
175}
176
1771;
178