VirtualBox

source: vbox/trunk/src/libs/openssl-3.1.7/configdata.pm.in@ 106165

最後變更 在這個檔案從106165是 104078,由 vboxsync 提交於 8 月 前

openssl-3.1.5: Applied and adjusted our OpenSSL changes to 3.1.4. bugref:10638

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

© 2024 Oracle Support Privacy / Do Not Sell My Info Terms of Use Trademark Policy Automated Access Etiquette