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     # 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