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-}
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::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 = <<'_____';
127use File::Spec::Functions;
128use lib '{- sourcedir('util', 'perl') -}';
129use lib '{- sourcedir('Configurations') -}';
130use lib '{- $config{builddir} -}';
131use 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 <<"_____";
186Unrecognised arguments.
187For 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
285NOTE: These variables only represent the configuration view.  The build file
286template may have processed these variables further, please have a look at the
287build 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
3381;
339
340__END__
341
342=head1 NAME
343
344configdata.pm - configuration data for OpenSSL builds
345
346=head1 SYNOPSIS
347
348Interactive:
349
350  perl configdata.pm [options]
351
352As data bank module:
353
354  use configdata;
355
356=head1 DESCRIPTION
357
358This module can be used in two modes, interactively and as a module containing
359all the data recorded by OpenSSL's Configure script.
360
361When used interactively, simply run it as any perl script.
362If run with no arguments, it will rebuild the build file (Makefile or
363corresponding).
364With at least one option, it will instead get the information you ask for, or
365re-run the configuration process.
366See L</OPTIONS> below for more information.
367
368When loaded as a module, you get a few databanks with useful information to
369perform 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
386Print a brief help message and exit.
387
388=item B<--man>
389
390Print the manual page and exit.
391
392=item B<--dump> | B<-d>
393
394Print all relevant configuration data.  This is equivalent to B<--command-line>
395B<--options> B<--target> B<--environment> B<--make-variables>
396B<--build-parameters>.
397
398=item B<--command-line> | B<-c>
399
400Print the current configuration command line.
401
402=item B<--options> | B<-o>
403
404Print the features, both enabled and disabled, and display defined macro and
405skipped directories where applicable.
406
407=item B<--target> | B<-t>
408
409Print the config attributes for this config target.
410
411=item B<--environment> | B<-e>
412
413Print the environment variables and their values at the time of configuration.
414
415=item B<--make-variables> | B<-m>
416
417Print the main make variables generated in the current configuration
418
419=item B<--build-parameters> | B<-b>
420
421Print the build parameters, i.e. build file and build file templates.
422
423=item B<--reconfigure> | B<--reconf> | B<-r>
424
425Re-run the configuration process.
426
427=item B<--verbose> | B<-v>
428
429Verbose output.
430
431=back
432
433=cut
434
435EOF
436