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