]>
Commit | Line | Data |
---|---|---|
e0a65194 | 1 | #! /usr/bin/env perl |
b0edda11 | 2 | # Copyright 2016-2018 The OpenSSL Project Authors. All Rights Reserved. |
291e94df | 3 | # |
e0a65194 RS |
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 | ||
291e94df RL |
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 | ||
14 | use strict; | |
15 | use warnings; | |
632b3092 | 16 | |
cb6afcd6 | 17 | use FindBin; |
9ab6fc59 RL |
18 | use Getopt::Std; |
19 | ||
291e94df RL |
20 | # We actually expect to get the following hash tables from configdata: |
21 | # | |
22 | # %config | |
23 | # %target | |
24 | # %withargs | |
deb02194 | 25 | # %unified_info |
291e94df RL |
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. | |
29 | die "You must run this script with -Mconfigdata\n" if !exists($config{target}); | |
30 | ||
deb02194 RL |
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 | ||
36 | package 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 | |
40 | use File::Basename; | |
41 | use File::Spec::Functions; | |
cb6afcd6 | 42 | use lib "$FindBin::Bin/perl"; |
deb02194 RL |
43 | use with_fallback qw(Text::Template); |
44 | ||
180df315 RL |
45 | #use parent qw/Text::Template/; |
46 | use vars qw/@ISA/; | |
47 | push @ISA, qw/Text::Template/; | |
deb02194 RL |
48 | |
49 | # Override constructor | |
50 | sub 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 | ||
61 | sub 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 | ||
71 | sub output_reset_on { | |
72 | my $self = shift; | |
73 | $self->{_output_off} = 0; | |
74 | } | |
75 | ||
76 | sub output_on { | |
77 | my $self = shift; | |
78 | if (--$self->{_output_off} < 0) { | |
79 | $self->{_output_off} = 0; | |
80 | } | |
81 | } | |
82 | ||
83 | sub output_off { | |
84 | my $self = shift; | |
85 | $self->{_output_off}++; | |
86 | } | |
87 | ||
88 | # Come back to main | |
89 | ||
90 | package main; | |
91 | ||
291e94df RL |
92 | # Helper functions for the templates ################################# |
93 | ||
94 | # It might be practical to quotify some strings and have them protected | |
44e69951 | 95 | # from possible harm. These functions primarily quote things that might |
291e94df RL |
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. | |
101 | sub quotify1 { | |
49cd47ea | 102 | my $s = my $orig = shift @_; |
291e94df | 103 | $s =~ s/([\$\@\\"'])/\\$1/g; |
49cd47ea | 104 | $s ne $orig || $s =~ /\s/ ? '"'.$s.'"' : $s; |
291e94df RL |
105 | } |
106 | ||
107 | # quotify_l LIST | |
108 | # For each defined element in LIST (i.e. elements that aren't undef), have | |
46f4e1be | 109 | # it quotified with 'quotify1' |
291e94df RL |
110 | sub 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 | ||
127 | my %lines = (); | |
128 | sub 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 | ||
9ab6fc59 RL |
141 | # Check options ###################################################### |
142 | ||
143 | my %opts = (); | |
144 | ||
145 | # -o ORIGINATOR | |
146 | # declares ORIGINATOR as the originating script. | |
147 | getopt('o', \%opts); | |
148 | ||
149 | my @autowarntext = ("WARNING: do not edit!", | |
150 | "Generated" | |
151 | . (defined($opts{o}) ? " by ".$opts{o} : "") | |
152 | . (scalar(@ARGV) > 0 ? " from ".join(", ",@ARGV) : "")); | |
153 | ||
291e94df RL |
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 | ||
160 | my $prev_linecount = 0; | |
161 | my $text = | |
162 | @ARGV | |
f6be8315 RL |
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; | |
291e94df RL |
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 | ||
cb6afcd6 RL |
179 | my $template = |
180 | OpenSSL::Template->new(TYPE => 'STRING', | |
181 | SOURCE => $text, | |
182 | PREPEND => qq{use lib "$FindBin::Bin/perl";}); | |
deb02194 RL |
183 | |
184 | sub output_reset_on { | |
185 | $template->output_reset_on(); | |
186 | ""; | |
187 | } | |
188 | sub output_on { | |
189 | $template->output_on(); | |
190 | ""; | |
191 | } | |
192 | sub output_off { | |
193 | $template->output_off(); | |
194 | ""; | |
195 | } | |
196 | ||
291e94df RL |
197 | $template->fill_in(OUTPUT => \*STDOUT, |
198 | HASH => { config => \%config, | |
199 | target => \%target, | |
58163021 | 200 | disabled => \%disabled, |
107b5792 | 201 | withargs => \%withargs, |
deb02194 | 202 | unified_info => \%unified_info, |
9ab6fc59 | 203 | autowarntext => \@autowarntext, |
291e94df | 204 | quotify1 => \"ify1, |
deb02194 RL |
205 | quotify_l => \"ify_l, |
206 | output_reset_on => \&output_reset_on, | |
207 | output_on => \&output_on, | |
208 | output_off => \&output_off }, | |
291e94df RL |
209 | DELIMITERS => [ "{-", "-}" ], |
210 | BROKEN => \&broken); |