Browse Source

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)
master
Richard Levitte 3 years ago
parent
commit
486f149131
2 changed files with 228 additions and 171 deletions
  1. +33
    -171
      util/dofile.pl
  2. +195
    -0
      util/perl/OpenSSL/Template.pm

+ 33
- 171
util/dofile.pl View File

@ -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();
"";
}
sub output_on {
$template->output_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_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 => \&quotify1,
quotify_l => \&quotify_l,
output_reset_on => \&output_reset_on,
output_on => \&output_on,
output_off => \&output_off },
DELIMITERS => [ "{-", "-}" ],
BROKEN => \&broken);

+ 195
- 0
util/perl/OpenSSL/Template.pm View 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 => \&quotify1,
quotify_l => \&quotify_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…
Cancel
Save