Browse Source

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)
master
Richard Levitte 4 months ago
parent
commit
da51dc5f68
7 changed files with 152 additions and 118 deletions
  1. +1
    -0
      Configurations/descrip.mms.tmpl
  2. +2
    -0
      Configurations/unix-Makefile.tmpl
  3. +1
    -0
      Configurations/windows-makefile.tmpl
  4. +13
    -70
      configdata.pm.in
  5. +1
    -1
      tools/c_rehash.in
  6. +0
    -45
      util/perl/OpenSSL/Template.pm
  7. +134
    -2
      util/perl/OpenSSL/Util.pm

+ 1
- 0
Configurations/descrip.mms.tmpl View File

@ -4,6 +4,7 @@
{-
use File::Spec::Functions qw/:DEFAULT abs2rel rel2abs/;
use File::Basename;
use OpenSSL::Util;
(our $osslprefix_q = platform->osslprefix()) =~ s/\$/\\\$/;


+ 2
- 0
Configurations/unix-Makefile.tmpl View File

@ -3,6 +3,8 @@
##
## {- join("\n## ", @autowarntext) -}
{-
use OpenSSL::Util;
our $makedep_scheme = $config{makedep_scheme};
our $makedepcmd = platform->makedepcmd();


+ 1
- 0
Configurations/windows-makefile.tmpl View File

@ -4,6 +4,7 @@
## {- join("\n## ", @autowarntext) -}
{-
use File::Basename;
use OpenSSL::Util;
our $sover_dirname = platform->shlib_version_as_filename();


+ 13
- 70
configdata.pm.in View File

@ -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


+ 1
- 1
tools/c_rehash.in View File

@ -1,5 +1,5 @@
#!{- $config{HASHBANGPERL} -}
{- use OpenSSL::Util; -}
# {- join("\n# ", @autowarntext) -}
# Copyright 1999-2021 The OpenSSL Project Authors. All Rights Reserved.
#


+ 0
- 45
util/perl/OpenSSL/Template.pm View File

@ -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>


+ 134
- 2
util/perl/OpenSSL/Util.pm View File

@ -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;

Loading…
Cancel
Save