diff options
author | Richard Levitte <levitte@openssl.org> | 2021-06-16 10:18:20 +0200 |
---|---|---|
committer | Richard Levitte <levitte@openssl.org> | 2021-06-18 09:08:16 +0200 |
commit | 1abcd1e858ea4b1e924bdd8141d55b889cc2fbc2 (patch) | |
tree | 17a38289b710543920c43f73080554500fa8bcea /util | |
parent | a205860404f219e4c07424ebe49b817bcaa6d488 (diff) |
OpenSSL::Test: Move the command line quotifier
The command line quotifier is more useful as a common utility, so it
gets moved to OpenSSL::Util, as the following two functions:
fixup_cmd_elements(), which is the generic command line reformatter
fixup_cmd(), which is like fixup_cmd_elements(), but treats the first
element specially where necessary (such as on VMS).
Reviewed-by: Tomas Mraz <tomas@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/15791)
Diffstat (limited to 'util')
-rw-r--r-- | util/perl/OpenSSL/Test.pm | 82 | ||||
-rw-r--r-- | util/perl/OpenSSL/Util.pm | 92 |
2 files changed, 100 insertions, 74 deletions
diff --git a/util/perl/OpenSSL/Test.pm b/util/perl/OpenSSL/Test.pm index 00aa4d841e..00ef1832d3 100644 --- a/util/perl/OpenSSL/Test.pm +++ b/util/perl/OpenSSL/Test.pm @@ -22,7 +22,7 @@ $VERSION = "1.0"; srctop_dir srctop_file data_file data_dir result_file result_dir - pipe with cmdstr quotify + pipe with cmdstr openssl_versions ok_nofips is_nofips isnt_nofips)); @@ -69,6 +69,7 @@ use File::Spec::Functions qw/file_name_is_absolute curdir canonpath splitdir use File::Path 2.00 qw/rmtree mkpath/; use File::Basename; use Cwd qw/getcwd abs_path/; +use OpenSSL::Util; my $level = 0; @@ -315,7 +316,7 @@ sub cmd { my @cmdargs = ( @$cmd ); my @prog = __wrap_cmd(shift @cmdargs, $opts{exe_shell} // ()); - return __decorate_cmd($num, [ @prog, quotify(@cmdargs) ], + return __decorate_cmd($num, [ @prog, fixup_cmd_elements(@cmdargs) ], %opts); } } @@ -809,50 +810,6 @@ sub cmdstr { =over 4 -=item B<quotify LIST> - -LIST is a list of strings that are going to be used as arguments for a -command, and makes sure to inject quotes and escapes as necessary depending -on the content of each string. - -This can also be used to put quotes around the executable of a command. -I<This must never ever be done on VMS.> - -=back - -=cut - -sub quotify { - # Unix setup (default if nothing else is mentioned) - my $arg_formatter = - sub { $_ = shift; - ($_ eq '' || /\s|[\{\}\\\$\[\]\*\?\|\&:;<>]/) ? "'$_'" : $_ }; - - if ( $^O eq "VMS") { # VMS setup - $arg_formatter = sub { - $_ = shift; - if ($_ eq '' || /\s|["[:upper:]]/) { - s/"/""/g; - '"'.$_.'"'; - } else { - $_; - } - }; - } elsif ( $^O eq "MSWin32") { # MSWin setup - $arg_formatter = sub { - $_ = shift; - if ($_ eq '' || /\s|["\|\&\*\;<>]/) { - s/(["\\])/\\$1/g; - '"'.$_.'"'; - } else { - $_; - } - }; - } - - return map { $arg_formatter->($_) } @_; -} - =over 4 =item B<openssl_versions> @@ -1247,16 +1204,11 @@ sub __wrap_cmd { # Otherwise, use the standard wrapper my $std_wrapper = __bldtop_file("util", "wrap.pl"); - if ($^O eq "VMS") { - # On VMS, running random executables without having a command - # symbol means running them with the MCR command. This is an - # old PDP-11 command that stuck around. So we get a command - # running perl running the script. - @prefix = ( "MCR", $^X, $std_wrapper ); - } elsif ($^O eq "MSWin32") { - # In the Windows case, we run perl explicitly. We might not - # need it, but that depends on if the user has associated the - # '.pl' extension with a perl interpreter, so better be safe. + if ($^O eq "VMS" || $^O eq "MSWin32") { + # On VMS and Windows, we run the perl executable explicitly, + # with necessary fixups. We might not need that for Windows, + # but that depends on if the user has associated the '.pl' + # extension with a perl interpreter, so better be safe. @prefix = ( __fixup_prg($^X), $std_wrapper ); } else { # Otherwise, we assume Unix semantics, and trust that the #! @@ -1277,23 +1229,7 @@ sub __wrap_cmd { sub __fixup_prg { my $prog = shift; - my $prefix = ""; - - if ($^O eq "VMS" ) { - $prefix = ($prog =~ /^(?:[\$a-z0-9_]+:)?[<\[]/i ? "mcr " : "mcr []"); - } - - if (defined($prog)) { - # Make sure to quotify the program file on platforms that may - # have spaces or similar in their path name. - # To our knowledge, VMS is the exception where quotifying should - # never happen. - ($prog) = quotify($prog) unless $^O eq "VMS"; - return $prefix.$prog; - } - - print STDERR "$prog not found\n"; - return undef; + return join(' ', fixup_cmd($prog)); } # __decorate_cmd NUM, CMDARRAYREF diff --git a/util/perl/OpenSSL/Util.pm b/util/perl/OpenSSL/Util.pm index f8fcb2a351..074bb00d99 100644 --- a/util/perl/OpenSSL/Util.pm +++ b/util/perl/OpenSSL/Util.pm @@ -16,7 +16,8 @@ use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = "0.1"; @ISA = qw(Exporter); -@EXPORT = qw(cmp_versions quotify1 quotify_l dump_data); +@EXPORT = qw(cmp_versions quotify1 quotify_l fixup_cmd_elements fixup_cmd + dump_data); @EXPORT_OK = qw(); =head1 NAME @@ -126,6 +127,95 @@ sub quotify_l { } @_; } +=over 4 + +=item fixup_cmd_elements LIST + +Fixes up the command line elements given by LIST in a platform specific +manner. + +The result of this function is a copy of LIST with strings where quotes and +escapes have been injected as necessary depending on the content of each +LIST string. + +This can also be used to put quotes around the executable of a command. +I<This must never ever be done on VMS.> + +=back + +=cut + +sub fixup_cmd_elements { + # A formatter for the command arguments, defaulting to the Unix setup + my $arg_formatter = + sub { $_ = shift; + ($_ eq '' || /\s|[\{\}\\\$\[\]\*\?\|\&:;<>]/) ? "'$_'" : $_ }; + + if ( $^O eq "VMS") { # VMS setup + $arg_formatter = sub { + $_ = shift; + if ($_ eq '' || /\s|["[:upper:]]/) { + s/"/""/g; + '"'.$_.'"'; + } else { + $_; + } + }; + } elsif ( $^O eq "MSWin32") { # MSWin setup + $arg_formatter = sub { + $_ = shift; + if ($_ eq '' || /\s|["\|\&\*\;<>]/) { + s/(["\\])/\\$1/g; + '"'.$_.'"'; + } else { + $_; + } + }; + } + + return ( map { $arg_formatter->($_) } @_ ); +} + +=over 4 + +=item fixup_cmd LIST + +This is a sibling of fixup_cmd_elements() that expects the LIST to be a +complete command line. It does the same thing as fixup_cmd_elements(), +expect that it treats the first LIST element specially on VMS. + +=back + +=cut + +sub fixup_cmd { + return fixup_cmd_elements(@_) unless $^O eq 'VMS'; + + # The rest is VMS specific + my $prog = shift; + + # On VMS, running random executables without having a command symbol + # means running them with the MCR command. This is an old PDP-11 + # command that stuck around. + # This assumes that we're passed the name of an executable. This is a + # safe assumption for OpenSSL command lines + my $prefix = 'MCR'; + + if ($prog =~ /^MCR$/i) { + # If the first element is "MCR" (independent of case) already, then + # we assume that the program it runs is already written the way it + # should, and just grab it. + $prog = shift; + } else { + # If the command itself doesn't have a directory spec, make sure + # that there is one. Otherwise, MCR assumes that the program + # resides in SYS$SYSTEM: + $prog = '[]' . $prog unless $prog =~ /^(?:[\$a-z0-9_]+:)?[<\[]/i; + } + + return ( $prefix, $prog, fixup_cmd_elements(@_) ); +} + =item dump_data REF, OPTS Dump the data from REF into a string that can be evaluated into the same |