diff options
Diffstat (limited to 'configdata.pm.in')
| -rw-r--r-- | configdata.pm.in | 487 |
1 files changed, 487 insertions, 0 deletions
diff --git a/configdata.pm.in b/configdata.pm.in new file mode 100644 index 000000000000..a4ae90729995 --- /dev/null +++ b/configdata.pm.in @@ -0,0 +1,487 @@ +#! {- $config{HASHBANGPERL} -} +# -*- mode: perl -*- +{- + # 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. Mixing File::Spec + # and File::Spec::Unix does just that. + use File::Spec::Unix; + use File::Spec; + use Cwd qw(abs_path); + sub _fixup_path { + my $path = shift; + + # Make the path absolute at all times + $path = abs_path($path); + + if ($^O eq 'VMS') { + # Convert any path of the VMS form VOLUME:[DIR1.DIR2]FILE to the + # Unix form /VOLUME/DIR1/DIR2/FILE, which is what VMS perl supports + # for 'use lib'. + + # Start with spliting the native path + (my $vol, my $dirs, my $file) = File::Spec->splitpath($path); + my @dirs = File::Spec->splitdir($dirs); + + # Reassemble it as a Unix path + $vol =~ s|:$||; + $dirs = File::Spec::Unix->catdir('', $vol, @dirs); + $path = File::Spec::Unix->catpath('', $dirs, $file); + } + + return $path; + } + sub sourcedir { + return _fixup_path(File::Spec->catdir($config{sourcedir}, @_)) + } + sub sourcefile { + return _fixup_path(File::Spec->catfile($config{sourcedir}, @_)) + } + use lib sourcedir('util', 'perl'); + use OpenSSL::Util; +-} +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 = ({- dump_data(\%config, indent => 0); -}); +our %target = ({- dump_data(\%target, indent => 0); -}); +our @disablables = ({- dump_data(\@disablables, indent => 0) -}); +our @disablables_int = ({- dump_data(\@disablables_int, indent => 0) -}); +our %disabled = ({- dump_data(\%disabled, indent => 0); -}); +our %withargs = ({- dump_data(\%withargs, indent => 0); -}); +our %unified_info = ({- dump_data(\%unified_info, indent => 0); -}); + +# Unexported, only used by OpenSSL::Test::Utils::available_protocols() +our %available_protocols = ( + tls => [{- dump_data(\@tls, indent => 0) -}], + dtls => [{- dump_data(\@dtls, indent => 0) -}], +); + +# The following data is only used when this files is use as a script +my @makevars = ({- dump_data(\@makevars, indent => 0); -}); +my %disabled_info = ({- dump_data(\%disabled_info, indent => 0); -}); +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 File::Compare qw(compare_text); + use File::Copy; + 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 + # We do that in two steps, where the first step emits perl + # snipets. + + my $buildfile = $config{build_file}; + my $buildfile_template = "$buildfile.in"; + my @autowarntext = ( + 'WARNING: do not edit!', + "Generated by configdata.pm from " + .join(", ", @{$config{build_file_templates}}), + "via $buildfile_template" + ); + my %gendata = ( + config => \%config, + target => \%target, + disabled => \%disabled, + withargs => \%withargs, + unified_info => \%unified_info, + autowarntext => \@autowarntext, + ); + + use lib '.'; + use lib '{- sourcedir('Configurations') -}'; + use gentemplate; + + open my $buildfile_template_fh, ">$buildfile_template" + or die "Trying to create $buildfile_template: $!"; + foreach (@{$config{build_file_templates}}) { + copy($_, $buildfile_template_fh) + or die "Trying to copy $_ into $buildfile_template: $!"; + } + gentemplate(output => $buildfile_template_fh, %gendata); + close $buildfile_template_fh; + print 'Created ',$buildfile_template,"\n"; + + 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 $tmpl; + open BUILDFILE, ">$buildfile.new" + or die "Trying to create $buildfile.new: $!"; + $tmpl = OpenSSL::Template->new(TYPE => 'FILE', + SOURCE => $buildfile_template); + $tmpl->fill_in(FILENAME => $_, + OUTPUT => \*BUILDFILE, + HASH => \%gendata, + 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 $OpenSSL::Template::ERROR; + close BUILDFILE; + rename("$buildfile.new", $buildfile) + or die "Trying to rename $buildfile.new to $buildfile: $!"; + print 'Created ',$buildfile,"\n"; + + my $configuration_h = + catfile('include', 'openssl', 'configuration.h'); + my $configuration_h_in = + catfile($config{sourcedir}, 'include', 'openssl', 'configuration.h.in'); + open CONFIGURATION_H, ">${configuration_h}.new" + or die "Trying to create ${configuration_h}.new: $!"; + $tmpl = OpenSSL::Template->new(TYPE => 'FILE', + SOURCE => $configuration_h_in); + $tmpl->fill_in(FILENAME => $_, + OUTPUT => \*CONFIGURATION_H, + HASH => \%gendata, + 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 $OpenSSL::Template::ERROR; + close CONFIGURATION_H; + + # When using stat() on Windows, we can get it to perform better by + # avoid some data. This doesn't affect the mtime field, so we're not + # losing anything... + ${^WIN32_SLOPPY_STAT} = 1; + + my $update_configuration_h = 0; + if (-f $configuration_h) { + my $configuration_h_mtime = (stat($configuration_h))[9]; + my $configuration_h_in_mtime = (stat($configuration_h_in))[9]; + + # If configuration.h.in was updated after the last configuration.h, + # or if configuration.h.new differs configuration.h, we update + # configuration.h + if ($configuration_h_mtime < $configuration_h_in_mtime + || compare_text("${configuration_h}.new", $configuration_h) != 0) { + $update_configuration_h = 1; + } else { + # If nothing has changed, let's just drop the new one and + # pretend like nothing happened + unlink "${configuration_h}.new" + } + } else { + $update_configuration_h = 1; + } + + if ($update_configuration_h) { + rename("${configuration_h}.new", $configuration_h) + or die "Trying to rename ${configuration_h}.new to $configuration_h: $!"; + print 'Created ',$configuration_h,"\n"; + } + + 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"; + + # We allow extra arguments with --query. That allows constructs like + # this: + # ./configdata.pm --query 'get_sources(@ARGV)' file1 file2 file3 + if (!$query && 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 |