mirror of
https://github.com/openssl/openssl.git
synced 2024-11-21 01:15:20 +08:00
841a438c7f
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)
445 lines
15 KiB
Perl
445 lines
15 KiB
Perl
#! {- $config{HASHBANGPERL} -}
|
|
# -*- mode: perl -*-
|
|
{-
|
|
sub out_item {
|
|
my $ref = shift;
|
|
# Available options:
|
|
# indent => callers indentation (int)
|
|
# delimiters => 1 if outer delimiters should be added
|
|
my %opts = @_;
|
|
|
|
my $indent = $opts{indent} // 0;
|
|
# Indentation of the whole structure, where applicable
|
|
my $nlindent1 = "\n" . ' ' x $indent;
|
|
# Indentation of individual items, where applicable
|
|
my $nlindent2 = "\n" . ' ' x ($indent + 4);
|
|
|
|
my $product; # Finished product, or reference to a function that
|
|
# produces a string, given $_
|
|
# The following are only used when $product is a function reference
|
|
my $delim_l; # Left delimiter of structure
|
|
my $delim_r; # Right delimiter of structure
|
|
my $separator; # Item separator
|
|
my @items; # Items to iterate over
|
|
|
|
if (ref($ref) eq "ARRAY") {
|
|
if (scalar @$ref == 0) {
|
|
$product = $opts{delimiters} ? '[]' : '';
|
|
} else {
|
|
$product = sub {
|
|
out_item(\$_, delimiters => 1, indent => $indent + 4)
|
|
};
|
|
$delim_l = ($opts{delimiters} ? '[' : '').$nlindent2;
|
|
$delim_r = $nlindent1.($opts{delimiters} ? ']' : '');
|
|
$separator = ",$nlindent2";
|
|
@items = @$ref;
|
|
}
|
|
} elsif (ref($ref) eq "HASH") {
|
|
if (scalar keys %$ref == 0) {
|
|
$product = $opts{delimiters} ? '{}' : '';
|
|
} else {
|
|
$product = sub {
|
|
quotify1($_) . " => "
|
|
. out_item($ref->{$_}, delimiters => 1, indent => $indent + 4)
|
|
};
|
|
$delim_l = ($opts{delimiters} ? '{' : '').$nlindent2;
|
|
$delim_r = $nlindent1.($opts{delimiters} ? '}' : '');
|
|
$separator = ",$nlindent2";
|
|
@items = sort keys %$ref;
|
|
}
|
|
} elsif (ref($ref) eq "SCALAR") {
|
|
$product = defined $$ref ? quotify1 $$ref : "undef";
|
|
} else {
|
|
$product = defined $ref ? quotify1 $ref : "undef";
|
|
}
|
|
|
|
if (ref($product) eq "CODE") {
|
|
$delim_l . join($separator, map { &$product } @items) . $delim_r;
|
|
} else {
|
|
$product;
|
|
}
|
|
}
|
|
|
|
# We must make sourcedir() return an absolute path, because configdata.pm
|
|
# may be loaded as a module from any script in any directory, making
|
|
# relative paths untrustable. Because the result is used with 'use lib',
|
|
# we must ensure that it returns a Unix style path. Cwd::abs_path does
|
|
# that (File::Spec::Functions::rel2abs return O/S specific paths)
|
|
use File::Spec::Functions;
|
|
use Cwd qw(abs_path);
|
|
sub sourcedir {
|
|
return abs_path(catdir($config{sourcedir}, @_));
|
|
}
|
|
sub sourcefile {
|
|
return abs_path(catfile($config{sourcedir}, @_));
|
|
}
|
|
-}
|
|
package configdata;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Exporter;
|
|
our @ISA = qw(Exporter);
|
|
our @EXPORT = qw(
|
|
%config %target %disabled %withargs %unified_info
|
|
@disablables @disablables_int
|
|
);
|
|
|
|
our %config = ({- out_item(\%config); -});
|
|
our %target = ({- out_item(\%target); -});
|
|
our @disablables = ({- out_item(\@disablables) -});
|
|
our @disablables_int = ({- out_item(\@disablables_int) -});
|
|
our %disabled = ({- out_item(\%disabled); -});
|
|
our %withargs = ({- out_item(\%withargs); -});
|
|
our %unified_info = ({- out_item(\%unified_info); -});
|
|
|
|
# Unexported, only used by OpenSSL::Test::Utils::available_protocols()
|
|
our %available_protocols = (
|
|
tls => [{- out_item(\@tls) -}],
|
|
dtls => [{- out_item(\@dtls) -}],
|
|
);
|
|
|
|
# The following data is only used when this files is use as a script
|
|
my @makevars = ({- out_item(\@makevars); -});
|
|
my %disabled_info = ({- out_item(\%disabled_info); -});
|
|
my @user_crossable = qw( {- join (' ', @user_crossable) -} );
|
|
|
|
# If run directly, we can give some answers, and even reconfigure
|
|
unless (caller) {
|
|
use Getopt::Long;
|
|
use File::Spec::Functions;
|
|
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 OpenSSL::Template;
|
|
|
|
my $prepend = <<'_____';
|
|
use File::Spec::Functions;
|
|
use lib '{- sourcedir('util', 'perl') -}';
|
|
use lib '{- sourcedir('Configurations') -}';
|
|
use lib '{- $config{builddir} -}';
|
|
use platform;
|
|
_____
|
|
|
|
my @autowarntext = (
|
|
'WARNING: do not edit!',
|
|
"Generated by configdata.pm from "
|
|
.join(", ", @{$config{build_file_templates}})
|
|
);
|
|
|
|
print 'Creating ',$target{build_file},"\n";
|
|
open BUILDFILE, ">$target{build_file}.new"
|
|
or die "Trying to create $target{build_file}.new: $!";
|
|
foreach (@{$config{build_file_templates}}) {
|
|
my $tmpl = OpenSSL::Template->new(TYPE => 'FILE',
|
|
SOURCE => $_);
|
|
$tmpl->fill_in(FILENAME => $_,
|
|
OUTPUT => \*BUILDFILE,
|
|
HASH => { config => \%config,
|
|
target => \%target,
|
|
disabled => \%disabled,
|
|
withargs => \%withargs,
|
|
unified_info => \%unified_info,
|
|
autowarntext => \@autowarntext },
|
|
PREPEND => $prepend,
|
|
# To ensure that global variables and functions
|
|
# defined in one template stick around for the
|
|
# next, making them combinable
|
|
PACKAGE => 'OpenSSL::safe')
|
|
or die $Text::Template::ERROR;
|
|
}
|
|
close BUILDFILE;
|
|
rename("$target{build_file}.new", $target{build_file})
|
|
or die "Trying to rename $target{build_file}.new to $target{build_file}: $!";
|
|
|
|
exit(0);
|
|
}
|
|
|
|
my $dump = undef;
|
|
my $cmdline = undef;
|
|
my $options = undef;
|
|
my $target = undef;
|
|
my $envvars = undef;
|
|
my $makevars = undef;
|
|
my $buildparams = undef;
|
|
my $reconf = undef;
|
|
my $verbose = undef;
|
|
my $query = undef;
|
|
my $help = undef;
|
|
my $man = undef;
|
|
GetOptions('dump|d' => \$dump,
|
|
'command-line|c' => \$cmdline,
|
|
'options|o' => \$options,
|
|
'target|t' => \$target,
|
|
'environment|e' => \$envvars,
|
|
'make-variables|m' => \$makevars,
|
|
'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";
|
|
|
|
if (scalar @ARGV > 0) {
|
|
print STDERR <<"_____";
|
|
Unrecognised arguments.
|
|
For more information, do '$0 --help'
|
|
_____
|
|
exit(2);
|
|
}
|
|
|
|
if ($help) {
|
|
pod2usage(-exitval => 0,
|
|
-verbose => 1);
|
|
}
|
|
if ($man) {
|
|
pod2usage(-exitval => 0,
|
|
-verbose => 2);
|
|
}
|
|
if ($dump || $cmdline) {
|
|
print "\nCommand line (with current working directory = $here):\n\n";
|
|
print ' ',join(' ',
|
|
$config{PERL},
|
|
catfile($config{sourcedir}, 'Configure'),
|
|
@{$config{perlargv}}), "\n";
|
|
print "\nPerl information:\n\n";
|
|
print ' ',$config{perl_cmd},"\n";
|
|
print ' ',$config{perl_version},' for ',$config{perl_archname},"\n";
|
|
}
|
|
if ($dump || $options) {
|
|
my $longest = 0;
|
|
my $longest2 = 0;
|
|
foreach my $what (@disablables) {
|
|
$longest = length($what) if $longest < length($what);
|
|
$longest2 = length($disabled{$what})
|
|
if $disabled{$what} && $longest2 < length($disabled{$what});
|
|
}
|
|
print "\nEnabled features:\n\n";
|
|
foreach my $what (@disablables) {
|
|
print " $what\n" unless $disabled{$what};
|
|
}
|
|
print "\nDisabled features:\n\n";
|
|
foreach my $what (@disablables) {
|
|
if ($disabled{$what}) {
|
|
print " $what", ' ' x ($longest - length($what) + 1),
|
|
"[$disabled{$what}]", ' ' x ($longest2 - length($disabled{$what}) + 1);
|
|
print $disabled_info{$what}->{macro}
|
|
if $disabled_info{$what}->{macro};
|
|
print ' (skip ',
|
|
join(', ', @{$disabled_info{$what}->{skipped}}),
|
|
')'
|
|
if $disabled_info{$what}->{skipped};
|
|
print "\n";
|
|
}
|
|
}
|
|
}
|
|
if ($dump || $target) {
|
|
print "\nConfig target attributes:\n\n";
|
|
foreach (sort keys %target) {
|
|
next if $_ =~ m|^_| || $_ eq 'template';
|
|
my $quotify = sub {
|
|
map {
|
|
if (defined $_) {
|
|
(my $x = $_) =~ s|([\\\$\@"])|\\$1|g; "\"$x\""
|
|
} else {
|
|
"undef";
|
|
}
|
|
} @_;
|
|
};
|
|
print ' ', $_, ' => ';
|
|
if (ref($target{$_}) eq "ARRAY") {
|
|
print '[ ', join(', ', $quotify->(@{$target{$_}})), " ],\n";
|
|
} else {
|
|
print $quotify->($target{$_}), ",\n"
|
|
}
|
|
}
|
|
}
|
|
if ($dump || $envvars) {
|
|
print "\nRecorded environment:\n\n";
|
|
foreach (sort keys %{$config{perlenv}}) {
|
|
print ' ',$_,' = ',($config{perlenv}->{$_} || ''),"\n";
|
|
}
|
|
}
|
|
if ($dump || $makevars) {
|
|
print "\nMakevars:\n\n";
|
|
foreach my $var (@makevars) {
|
|
my $prefix = '';
|
|
$prefix = $config{CROSS_COMPILE}
|
|
if grep { $var eq $_ } @user_crossable;
|
|
$prefix //= '';
|
|
print ' ',$var,' ' x (16 - length $var),'= ',
|
|
(ref $config{$var} eq 'ARRAY'
|
|
? join(' ', @{$config{$var}})
|
|
: $prefix.$config{$var}),
|
|
"\n"
|
|
if defined $config{$var};
|
|
}
|
|
|
|
my @buildfile = ($config{builddir}, $config{build_file});
|
|
unshift @buildfile, $here
|
|
unless file_name_is_absolute($config{builddir});
|
|
my $buildfile = canonpath(catdir(@buildfile));
|
|
print <<"_____";
|
|
|
|
NOTE: These variables only represent the configuration view. The build file
|
|
template may have processed these variables further, please have a look at the
|
|
build file for more exact data:
|
|
$buildfile
|
|
_____
|
|
}
|
|
if ($dump || $buildparams) {
|
|
my @buildfile = ($config{builddir}, $config{build_file});
|
|
unshift @buildfile, $here
|
|
unless file_name_is_absolute($config{builddir});
|
|
print "\nbuild file:\n\n";
|
|
print " ", canonpath(catfile(@buildfile)),"\n";
|
|
|
|
print "\nbuild file templates:\n\n";
|
|
foreach (@{$config{build_file_templates}}) {
|
|
my @tmpl = ($_);
|
|
unshift @tmpl, $here
|
|
unless file_name_is_absolute($config{sourcedir});
|
|
print ' ',canonpath(catfile(@tmpl)),"\n";
|
|
}
|
|
}
|
|
if ($reconf) {
|
|
if ($verbose) {
|
|
print 'Reconfiguring with: ', join(' ',@{$config{perlargv}}), "\n";
|
|
foreach (sort keys %{$config{perlenv}}) {
|
|
print ' ',$_,' = ',($config{perlenv}->{$_} || ""),"\n";
|
|
}
|
|
}
|
|
|
|
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;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
configdata.pm - configuration data for OpenSSL builds
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
Interactive:
|
|
|
|
perl configdata.pm [options]
|
|
|
|
As data bank module:
|
|
|
|
use configdata;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module can be used in two modes, interactively and as a module containing
|
|
all the data recorded by OpenSSL's Configure script.
|
|
|
|
When used interactively, simply run it as any perl script.
|
|
If run with no arguments, it will rebuild the build file (Makefile or
|
|
corresponding).
|
|
With at least one option, it will instead get the information you ask for, or
|
|
re-run the configuration process.
|
|
See L</OPTIONS> below for more information.
|
|
|
|
When loaded as a module, you get a few databanks with useful information to
|
|
perform build related tasks. The databanks are:
|
|
|
|
%config Configured things.
|
|
%target The OpenSSL config target with all inheritances
|
|
resolved.
|
|
%disabled The features that are disabled.
|
|
@disablables The list of features that can be disabled.
|
|
%withargs All data given through --with-THING options.
|
|
%unified_info All information that was computed from the build.info
|
|
files.
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over 4
|
|
|
|
=item B<--help>
|
|
|
|
Print a brief help message and exit.
|
|
|
|
=item B<--man>
|
|
|
|
Print the manual page and exit.
|
|
|
|
=item B<--dump> | B<-d>
|
|
|
|
Print all relevant configuration data. This is equivalent to B<--command-line>
|
|
B<--options> B<--target> B<--environment> B<--make-variables>
|
|
B<--build-parameters>.
|
|
|
|
=item B<--command-line> | B<-c>
|
|
|
|
Print the current configuration command line.
|
|
|
|
=item B<--options> | B<-o>
|
|
|
|
Print the features, both enabled and disabled, and display defined macro and
|
|
skipped directories where applicable.
|
|
|
|
=item B<--target> | B<-t>
|
|
|
|
Print the config attributes for this config target.
|
|
|
|
=item B<--environment> | B<-e>
|
|
|
|
Print the environment variables and their values at the time of configuration.
|
|
|
|
=item B<--make-variables> | B<-m>
|
|
|
|
Print the main make variables generated in the current configuration
|
|
|
|
=item B<--build-parameters> | B<-b>
|
|
|
|
Print the build parameters, i.e. build file and build file templates.
|
|
|
|
=item B<--reconfigure> | B<--reconf> | B<-r>
|
|
|
|
Re-run the configuration process.
|
|
|
|
=item B<--verbose> | B<-v>
|
|
|
|
Verbose output.
|
|
|
|
=back
|
|
|
|
=cut
|
|
|
|
EOF
|