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 Getopt::Std;
  18 use FindBin;
  19 use lib "$FindBin::Bin/perl";
  20
  21 # We actually expect to get the following hash tables from configdata:
  22 #
  23 #    %config
  24 #    %target
  25 #    %withargs
  26 #    %unified_info
  27 #
  28 # We just do a minimal test to see that we got what we expected.
  29 # $config{target} must exist as an absolute minimum.
  30 die "You must run this script with -Mconfigdata\n" if !exists($config{target});
  31
  32 # Make a subclass of Text::Template to override append_text_to_result,
  33 # as recommended here:
  34 #
  35 # http://search.cpan.org/~mjd/Text-Template-1.46/lib/Text/Template.pm#Automatic_postprocessing_of_template_hunks
  36
  37 package OpenSSL::Template;
  38
  39 # Because we know that Text::Template isn't a core Perl module, we use
  40 # a fallback in case it's not installed on the system
  41 use OpenSSL::fallback "$FindBin::Bin/../external/perl/MODULES.txt";
  42 use Text::Template 1.46;
  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 primarily 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 'quotify1'
 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 = Text::Template::_load_text($_);
 163                      if (!defined($x)) {
 164                          die $Text::Template::ERROR, "\n";
 165                      }
 166                      $x = "{- output_reset_on() -}" . $x;
 167                      my $linecount = $x =~ tr/\n//;
 168                      $prev_linecount = ($linecount += $prev_linecount);
 169                      $lines{$linecount} = $_;
 170                      $x } @ARGV)
 171     : join("", <STDIN>);
 172
 173 # Engage! ############################################################
 174
 175 # Load the full template (combination of files) into Text::Template
 176 # and fill it up with our data.  Output goes directly to STDOUT
 177
 178 my $prepend = qq{
 179 use File::Spec::Functions;
 180 use lib catdir('$config{sourcedir}', 'util', 'perl');
 181 };
 182 $prepend .= qq{
 183 use lib catdir('$config{sourcedir}', 'Configurations');
 184 use lib '$config{builddir}';
 185 use platform;
 186 } if defined $target{perl_platform};
 187
 188 my $template =
 189     OpenSSL::Template->new(TYPE => 'STRING',
 190                            SOURCE => $text,
 191                            PREPEND => $prepend);
 192
 193 sub output_reset_on {
 194     $template->output_reset_on();
 195     "";
 196 }
 197 sub output_on {
 198     $template->output_on();
 199     "";
 200 }
 201 sub output_off {
 202     $template->output_off();
 203     "";
 204 }
 205
 206 $template->fill_in(OUTPUT => \*STDOUT,
 207                    HASH => { config => \%config,
 208                              target => \%target,
 209                              disabled => \%disabled,
 210                              withargs => \%withargs,
 211                              unified_info => \%unified_info,
 212                              autowarntext => \@autowarntext,
 213                              quotify1 => \&quotify1,
 214                              quotify_l => \&quotify_l,
 215                              output_reset_on => \&output_reset_on,
 216                              output_on => \&output_on,
 217                              output_off => \&output_off },
 218                    DELIMITERS => [ "{-", "-}" ],
 219                    BROKEN => \&broken);