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