util/dofile.pl

   1 #! /usr/bin/env perl
   2 # Copyright 2016-2018 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 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 qw(Text::Template);
  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 $template =
 180     OpenSSL::Template->new(TYPE => 'STRING',
 181                            SOURCE => $text,
 182                            PREPEND => qq{use lib "$FindBin::Bin/perl";});
 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
 197 $template->fill_in(OUTPUT => \*STDOUT,
 198                    HASH => { config => \%config,
 199                              target => \%target,
 200                              disabled => \%disabled,
 201                              withargs => \%withargs,
 202                              unified_info => \%unified_info,
 203                              autowarntext => \@autowarntext,
 204                              quotify1 => \&quotify1,
 205                              quotify_l => \&quotify_l,
 206                              output_reset_on => \&output_reset_on,
 207                              output_on => \&output_on,
 208                              output_off => \&output_off },
 209                    DELIMITERS => [ "{-", "-}" ],
 210                    BROKEN => \&broken);