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)

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;