1#! /usr/bin/env perl 2# Copyright 2016-2018 The OpenSSL Project Authors. All Rights Reserved. 3# 4# Licensed under the OpenSSL license (the "License"). You may not use 5# this file except in compliance with the License. You can obtain a copy 6# in the file LICENSE in the source distribution or at 7# https://www.openssl.org/source/license.html 8 9# Reads one or more template files and runs it through Text::Template 10# 11# It is assumed that this scripts is called with -Mconfigdata, a module 12# that holds configuration data in %config 13 14use strict; 15use warnings; 16 17use FindBin; 18use Getopt::Std; 19 20# We actually expect to get the following hash tables from configdata: 21# 22# %config 23# %target 24# %withargs 25# %unified_info 26# 27# We just do a minimal test to see that we got what we expected. 28# $config{target} must exist as an absolute minimum. 29die "You must run this script with -Mconfigdata\n" if !exists($config{target}); 30 31# Make a subclass of Text::Template to override append_text_to_result, 32# as recommended here: 33# 34# http://search.cpan.org/~mjd/Text-Template-1.46/lib/Text/Template.pm#Automatic_postprocessing_of_template_hunks 35 36package OpenSSL::Template; 37 38# Because we know that Text::Template isn't a core Perl module, we use 39# a fallback in case it's not installed on the system 40use File::Basename; 41use File::Spec::Functions; 42use lib "$FindBin::Bin/perl"; 43use with_fallback "Text::Template 1.46"; 44 45#use parent qw/Text::Template/; 46use vars qw/@ISA/; 47push @ISA, qw/Text::Template/; 48 49# Override constructor 50sub new { 51 my ($class) = shift; 52 53 # Call the constructor of the parent class, Person. 54 my $self = $class->SUPER::new( @_ ); 55 # Add few more attributes 56 $self->{_output_off} = 0; # Default to output hunks 57 bless $self, $class; 58 return $self; 59} 60 61sub append_text_to_output { 62 my $self = shift; 63 64 if ($self->{_output_off} == 0) { 65 $self->SUPER::append_text_to_output(@_); 66 } 67 68 return; 69} 70 71sub output_reset_on { 72 my $self = shift; 73 $self->{_output_off} = 0; 74} 75 76sub output_on { 77 my $self = shift; 78 if (--$self->{_output_off} < 0) { 79 $self->{_output_off} = 0; 80 } 81} 82 83sub output_off { 84 my $self = shift; 85 $self->{_output_off}++; 86} 87 88# Come back to main 89 90package main; 91 92# Helper functions for the templates ################################# 93 94# It might be practical to quotify some strings and have them protected 95# from possible harm. These functions primarily quote things that might 96# be interpreted wrongly by a perl eval. 97 98# quotify1 STRING 99# This adds quotes (") around the given string, and escapes any $, @, \, 100# " and ' by prepending a \ to them. 101sub quotify1 { 102 my $s = shift @_; 103 $s =~ s/([\$\@\\"'])/\\$1/g; 104 '"'.$s.'"'; 105} 106 107# quotify_l LIST 108# For each defined element in LIST (i.e. elements that aren't undef), have 109# it quotified with 'quotify1' 110sub quotify_l { 111 map { 112 if (!defined($_)) { 113 (); 114 } else { 115 quotify1($_); 116 } 117 } @_; 118} 119 120# Error reporter ##################################################### 121 122# The error reporter uses %lines to figure out exactly which file the 123# error happened and at what line. Not that the line number may be 124# the start of a perl snippet rather than the exact line where it 125# happened. Nothing we can do about that here. 126 127my %lines = (); 128sub broken { 129 my %args = @_; 130 my $filename = "<STDIN>"; 131 my $deducelines = 0; 132 foreach (sort keys %lines) { 133 $filename = $lines{$_}; 134 last if ($_ > $args{lineno}); 135 $deducelines += $_; 136 } 137 print STDERR $args{error}," in $filename, fragment starting at line ",$args{lineno}-$deducelines; 138 undef; 139} 140 141# Check options ###################################################### 142 143my %opts = (); 144 145# -o ORIGINATOR 146# declares ORIGINATOR as the originating script. 147getopt('o', \%opts); 148 149my @autowarntext = ("WARNING: do not edit!", 150 "Generated" 151 . (defined($opts{o}) ? " by ".$opts{o} : "") 152 . (scalar(@ARGV) > 0 ? " from ".join(", ",@ARGV) : "")); 153 154# Template reading ################################################### 155 156# Read in all the templates into $text, while keeping track of each 157# file and its size in lines, to try to help report errors with the 158# correct file name and line number. 159 160my $prev_linecount = 0; 161my $text = 162 @ARGV 163 ? join("", map { my $x = Text::Template::_load_text($_); 164 if (!defined($x)) { 165 die $Text::Template::ERROR, "\n"; 166 } 167 $x = "{- output_reset_on() -}" . $x; 168 my $linecount = $x =~ tr/\n//; 169 $prev_linecount = ($linecount += $prev_linecount); 170 $lines{$linecount} = $_; 171 $x } @ARGV) 172 : join("", <STDIN>); 173 174# Engage! ############################################################ 175 176# Load the full template (combination of files) into Text::Template 177# and fill it up with our data. Output goes directly to STDOUT 178 179my $template = 180 OpenSSL::Template->new(TYPE => 'STRING', 181 SOURCE => $text, 182 PREPEND => qq{use lib "$FindBin::Bin/perl";}); 183 184sub output_reset_on { 185 $template->output_reset_on(); 186 ""; 187} 188sub output_on { 189 $template->output_on(); 190 ""; 191} 192sub output_off { 193 $template->output_off(); 194 ""; 195} 196 197$template->fill_in(OUTPUT => \*STDOUT, 198 HASH => { config => \%config, 199 target => \%target, 200 disabled => \%disabled, 201 withargs => \%withargs, 202 unified_info => \%unified_info, 203 autowarntext => \@autowarntext, 204 quotify1 => \"ify1, 205 quotify_l => \"ify_l, 206 output_reset_on => \&output_reset_on, 207 output_on => \&output_on, 208 output_off => \&output_off }, 209 DELIMITERS => [ "{-", "-}" ], 210 BROKEN => \&broken); 211