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 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     if (scalar @ARGV > 0) {
 182         print STDERR <<"_____";
 183 Unrecognised arguments.
 184 For more information, do '$0 --help'
 185 _____
 186         exit(2);
 187     }
 188
 189     if ($help) {
 190         pod2usage(-exitval => 0,
 191                   -verbose => 1);
 192     }
 193     if ($man) {
 194         pod2usage(-exitval => 0,
 195                   -verbose => 2);
 196     }
 197     if ($dump || $cmdline) {
 198         print "\nCommand line (with current working directory = $here):\n\n";
 199         print '    ',join(' ',
 200                           $config{PERL},
 201                           catfile($config{sourcedir}, 'Configure'),
 202                           @{$config{perlargv}}), "\n";
 203         print "\nPerl information:\n\n";
 204         print '    ',$config{perl_cmd},"\n";
 205         print '    ',$config{perl_version},' for ',$config{perl_archname},"\n";
 206     }
 207     if ($dump || $options) {
 208         my $longest = 0;
 209         my $longest2 = 0;
 210         foreach my $what (@disablables) {
 211             $longest = length($what) if $longest < length($what);
 212             $longest2 = length($disabled{$what})
 213                 if $disabled{$what} && $longest2 < length($disabled{$what});
 214         }
 215         print "\nEnabled features:\n\n";
 216         foreach my $what (@disablables) {
 217             print "    $what\n" unless $disabled{$what};
 218         }
 219         print "\nDisabled features:\n\n";
 220         foreach my $what (@disablables) {
 221             if ($disabled{$what}) {
 222                 print "    $what", ' ' x ($longest - length($what) + 1),
 223                     "[$disabled{$what}]", ' ' x ($longest2 - length($disabled{$what}) + 1);
 224                 print $disabled_info{$what}->{macro}
 225                     if $disabled_info{$what}->{macro};
 226                 print ' (skip ',
 227                     join(', ', @{$disabled_info{$what}->{skipped}}),
 228                     ')'
 229                     if $disabled_info{$what}->{skipped};
 230                 print "\n";
 231             }
 232         }
 233     }
 234     if ($dump || $target) {
 235         print "\nConfig target attributes:\n\n";
 236         foreach (sort keys %target) {
 237             next if $_ =~ m|^_| || $_ eq 'template';
 238             my $quotify = sub {
 239                 map {
 240                     if (defined $_) {
 241                         (my $x = $_) =~ s|([\\\$\@"])|\\$1|g; "\"$x\""
 242                     } else {
 243                         "undef";
 244                     }
 245                 } @_;
 246             };
 247             print '    ', $_, ' => ';
 248             if (ref($target{$_}) eq "ARRAY") {
 249                 print '[ ', join(', ', $quotify->(@{$target{$_}})), " ],\n";
 250             } else {
 251                 print $quotify->($target{$_}), ",\n"
 252             }
 253         }
 254     }
 255     if ($dump || $envvars) {
 256         print "\nRecorded environment:\n\n";
 257         foreach (sort keys %{$config{perlenv}}) {
 258             print '    ',$_,' = ',($config{perlenv}->{$_} || ''),"\n";
 259         }
 260     }
 261     if ($dump || $makevars) {
 262         print "\nMakevars:\n\n";
 263         foreach my $var (@makevars) {
 264             my $prefix = '';
 265             $prefix = $config{CROSS_COMPILE}
 266                 if grep { $var eq $_ } @user_crossable;
 267             $prefix //= '';
 268             print '    ',$var,' ' x (16 - length $var),'= ',
 269                 (ref $config{$var} eq 'ARRAY'
 270                  ? join(' ', @{$config{$var}})
 271                  : $prefix.$config{$var}),
 272                 "\n"
 273                 if defined $config{$var};
 274         }
 275
 276         my @buildfile = ($config{builddir}, $config{build_file});
 277         unshift @buildfile, $here
 278             unless file_name_is_absolute($config{builddir});
 279         my $buildfile = canonpath(catdir(@buildfile));
 280         print <<"_____";
 281
 282 NOTE: These variables only represent the configuration view.  The build file
 283 template may have processed these variables further, please have a look at the
 284 build file for more exact data:
 285     $buildfile
 286 _____
 287     }
 288     if ($dump || $buildparams) {
 289         my @buildfile = ($config{builddir}, $config{build_file});
 290         unshift @buildfile, $here
 291             unless file_name_is_absolute($config{builddir});
 292         print "\nbuild file:\n\n";
 293         print "    ", canonpath(catfile(@buildfile)),"\n";
 294
 295         print "\nbuild file templates:\n\n";
 296         foreach (@{$config{build_file_templates}}) {
 297             my @tmpl = ($_);
 298             unshift @tmpl, $here
 299                 unless file_name_is_absolute($config{sourcedir});
 300             print '    ',canonpath(catfile(@tmpl)),"\n";
 301         }
 302     }
 303     if ($reconf) {
 304         if ($verbose) {
 305             print 'Reconfiguring with: ', join(' ',@{$config{perlargv}}), "\n";
 306             foreach (sort keys %{$config{perlenv}}) {
 307                 print '    ',$_,' = ',($config{perlenv}->{$_} || ""),"\n";
 308             }
 309         }
 310
 311         chdir $here;
 312         exec $^X,catfile($config{sourcedir}, 'Configure'),'reconf';
 313     }
 314     if ($query) {
 315         use OpenSSL::Config::Query;
 316
 317         my $confquery = OpenSSL::Config::Query->new(info => \%unified_info,
 318                                                     config => \%config);
 319         my $result = eval "\$confquery->$query";
 320
 321         # We may need a result class with a printing function at some point.
 322         # Until then, we assume that we get a scalar, or a list or a hash table
 323         # with scalar values and simply print them in some orderly fashion.
 324         if (ref $result eq 'ARRAY') {
 325             print "$_\n" foreach @$result;
 326         } elsif (ref $result eq 'HASH') {
 327             print "$_ : \\\n  ", join(" \\\n  ", @{$result->{$_}}), "\n"
 328                 foreach sort keys %$result;
 329         } elsif (ref $result eq 'SCALAR') {
 330             print "$$result\n";
 331         }
 332     }
 333 }
 334
 335 1;
 336
 337 __END__
 338
 339 =head1 NAME
 340
 341 configdata.pm - configuration data for OpenSSL builds
 342
 343 =head1 SYNOPSIS
 344
 345 Interactive:
 346
 347   perl configdata.pm [options]
 348
 349 As data bank module:
 350
 351   use configdata;
 352
 353 =head1 DESCRIPTION
 354
 355 This module can be used in two modes, interactively and as a module containing
 356 all the data recorded by OpenSSL's Configure script.
 357
 358 When used interactively, simply run it as any perl script.
 359 If run with no arguments, it will rebuild the build file (Makefile or
 360 corresponding).
 361 With at least one option, it will instead get the information you ask for, or
 362 re-run the configuration process.
 363 See L</OPTIONS> below for more information.
 364
 365 When loaded as a module, you get a few databanks with useful information to
 366 perform build related tasks.  The databanks are:
 367
 368     %config             Configured things.
 369     %target             The OpenSSL config target with all inheritances
 370                         resolved.
 371     %disabled           The features that are disabled.
 372     @disablables        The list of features that can be disabled.
 373     %withargs           All data given through --with-THING options.
 374     %unified_info       All information that was computed from the build.info
 375                         files.
 376
 377 =head1 OPTIONS
 378
 379 =over 4
 380
 381 =item B<--help>
 382
 383 Print a brief help message and exit.
 384
 385 =item B<--man>
 386
 387 Print the manual page and exit.
 388
 389 =item B<--dump> | B<-d>
 390
 391 Print all relevant configuration data.  This is equivalent to B<--command-line>
 392 B<--options> B<--target> B<--environment> B<--make-variables>
 393 B<--build-parameters>.
 394
 395 =item B<--command-line> | B<-c>
 396
 397 Print the current configuration command line.
 398
 399 =item B<--options> | B<-o>
 400
 401 Print the features, both enabled and disabled, and display defined macro and
 402 skipped directories where applicable.
 403
 404 =item B<--target> | B<-t>
 405
 406 Print the config attributes for this config target.
 407
 408 =item B<--environment> | B<-e>
 409
 410 Print the environment variables and their values at the time of configuration.
 411
 412 =item B<--make-variables> | B<-m>
 413
 414 Print the main make variables generated in the current configuration
 415
 416 =item B<--build-parameters> | B<-b>
 417
 418 Print the build parameters, i.e. build file and build file templates.
 419
 420 =item B<--reconfigure> | B<--reconf> | B<-r>
 421
 422 Re-run the configuration process.
 423
 424 =item B<--verbose> | B<-v>
 425
 426 Verbose output.
 427
 428 =back
 429
 430 =cut
 431
 432 EOF