From 841a438c7f67f697dd6710b26cc6536dd76a420a Mon Sep 17 00:00:00 2001 From: Richard Levitte Date: Mon, 26 Apr 2021 19:41:54 +0200 Subject: Add OpenSSL::Config::Query and use it in configdata.pm OpenSSL::Config::Query is a configuration querying tool that's meant to make it easier to query the diverse configuration data for info. That's much easier than to dig through all the parts of %unified_info. Reviewed-by: Tomas Mraz (Merged from https://github.com/openssl/openssl/pull/8871) --- util/perl/OpenSSL/Config/Query.pm | 177 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 util/perl/OpenSSL/Config/Query.pm (limited to 'util/perl') diff --git a/util/perl/OpenSSL/Config/Query.pm b/util/perl/OpenSSL/Config/Query.pm new file mode 100644 index 0000000000..22d6a459bd --- /dev/null +++ b/util/perl/OpenSSL/Config/Query.pm @@ -0,0 +1,177 @@ +# Copyright 2021 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the Apache License 2.0 (the "License"). You may not use +# this file except in compliance with the License. You can obtain a copy +# in the file LICENSE in the source distribution or at +# https://www.openssl.org/source/license.html + +package OpenSSL::Config::Query; + +use 5.10.0; +use strict; +use warnings; +use Carp; + +=head1 NAME + +OpenSSL::Config::Query - Query OpenSSL configuration info + +=head1 SYNOPSIS + + use OpenSSL::Config::Info; + + my $query = OpenSSL::Config::Query->new(info => \%unified_info); + + # Query for something that's expected to give a scalar back + my $variable = $query->method(... args ...); + + # Query for something that's expected to give a list back + my @variable = $query->method(... args ...); + +=head1 DESCRIPTION + +The unified info structure, commonly known as the %unified_info table, has +become quite complex, and a bit overwhelming to look through directly. This +module makes querying this structure simpler, through diverse methods. + +=head2 Constructor + +=over 4 + +=item B I<%options> + +Creates an instance of the B class. It takes options +in keyed pair form, i.e. a series of C<< key => value >> pairs. Available +options are: + +=over 4 + +=item B =E I + +A reference to a unified information hash table, most commonly known as +%unified_info. + +=item B =E I + +A reference to a config information hash table, most commonly known as +%config. + +=back + +Example: + + my $info = OpenSSL::Config::Info->new(info => \%unified_info); + +=back + +=cut + +sub new { + my $class = shift; + my %opts = @_; + + my @messages = _check_accepted_options(\%opts, + info => 'HASH', + config => 'HASH'); + croak $messages[0] if @messages; + + # We make a shallow copy of the input structure. We might make + # a different choice in the future... + my $instance = { info => $opts{info} // {}, + config => $opts{config} // {} }; + bless $instance, $class; + + return $instance; +} + +=head2 Query methods + +=over 4 + +=item B I + +LIST is expected to be the collection of names of end products, such as +programs, modules, libraries. + +The returned result is a hash table reference, with each key being one of +these end product names, and its value being a reference to an array of +source file names that constitutes everything that will or may become part +of that end product. + +=cut + +sub get_sources { + my $self = shift; + + my $result = {}; + foreach (@_) { + my @sources = @{$self->{info}->{sources}->{$_} // []}; + my @staticlibs = + grep { $_ =~ m|\.a$| } @{$self->{info}->{depends}->{$_} // []}; + + my %parts = ( %{$self->get_sources(@sources)}, + %{$self->get_sources(@staticlibs)} ); + my @parts = map { @{$_} } values %parts; + + my @generator = + ( ( $self->{info}->{generate}->{$_} // [] ) -> [0] // () ); + my %generator_parts = %{$self->get_sources(@generator)}; + # if there are any generator parts, we ignore it, because that means + # it's a compiled program and thus NOT part of the source that's + # queried. + @generator = () if %generator_parts; + + my @partial_result = + ( ( map { @{$_} } values %parts ), + ( grep { !defined($parts{$_}) } @sources, @generator ) ); + + # Push conditionally, to avoid creating $result->{$_} with an empty + # value + push @{$result->{$_}}, @partial_result if @partial_result; + } + + return $result; +} + +=item B I + +LIST is expected to be the collection of names of configuration data, such +as build_infos, sourcedir, ... + +The returned result is a hash table reference, with each key being one of +these configuration data names, and its value being a reference to the value +corresponding to that name. + +=cut + +sub get_config { + my $self = shift; + + return { map { $_ => $self->{config}->{$_} } @_ }; +} + +######## +# +# Helper functions +# + +sub _check_accepted_options { + my $opts = shift; # HASH reference (hopefully) + my %conds = @_; # key => type + + my @messages; + my %optnames = map { $_ => 1 } keys %$opts; + foreach (keys %conds) { + delete $optnames{$_}; + } + push @messages, "Unknown options: " . join(', ', sort keys %optnames) + if keys %optnames; + foreach (sort keys %conds) { + push @messages, "'$_' value not a $conds{$_} reference" + if (defined $conds{$_} && defined $opts->{$_} + && ref $opts->{$_} ne $conds{$_}); + } + return @messages; +} + +1; -- cgit v1.2.3