diff options
| -rw-r--r-- | configdata.pm.in | 26 | ||||
| -rw-r--r-- | util/perl/OpenSSL/Config/Query.pm | 177 |
2 files changed, 201 insertions, 2 deletions
diff --git a/configdata.pm.in b/configdata.pm.in index 279b8f75c9..3481eab277 100644 --- a/configdata.pm.in +++ b/configdata.pm.in @@ -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; 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<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; |