mirror of https://github.com/openssl/openssl
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 <tomas@openssl.org> (Merged from https://github.com/openssl/openssl/pull/8871)
This commit is contained in:
Richard Levitte
parent
02669b677e
commit
841a438c7f
|
|
@ -112,13 +112,14 @@ unless (caller) {
|
|||
use File::Basename;
|
||||
use Pod::Usage;
|
||||
|
||||
use lib '{- sourcedir('util', 'perl') -}';
|
||||
use OpenSSL::fallback '{- sourcefile('external', 'perl', 'MODULES.txt') -}';
|
||||
|
||||
my $here = dirname($0);
|
||||
|
||||
if (scalar @ARGV == 0) {
|
||||
# With no arguments, re-create the build file
|
||||
|
||||
use lib '{- sourcedir('util', 'perl') -}';
|
||||
use OpenSSL::fallback '{- sourcefile('external', 'perl', 'MODULES.txt') -}';
|
||||
use OpenSSL::Template;
|
||||
|
||||
my $prepend = <<'_____';
|
||||
|
|
@ -172,6 +173,7 @@ _____
|
|||
my $buildparams = undef;
|
||||
my $reconf = undef;
|
||||
my $verbose = undef;
|
||||
my $query = undef;
|
||||
my $help = undef;
|
||||
my $man = undef;
|
||||
GetOptions('dump|d' => \$dump,
|
||||
|
|
@ -183,6 +185,7 @@ _____
|
|||
'build-parameters|b' => \$buildparams,
|
||||
'reconfigure|reconf|r' => \$reconf,
|
||||
'verbose|v' => \$verbose,
|
||||
'query|q=s' => \$query,
|
||||
'help' => \$help,
|
||||
'man' => \$man)
|
||||
or die "Errors in command line arguments\n";
|
||||
|
|
@ -320,6 +323,25 @@ _____
|
|||
chdir $here;
|
||||
exec $^X,catfile($config{sourcedir}, 'Configure'),'reconf';
|
||||
}
|
||||
if ($query) {
|
||||
use OpenSSL::Config::Query;
|
||||
|
||||
my $confquery = OpenSSL::Config::Query->new(info => \%unified_info,
|
||||
config => \%config);
|
||||
my $result = eval "\$confquery->$query";
|
||||
|
||||
# We may need a result class with a printing function at some point.
|
||||
# Until then, we assume that we get a scalar, or a list or a hash table
|
||||
# with scalar values and simply print them in some orderly fashion.
|
||||
if (ref $result eq 'ARRAY') {
|
||||
print "$_\n" foreach @$result;
|
||||
} elsif (ref $result eq 'HASH') {
|
||||
print "$_ : \\\n ", join(" \\\n ", @{$result->{$_}}), "\n"
|
||||
foreach sort keys %$result;
|
||||
} elsif (ref $result eq 'SCALAR') {
|
||||
print "$$result\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -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<new> I<%options>
|
||||
|
||||
Creates an instance of the B<OpenSSL::Config::Query> class. It takes options
|
||||
in keyed pair form, i.e. a series of C<< key => value >> pairs. Available
|
||||
options are:
|
||||
|
||||
=over 4
|
||||
|
||||
=item B<info> =E<gt> I<HASHREF>
|
||||
|
||||
A reference to a unified information hash table, most commonly known as
|
||||
%unified_info.
|
||||
|
||||
=item B<config> =E<gt> I<HASHREF>
|
||||
|
||||
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<get_sources> I<LIST>
|
||||
|
||||
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<get_config> I<LIST>
|
||||
|
||||
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;
|
||||
Loading…
Reference in New Issue