| 1 | #! {- $config{HASHBANGPERL} -}
|
|---|
| 2 | # -*- mode: perl -*-
|
|---|
| 3 | {-
|
|---|
| 4 | # We must make sourcedir() return an absolute path, because configdata.pm
|
|---|
| 5 | # may be loaded as a module from any script in any directory, making
|
|---|
| 6 | # relative paths untrustable. Because the result is used with 'use lib',
|
|---|
| 7 | # we must ensure that it returns a Unix style path. Mixing File::Spec
|
|---|
| 8 | # and File::Spec::Unix does just that.
|
|---|
| 9 | use File::Spec::Unix;
|
|---|
| 10 | use File::Spec;
|
|---|
| 11 | use Cwd qw(abs_path);
|
|---|
| 12 | sub _fixup_path {
|
|---|
| 13 | my $path = shift;
|
|---|
| 14 |
|
|---|
| 15 | # Make the path absolute at all times
|
|---|
| 16 | $path = abs_path($path);
|
|---|
| 17 |
|
|---|
| 18 | if ($^O eq 'VMS') {
|
|---|
| 19 | # Convert any path of the VMS form VOLUME:[DIR1.DIR2]FILE to the
|
|---|
| 20 | # Unix form /VOLUME/DIR1/DIR2/FILE, which is what VMS perl supports
|
|---|
| 21 | # for 'use lib'.
|
|---|
| 22 |
|
|---|
| 23 | # Start with spliting the native path
|
|---|
| 24 | (my $vol, my $dirs, my $file) = File::Spec->splitpath($path);
|
|---|
| 25 | my @dirs = File::Spec->splitdir($dirs);
|
|---|
| 26 |
|
|---|
| 27 | # Reassemble it as a Unix path
|
|---|
| 28 | $vol =~ s|:$||;
|
|---|
| 29 | $dirs = File::Spec::Unix->catdir('', $vol, @dirs);
|
|---|
| 30 | $path = File::Spec::Unix->catpath('', $dirs, $file);
|
|---|
| 31 | }
|
|---|
| 32 |
|
|---|
| 33 | return $path;
|
|---|
| 34 | }
|
|---|
| 35 | sub sourcedir {
|
|---|
| 36 | return _fixup_path(File::Spec->catdir($config{sourcedir}, @_))
|
|---|
| 37 | }
|
|---|
| 38 | sub sourcefile {
|
|---|
| 39 | return _fixup_path(File::Spec->catfile($config{sourcedir}, @_))
|
|---|
| 40 | }
|
|---|
| 41 | use lib sourcedir('util', 'perl');
|
|---|
| 42 | use OpenSSL::Util;
|
|---|
| 43 | -}
|
|---|
| 44 | package configdata;
|
|---|
| 45 |
|
|---|
| 46 | use strict;
|
|---|
| 47 | use warnings;
|
|---|
| 48 |
|
|---|
| 49 | use Exporter;
|
|---|
| 50 | our @ISA = qw(Exporter);
|
|---|
| 51 | our @EXPORT = qw(
|
|---|
| 52 | %config %target %disabled %withargs %unified_info
|
|---|
| 53 | @disablables @disablables_int
|
|---|
| 54 | );
|
|---|
| 55 |
|
|---|
| 56 | our %config = ({- dump_data(\%config, indent => 0); -});
|
|---|
| 57 | our %target = ({- dump_data(\%target, indent => 0); -});
|
|---|
| 58 | our @disablables = ({- dump_data(\@disablables, indent => 0) -});
|
|---|
| 59 | our @disablables_int = ({- dump_data(\@disablables_int, indent => 0) -});
|
|---|
| 60 | our %disabled = ({- dump_data(\%disabled, indent => 0); -});
|
|---|
| 61 | our %withargs = ({- dump_data(\%withargs, indent => 0); -});
|
|---|
| 62 | our %unified_info = ({- dump_data(\%unified_info, indent => 0); -});
|
|---|
| 63 |
|
|---|
| 64 | # Unexported, only used by OpenSSL::Test::Utils::available_protocols()
|
|---|
| 65 | our %available_protocols = (
|
|---|
| 66 | tls => [{- dump_data(\@tls, indent => 0) -}],
|
|---|
| 67 | dtls => [{- dump_data(\@dtls, indent => 0) -}],
|
|---|
| 68 | );
|
|---|
| 69 |
|
|---|
| 70 | # The following data is only used when this files is use as a script
|
|---|
| 71 | my @makevars = ({- dump_data(\@makevars, indent => 0); -});
|
|---|
| 72 | my %disabled_info = ({- dump_data(\%disabled_info, indent => 0); -});
|
|---|
| 73 | my @user_crossable = qw( {- join (' ', @user_crossable) -} );
|
|---|
| 74 |
|
|---|
| 75 | # If run directly, we can give some answers, and even reconfigure
|
|---|
| 76 | unless (caller) {
|
|---|
| 77 | use Getopt::Long;
|
|---|
| 78 | use File::Spec::Functions;
|
|---|
| 79 | use File::Basename;
|
|---|
| 80 | use File::Copy;
|
|---|
| 81 | use Pod::Usage;
|
|---|
| 82 |
|
|---|
| 83 | use lib '{- sourcedir('util', 'perl') -}';
|
|---|
| 84 | use OpenSSL::fallback '{- sourcefile('external', 'perl', 'MODULES.txt') -}';
|
|---|
| 85 |
|
|---|
| 86 | my $here = dirname($0);
|
|---|
| 87 |
|
|---|
| 88 | if (scalar @ARGV == 0) {
|
|---|
| 89 | # With no arguments, re-create the build file
|
|---|
| 90 | # We do that in two steps, where the first step emits perl
|
|---|
| 91 | # snipets.
|
|---|
| 92 |
|
|---|
| 93 | my $buildfile = $target{build_file};
|
|---|
| 94 | my $buildfile_template = "$buildfile.in";
|
|---|
| 95 | my @autowarntext = (
|
|---|
| 96 | 'WARNING: do not edit!',
|
|---|
| 97 | "Generated by configdata.pm from "
|
|---|
| 98 | .join(", ", @{$config{build_file_templates}}),
|
|---|
| 99 | "via $buildfile_template"
|
|---|
| 100 | );
|
|---|
| 101 | my %gendata = (
|
|---|
| 102 | config => \%config,
|
|---|
| 103 | target => \%target,
|
|---|
| 104 | disabled => \%disabled,
|
|---|
| 105 | withargs => \%withargs,
|
|---|
| 106 | unified_info => \%unified_info,
|
|---|
| 107 | autowarntext => \@autowarntext,
|
|---|
| 108 | );
|
|---|
| 109 |
|
|---|
| 110 | use lib '.';
|
|---|
| 111 | use lib '{- sourcedir('Configurations') -}';
|
|---|
| 112 | use gentemplate;
|
|---|
| 113 |
|
|---|
| 114 | print 'Creating ',$buildfile_template,"\n";
|
|---|
| 115 | open my $buildfile_template_fh, ">$buildfile_template"
|
|---|
| 116 | or die "Trying to create $buildfile_template: $!";
|
|---|
| 117 | foreach (@{$config{build_file_templates}}) {
|
|---|
| 118 | copy($_, $buildfile_template_fh)
|
|---|
| 119 | or die "Trying to copy $_ into $buildfile_template: $!";
|
|---|
| 120 | }
|
|---|
| 121 | gentemplate(output => $buildfile_template_fh, %gendata);
|
|---|
| 122 | close $buildfile_template_fh;
|
|---|
| 123 |
|
|---|
| 124 | use OpenSSL::Template;
|
|---|
| 125 |
|
|---|
| 126 | my $prepend = <<'_____';
|
|---|
| 127 | use File::Spec::Functions;
|
|---|
| 128 | use lib '{- sourcedir('util', 'perl') -}';
|
|---|
| 129 | use lib '{- sourcedir('Configurations') -}';
|
|---|
| 130 | use lib '{- $config{builddir} -}';
|
|---|
| 131 | use platform;
|
|---|
| 132 | _____
|
|---|
| 133 |
|
|---|
| 134 | print 'Creating ',$buildfile,"\n";
|
|---|
| 135 | open BUILDFILE, ">$buildfile.new"
|
|---|
| 136 | or die "Trying to create $buildfile.new: $!";
|
|---|
| 137 | my $tmpl = OpenSSL::Template->new(TYPE => 'FILE',
|
|---|
| 138 | SOURCE => $buildfile_template);
|
|---|
| 139 | $tmpl->fill_in(FILENAME => $_,
|
|---|
| 140 | OUTPUT => \*BUILDFILE,
|
|---|
| 141 | HASH => \%gendata,
|
|---|
| 142 | PREPEND => $prepend,
|
|---|
| 143 | # To ensure that global variables and functions
|
|---|
| 144 | # defined in one template stick around for the
|
|---|
| 145 | # next, making them combinable
|
|---|
| 146 | PACKAGE => 'OpenSSL::safe')
|
|---|
| 147 | or die $Text::Template::ERROR;
|
|---|
| 148 | close BUILDFILE;
|
|---|
| 149 | rename("$buildfile.new", $buildfile)
|
|---|
| 150 | or die "Trying to rename $buildfile.new to $buildfile: $!";
|
|---|
| 151 |
|
|---|
| 152 | exit(0);
|
|---|
| 153 | }
|
|---|
| 154 |
|
|---|
| 155 | my $dump = undef;
|
|---|
| 156 | my $cmdline = undef;
|
|---|
| 157 | my $options = undef;
|
|---|
| 158 | my $target = undef;
|
|---|
| 159 | my $envvars = undef;
|
|---|
| 160 | my $makevars = undef;
|
|---|
| 161 | my $buildparams = undef;
|
|---|
| 162 | my $reconf = undef;
|
|---|
| 163 | my $verbose = undef;
|
|---|
| 164 | my $query = undef;
|
|---|
| 165 | my $help = undef;
|
|---|
| 166 | my $man = undef;
|
|---|
| 167 | GetOptions('dump|d' => \$dump,
|
|---|
| 168 | 'command-line|c' => \$cmdline,
|
|---|
| 169 | 'options|o' => \$options,
|
|---|
| 170 | 'target|t' => \$target,
|
|---|
| 171 | 'environment|e' => \$envvars,
|
|---|
| 172 | 'make-variables|m' => \$makevars,
|
|---|
| 173 | 'build-parameters|b' => \$buildparams,
|
|---|
| 174 | 'reconfigure|reconf|r' => \$reconf,
|
|---|
| 175 | 'verbose|v' => \$verbose,
|
|---|
| 176 | 'query|q=s' => \$query,
|
|---|
| 177 | 'help' => \$help,
|
|---|
| 178 | 'man' => \$man)
|
|---|
| 179 | or die "Errors in command line arguments\n";
|
|---|
| 180 |
|
|---|
| 181 | # We allow extra arguments with --query. That allows constructs like
|
|---|
| 182 | # this:
|
|---|
| 183 | # ./configdata.pm --query 'get_sources(@ARGV)' file1 file2 file3
|
|---|
| 184 | if (!$query && scalar @ARGV > 0) {
|
|---|
| 185 | print STDERR <<"_____";
|
|---|
| 186 | Unrecognised arguments.
|
|---|
| 187 | For more information, do '$0 --help'
|
|---|
| 188 | _____
|
|---|
| 189 | exit(2);
|
|---|
| 190 | }
|
|---|
| 191 |
|
|---|
| 192 | if ($help) {
|
|---|
| 193 | pod2usage(-exitval => 0,
|
|---|
| 194 | -verbose => 1);
|
|---|
| 195 | }
|
|---|
| 196 | if ($man) {
|
|---|
| 197 | pod2usage(-exitval => 0,
|
|---|
| 198 | -verbose => 2);
|
|---|
| 199 | }
|
|---|
| 200 | if ($dump || $cmdline) {
|
|---|
| 201 | print "\nCommand line (with current working directory = $here):\n\n";
|
|---|
| 202 | print ' ',join(' ',
|
|---|
| 203 | $config{PERL},
|
|---|
| 204 | catfile($config{sourcedir}, 'Configure'),
|
|---|
| 205 | @{$config{perlargv}}), "\n";
|
|---|
| 206 | print "\nPerl information:\n\n";
|
|---|
| 207 | print ' ',$config{perl_cmd},"\n";
|
|---|
| 208 | print ' ',$config{perl_version},' for ',$config{perl_archname},"\n";
|
|---|
| 209 | }
|
|---|
| 210 | if ($dump || $options) {
|
|---|
| 211 | my $longest = 0;
|
|---|
| 212 | my $longest2 = 0;
|
|---|
| 213 | foreach my $what (@disablables) {
|
|---|
| 214 | $longest = length($what) if $longest < length($what);
|
|---|
| 215 | $longest2 = length($disabled{$what})
|
|---|
| 216 | if $disabled{$what} && $longest2 < length($disabled{$what});
|
|---|
| 217 | }
|
|---|
| 218 | print "\nEnabled features:\n\n";
|
|---|
| 219 | foreach my $what (@disablables) {
|
|---|
| 220 | print " $what\n" unless $disabled{$what};
|
|---|
| 221 | }
|
|---|
| 222 | print "\nDisabled features:\n\n";
|
|---|
| 223 | foreach my $what (@disablables) {
|
|---|
| 224 | if ($disabled{$what}) {
|
|---|
| 225 | print " $what", ' ' x ($longest - length($what) + 1),
|
|---|
| 226 | "[$disabled{$what}]", ' ' x ($longest2 - length($disabled{$what}) + 1);
|
|---|
| 227 | print $disabled_info{$what}->{macro}
|
|---|
| 228 | if $disabled_info{$what}->{macro};
|
|---|
| 229 | print ' (skip ',
|
|---|
| 230 | join(', ', @{$disabled_info{$what}->{skipped}}),
|
|---|
| 231 | ')'
|
|---|
| 232 | if $disabled_info{$what}->{skipped};
|
|---|
| 233 | print "\n";
|
|---|
| 234 | }
|
|---|
| 235 | }
|
|---|
| 236 | }
|
|---|
| 237 | if ($dump || $target) {
|
|---|
| 238 | print "\nConfig target attributes:\n\n";
|
|---|
| 239 | foreach (sort keys %target) {
|
|---|
| 240 | next if $_ =~ m|^_| || $_ eq 'template';
|
|---|
| 241 | my $quotify = sub {
|
|---|
| 242 | map {
|
|---|
| 243 | if (defined $_) {
|
|---|
| 244 | (my $x = $_) =~ s|([\\\$\@"])|\\$1|g; "\"$x\""
|
|---|
| 245 | } else {
|
|---|
| 246 | "undef";
|
|---|
| 247 | }
|
|---|
| 248 | } @_;
|
|---|
| 249 | };
|
|---|
| 250 | print ' ', $_, ' => ';
|
|---|
| 251 | if (ref($target{$_}) eq "ARRAY") {
|
|---|
| 252 | print '[ ', join(', ', $quotify->(@{$target{$_}})), " ],\n";
|
|---|
| 253 | } else {
|
|---|
| 254 | print $quotify->($target{$_}), ",\n"
|
|---|
| 255 | }
|
|---|
| 256 | }
|
|---|
| 257 | }
|
|---|
| 258 | if ($dump || $envvars) {
|
|---|
| 259 | print "\nRecorded environment:\n\n";
|
|---|
| 260 | foreach (sort keys %{$config{perlenv}}) {
|
|---|
| 261 | print ' ',$_,' = ',($config{perlenv}->{$_} || ''),"\n";
|
|---|
| 262 | }
|
|---|
| 263 | }
|
|---|
| 264 | if ($dump || $makevars) {
|
|---|
| 265 | print "\nMakevars:\n\n";
|
|---|
| 266 | foreach my $var (@makevars) {
|
|---|
| 267 | my $prefix = '';
|
|---|
| 268 | $prefix = $config{CROSS_COMPILE}
|
|---|
| 269 | if grep { $var eq $_ } @user_crossable;
|
|---|
| 270 | $prefix //= '';
|
|---|
| 271 | print ' ',$var,' ' x (16 - length $var),'= ',
|
|---|
| 272 | (ref $config{$var} eq 'ARRAY'
|
|---|
| 273 | ? join(' ', @{$config{$var}})
|
|---|
| 274 | : $prefix.$config{$var}),
|
|---|
| 275 | "\n"
|
|---|
| 276 | if defined $config{$var};
|
|---|
| 277 | }
|
|---|
| 278 |
|
|---|
| 279 | my @buildfile = ($config{builddir}, $config{build_file});
|
|---|
| 280 | unshift @buildfile, $here
|
|---|
| 281 | unless file_name_is_absolute($config{builddir});
|
|---|
| 282 | my $buildfile = canonpath(catdir(@buildfile));
|
|---|
| 283 | print <<"_____";
|
|---|
| 284 |
|
|---|
| 285 | NOTE: These variables only represent the configuration view. The build file
|
|---|
| 286 | template may have processed these variables further, please have a look at the
|
|---|
| 287 | build file for more exact data:
|
|---|
| 288 | $buildfile
|
|---|
| 289 | _____
|
|---|
| 290 | }
|
|---|
| 291 | if ($dump || $buildparams) {
|
|---|
| 292 | my @buildfile = ($config{builddir}, $config{build_file});
|
|---|
| 293 | unshift @buildfile, $here
|
|---|
| 294 | unless file_name_is_absolute($config{builddir});
|
|---|
| 295 | print "\nbuild file:\n\n";
|
|---|
| 296 | print " ", canonpath(catfile(@buildfile)),"\n";
|
|---|
| 297 |
|
|---|
| 298 | print "\nbuild file templates:\n\n";
|
|---|
| 299 | foreach (@{$config{build_file_templates}}) {
|
|---|
| 300 | my @tmpl = ($_);
|
|---|
| 301 | unshift @tmpl, $here
|
|---|
| 302 | unless file_name_is_absolute($config{sourcedir});
|
|---|
| 303 | print ' ',canonpath(catfile(@tmpl)),"\n";
|
|---|
| 304 | }
|
|---|
| 305 | }
|
|---|
| 306 | if ($reconf) {
|
|---|
| 307 | if ($verbose) {
|
|---|
| 308 | print 'Reconfiguring with: ', join(' ',@{$config{perlargv}}), "\n";
|
|---|
| 309 | foreach (sort keys %{$config{perlenv}}) {
|
|---|
| 310 | print ' ',$_,' = ',($config{perlenv}->{$_} || ""),"\n";
|
|---|
| 311 | }
|
|---|
| 312 | }
|
|---|
| 313 |
|
|---|
| 314 | chdir $here;
|
|---|
| 315 | exec $^X,catfile($config{sourcedir}, 'Configure'),'reconf';
|
|---|
| 316 | }
|
|---|
| 317 | if ($query) {
|
|---|
| 318 | use OpenSSL::Config::Query;
|
|---|
| 319 |
|
|---|
| 320 | my $confquery = OpenSSL::Config::Query->new(info => \%unified_info,
|
|---|
| 321 | config => \%config);
|
|---|
| 322 | my $result = eval "\$confquery->$query";
|
|---|
| 323 |
|
|---|
| 324 | # We may need a result class with a printing function at some point.
|
|---|
| 325 | # Until then, we assume that we get a scalar, or a list or a hash table
|
|---|
| 326 | # with scalar values and simply print them in some orderly fashion.
|
|---|
| 327 | if (ref $result eq 'ARRAY') {
|
|---|
| 328 | print "$_\n" foreach @$result;
|
|---|
| 329 | } elsif (ref $result eq 'HASH') {
|
|---|
| 330 | print "$_ : \\\n ", join(" \\\n ", @{$result->{$_}}), "\n"
|
|---|
| 331 | foreach sort keys %$result;
|
|---|
| 332 | } elsif (ref $result eq 'SCALAR') {
|
|---|
| 333 | print "$$result\n";
|
|---|
| 334 | }
|
|---|
| 335 | }
|
|---|
| 336 | }
|
|---|
| 337 |
|
|---|
| 338 | 1;
|
|---|
| 339 |
|
|---|
| 340 | __END__
|
|---|
| 341 |
|
|---|
| 342 | =head1 NAME
|
|---|
| 343 |
|
|---|
| 344 | configdata.pm - configuration data for OpenSSL builds
|
|---|
| 345 |
|
|---|
| 346 | =head1 SYNOPSIS
|
|---|
| 347 |
|
|---|
| 348 | Interactive:
|
|---|
| 349 |
|
|---|
| 350 | perl configdata.pm [options]
|
|---|
| 351 |
|
|---|
| 352 | As data bank module:
|
|---|
| 353 |
|
|---|
| 354 | use configdata;
|
|---|
| 355 |
|
|---|
| 356 | =head1 DESCRIPTION
|
|---|
| 357 |
|
|---|
| 358 | This module can be used in two modes, interactively and as a module containing
|
|---|
| 359 | all the data recorded by OpenSSL's Configure script.
|
|---|
| 360 |
|
|---|
| 361 | When used interactively, simply run it as any perl script.
|
|---|
| 362 | If run with no arguments, it will rebuild the build file (Makefile or
|
|---|
| 363 | corresponding).
|
|---|
| 364 | With at least one option, it will instead get the information you ask for, or
|
|---|
| 365 | re-run the configuration process.
|
|---|
| 366 | See L</OPTIONS> below for more information.
|
|---|
| 367 |
|
|---|
| 368 | When loaded as a module, you get a few databanks with useful information to
|
|---|
| 369 | perform build related tasks. The databanks are:
|
|---|
| 370 |
|
|---|
| 371 | %config Configured things.
|
|---|
| 372 | %target The OpenSSL config target with all inheritances
|
|---|
| 373 | resolved.
|
|---|
| 374 | %disabled The features that are disabled.
|
|---|
| 375 | @disablables The list of features that can be disabled.
|
|---|
| 376 | %withargs All data given through --with-THING options.
|
|---|
| 377 | %unified_info All information that was computed from the build.info
|
|---|
| 378 | files.
|
|---|
| 379 |
|
|---|
| 380 | =head1 OPTIONS
|
|---|
| 381 |
|
|---|
| 382 | =over 4
|
|---|
| 383 |
|
|---|
| 384 | =item B<--help>
|
|---|
| 385 |
|
|---|
| 386 | Print a brief help message and exit.
|
|---|
| 387 |
|
|---|
| 388 | =item B<--man>
|
|---|
| 389 |
|
|---|
| 390 | Print the manual page and exit.
|
|---|
| 391 |
|
|---|
| 392 | =item B<--dump> | B<-d>
|
|---|
| 393 |
|
|---|
| 394 | Print all relevant configuration data. This is equivalent to B<--command-line>
|
|---|
| 395 | B<--options> B<--target> B<--environment> B<--make-variables>
|
|---|
| 396 | B<--build-parameters>.
|
|---|
| 397 |
|
|---|
| 398 | =item B<--command-line> | B<-c>
|
|---|
| 399 |
|
|---|
| 400 | Print the current configuration command line.
|
|---|
| 401 |
|
|---|
| 402 | =item B<--options> | B<-o>
|
|---|
| 403 |
|
|---|
| 404 | Print the features, both enabled and disabled, and display defined macro and
|
|---|
| 405 | skipped directories where applicable.
|
|---|
| 406 |
|
|---|
| 407 | =item B<--target> | B<-t>
|
|---|
| 408 |
|
|---|
| 409 | Print the config attributes for this config target.
|
|---|
| 410 |
|
|---|
| 411 | =item B<--environment> | B<-e>
|
|---|
| 412 |
|
|---|
| 413 | Print the environment variables and their values at the time of configuration.
|
|---|
| 414 |
|
|---|
| 415 | =item B<--make-variables> | B<-m>
|
|---|
| 416 |
|
|---|
| 417 | Print the main make variables generated in the current configuration
|
|---|
| 418 |
|
|---|
| 419 | =item B<--build-parameters> | B<-b>
|
|---|
| 420 |
|
|---|
| 421 | Print the build parameters, i.e. build file and build file templates.
|
|---|
| 422 |
|
|---|
| 423 | =item B<--reconfigure> | B<--reconf> | B<-r>
|
|---|
| 424 |
|
|---|
| 425 | Re-run the configuration process.
|
|---|
| 426 |
|
|---|
| 427 | =item B<--verbose> | B<-v>
|
|---|
| 428 |
|
|---|
| 429 | Verbose output.
|
|---|
| 430 |
|
|---|
| 431 | =back
|
|---|
| 432 |
|
|---|
| 433 | =cut
|
|---|
| 434 |
|
|---|
| 435 | EOF
|
|---|
