]>
Commit | Line | Data |
---|---|---|
1f86b822 RL |
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 | my $here = dirname($0); | |
116 | ||
117 | if (scalar @ARGV == 0) { | |
118 | # With no arguments, re-create the build file | |
119 | ||
120 | use lib '{- sourcedir('util', 'perl') -}'; | |
121 | use OpenSSL::fallback '{- sourcefile('external', 'perl', 'MODULES.txt') -}'; | |
122 | use OpenSSL::Template; | |
123 | ||
124 | my $prepend = <<"_____"; | |
125 | use File::Spec::Functions; | |
126 | use lib '{- sourcedir('util', 'perl') -}'; | |
127 | _____ | |
128 | $prepend .= <<"_____" if defined $target{perl_platform}; | |
129 | use lib '{- sourcedir('Configurations') -}'; | |
130 | use lib '{- $config{builddir} -}'; | |
131 | use platform; | |
132 | _____ | |
133 | ||
134 | my @autowarntext = ( | |
135 | 'WARNING: do not edit!', | |
136 | "Generated by configdata.pm from " | |
137 | .join(", ", @{$config{build_file_templates}}) | |
138 | ); | |
139 | ||
140 | print 'Creating ',$target{build_file},"\n"; | |
141 | open BUILDFILE, ">$target{build_file}.new" | |
142 | or die "Trying to create $target{build_file}.new: $!"; | |
143 | foreach (@{$config{build_file_templates}}) { | |
144 | my $tmpl = OpenSSL::Template->new(TYPE => 'FILE', | |
145 | SOURCE => $_); | |
146 | $tmpl->fill_in(FILENAME => $_, | |
147 | OUTPUT => \*BUILDFILE, | |
148 | HASH => { config => \%config, | |
149 | target => \%target, | |
150 | disabled => \%disabled, | |
151 | withargs => \%withargs, | |
152 | unified_info => \%unified_info, | |
153 | autowarntext => \@autowarntext }, | |
154 | PREPEND => $prepend, | |
155 | # To ensure that global variables and functions | |
156 | # defined in one template stick around for the | |
157 | # next, making them combinable | |
158 | PACKAGE => 'OpenSSL::safe') | |
159 | or die $Text::Template::ERROR; | |
160 | } | |
161 | close BUILDFILE; | |
162 | rename("$target{build_file}.new", $target{build_file}) | |
163 | or die "Trying to rename $target{build_file}.new to $target{build_file}: $!"; | |
164 | ||
165 | exit(0); | |
166 | } | |
167 | ||
168 | my $dump = undef; | |
169 | my $cmdline = undef; | |
170 | my $options = undef; | |
171 | my $target = undef; | |
172 | my $envvars = undef; | |
173 | my $makevars = undef; | |
174 | my $buildparams = undef; | |
175 | my $reconf = undef; | |
176 | my $verbose = 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 | 'help' => \$help, | |
189 | 'man' => \$man) | |
190 | or die "Errors in command line arguments\n"; | |
191 | ||
192 | if (scalar @ARGV > 0) { | |
193 | print STDERR <<"_____"; | |
194 | Unrecognised arguments. | |
195 | For more information, do '$0 --help' | |
196 | _____ | |
197 | exit(2); | |
198 | } | |
199 | ||
200 | if ($help) { | |
201 | pod2usage(-exitval => 0, | |
202 | -verbose => 1); | |
203 | } | |
204 | if ($man) { | |
205 | pod2usage(-exitval => 0, | |
206 | -verbose => 2); | |
207 | } | |
208 | if ($dump || $cmdline) { | |
209 | print "\nCommand line (with current working directory = $here):\n\n"; | |
210 | print ' ',join(' ', | |
211 | $config{PERL}, | |
212 | catfile($config{sourcedir}, 'Configure'), | |
213 | @{$config{perlargv}}), "\n"; | |
214 | print "\nPerl information:\n\n"; | |
215 | print ' ',$config{perl_cmd},"\n"; | |
216 | print ' ',$config{perl_version},' for ',$config{perl_archname},"\n"; | |
217 | } | |
218 | if ($dump || $options) { | |
219 | my $longest = 0; | |
220 | my $longest2 = 0; | |
221 | foreach my $what (@disablables) { | |
222 | $longest = length($what) if $longest < length($what); | |
223 | $longest2 = length($disabled{$what}) | |
224 | if $disabled{$what} && $longest2 < length($disabled{$what}); | |
225 | } | |
226 | print "\nEnabled features:\n\n"; | |
227 | foreach my $what (@disablables) { | |
228 | print " $what\n" unless $disabled{$what}; | |
229 | } | |
230 | print "\nDisabled features:\n\n"; | |
231 | foreach my $what (@disablables) { | |
232 | if ($disabled{$what}) { | |
233 | print " $what", ' ' x ($longest - length($what) + 1), | |
234 | "[$disabled{$what}]", ' ' x ($longest2 - length($disabled{$what}) + 1); | |
235 | print $disabled_info{$what}->{macro} | |
236 | if $disabled_info{$what}->{macro}; | |
237 | print ' (skip ', | |
238 | join(', ', @{$disabled_info{$what}->{skipped}}), | |
239 | ')' | |
240 | if $disabled_info{$what}->{skipped}; | |
241 | print "\n"; | |
242 | } | |
243 | } | |
244 | } | |
245 | if ($dump || $target) { | |
246 | print "\nConfig target attributes:\n\n"; | |
247 | foreach (sort keys %target) { | |
248 | next if $_ =~ m|^_| || $_ eq 'template'; | |
249 | my $quotify = sub { | |
250 | map { (my $x = $_) =~ s|([\\\$\@"])|\\$1|g; "\"$x\""} @_; | |
251 | }; | |
252 | print ' ', $_, ' => '; | |
253 | if (ref($target{$_}) eq "ARRAY") { | |
254 | print '[ ', join(', ', $quotify->(@{$target{$_}})), " ],\n"; | |
255 | } else { | |
256 | print $quotify->($target{$_}), ",\n" | |
257 | } | |
258 | } | |
259 | } | |
260 | if ($dump || $envvars) { | |
261 | print "\nRecorded environment:\n\n"; | |
262 | foreach (sort keys %{$config{perlenv}}) { | |
263 | print ' ',$_,' = ',($config{perlenv}->{$_} || ''),"\n"; | |
264 | } | |
265 | } | |
266 | if ($dump || $makevars) { | |
267 | print "\nMakevars:\n\n"; | |
268 | foreach my $var (@makevars) { | |
269 | my $prefix = ''; | |
270 | $prefix = $config{CROSS_COMPILE} | |
271 | if grep { $var eq $_ } @user_crossable; | |
272 | $prefix //= ''; | |
273 | print ' ',$var,' ' x (16 - length $var),'= ', | |
274 | (ref $config{$var} eq 'ARRAY' | |
275 | ? join(' ', @{$config{$var}}) | |
276 | : $prefix.$config{$var}), | |
277 | "\n" | |
278 | if defined $config{$var}; | |
279 | } | |
280 | ||
281 | my @buildfile = ($config{builddir}, $config{build_file}); | |
282 | unshift @buildfile, $here | |
283 | unless file_name_is_absolute($config{builddir}); | |
284 | my $buildfile = canonpath(catdir(@buildfile)); | |
285 | print <<"_____"; | |
286 | ||
287 | NOTE: These variables only represent the configuration view. The build file | |
288 | template may have processed these variables further, please have a look at the | |
289 | build file for more exact data: | |
290 | $buildfile | |
291 | _____ | |
292 | } | |
293 | if ($dump || $buildparams) { | |
294 | my @buildfile = ($config{builddir}, $config{build_file}); | |
295 | unshift @buildfile, $here | |
296 | unless file_name_is_absolute($config{builddir}); | |
297 | print "\nbuild file:\n\n"; | |
298 | print " ", canonpath(catfile(@buildfile)),"\n"; | |
299 | ||
300 | print "\nbuild file templates:\n\n"; | |
301 | foreach (@{$config{build_file_templates}}) { | |
302 | my @tmpl = ($_); | |
303 | unshift @tmpl, $here | |
304 | unless file_name_is_absolute($config{sourcedir}); | |
305 | print ' ',canonpath(catfile(@tmpl)),"\n"; | |
306 | } | |
307 | } | |
308 | if ($reconf) { | |
309 | if ($verbose) { | |
310 | print 'Reconfiguring with: ', join(' ',@{$config{perlargv}}), "\n"; | |
311 | foreach (sort keys %{$config{perlenv}}) { | |
312 | print ' ',$_,' = ',($config{perlenv}->{$_} || ""),"\n"; | |
313 | } | |
314 | } | |
315 | ||
316 | chdir $here; | |
317 | exec $^X,catfile($config{sourcedir}, 'Configure'),'reconf'; | |
318 | } | |
319 | } | |
320 | ||
321 | 1; | |
322 | ||
323 | __END__ | |
324 | ||
325 | =head1 NAME | |
326 | ||
327 | configdata.pm - configuration data for OpenSSL builds | |
328 | ||
329 | =head1 SYNOPSIS | |
330 | ||
331 | Interactive: | |
332 | ||
333 | perl configdata.pm [options] | |
334 | ||
335 | As data bank module: | |
336 | ||
337 | use configdata; | |
338 | ||
339 | =head1 DESCRIPTION | |
340 | ||
341 | This module can be used in two modes, interactively and as a module containing | |
342 | all the data recorded by OpenSSL's Configure script. | |
343 | ||
344 | When used interactively, simply run it as any perl script. | |
345 | If run with no arguments, it will rebuild the build file (Makefile or | |
346 | corresponding). | |
347 | With at least one option, it will instead get the information you ask for, or | |
348 | re-run the configuration process. | |
349 | See L</OPTIONS> below for more information. | |
350 | ||
351 | When loaded as a module, you get a few databanks with useful information to | |
352 | perform build related tasks. The databanks are: | |
353 | ||
354 | %config Configured things. | |
355 | %target The OpenSSL config target with all inheritances | |
356 | resolved. | |
357 | %disabled The features that are disabled. | |
358 | @disablables The list of features that can be disabled. | |
359 | %withargs All data given through --with-THING options. | |
360 | %unified_info All information that was computed from the build.info | |
361 | files. | |
362 | ||
363 | =head1 OPTIONS | |
364 | ||
365 | =over 4 | |
366 | ||
367 | =item B<--help> | |
368 | ||
369 | Print a brief help message and exit. | |
370 | ||
371 | =item B<--man> | |
372 | ||
373 | Print the manual page and exit. | |
374 | ||
375 | =item B<--dump> | B<-d> | |
376 | ||
377 | Print all relevant configuration data. This is equivalent to B<--command-line> | |
378 | B<--options> B<--target> B<--environment> B<--make-variables> | |
379 | B<--build-parameters>. | |
380 | ||
381 | =item B<--command-line> | B<-c> | |
382 | ||
383 | Print the current configuration command line. | |
384 | ||
385 | =item B<--options> | B<-o> | |
386 | ||
387 | Print the features, both enabled and disabled, and display defined macro and | |
388 | skipped directories where applicable. | |
389 | ||
390 | =item B<--target> | B<-t> | |
391 | ||
392 | Print the config attributes for this config target. | |
393 | ||
394 | =item B<--environment> | B<-e> | |
395 | ||
396 | Print the environment variables and their values at the time of configuration. | |
397 | ||
398 | =item B<--make-variables> | B<-m> | |
399 | ||
400 | Print the main make variables generated in the current configuration | |
401 | ||
402 | =item B<--build-parameters> | B<-b> | |
403 | ||
404 | Print the build parameters, i.e. build file and build file templates. | |
405 | ||
406 | =item B<--reconfigure> | B<--reconf> | B<-r> | |
407 | ||
408 | Re-run the configuration process. | |
409 | ||
410 | =item B<--verbose> | B<-v> | |
411 | ||
412 | Verbose output. | |
413 | ||
414 | =back | |
415 | ||
416 | =cut | |
417 | ||
418 | EOF |