From 486f149131e94c970da1b89ebe8c66ab88e5d343 Mon Sep 17 00:00:00 2001 From: Richard Levitte Date: Sun, 25 Aug 2019 10:44:41 +0200 Subject: [PATCH] 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 (Merged from https://github.com/openssl/openssl/pull/9693) --- util/dofile.pl | 204 ++++++---------------------------- util/perl/OpenSSL/Template.pm | 195 ++++++++++++++++++++++++++++++++ 2 files changed, 228 insertions(+), 171 deletions(-) create mode 100644 util/perl/OpenSSL/Template.pm diff --git a/util/dofile.pl b/util/dofile.pl index 8cf66cd742..9fa8684549 100644 --- a/util/dofile.pl +++ b/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 = ""; - 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("", ); + ? map { { TYPE => 'FILE', SOURCE => $_, FILENAME => $_ } } @ARGV + : ( { TYPE => 'FILEHANDLE', SOURCE => \*STDIN, FILENAME => '' } ); # 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 => \"ify1, - quotify_l => \"ify_l, - output_reset_on => \&output_reset_on, - output_on => \&output_on, - output_off => \&output_off }, - DELIMITERS => [ "{-", "-}" ], - BROKEN => \&broken); diff --git a/util/perl/OpenSSL/Template.pm b/util/perl/OpenSSL/Template.pm new file mode 100644 index 0000000000..ed89d15085 --- /dev/null +++ b/util/perl/OpenSSL/Template.pm @@ -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 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. + +=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 will only become part of the template output +if C 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 + +=head1 AUTHORS + +Richard Levitte Elevitte@openssl.orgE + +=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. + +=cut -- 2.25.1