configdata.pm.in

   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 splitting 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::Compare qw(compare_text);
  81     use File::Copy;
  82     use Pod::Usage;
  83
  84     use lib '{- sourcedir('util', 'perl') -}';
  85     use OpenSSL::fallback '{- sourcefile('external', 'perl', 'MODULES.txt') -}';
  86
  87     my $here = dirname($0);
  88
  89     if (scalar @ARGV == 0) {
  90         # With no arguments, re-create the build file
  91         # We do that in two steps, where the first step emits perl
  92         # snippets.
  93
  94         my $buildfile = $target{build_file};
  95         my $buildfile_template = "$buildfile.in";
  96         my @autowarntext = (
  97             'WARNING: do not edit!',
  98             "Generated by configdata.pm from "
  99             .join(", ", @{$config{build_file_templates}}),
 100             "via $buildfile_template"
 101         );
 102         my %gendata = (
 103             config => \%config,
 104             target => \%target,
 105             disabled => \%disabled,
 106             withargs => \%withargs,
 107             unified_info => \%unified_info,
 108             autowarntext => \@autowarntext,
 109             );
 110
 111         use lib '.';
 112         use lib '{- sourcedir('Configurations') -}';
 113         use gentemplate;
 114
 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         print 'Created ',$buildfile_template,"\n";
 124
 125         use OpenSSL::Template;
 126
 127         my $prepend = <<'_____';
 128 use File::Spec::Functions;
 129 use lib '{- sourcedir('util', 'perl') -}';
 130 use lib '{- sourcedir('Configurations') -}';
 131 use lib '{- $config{builddir} -}';
 132 use platform;
 133 _____
 134
 135         my $tmpl;
 136         open BUILDFILE, ">$buildfile.new"
 137             or die "Trying to create $buildfile.new: $!";
 138         $tmpl = OpenSSL::Template->new(TYPE => 'FILE',
 139                                        SOURCE => $buildfile_template);
 140         $tmpl->fill_in(FILENAME => $_,
 141                        OUTPUT => \*BUILDFILE,
 142                        HASH => \%gendata,
 143                        PREPEND => $prepend,
 144                        # To ensure that global variables and functions
 145                        # defined in one template stick around for the
 146                        # next, making them combinable
 147                        PACKAGE => 'OpenSSL::safe')
 148             or die $Text::Template::ERROR;
 149         close BUILDFILE;
 150         rename("$buildfile.new", $buildfile)
 151             or die "Trying to rename $buildfile.new to $buildfile: $!";
 152         print 'Created ',$buildfile,"\n";
 153
 154         my $configuration_h =
 155             catfile('include', 'openssl', 'configuration.h');
 156         my $configuration_h_in =
 157             catfile($config{sourcedir}, 'include', 'openssl', 'configuration.h.in');
 158         open CONFIGURATION_H, ">${configuration_h}.new"
 159             or die "Trying to create ${configuration_h}.new: $!";
 160         $tmpl = OpenSSL::Template->new(TYPE => 'FILE',
 161                                        SOURCE => $configuration_h_in);
 162         $tmpl->fill_in(FILENAME => $_,
 163                        OUTPUT => \*CONFIGURATION_H,
 164                        HASH => \%gendata,
 165                        PREPEND => $prepend,
 166                        # To ensure that global variables and functions
 167                        # defined in one template stick around for the
 168                        # next, making them combinable
 169                        PACKAGE => 'OpenSSL::safe')
 170             or die $Text::Template::ERROR;
 171         close CONFIGURATION_H;
 172
 173         # When using stat() on Windows, we can get it to perform better by
 174         # avoid some data.  This doesn't affect the mtime field, so we're not
 175         # losing anything...
 176         ${^WIN32_SLOPPY_STAT} = 1;
 177
 178         my $update_configuration_h = 0;
 179         if (-f $configuration_h) {
 180             my $configuration_h_mtime = (stat($configuration_h))[9];
 181             my $configuration_h_in_mtime = (stat($configuration_h_in))[9];
 182
 183             # If configuration.h.in was updated after the last configuration.h,
 184             # or if configuration.h.new differs configuration.h, we update
 185             # configuration.h
 186             if ($configuration_h_mtime < $configuration_h_in_mtime
 187                 || compare_text("${configuration_h}.new", $configuration_h) != 0) {
 188                 $update_configuration_h = 1;
 189             } else {
 190                 # If nothing has changed, let's just drop the new one and
 191                 # pretend like nothing happened
 192                 unlink "${configuration_h}.new"
 193             }
 194         } else {
 195             $update_configuration_h = 1;
 196         }
 197
 198         if ($update_configuration_h) {
 199             rename("${configuration_h}.new", $configuration_h)
 200                 or die "Trying to rename ${configuration_h}.new to $configuration_h: $!";
 201             print 'Created ',$configuration_h,"\n";
 202         }
 203
 204         exit(0);
 205     }
 206
 207     my $dump = undef;
 208     my $cmdline = undef;
 209     my $options = undef;
 210     my $target = undef;
 211     my $envvars = undef;
 212     my $makevars = undef;
 213     my $buildparams = undef;
 214     my $reconf = undef;
 215     my $verbose = undef;
 216     my $query = undef;
 217     my $help = undef;
 218     my $man = undef;
 219     GetOptions('dump|d'                 => \$dump,
 220                'command-line|c'         => \$cmdline,
 221                'options|o'              => \$options,
 222                'target|t'               => \$target,
 223                'environment|e'          => \$envvars,
 224                'make-variables|m'       => \$makevars,
 225                'build-parameters|b'     => \$buildparams,
 226                'reconfigure|reconf|r'   => \$reconf,
 227                'verbose|v'              => \$verbose,
 228                'query|q=s'              => \$query,
 229                'help'                   => \$help,
 230                'man'                    => \$man)
 231         or die "Errors in command line arguments\n";
 232
 233     # We allow extra arguments with --query.  That allows constructs like
 234     # this:
 235     # ./configdata.pm --query 'get_sources(@ARGV)' file1 file2 file3
 236     if (!$query && scalar @ARGV > 0) {
 237         print STDERR <<"_____";
 238 Unrecognised arguments.
 239 For more information, do '$0 --help'
 240 _____
 241         exit(2);
 242     }
 243
 244     if ($help) {
 245         pod2usage(-exitval => 0,
 246                   -verbose => 1);
 247     }
 248     if ($man) {
 249         pod2usage(-exitval => 0,
 250                   -verbose => 2);
 251     }
 252     if ($dump || $cmdline) {
 253         print "\nCommand line (with current working directory = $here):\n\n";
 254         print '    ',join(' ',
 255                           $config{PERL},
 256                           catfile($config{sourcedir}, 'Configure'),
 257                           @{$config{perlargv}}), "\n";
 258         print "\nPerl information:\n\n";
 259         print '    ',$config{perl_cmd},"\n";
 260         print '    ',$config{perl_version},' for ',$config{perl_archname},"\n";
 261     }
 262     if ($dump || $options) {
 263         my $longest = 0;
 264         my $longest2 = 0;
 265         foreach my $what (@disablables) {
 266             $longest = length($what) if $longest < length($what);
 267             $longest2 = length($disabled{$what})
 268                 if $disabled{$what} && $longest2 < length($disabled{$what});
 269         }
 270         print "\nEnabled features:\n\n";
 271         foreach my $what (@disablables) {
 272             print "    $what\n" unless $disabled{$what};
 273         }
 274         print "\nDisabled features:\n\n";
 275         foreach my $what (@disablables) {
 276             if ($disabled{$what}) {
 277                 print "    $what", ' ' x ($longest - length($what) + 1),
 278                     "[$disabled{$what}]", ' ' x ($longest2 - length($disabled{$what}) + 1);
 279                 print $disabled_info{$what}->{macro}
 280                     if $disabled_info{$what}->{macro};
 281                 print ' (skip ',
 282                     join(', ', @{$disabled_info{$what}->{skipped}}),
 283                     ')'
 284                     if $disabled_info{$what}->{skipped};
 285                 print "\n";
 286             }
 287         }
 288     }
 289     if ($dump || $target) {
 290         print "\nConfig target attributes:\n\n";
 291         foreach (sort keys %target) {
 292             next if $_ =~ m|^_| || $_ eq 'template';
 293             my $quotify = sub {
 294                 map {
 295                     if (defined $_) {
 296                         (my $x = $_) =~ s|([\\\$\@"])|\\$1|g; "\"$x\""
 297                     } else {
 298                         "undef";
 299                     }
 300                 } @_;
 301             };
 302             print '    ', $_, ' => ';
 303             if (ref($target{$_}) eq "ARRAY") {
 304                 print '[ ', join(', ', $quotify->(@{$target{$_}})), " ],\n";
 305             } else {
 306                 print $quotify->($target{$_}), ",\n"
 307             }
 308         }
 309     }
 310     if ($dump || $envvars) {
 311         print "\nRecorded environment:\n\n";
 312         foreach (sort keys %{$config{perlenv}}) {
 313             print '    ',$_,' = ',($config{perlenv}->{$_} || ''),"\n";
 314         }
 315     }
 316     if ($dump || $makevars) {
 317         print "\nMakevars:\n\n";
 318         foreach my $var (@makevars) {
 319             my $prefix = '';
 320             $prefix = $config{CROSS_COMPILE}
 321                 if grep { $var eq $_ } @user_crossable;
 322             $prefix //= '';
 323             print '    ',$var,' ' x (16 - length $var),'= ',
 324                 (ref $config{$var} eq 'ARRAY'
 325                  ? join(' ', @{$config{$var}})
 326                  : $prefix.$config{$var}),
 327                 "\n"
 328                 if defined $config{$var};
 329         }
 330
 331         my @buildfile = ($config{builddir}, $config{build_file});
 332         unshift @buildfile, $here
 333             unless file_name_is_absolute($config{builddir});
 334         my $buildfile = canonpath(catdir(@buildfile));
 335         print <<"_____";
 336
 337 NOTE: These variables only represent the configuration view.  The build file
 338 template may have processed these variables further, please have a look at the
 339 build file for more exact data:
 340     $buildfile
 341 _____
 342     }
 343     if ($dump || $buildparams) {
 344         my @buildfile = ($config{builddir}, $config{build_file});
 345         unshift @buildfile, $here
 346             unless file_name_is_absolute($config{builddir});
 347         print "\nbuild file:\n\n";
 348         print "    ", canonpath(catfile(@buildfile)),"\n";
 349
 350         print "\nbuild file templates:\n\n";
 351         foreach (@{$config{build_file_templates}}) {
 352             my @tmpl = ($_);
 353             unshift @tmpl, $here
 354                 unless file_name_is_absolute($config{sourcedir});
 355             print '    ',canonpath(catfile(@tmpl)),"\n";
 356         }
 357     }
 358     if ($reconf) {
 359         if ($verbose) {
 360             print 'Reconfiguring with: ', join(' ',@{$config{perlargv}}), "\n";
 361             foreach (sort keys %{$config{perlenv}}) {
 362                 print '    ',$_,' = ',($config{perlenv}->{$_} || ""),"\n";
 363             }
 364         }
 365
 366         chdir $here;
 367         exec $^X,catfile($config{sourcedir}, 'Configure'),'reconf';
 368     }
 369     if ($query) {
 370         use OpenSSL::Config::Query;
 371
 372         my $confquery = OpenSSL::Config::Query->new(info => \%unified_info,
 373                                                     config => \%config);
 374         my $result = eval "\$confquery->$query";
 375
 376         # We may need a result class with a printing function at some point.
 377         # Until then, we assume that we get a scalar, or a list or a hash table
 378         # with scalar values and simply print them in some orderly fashion.
 379         if (ref $result eq 'ARRAY') {
 380             print "$_\n" foreach @$result;
 381         } elsif (ref $result eq 'HASH') {
 382             print "$_ : \\\n  ", join(" \\\n  ", @{$result->{$_}}), "\n"
 383                 foreach sort keys %$result;
 384         } elsif (ref $result eq 'SCALAR') {
 385             print "$$result\n";
 386         }
 387     }
 388 }
 389
 390 1;
 391
 392 __END__
 393
 394 =head1 NAME
 395
 396 configdata.pm - configuration data for OpenSSL builds
 397
 398 =head1 SYNOPSIS
 399
 400 Interactive:
 401
 402   perl configdata.pm [options]
 403
 404 As data bank module:
 405
 406   use configdata;
 407
 408 =head1 DESCRIPTION
 409
 410 This module can be used in two modes, interactively and as a module containing
 411 all the data recorded by OpenSSL's Configure script.
 412
 413 When used interactively, simply run it as any perl script.
 414 If run with no arguments, it will rebuild the build file (Makefile or
 415 corresponding).
 416 With at least one option, it will instead get the information you ask for, or
 417 re-run the configuration process.
 418 See L</OPTIONS> below for more information.
 419
 420 When loaded as a module, you get a few databanks with useful information to
 421 perform build related tasks.  The databanks are:
 422
 423     %config             Configured things.
 424     %target             The OpenSSL config target with all inheritances
 425                         resolved.
 426     %disabled           The features that are disabled.
 427     @disablables        The list of features that can be disabled.
 428     %withargs           All data given through --with-THING options.
 429     %unified_info       All information that was computed from the build.info
 430                         files.
 431
 432 =head1 OPTIONS
 433
 434 =over 4
 435
 436 =item B<--help>
 437
 438 Print a brief help message and exit.
 439
 440 =item B<--man>
 441
 442 Print the manual page and exit.
 443
 444 =item B<--dump> | B<-d>
 445
 446 Print all relevant configuration data.  This is equivalent to B<--command-line>
 447 B<--options> B<--target> B<--environment> B<--make-variables>
 448 B<--build-parameters>.
 449
 450 =item B<--command-line> | B<-c>
 451
 452 Print the current configuration command line.
 453
 454 =item B<--options> | B<-o>
 455
 456 Print the features, both enabled and disabled, and display defined macro and
 457 skipped directories where applicable.
 458
 459 =item B<--target> | B<-t>
 460
 461 Print the config attributes for this config target.
 462
 463 =item B<--environment> | B<-e>
 464
 465 Print the environment variables and their values at the time of configuration.
 466
 467 =item B<--make-variables> | B<-m>
 468
 469 Print the main make variables generated in the current configuration
 470
 471 =item B<--build-parameters> | B<-b>
 472
 473 Print the build parameters, i.e. build file and build file templates.
 474
 475 =item B<--reconfigure> | B<--reconf> | B<-r>
 476
 477 Re-run the configuration process.
 478
 479 =item B<--verbose> | B<-v>
 480
 481 Verbose output.
 482
 483 =back
 484
 485 =cut
 486
 487 EOF