| #! {- $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; |
| |
| 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 = <<"_____"; |
| 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 $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, |
| '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'; |
| } |
| } |
| |
| 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 |