From da51dc5f68c9e7924be3d5071ba8aea439a4d1c9 Mon Sep 17 00:00:00 2001 From: Richard Levitte Date: Mon, 17 May 2021 14:25:12 +0200 Subject: [PATCH] Move some OpenSSL perl utility functions to OpenSSL::Util quotify1() and quotify_l() were in OpenSSL::Template, but should be more widely usable. configdata.pm.in's out_item() is also more widely useful and is therefore moved to OpenSSL::Util as well, and renamed to dump_data(). Reviewed-by: Tomas Mraz (Merged from https://github.com/openssl/openssl/pull/15310) --- Configurations/descrip.mms.tmpl | 1 + Configurations/unix-Makefile.tmpl | 2 + Configurations/windows-makefile.tmpl | 1 + configdata.pm.in | 83 +++------------- tools/c_rehash.in | 2 +- util/perl/OpenSSL/Template.pm | 45 --------- util/perl/OpenSSL/Util.pm | 136 ++++++++++++++++++++++++++- 7 files changed, 152 insertions(+), 118 deletions(-) diff --git a/Configurations/descrip.mms.tmpl b/Configurations/descrip.mms.tmpl index 920c0abfeb..a357ae5c3b 100644 --- a/Configurations/descrip.mms.tmpl +++ b/Configurations/descrip.mms.tmpl @@ -4,6 +4,7 @@ {- use File::Spec::Functions qw/:DEFAULT abs2rel rel2abs/; use File::Basename; + use OpenSSL::Util; (our $osslprefix_q = platform->osslprefix()) =~ s/\$/\\\$/; diff --git a/Configurations/unix-Makefile.tmpl b/Configurations/unix-Makefile.tmpl index f729416d1d..8b45e75f57 100644 --- a/Configurations/unix-Makefile.tmpl +++ b/Configurations/unix-Makefile.tmpl @@ -3,6 +3,8 @@ ## ## {- join("\n## ", @autowarntext) -} {- + use OpenSSL::Util; + our $makedep_scheme = $config{makedep_scheme}; our $makedepcmd = platform->makedepcmd(); diff --git a/Configurations/windows-makefile.tmpl b/Configurations/windows-makefile.tmpl index 014c1eb8d1..a7123f6a5e 100644 --- a/Configurations/windows-makefile.tmpl +++ b/Configurations/windows-makefile.tmpl @@ -4,6 +4,7 @@ ## {- join("\n## ", @autowarntext) -} {- use File::Basename; + use OpenSSL::Util; our $sover_dirname = platform->shlib_version_as_filename(); diff --git a/configdata.pm.in b/configdata.pm.in index 3481eab277..666d1f36d8 100644 --- a/configdata.pm.in +++ b/configdata.pm.in @@ -1,65 +1,6 @@ #! {- $config{HASHBANGPERL} -} # -*- mode: perl -*- {- - sub out_item { - my $ref = shift; - # Available options: - # indent => callers indentation (int) - # delimiters => 1 if outer delimiters should be added - my %opts = @_; - - my $indent = $opts{indent} // 0; - # Indentation of the whole structure, where applicable - my $nlindent1 = "\n" . ' ' x $indent; - # Indentation of individual items, where applicable - my $nlindent2 = "\n" . ' ' x ($indent + 4); - - my $product; # Finished product, or reference to a function that - # produces a string, given $_ - # The following are only used when $product is a function reference - my $delim_l; # Left delimiter of structure - my $delim_r; # Right delimiter of structure - my $separator; # Item separator - my @items; # Items to iterate over - - if (ref($ref) eq "ARRAY") { - if (scalar @$ref == 0) { - $product = $opts{delimiters} ? '[]' : ''; - } else { - $product = sub { - out_item(\$_, delimiters => 1, indent => $indent + 4) - }; - $delim_l = ($opts{delimiters} ? '[' : '').$nlindent2; - $delim_r = $nlindent1.($opts{delimiters} ? ']' : ''); - $separator = ",$nlindent2"; - @items = @$ref; - } - } elsif (ref($ref) eq "HASH") { - if (scalar keys %$ref == 0) { - $product = $opts{delimiters} ? '{}' : ''; - } else { - $product = sub { - quotify1($_) . " => " - . out_item($ref->{$_}, delimiters => 1, indent => $indent + 4) - }; - $delim_l = ($opts{delimiters} ? '{' : '').$nlindent2; - $delim_r = $nlindent1.($opts{delimiters} ? '}' : ''); - $separator = ",$nlindent2"; - @items = sort keys %$ref; - } - } elsif (ref($ref) eq "SCALAR") { - $product = defined $$ref ? quotify1 $$ref : "undef"; - } else { - $product = defined $ref ? quotify1 $ref : "undef"; - } - - if (ref($product) eq "CODE") { - $delim_l . join($separator, map { &$product } @items) . $delim_r; - } else { - $product; - } - } - # We must make sourcedir() return an absolute path, because configdata.pm # may be loaded as a module from any script in any directory, making # relative paths untrustable. Because the result is used with 'use lib', @@ -73,6 +14,8 @@ sub sourcefile { return abs_path(catfile($config{sourcedir}, @_)); } + use lib sourcedir('util', 'perl'); + use OpenSSL::Util; -} package configdata; @@ -86,23 +29,23 @@ our @EXPORT = qw( @disablables @disablables_int ); -our %config = ({- out_item(\%config); -}); -our %target = ({- out_item(\%target); -}); -our @disablables = ({- out_item(\@disablables) -}); -our @disablables_int = ({- out_item(\@disablables_int) -}); -our %disabled = ({- out_item(\%disabled); -}); -our %withargs = ({- out_item(\%withargs); -}); -our %unified_info = ({- out_item(\%unified_info); -}); +our %config = ({- dump_data(\%config, indent => 0); -}); +our %target = ({- dump_data(\%target, indent => 0); -}); +our @disablables = ({- dump_data(\@disablables, indent => 0) -}); +our @disablables_int = ({- dump_data(\@disablables_int, indent => 0) -}); +our %disabled = ({- dump_data(\%disabled, indent => 0); -}); +our %withargs = ({- dump_data(\%withargs, indent => 0); -}); +our %unified_info = ({- dump_data(\%unified_info, indent => 0); -}); # Unexported, only used by OpenSSL::Test::Utils::available_protocols() our %available_protocols = ( - tls => [{- out_item(\@tls) -}], - dtls => [{- out_item(\@dtls) -}], + tls => [{- dump_data(\@tls, indent => 0) -}], + dtls => [{- dump_data(\@dtls, indent => 0) -}], ); # The following data is only used when this files is use as a script -my @makevars = ({- out_item(\@makevars); -}); -my %disabled_info = ({- out_item(\%disabled_info); -}); +my @makevars = ({- dump_data(\@makevars, indent => 0); -}); +my %disabled_info = ({- dump_data(\%disabled_info, indent => 0); -}); my @user_crossable = qw( {- join (' ', @user_crossable) -} ); # If run directly, we can give some answers, and even reconfigure diff --git a/tools/c_rehash.in b/tools/c_rehash.in index 1566d141d3..54cad6138b 100644 --- a/tools/c_rehash.in +++ b/tools/c_rehash.in @@ -1,5 +1,5 @@ #!{- $config{HASHBANGPERL} -} - +{- use OpenSSL::Util; -} # {- join("\n# ", @autowarntext) -} # Copyright 1999-2021 The OpenSSL Project Authors. All Rights Reserved. # diff --git a/util/perl/OpenSSL/Template.pm b/util/perl/OpenSSL/Template.pm index ed89d15085..bed13d20f9 100644 --- a/util/perl/OpenSSL/Template.pm +++ b/util/perl/OpenSSL/Template.pm @@ -130,51 +130,6 @@ sub output_off { # Helper functions for the templates ################################# -# It might be practical to quotify some strings and have them protected -# from possible harm. These functions primarily quote things that might -# be interpreted wrongly by a perl eval. - -# NOTE THAT THESE AREN'T CLASS METHODS! - -=over 4 - -=item quotify1 STRING - -This adds quotes (") around the given string, and escapes any $, @, \, -" and ' by prepending a \ to them. - -=back - -=cut - -sub quotify1 { - my $s = shift @_; - $s =~ s/([\$\@\\"'])/\\$1/g; - '"'.$s.'"'; -} - -=over 4 - -=item quotify_l LIST - -For each defined element in LIST (i.e. elements that aren't undef), have -it quotified with 'quotify1'. -Undefined elements are ignored. - -=back - -=cut - -sub quotify_l { - map { - if (!defined($_)) { - (); - } else { - quotify1($_); - } - } @_; -} - =head1 SEE ALSO L diff --git a/util/perl/OpenSSL/Util.pm b/util/perl/OpenSSL/Util.pm index 1c8c6afa44..8b3743aa2a 100644 --- a/util/perl/OpenSSL/Util.pm +++ b/util/perl/OpenSSL/Util.pm @@ -6,7 +6,7 @@ # in the file LICENSE in the source distribution or at # https://www.openssl.org/source/license.html -package OpenSSL::Ordinals; +package OpenSSL::Util; use strict; use warnings; @@ -16,7 +16,7 @@ use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = "0.1"; @ISA = qw(Exporter); -@EXPORT = qw(cmp_versions); +@EXPORT = qw(cmp_versions quotify1 quotify_l dump_data); @EXPORT_OK = qw(); =head1 NAME @@ -85,4 +85,136 @@ sub cmp_versions { return $verdict; } +# It might be practical to quotify some strings and have them protected +# from possible harm. These functions primarily quote things that might +# be interpreted wrongly by a perl eval. + +=over 4 + +=item quotify1 STRING + +This adds quotes (") around the given string, and escapes any $, @, \, +" and ' by prepending a \ to them. + +=back + +=cut + +sub quotify1 { + my $s = shift @_; + $s =~ s/([\$\@\\"'])/\\$1/g; + '"'.$s.'"'; +} + +=over 4 + +=item quotify_l LIST + +For each defined element in LIST (i.e. elements that aren't undef), have +it quotified with 'quotify1'. +Undefined elements are ignored. + +=cut + +sub quotify_l { + map { + if (!defined($_)) { + (); + } else { + quotify1($_); + } + } @_; +} + +=item dump_data REF, OPTS + +Dump the data from REF into a string that can be evaluated into the same +data by Perl. + +OPTS is the rest of the arguments, expected to be pairs formed with C<< => >>. +The following OPTS keywords are understood: + +=over 4 + +=item B 0 | 1> + +Include the outer delimiter of the REF type in the resulting string if C<1>, +otherwise not. + +=item B num> + +The indentation of the caller, i.e. an initial value. If not given, there +will be no indentation at all, and the string will only be one line. + +=back + +=cut + +sub dump_data { + my $ref = shift; + # Available options: + # indent => callers indentation ( undef for no indentation, + # an integer otherwise ) + # delimiters => 1 if outer delimiters should be added + my %opts = @_; + + my $indent = $opts{indent} // 1; + # Indentation of the whole structure, where applicable + my $nlindent1 = defined $opts{indent} ? "\n" . ' ' x $indent : ' '; + # Indentation of individual items, where applicable + my $nlindent2 = defined $opts{indent} ? "\n" . ' ' x ($indent + 4) : ' '; + my %subopts = (); + + $subopts{delimiters} = 1; + $subopts{indent} = $opts{indent} + 4 if defined $opts{indent}; + + my $product; # Finished product, or reference to a function that + # produces a string, given $_ + # The following are only used when $product is a function reference + my $delim_l; # Left delimiter of structure + my $delim_r; # Right delimiter of structure + my $separator; # Item separator + my @items; # Items to iterate over + + if (ref($ref) eq "ARRAY") { + if (scalar @$ref == 0) { + $product = $opts{delimiters} ? '[]' : ''; + } else { + $product = sub { + dump_data(\$_, %subopts) + }; + $delim_l = ($opts{delimiters} ? '[' : '').$nlindent2; + $delim_r = $nlindent1.($opts{delimiters} ? ']' : ''); + $separator = ",$nlindent2"; + @items = @$ref; + } + } elsif (ref($ref) eq "HASH") { + if (scalar keys %$ref == 0) { + $product = $opts{delimiters} ? '{}' : ''; + } else { + $product = sub { + quotify1($_) . " => " . dump_data($ref->{$_}, %subopts); + }; + $delim_l = ($opts{delimiters} ? '{' : '').$nlindent2; + $delim_r = $nlindent1.($opts{delimiters} ? '}' : ''); + $separator = ",$nlindent2"; + @items = sort keys %$ref; + } + } elsif (ref($ref) eq "SCALAR") { + $product = defined $$ref ? quotify1 $$ref : "undef"; + } else { + $product = defined $ref ? quotify1 $ref : "undef"; + } + + if (ref($product) eq "CODE") { + $delim_l . join($separator, map { &$product } @items) . $delim_r; + } else { + $product; + } +} + +=back + +=cut + 1; -- 2.39.2