Update documentation regarding required output buffer memory size
[openssl.git] / util / dofile.pl
1 #! /usr/bin/env perl
2 # Copyright 2016-2018 The OpenSSL Project Authors. All Rights Reserved.
3 #
4 # Licensed under the Apache License 2.0 (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 FindBin;
18 use 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.
29 die "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
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;
42 use lib "$FindBin::Bin/perl";
43 use with_fallback "Text::Template 1.46";
44
45 #use parent qw/Text::Template/;
46 use vars qw/@ISA/;
47 push @ISA, qw/Text::Template/;
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
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.
101 sub 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'
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
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
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
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
179 my $prepend = qq{
180 use File::Spec::Functions;
181 use lib catdir('$config{sourcedir}', 'util', 'perl');
182 };
183 $prepend .= qq{
184 use lib catdir('$config{sourcedir}', 'Configurations');
185 use lib '$config{builddir}';
186 use platform;
187 } if defined $target{perl_platform};
188
189 my $template =
190     OpenSSL::Template->new(TYPE => 'STRING',
191                            SOURCE => $text,
192                            PREPEND => $prepend);
193
194 sub output_reset_on {
195     $template->output_reset_on();
196     "";
197 }
198 sub output_on {
199     $template->output_on();
200     "";
201 }
202 sub output_off {
203     $template->output_off();
204     "";
205 }
206
207 $template->fill_in(OUTPUT => \*STDOUT,
208                    HASH => { config => \%config,
209                              target => \%target,
210                              disabled => \%disabled,
211                              withargs => \%withargs,
212                              unified_info => \%unified_info,
213                              autowarntext => \@autowarntext,
214                              quotify1 => \&quotify1,
215                              quotify_l => \&quotify_l,
216                              output_reset_on => \&output_reset_on,
217                              output_on => \&output_on,
218                              output_off => \&output_off },
219                    DELIMITERS => [ "{-", "-}" ],
220                    BROKEN => \&broken);