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
  40 # Override constructor
  41 sub new {
  42     my ($class) = shift;
  43
  44     # Call the constructor of the parent class, Person.
  45     my $self = $class->SUPER::new( @_ );
  46     # Add few more attributes
  47     $self->{_output_off}   = 0; # Default to output hunks
  48     bless $self, $class;
  49     return $self;
  50 }
  51
  52 sub append_text_to_output {
  53     my $self = shift;
  54
  55     if ($self->{_output_off} == 0) {
  56         $self->SUPER::append_text_to_output(@_);
  57     }
  58
  59     return;
  60 }
  61
  62 sub output_reset_on {
  63     my $self = shift;
  64     $self->{_output_off} = 0;
  65 }
  66
  67 sub output_on {
  68     my $self = shift;
  69     if (--$self->{_output_off} < 0) {
  70         $self->{_output_off} = 0;
  71     }
  72 }
  73
  74 sub output_off {
  75     my $self = shift;
  76     $self->{_output_off}++;
  77 }
  78
  79 # Come back to main
  80
  81 package main;
  82
  83 # Helper functions for the templates #################################
  84
  85 # It might be practical to quotify some strings and have them protected
  86 # from possible harm.  These functions primarly quote things that might
  87 # be interpreted wrongly by a perl eval.
  88
  89 # quotify1 STRING
  90 # This adds quotes (") around the given string, and escapes any $, @, \,
  91 # " and ' by prepending a \ to them.
  92 sub quotify1 {
  93     my $s = shift @_;
  94     $s =~ s/([\$\@\\"'])/\\$1/g;
  95     '"'.$s.'"';
  96 }
  97
  98 # quotify_l LIST
  99 # For each defined element in LIST (i.e. elements that aren't undef), have
 100 # it quotified with 'quotofy1'
 101 sub quotify_l {
 102     map {
 103         if (!defined($_)) {
 104             ();
 105         } else {
 106             quotify1($_);
 107         }
 108     } @_;
 109 }
 110
 111 # Error reporter #####################################################
 112
 113 # The error reporter uses %lines to figure out exactly which file the
 114 # error happened and at what line.  Not that the line number may be
 115 # the start of a perl snippet rather than the exact line where it
 116 # happened.  Nothing we can do about that here.
 117
 118 my %lines = ();
 119 sub broken {
 120     my %args = @_;
 121     my $filename = "<STDIN>";
 122     my $deducelines = 0;
 123     foreach (sort keys %lines) {
 124         $filename = $lines{$_};
 125         last if ($_ > $args{lineno});
 126         $deducelines += $_;
 127     }
 128     print STDERR $args{error}," in $filename, fragment starting at line ",$args{lineno}-$deducelines;
 129     undef;
 130 }
 131
 132 # Check options ######################################################
 133
 134 my %opts = ();
 135
 136 # -o ORIGINATOR
 137 #               declares ORIGINATOR as the originating script.
 138 getopt('o', \%opts);
 139
 140 my @autowarntext = ("WARNING: do not edit!",
 141                     "Generated"
 142                     . (defined($opts{o}) ? " by ".$opts{o} : "")
 143                     . (scalar(@ARGV) > 0 ? " from ".join(", ",@ARGV) : ""));
 144
 145 # Template reading ###################################################
 146
 147 # Read in all the templates into $text, while keeping track of each
 148 # file and its size in lines, to try to help report errors with the
 149 # correct file name and line number.
 150
 151 my $prev_linecount = 0;
 152 my $text =
 153     @ARGV
 154     ? join("", map { my $x = "{- output_reset_on() -}".Text::Template::_load_text($_);
 155                      my $linecount = $x =~ tr/\n//;
 156                      $prev_linecount = ($linecount += $prev_linecount);
 157                      $lines{$linecount} = $_;
 158                      $x } @ARGV)
 159     : join("", <STDIN>);
 160
 161 # Engage! ############################################################
 162
 163 # Load the full template (combination of files) into Text::Template
 164 # and fill it up with our data.  Output goes directly to STDOUT
 165
 166 my $template = OpenSSL::Template->new(TYPE => 'STRING', SOURCE => $text );
 167
 168 sub output_reset_on {
 169     $template->output_reset_on();
 170     "";
 171 }
 172 sub output_on {
 173     $template->output_on();
 174     "";
 175 }
 176 sub output_off {
 177     $template->output_off();
 178     "";
 179 }
 180
 181 $template->fill_in(OUTPUT => \*STDOUT,
 182                    HASH => { config => \%config,
 183                              target => \%target,
 184                              withargs => \%withargs,
 185                              unified_info => \%unified_info,
 186                              autowarntext => \@autowarntext,
 187                              quotify1 => \&quotify1,
 188                              quotify_l => \&quotify_l,
 189                              output_reset_on => \&output_reset_on,
 190                              output_on => \&output_on,
 191                              output_off => \&output_off },
 192                    DELIMITERS => [ "{-", "-}" ],
 193                    BROKEN => \&broken);