summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard Levitte <levitte@openssl.org>2021-05-17 14:25:12 +0200
committerRichard Levitte <levitte@openssl.org>2021-05-19 10:13:02 +0200
commitda51dc5f68c9e7924be3d5071ba8aea439a4d1c9 (patch)
tree7ed68e17fb2f48e22bccfe73f097468c85cce4b4
parent8a734d3aaf4e4784581b87cdf2a4b3e2c2403b97 (diff)
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 <tomas@openssl.org> (Merged from https://github.com/openssl/openssl/pull/15310)
-rw-r--r--Configurations/descrip.mms.tmpl1
-rw-r--r--Configurations/unix-Makefile.tmpl2
-rw-r--r--Configurations/windows-makefile.tmpl1
-rw-r--r--configdata.pm.in83
-rw-r--r--tools/c_rehash.in2
-rw-r--r--util/perl/OpenSSL/Template.pm45
-rw-r--r--util/perl/OpenSSL/Util.pm136
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<Text::Template>
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<delimiters =E<gt> 0 | 1>
+
+Include the outer delimiter of the REF type in the resulting string if C<1>,
+otherwise not.
+
+=item B<indent =E<gt> 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;