mirror of
https://github.com/openssl/openssl.git
synced 2025-03-19 19:50:42 +08:00
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)
This commit is contained in:
Richard Levitte
parent
8a734d3aaf
commit
da51dc5f68
@ -4,6 +4,7 @@
|
||||
{-
|
||||
use File::Spec::Functions qw/:DEFAULT abs2rel rel2abs/;
|
||||
use File::Basename;
|
||||
use OpenSSL::Util;
|
||||
|
||||
(our $osslprefix_q = platform->osslprefix()) =~ s/\$/\\\$/;
|
||||
|
||||
|
||||
@ -3,6 +3,8 @@
|
||||
##
|
||||
## {- join("\n## ", @autowarntext) -}
|
||||
{-
|
||||
use OpenSSL::Util;
|
||||
|
||||
our $makedep_scheme = $config{makedep_scheme};
|
||||
our $makedepcmd = platform->makedepcmd();
|
||||
|
||||
|
||||
@ -4,6 +4,7 @@
|
||||
## {- join("\n## ", @autowarntext) -}
|
||||
{-
|
||||
use File::Basename;
|
||||
use OpenSSL::Util;
|
||||
|
||||
our $sover_dirname = platform->shlib_version_as_filename();
|
||||
|
||||
|
||||
@ -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,5 +1,5 @@
|
||||
#!{- $config{HASHBANGPERL} -}
|
||||
|
||||
{- use OpenSSL::Util; -}
|
||||
# {- join("\n# ", @autowarntext) -}
|
||||
# Copyright 1999-2021 The OpenSSL Project Authors. All Rights Reserved.
|
||||
#
|
||||
|
||||
@ -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>
|
||||
|
||||
@ -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…
x
Reference in New Issue
Block a user