configdata.pm.in

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