mirror of https://github.com/openssl/openssl.git
				
				
				
			
		
			
				
	
	
		
			488 lines
		
	
	
		
			16 KiB
		
	
	
	
		
			Perl
		
	
	
	
			
		
		
	
	
			488 lines
		
	
	
		
			16 KiB
		
	
	
	
		
			Perl
		
	
	
	
| #! {- $config{HASHBANGPERL} -}
 | |
| # -*- mode: perl -*-
 | |
| {-
 | |
|  # We must make sourcedir() return an absolute path, because configdata.pm
 | |
|  # may be loaded as a module from any script in any directory, making
 | |
|  # relative paths untrustable.  Because the result is used with 'use lib',
 | |
|  # we must ensure that it returns a Unix style path.  Mixing File::Spec
 | |
|  # and File::Spec::Unix does just that.
 | |
|  use File::Spec::Unix;
 | |
|  use File::Spec;
 | |
|  use Cwd qw(abs_path);
 | |
|  sub _fixup_path {
 | |
|      my $path = shift;
 | |
| 
 | |
|      # Make the path absolute at all times
 | |
|      $path = abs_path($path);
 | |
| 
 | |
|      if ($^O eq 'VMS') {
 | |
|          # Convert any path of the VMS form VOLUME:[DIR1.DIR2]FILE to the
 | |
|          # Unix form /VOLUME/DIR1/DIR2/FILE, which is what VMS perl supports
 | |
|          # for 'use lib'.
 | |
| 
 | |
|          # Start with splitting the native path
 | |
|          (my $vol, my $dirs, my $file) = File::Spec->splitpath($path);
 | |
|          my @dirs = File::Spec->splitdir($dirs);
 | |
| 
 | |
|          # Reassemble it as a Unix path
 | |
|          $vol =~ s|:$||;
 | |
|          $dirs = File::Spec::Unix->catdir('', $vol, @dirs);
 | |
|          $path = File::Spec::Unix->catpath('', $dirs, $file);
 | |
|      }
 | |
| 
 | |
|      return $path;
 | |
|  }
 | |
|  sub sourcedir {
 | |
|      return _fixup_path(File::Spec->catdir($config{sourcedir}, @_))
 | |
|  }
 | |
|  sub sourcefile {
 | |
|      return _fixup_path(File::Spec->catfile($config{sourcedir}, @_))
 | |
|  }
 | |
|  use lib sourcedir('util', 'perl');
 | |
|  use OpenSSL::Util;
 | |
| -}
 | |
| package configdata;
 | |
| 
 | |
| use strict;
 | |
| use warnings;
 | |
| 
 | |
| use Exporter;
 | |
| our @ISA = qw(Exporter);
 | |
| our @EXPORT = qw(
 | |
|     %config %target %disabled %withargs %unified_info
 | |
|     @disablables @disablables_int
 | |
| );
 | |
| 
 | |
| our %config = ({- dump_data(\%config, indent => 0); -});
 | |
| our %target = ({- dump_data(\%target, indent => 0); -});
 | |
| our @disablables = ({- dump_data(\@disablables, indent => 0) -});
 | |
| our @disablables_int = ({- dump_data(\@disablables_int, indent => 0) -});
 | |
| our %disabled = ({- dump_data(\%disabled, indent => 0); -});
 | |
| our %withargs = ({- dump_data(\%withargs, indent => 0); -});
 | |
| our %unified_info = ({- dump_data(\%unified_info, indent => 0); -});
 | |
| 
 | |
| # Unexported, only used by OpenSSL::Test::Utils::available_protocols()
 | |
| our %available_protocols = (
 | |
|     tls  => [{- dump_data(\@tls, indent => 0) -}],
 | |
|     dtls => [{- dump_data(\@dtls, indent => 0) -}],
 | |
| );
 | |
| 
 | |
| # The following data is only used when this files is use as a script
 | |
| my @makevars = ({- dump_data(\@makevars, indent => 0); -});
 | |
| my %disabled_info = ({- dump_data(\%disabled_info, indent => 0); -});
 | |
| my @user_crossable = qw( {- join (' ', @user_crossable) -} );
 | |
| 
 | |
| # If run directly, we can give some answers, and even reconfigure
 | |
