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