diff options
author | Richard Levitte <levitte@openssl.org> | 2023-03-06 08:49:08 +0100 |
---|---|---|
committer | Richard Levitte <levitte@openssl.org> | 2023-03-08 12:29:22 +0100 |
commit | 5ec4f45ef56dfe7733b70413f8e78426f19fb433 (patch) | |
tree | 53a09faeb6165bc3fd0c62cad47b0d3df13e3398 /util | |
parent | 1939ee7f252ffebd91c29384db4133290489e026 (diff) | |
download | openssl-new-5ec4f45ef56dfe7733b70413f8e78426f19fb433.tar.gz |
Fix how util/wrap.pl is used in OpenSSL::Util::fixup_cmd()
The mechanism was pretty tentative and wasn't well tested for diverse
situations.
Reviewed-by: Dmitry Belyavskiy <beldmit@gmail.com>
Reviewed-by: Tomas Mraz <tomas@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/20415)
Diffstat (limited to 'util')
-rw-r--r-- | util/perl/OpenSSL/Util.pm | 57 |
1 files changed, 38 insertions, 19 deletions
diff --git a/util/perl/OpenSSL/Util.pm b/util/perl/OpenSSL/Util.pm index 44e87afee2..e75b1a43b8 100644 --- a/util/perl/OpenSSL/Util.pm +++ b/util/perl/OpenSSL/Util.pm @@ -192,28 +192,47 @@ 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; + my $cmd = shift; + + # Prefix to be applied as needed. Essentially, we need to determine + # if the command is an executable file (something.EXE), and invoke it + # with the MCR command in that case. MCR is an old PDP-11 command that + # stuck around. + my @prefix; + + if ($cmd =~ m|^\@|) { + # The command is an invocation of a command procedure (also known as + # "script"), no modification needed. + @prefix = (); + } elsif ($cmd =~ m|^MCR$|) { + # The command is MCR, so there's nothing much to do apart from + # making sure that the file name following it isn't treated with + # fixup_cmd_elements(), 'cause MCR doesn't like strings. + @prefix = ( $cmd ); + $cmd = 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; + # All that's left now is to check whether the command is an executable + # file, and if it's not, simply assume that it is a DCL command. + + # Make sure we have a proper file name, i.e. add the default + # extension '.exe' if there isn't one already. + my $executable = ($cmd =~ m|.[a-z0-9\$]*$|) ? $cmd : $cmd . '.exe'; + if (-e $executable) { + # It seems to be an executable, so we make sure to prefix it + # with MCR, for proper invocation. We also make sure that + # there's a directory specification, or otherwise, MCR will + # assume that the executable is in SYS$SYSTEM: + @prefix = ( 'MCR' ); + $cmd = '[]' . $cmd unless $cmd =~ /^(?:[\$a-z0-9_]+:)?[<\[]/i; + } else { + # If it isn't an executable, then we assume that it's a DCL + # command, and do no further processing, apart from argument + # fixup. + @prefix = (); + } } - return ( $prefix, $prog, fixup_cmd_elements(@_) ); + return ( @prefix, $cmd, fixup_cmd_elements(@_) ); } =item dump_data REF, OPTS |