2
0

dofile.pl 5.9 KB

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