mirror of
https://github.com/openssl/openssl.git
synced 2025-04-06 20:20:50 +08:00
util/dofile.pl, util/perl/OpenSSL/Template.pm: move parts of dofile.pl
We make a module OpenSSL::Template from the central parts of util/dofile.pl, and also reduce the amount of ugly code with more proper use of Text::Template. OpenSSL::Template is a simply subclass of Text::Template. Reviewed-by: Matt Caswell <matt@openssl.org> (Merged from https://github.com/openssl/openssl/pull/9693)
This commit is contained in:
Richard Levitte
parent
d4830d018d
commit
486f149131
202
util/dofile.pl
202
util/dofile.pl
@ -14,9 +14,11 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Getopt::Std;
|
||||
use FindBin;
|
||||
use lib "$FindBin::Bin/perl";
|
||||
use OpenSSL::fallback "$FindBin::Bin/../external/perl/MODULES.txt";
|
||||
use Getopt::Std;
|
||||
use OpenSSL::Template;
|
||||
|
||||
# We actually expect to get the following hash tables from configdata:
|
||||
#
|
||||
@ -27,115 +29,8 @@ use lib "$FindBin::Bin/perl";
|
||||
#
|
||||
# We just do a minimal test to see that we got what we expected.
|
||||
# $config{target} must exist as an absolute minimum.
|
||||
die "You must run this script with -Mconfigdata\n" if !exists($config{target});
|
||||
|
||||
# Make a subclass of Text::Template to override append_text_to_result,
|
||||
# as recommended here:
|
||||
#
|
||||
# http://search.cpan.org/~mjd/Text-Template-1.46/lib/Text/Template.pm#Automatic_postprocessing_of_template_hunks
|
||||
|
||||
package OpenSSL::Template;
|
||||
|
||||
# Because we know that Text::Template isn't a core Perl module, we use
|
||||
# a fallback in case it's not installed on the system
|
||||
use OpenSSL::fallback "$FindBin::Bin/../external/perl/MODULES.txt";
|
||||
use Text::Template 1.46;
|
||||
|
||||
#use parent qw/Text::Template/;
|
||||
use vars qw/@ISA/;
|
||||
push @ISA, qw/Text::Template/;
|
||||
|
||||
# Override constructor
|
||||
sub new {
|
||||
my ($class) = shift;
|
||||
|
||||
# Call the constructor of the parent class, Person.
|
||||
my $self = $class->SUPER::new( @_ );
|
||||
# Add few more attributes
|
||||
$self->{_output_off} = 0; # Default to output hunks
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub append_text_to_output {
|
||||
my $self = shift;
|
||||
|
||||
if ($self->{_output_off} == 0) {
|
||||
$self->SUPER::append_text_to_output(@_);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub output_reset_on {
|
||||
my $self = shift;
|
||||
$self->{_output_off} = 0;
|
||||
}
|
||||
|
||||
sub output_on {
|
||||
my $self = shift;
|
||||
if (--$self->{_output_off} < 0) {
|
||||
$self->{_output_off} = 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub output_off {
|
||||
my $self = shift;
|
||||
$self->{_output_off}++;
|
||||
}
|
||||
|
||||
# Come back to main
|
||||
|
||||
package main;
|
||||
|
||||
# Helper functions for the templates #################################
|
||||
|
||||
# It might be practical to quotify some strings and have them protected
|
||||
# from possible harm. These functions primarily quote things that might
|
||||
# be interpreted wrongly by a perl eval.
|
||||
|
||||
# quotify1 STRING
|
||||
# This adds quotes (") around the given string, and escapes any $, @, \,
|
||||
# " and ' by prepending a \ to them.
|
||||
sub quotify1 {
|
||||
my $s = shift @_;
|
||||
$s =~ s/([\$\@\\"'])/\\$1/g;
|
||||
'"'.$s.'"';
|
||||
}
|
||||
|
||||
# quotify_l LIST
|
||||
# For each defined element in LIST (i.e. elements that aren't undef), have
|
||||
# it quotified with 'quotify1'
|
||||
sub quotify_l {
|
||||
map {
|
||||
if (!defined($_)) {
|
||||
();
|
||||
} else {
|
||||
quotify1($_);
|
||||
}
|
||||
} @_;
|
||||
}
|
||||
|
||||
# Error reporter #####################################################
|
||||
|
||||
# The error reporter uses %lines to figure out exactly which file the
|
||||
# error happened and at what line. Not that the line number may be
|
||||
# the start of a perl snippet rather than the exact line where it
|
||||
# happened. Nothing we can do about that here.
|
||||
|
||||
my %lines = ();
|
||||
sub broken {
|
||||
my %args = @_;
|
||||
my $filename = "<STDIN>";
|
||||
my $deducelines = 0;
|
||||
foreach (sort keys %lines) {
|
||||
$filename = $lines{$_};
|
||||
last if ($_ > $args{lineno});
|
||||
$deducelines += $_;
|
||||
}
|
||||
print STDERR $args{error}," in $filename, fragment starting at line ",$args{lineno}-$deducelines;
|
||||
undef;
|
||||
}
|
||||
die "You must run this script with -Mconfigdata\n"
|
||||
if !exists($config{target});
|
||||
|
||||
# Check options ######################################################
|
||||
|
||||
@ -146,74 +41,41 @@ my %opts = ();
|
||||
getopt('o', \%opts);
|
||||
|
||||
my @autowarntext = ("WARNING: do not edit!",
|
||||
"Generated"
|
||||
. (defined($opts{o}) ? " by ".$opts{o} : "")
|
||||
. (scalar(@ARGV) > 0 ? " from ".join(", ",@ARGV) : ""));
|
||||
"Generated"
|
||||
. (defined($opts{o}) ? " by ".$opts{o} : "")
|
||||
. (scalar(@ARGV) > 0 ? " from ".join(", ",@ARGV) : ""));
|
||||
|
||||
# Template reading ###################################################
|
||||
# Template setup #####################################################
|
||||
|
||||
# Read in all the templates into $text, while keeping track of each
|
||||
# file and its size in lines, to try to help report errors with the
|
||||
# correct file name and line number.
|
||||
|
||||
my $prev_linecount = 0;
|
||||
my $text =
|
||||
my @template_settings =
|
||||
@ARGV
|
||||
? join("", map { my $x = Text::Template::_load_text($_);
|
||||
if (!defined($x)) {
|
||||
die $Text::Template::ERROR, "\n";
|
||||
}
|
||||
$x = "{- output_reset_on() -}" . $x;
|
||||
my $linecount = $x =~ tr/\n//;
|
||||
$prev_linecount = ($linecount += $prev_linecount);
|
||||
$lines{$linecount} = $_;
|
||||
$x } @ARGV)
|
||||
: join("", <STDIN>);
|
||||
? map { { TYPE => 'FILE', SOURCE => $_, FILENAME => $_ } } @ARGV
|
||||
: ( { TYPE => 'FILEHANDLE', SOURCE => \*STDIN, FILENAME => '<stdin>' } );
|
||||
|
||||
# Engage! ############################################################
|
||||
|
||||
# Load the full template (combination of files) into Text::Template
|
||||
# and fill it up with our data. Output goes directly to STDOUT
|
||||
|
||||
my $prepend = qq{
|
||||
my $prepend = <<"_____";
|
||||
use File::Spec::Functions;
|
||||
use lib catdir('$config{sourcedir}', 'util', 'perl');
|
||||
};
|
||||
$prepend .= qq{
|
||||
use lib catdir('$config{sourcedir}', 'Configurations');
|
||||
_____
|
||||
$prepend .= <<"_____" if defined $target{perl_platform};
|
||||
use lib "$FindBin::Bin/../Configurations";
|
||||
use lib '$config{builddir}';
|
||||
use platform;
|
||||
} if defined $target{perl_platform};
|
||||
_____
|
||||
|
||||
my $template =
|
||||
OpenSSL::Template->new(TYPE => 'STRING',
|
||||
SOURCE => $text,
|
||||
PREPEND => $prepend);
|
||||
|
||||
sub output_reset_on {
|
||||
$template->output_reset_on();
|
||||
"";
|
||||
foreach (@template_settings) {
|
||||
my $template = OpenSSL::Template->new(%$_);
|
||||
$template->fill_in(%$_,
|
||||
OUTPUT => \*STDOUT,
|
||||
HASH => { config => \%config,
|
||||
target => \%target,
|
||||
disabled => \%disabled,
|
||||
withargs => \%withargs,
|
||||
unified_info => \%unified_info,
|
||||
autowarntext => \@autowarntext },
|
||||
PREPEND => $prepend,
|
||||
# To ensure that global variables and functions
|
||||
# defined in one template stick around for the
|
||||
# next, making them combinable
|
||||
PACKAGE => 'OpenSSL::safe');
|
||||
}
|
||||
sub output_on {
|
||||
$template->output_on();
|
||||
"";
|
||||
}
|
||||
sub output_off {
|
||||
$template->output_off();
|
||||
"";
|
||||
}
|
||||
|
||||
$template->fill_in(OUTPUT => \*STDOUT,
|
||||
HASH => { config => \%config,
|
||||
target => \%target,
|
||||
disabled => \%disabled,
|
||||
withargs => \%withargs,
|
||||
unified_info => \%unified_info,
|
||||
autowarntext => \@autowarntext,
|
||||
quotify1 => \"ify1,
|
||||
quotify_l => \"ify_l,
|
||||
output_reset_on => \&output_reset_on,
|
||||
output_on => \&output_on,
|
||||
output_off => \&output_off },
|
||||
DELIMITERS => [ "{-", "-}" ],
|
||||
BROKEN => \&broken);
|
||||
|
||||
195
util/perl/OpenSSL/Template.pm
Normal file
195
util/perl/OpenSSL/Template.pm
Normal file
@ -0,0 +1,195 @@
|
||||
#! /usr/bin/env perl
|
||||
# Copyright 2016-2019 The OpenSSL Project Authors. All Rights Reserved.
|
||||
#
|
||||
# Licensed under the Apache License 2.0 (the "License"). You may not use
|
||||
# this file except in compliance with the License. You can obtain a copy
|
||||
# in the file LICENSE in the source distribution or at
|
||||
# https://www.openssl.org/source/license.html
|
||||
|
||||
# Implements the functionality to read one or more template files and run
|
||||
# them through Text::Template
|
||||
|
||||
package OpenSSL::Template;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
OpenSSL::Template - a private extension of Text::Template
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This provides exactly the functionality from Text::Template, with the
|
||||
following additions:
|
||||
|
||||
=over 4
|
||||
|
||||
=item -
|
||||
|
||||
The template perl code delimiters (given with the C<DELIMITER> option)
|
||||
are set to C<{-> and C<-}> by default.
|
||||
|
||||
=item -
|
||||
|
||||
A few extra functions are offered to be used by the template perl code, see
|
||||
L</Functions>.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
use File::Basename;
|
||||
use File::Spec::Functions;
|
||||
use Text::Template 1.46;
|
||||
|
||||
our @ISA = qw(Text::Template); # parent
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
|
||||
# Call the constructor of the parent class.
|
||||
my $self = $class->SUPER::new(DELIMITERS => [ '{-', '-}'],
|
||||
@_ );
|
||||
|
||||
# Add few more attributes
|
||||
$self->{_output_off} = 0; # Default to output hunks
|
||||
|
||||
return bless $self, $class;
|
||||
}
|
||||
|
||||
sub fill_in {
|
||||
my $self = shift;
|
||||
my %opts = @_;
|
||||
my %hash = ( %{$opts{HASH}} );
|
||||
delete $opts{HASH};
|
||||
|
||||
$self->SUPER::fill_in(HASH => { quotify1 => \"ify1,
|
||||
quotify_l => \"ify_l,
|
||||
output_on => sub { $self->output_on() },
|
||||
output_off => sub { $self->output_off() },
|
||||
%hash },
|
||||
%opts);
|
||||
}
|
||||
|
||||
=head2 Functions
|
||||
|
||||
=cut
|
||||
|
||||
# Override Text::Template's append_text_to_result, as recommended here:
|
||||
#
|
||||
# http://search.cpan.org/~mjd/Text-Template-1.46/lib/Text/Template.pm#Automatic_postprocessing_of_template_hunks
|
||||
sub append_text_to_output {
|
||||
my $self = shift;
|
||||
|
||||
if ($self->{_output_off} == 0) {
|
||||
$self->SUPER::append_text_to_output(@_);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
=begin comment
|
||||
|
||||
We lie about the OO nature of output_on() and output_off(), 'cause that's
|
||||
not how we pass them, see the HASH option used in fill_in() above
|
||||
|
||||
=end comment
|
||||
|
||||
=over 4
|
||||
|
||||
=item output_on()
|
||||
|
||||
=item output_off()
|
||||
|
||||
Switch on or off template output. Here's an example usage:
|
||||
|
||||
=over 4
|
||||
|
||||
{- output_off() if CONDITION -}
|
||||
whatever
|
||||
{- output_on() if CONDITION -}
|
||||
|
||||
=back
|
||||
|
||||
In this example, C<whatever> will only become part of the template output
|
||||
if C<CONDITION> is true.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub output_on {
|
||||
my $self = shift;
|
||||
if (--$self->{_output_off} < 0) {
|
||||
$self->{_output_off} = 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub output_off {
|
||||
my $self = shift;
|
||||
$self->{_output_off}++;
|
||||
}
|
||||
|
||||
# Helper functions for the templates #################################
|
||||
|
||||
# It might be practical to quotify some strings and have them protected
|
||||
# from possible harm. These functions primarily quote things that might
|
||||
# be interpreted wrongly by a perl eval.
|
||||
|
||||
# NOTE THAT THESE AREN'T CLASS METHODS!
|
||||
|
||||
=over 4
|
||||
|
||||
=item quotify1 STRING
|
||||
|
||||
This adds quotes (") around the given string, and escapes any $, @, \,
|
||||
" and ' by prepending a \ to them.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub quotify1 {
|
||||
my $s = shift @_;
|
||||
$s =~ s/([\$\@\\"'])/\\$1/g;
|
||||
'"'.$s.'"';
|
||||
}
|
||||
|
||||
=over 4
|
||||
|
||||
=item quotify_l LIST
|
||||
|
||||
For each defined element in LIST (i.e. elements that aren't undef), have
|
||||
it quotified with 'quotify1'.
|
||||
Undefined elements are ignored.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub quotify_l {
|
||||
map {
|
||||
if (!defined($_)) {
|
||||
();
|
||||
} else {
|
||||
quotify1($_);
|
||||
}
|
||||
} @_;
|
||||
}
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Text::Template>
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
Richard Levitte E<lt>levitte@openssl.orgE<gt>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright 2016-2019 The OpenSSL Project Authors. All Rights Reserved.
|
||||
|
||||
Licensed under the Apache License 2.0 (the "License"). You may not use
|
||||
this file except in compliance with the License. You can obtain a copy
|
||||
in the file LICENSE in the source distribution or at
|
||||
L<https://www.openssl.org/source/license.html>.
|
||||
|
||||
=cut
|
||||
Loading…
x
Reference in New Issue
Block a user