| unless (caller) {
 | |
|     use Getopt::Long;
 | |
|     use File::Spec::Functions;
 | |
|     use File::Basename;
 | |
|     use File::Compare qw(compare_text);
 | |
|     use File::Copy;
 | |
|     use Pod::Usage;
 | |
| 
 | |
|     use lib '{- sourcedir('util', 'perl') -}';
 | |
|     use OpenSSL::fallback '{- sourcefile('external', 'perl', 'MODULES.txt') -}';
 | |
| 
 | |
|     my $here = dirname($0);
 | |
| 
 | |
|     if (scalar @ARGV == 0) {
 | |
|         # With no arguments, re-create the build file
 | |
|         # We do that in two steps, where the first step emits perl
 | |
|         # snippets.
 | |
| 
 | |
|         my $buildfile = $config{build_file};
 | |
|         my $buildfile_template = "$buildfile.in";
 | |
|         my @autowarntext = (
 | |
|             'WARNING: do not edit!',
 | |
|             "Generated by configdata.pm from "
 | |
|             .join(", ", @{$config{build_file_templates}}),
 | |
|             "via $buildfile_template"
 | |
|         );
 | |
|         my %gendata = (
 | |
|             config => \%config,
 | |
|             target => \%target,
 | |
|             disabled => \%disabled,
 | |
|             withargs => \%withargs,
 | |
|             unified_info => \%unified_info,
 | |
|             autowarntext => \@autowarntext,
 | |
|             );
 | |
| 
 | |
|         use lib '.';
 | |
|         use lib '{- sourcedir('Configurations') -}';
 | |
|         use gentemplate;
 | |
| 
 | |
|         open my $buildfile_template_fh, ">$buildfile_template"
 | |
|             or die "Trying to create $buildfile_template: $!";
 | |
|         foreach (@{$config{build_file_templates}}) {
 | |
|             copy($_, $buildfile_template_fh)
 | |
|                 or die "Trying to copy $_ into $buildfile_template: $!";
 | |
|         }
 | |
|         gentemplate(output => $buildfile_template_fh, %gendata);
 | |
|         close $buildfile_template_fh;
 | |
|         print 'Created ',$buildfile_template,"\n";
 | |
| 
 | |
|         use OpenSSL::Template;
 | |
| 
 | |
|         my $prepend = <<'_____';
 | |
| use File::Spec::Functions;
 | |
| use lib '{- sourcedir('util', 'perl') -}';
 | |
| use lib '{- sourcedir('Configurations') -}';
 | |
| use lib '{- $config{builddir} -}';
 | |
| use platform;
 | |
| _____
 | |
| 
 | |
|         my $tmpl;
 | |
|         open BUILDFILE, ">$buildfile.new"
 | |
|             or die "Trying to create $buildfile.new: $!";
 | |
|         $tmpl = OpenSSL::Template->new(TYPE => 'FILE',
 | |
|                                        SOURCE => $buildfile_template);
 | |
|         $tmpl->fill_in(FILENAME => $_,
 | |
|                        OUTPUT => \*BUILDFILE,
 | |
|                        HASH => \%gendata,
 | |
|                        PREPEND => $prepend,
 | |
|                        # To ensure that global variables and functions
 | |
|                        # defined in one template stick around for the
 | |
|                        # next, making them combinable
 | |
|                        PACKAGE => 'OpenSSL::safe')
 | |
|             or die $OpenSSL::Template::ERROR;
 | |
|         close BUILDFILE;
 | |
|         rename("$buildfile.new", $buildfile)
 | |
|             or die "Trying to rename $buildfile.new to $buildfile: $!";
 | |
|         print 'Created ',$buildfile,"\n";
 | |
| 
 | |
|         my $configuration_h =
 | |
|             catfile('include', 'openssl', 'configuration.h');
 | |
|         my $configuration_h_in =
 | |
|             catfile($config{sourcedir}, 'include', 'openssl', 'configuration.h.in');
 | |
|         open CONFIGURATION_H, ">${configuration_h}.new"
 | |
|             or die "Trying to create ${configuration_h}.new: $!";
 | |
|         $tmpl = OpenSSL::Template->new(TYPE => 'FILE',
 | |
|                                        SOURCE => $configuration_h_in);
 | |
|         $tmpl->fill_in(FILENAME => $_,
 | |
|                        OUTPUT => \*CONFIGURATION_H,
 | |
|                        HASH => \%gendata,
 | |
|                        PREPEND => $prepend,
 | |
|                        # To ensure that global variables and functions
 | |
|                        # defined in one template stick around for the
 | |
|                        # next, making them combinable
 | |
|                        PACKAGE => 'OpenSSL::safe')
 | |
|             or die $OpenSSL::Template::ERROR;
 | |
|         close CONFIGURATION_H;
 | |
| 
 | |
|         # When using stat() on Windows, we can get it to perform better by
 | |
|         # avoid some data.  This doesn't affect the mtime field, so we're not
 | |
|         # losing anything...
 | |
|         ${^WIN32_SLOPPY_STAT} = 1;
 | |
| 
 | |
|         my $update_configuration_h = 0;
 | |
|         if (-f $configuration_h) {
 | |
|             my $configuration_h_mtime = (stat($configuration_h))[9];
 | |
|             my $configuration_h_in_mtime = (stat($configuration_h_in))[9];
 | |
| 
 | |
|             # If configuration.h.in was updated after the last configuration.h,
 | |
|             # or if configuration.h.new differs configuration.h, we update
 | |
|             # configuration.h
 | |
|             if ($configuration_h_mtime < $configuration_h_in_mtime
 | |
|                 || compare_text("${configuration_h}.new", $configuration_h) != 0) {
 | |
|                 $update_configuration_h = 1;
 | |
|             } else {
 | |
|                 # If nothing has changed, let's just drop the new one and
 | |
|                 # pretend like nothing happened
 | |
|                 unlink "${configuration_h}.new"
 | |
|             }
 | |
|         } else {
 | |
|             $update_configuration_h = 1;
 | |
|         }
 | |
| 
 | |
|         if ($update_configuration_h) {
 | |
|             rename("${configuration_h}.new", $configuration_h)
 | |
|                 or die "Trying to rename ${configuration_h}.new to $configuration_h: $!";
 | |
|             print 'Created ',$configuration_h,"\n";
 | |
|         }
 | |
| 
 | |
|         exit(0);
 | |
|     }
 | |
| 
 | |
|     my $dump = undef;
 | |
|     my $cmdline = undef;
 | |
|     my $options = undef;
 | |
|     my $target = undef;
 | |
|     my $envvars = undef;
 | |
|     my $makevars = undef;
 | |
|     my $buildparams = undef;
 | |
|     my $reconf = undef;
 | |
|     my $verbose = undef;
 | |
|     my $query = undef;
 | |
|     my $help = undef;
 | |
|     my $man = undef;
 | |
|     GetOptions('dump|d'                 => \$dump,
 | |
|                'command-line|c'         => \$cmdline,
 | |
|                'options|o'              => \$options,
 | |
|                'target|t'               => \$target,
 | |
|                'environment|e'          => \$envvars,
 | |
|                'make-variables|m'       => \$makevars,
 | |
|                'build-parameters|b'     => \$buildparams,
 | |
|                'reconfigure|reconf|r'   => \$reconf,
 | |
|                'verbose|v'              => \$verbose,
 | |
|                'query|q=s'              => \$query,
 | |
|                'help'                   => \$help,
 | |
|                'man'                    => \$man)
 | |
|         or die "Errors in command line arguments\n";
 | |
| 
 | |
|     # We allow extra arguments with --query.  That allows constructs like
 | |
|     # this:
 | |
|     # ./configdata.pm --query 'get_sources(@ARGV)' file1 file2 file3
 | |
|     if (!$query && scalar @ARGV > 0) {
 | |
|         print STDERR <<"_____";
 | |
| Unrecognised arguments.
 | |
| For more information, do '$0 --help'
 | |
| _____
 | |
|         exit(2);
 | |
|     }
 | |
| 
 | |
|     if ($help) {
 | |
|         pod2usage(-exitval => 0,
 | |
|                   -verbose => 1);
 | |
|     }
 | |
|     if ($man) {
 | |
|         pod2usage(-exitval => 0,
 | |
|                   -verbose => 2);
 | |
|     }
 | |
|     if ($dump || $cmdline) {
 | |
|         print "\nCommand line (with current working directory = $here):\n\n";
 | |
|         print '    ',join(' ',
 | |
|                           $config{PERL},
 | |
|                           catfile($config{sourcedir}, 'Configure'),
 | |
|                           @{$config{perlargv}}), "\n";
 | |
|         print "\nPerl information:\n\n";
 | |
|         print '    ',$config{perl_cmd},"\n";
 | |
|         print '    ',$config{perl_version},' for ',$config{perl_archname},"\n";
 | |
|     }
 | |
|     if ($dump || $options) {
 | |
|         my $longest = 0;
 | |
|         my $longest2 = 0;
 | |
|         foreach my $what (@disablables) {
 | |
|             $longest = length($what) if $longest < length($what);
 | |
|             $longest2 = length($disabled{$what})
 | |
|                 if $disabled{$what} && $longest2 < length($disabled{$what});
 | |
|         }
 | |
|         print "\nEnabled features:\n\n";
 | |
|         foreach my $what (@disablables) {
 | |
|             print "    $what\n" unless $disabled{$what};
 | |
|         }
 | |
|         print "\nDisabled features:\n\n";
 | |
|         foreach my $what (@disablables) {
 | |
|             if ($disabled{$what}) {
 | |
|                 print "    $what", ' ' x ($longest - length($what) + 1),
 | |
|                     "[$disabled{$what}]", ' ' x ($longest2 - length($disabled{$what}) + 1);
 | |
|                 print $disabled_info{$what}->{macro}
 | |
|                     if $disabled_info{$what}->{macro};
 | |
|                 print ' (skip ',
 | |
|                     join(', ', @{$disabled_info{$what}->{skipped}}),
 | |
|                     ')'
 | |
|                     if $disabled_info{$what}->{skipped};
 | |
|                 print "\n";
 | |
|             }
 | |
|         }
 | |
|     }
 | |
|     if ($dump || $target) {
 | |
|         print "\nConfig target attributes:\n\n";
 | |
|         foreach (sort keys %target) {
 | |
|             next if $_ =~ m|^_| || $_ eq 'template';
 | |
|             my $quotify = sub {
 | |
|                 map {
 | |
|                     if (defined $_) {
 | |
|                         (my $x = $_) =~ s|([\\\$\@"])|\\$1|g; "\"$x\""
 | |
|                     } else {
 | |
|                         "undef";
 | |
|                     }
 | |
|                 } @_;
 | |
|             };
 | |
|             print '    ', $_, ' => ';
 | |
|             if (ref($target{$_}) eq "ARRAY") {
 | |
|                 print '[ ', join(', ', $quotify->(@{$target{$_}})), " ],\n";
 | |
|             } else {
 | |
|                 print $quotify->($target{$_}), ",\n"
 | |
|             }
 | |
|         }
 | |
|     }
 | |
|     if ($dump || $envvars) {
 | |
|         print "\nRecorded environment:\n\n";
 | |
|         foreach (sort keys %{$config{perlenv}}) {
 | |
|             print '    ',$_,' = ',($config{perlenv}->{$_} || ''),"\n";
 | |
|         }
 | |
|     }
 | |
|     if ($dump || $makevars) {
 | |
|         print "\nMakevars:\n\n";
 | |
|         foreach my $var (@makevars) {
 | |
|             my $prefix = '';
 | |
|             $prefix = $config{CROSS_COMPILE}
 | |
|                 if grep { $var eq $_ } @user_crossable;
 | |
|             $prefix //= '';
 | |
|             print '    ',$var,' ' x (16 - length $var),'= ',
 | |
|                 (ref $config{$var} eq 'ARRAY'
 | |
|                  ? join(' ', @{$config{$var}})
 | |
|                  : $prefix.$config{$var}),
 | |
|                 "\n"
 | |
|                 if defined $config{$var};
 | |
|         }
 | |
| 
 | |
|         my @buildfile = ($config{builddir}, $config{build_file});
 | |
|         unshift @buildfile, $here
 | |
|             unless file_name_is_absolute($config{builddir});
 | |
|         my $buildfile = canonpath(catdir(@buildfile));
 | |
|         print <<"_____";
 | |
| 
 | |
| NOTE: These variables only represent the configuration view.  The build file
 | |
| template may have processed these variables further, please have a look at the
 | |
| build file for more exact data:
 | |
|     $buildfile
 | |
| _____
 | |
|     }
 | |
|     if ($dump || $buildparams) {
 | |
|         my @buildfile = ($config{builddir}, $config{build_file});
 | |
|         unshift @buildfile, $here
 | |
|             unless file_name_is_absolute($config{builddir});
 | |
|         print "\nbuild file:\n\n";
 | |
|         print "    ", canonpath(catfile(@buildfile)),"\n";
 | |
| 
 | |
|         print "\nbuild file templates:\n\n";
 | |
|         foreach (@{$config{build_file_templates}}) {
 | |
|             my @tmpl = ($_);
 | |
|             unshift @tmpl, $here
 | |
|                 unless file_name_is_absolute($config{sourcedir});
 | |
|             print '    ',canonpath(catfile(@tmpl)),"\n";
 | |
|         }
 | |
|     }
 | |
|     if ($reconf) {
 | |
|         if ($verbose) {
 | |
|             print 'Reconfiguring with: ', join(' ',@{$config{perlargv}}), "\n";
 | |
|             foreach (sort keys %{$config{perlenv}}) {
 | |
|                 print '    ',$_,' = ',($config{perlenv}->{$_} || ""),"\n";
 | |
|             }
 | |
|         }
 | |
| 
 | |
|         chdir $here;
 | |
|         exec $^X,catfile($config{sourcedir}, 'Configure'),'reconf';
 | |
|     }
 | |
|     if ($query) {
 | |
|         use OpenSSL::Config::Query;
 | |
| 
 | |
|         my $confquery = OpenSSL::Config::Query->new(info => \%unified_info,
 | |
|                                                     config => \%config);
 | |
|         my $result = eval "\$confquery->$query";
 | |
| 
 | |
|         # We may need a result class with a printing function at some point.
 | |
|         # Until then, we assume that we get a scalar, or a list or a hash table
 | |
|         # with scalar values and simply print them in some orderly fashion.
 | |
|         if (ref $result eq 'ARRAY') {
 | |
|             print "$_\n" foreach @$result;
 | |
|         } elsif (ref $result eq 'HASH') {
 | |
|             print "$_ : \\\n  ", join(" \\\n  ", @{$result->{$_}}), "\n"
 | |
|                 foreach sort keys %$result;
 | |
|         } elsif (ref $result eq 'SCALAR') {
 | |
|             print "$$result\n";
 | |
|         }
 | |
|     }
 | |
| }
 | |
| 
 | |
| 1;
 | |
| 
 | |
| __END__
 | |
| 
 | |
| =head1 NAME
 | |
| 
 | |
| configdata.pm - configuration data for OpenSSL builds
 | |
| 
 | |
| =head1 SYNOPSIS
 | |
| 
 | |
| Interactive:
 | |
| 
 | |
|   perl configdata.pm [options]
 | |
| 
 | |
| As data bank module:
 | |
| 
 | |
|   use configdata;
 | |
| 
 | |
| =head1 DESCRIPTION
 | |
| 
 | |
| This module can be used in two modes, interactively and as a module containing
 | |
| all the data recorded by OpenSSL's Configure script.
 | |
| 
 | |
| When used interactively, simply run it as any perl script.
 | |
| If run with no arguments, it will rebuild the build file (Makefile or
 | |
| corresponding).
 | |
| With at least one option, it will instead get the information you ask for, or
 | |
| re-run the configuration process.
 | |
| See L</OPTIONS> below for more information.
 | |
| 
 | |
| When loaded as a module, you get a few databanks with useful information to
 | |
| perform build related tasks.  The databanks are:
 | |
| 
 | |
|     %config             Configured things.
 | |
|     %target             The OpenSSL config target with all inheritances
 | |
|                         resolved.
 | |
|     %disabled           The features that are disabled.
 | |
|     @disablables        The list of features that can be disabled.
 | |
|     %withargs           All data given through --with-THING options.
 | |
|     %unified_info       All information that was computed from the build.info
 | |
|                         files.
 | |
| 
 | |
| =head1 OPTIONS
 | |
| 
 | |
| =over 4
 | |
| 
 | |
| =item B<--help>
 | |
| 
 | |
| Print a brief help message and exit.
 | |
| 
 | |
| =item B<--man>
 | |
| 
 | |
| Print the manual page and exit.
 | |
| 
 | |
| =item B<--dump> | B<-d>
 | |
| 
 | |
| Print all relevant configuration data.  This is equivalent to B<--command-line>
 | |
| B<--options> B<--target> B<--environment> B<--make-variables>
 | |
| B<--build-parameters>.
 | |
| 
 | |
| =item B<--command-line> | B<-c>
 | |
| 
 | |
| Print the current configuration command line.
 | |
| 
 | |
| =item B<--options> | B<-o>
 | |
| 
 | |
| Print the features, both enabled and disabled, and display defined macro and
 | |
| skipped directories where applicable.
 | |
| 
 | |
| =item B<--target> | B<-t>
 | |
| 
 | |
| Print the config attributes for this config target.
 | |
| 
 | |
| =item B<--environment> | B<-e>
 | |
| 
 | |
| Print the environment variables and their values at the time of configuration.
 | |
| 
 | |
| =item B<--make-variables> | B<-m>
 | |
| 
 | |
| Print the main make variables generated in the current configuration
 | |
| 
 | |
| =item B<--build-parameters> | B<-b>
 | |
| 
 | |
| Print the build parameters, i.e. build file and build file templates.
 | |
| 
 | |
| =item B<--reconfigure> | B<--reconf> | B<-r>
 | |
| 
 | |
| Re-run the configuration process.
 | |
| 
 | |
| =item B<--verbose> | B<-v>
 | |
| 
 | |
| Verbose output.
 | |
| 
 | |
| =back
 | |
| 
 | |
| =cut
 | |
| 
 | |
| EOF
 |