In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f5fe1b19fc61e51b533b25b128ec7a6f764372da?hp=7082c44063b6e00b0bad96f3d8adec0946f1938c>
- Log ----------------------------------------------------------------- commit f5fe1b19fc61e51b533b25b128ec7a6f764372da Author: Tony Cook <[email protected]> Date: Tue Feb 10 15:54:16 2015 +1100 remove the shell fallback from list pipe open on Win32 This is a potential security issue, and while we'd need a deprecation cycle to remove it from system(), there hasn't been a production release of perl with list pipe open, so we can pretend it never was. Without the shell, CreateProcess() won't pick up .cmd or .bat files, which several perl utilities are packaged as on Win32, so use qualified_path() to produce a full executable name. ----------------------------------------------------------------------- Summary of changes: pod/perlport.pod | 3 --- t/win32/system_tests | 4 ++-- win32/win32.c | 44 +++++++++++++++++++++++++++----------------- 3 files changed, 29 insertions(+), 22 deletions(-) diff --git a/pod/perlport.pod b/pod/perlport.pod index 3bb10e3..62443d6 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -1874,9 +1874,6 @@ Not implemented. (Android, Win32, VMS, S<Plan 9>, S<RISC OS>, VOS) open to C<|-> and C<-|> are unsupported. (Win32, S<RISC OS>) -List-form pipe opens may fall back to the shell if the first spawn() -fails. (Win32) - Opening a process does not automatically flush output handles on some platforms. (SunOS, Solaris, HP-UX) diff --git a/t/win32/system_tests b/t/win32/system_tests index 8307222..91113db 100644 --- a/t/win32/system_tests +++ b/t/win32/system_tests @@ -121,12 +121,12 @@ for my $cmds (@commands) { $^D = 0; note "# pipe [".join(";", @cmds, @args). "]"; - if (open my $io, "|-", @cmds, @args) { + if (open my $io, "-|", @cmds, @args) { print <$io>; close $io; } else { - print "Failed pipe open: $!\n"; + print STDERR "Failed pipe open [",join(";", @cmds, @args),"]: $!\n"; } } } diff --git a/win32/win32.c b/win32/win32.c index ebb2b19..a78c598 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -149,7 +149,7 @@ static long filetime_to_clock(PFILETIME ft); static BOOL filetime_from_time(PFILETIME ft, time_t t); static char* create_command_line(char *cname, STRLEN clen, const char * const *args); -static char* qualified_path(const char *cmd); +static char* qualified_path(const char *cmd, bool other_exts); static void ansify_path(void); static LRESULT win32_process_message(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam); @@ -3009,23 +3009,20 @@ do_popen(const char *mode, const char *command, IV narg, SV **args) { } else { int i; + const char *exe_name; Newx(args_pvs, narg + 1 + w32_perlshell_items, const char *); SAVEFREEPV(args_pvs); for (i = 0; i < narg; ++i) args_pvs[i] = SvPV_nolen(args[i]); args_pvs[i] = NULL; + exe_name = qualified_path(args_pvs[0], TRUE); + if (!exe_name) + /* let CreateProcess() try to find it instead */ + exe_name = args_pvs[0]; - if ((childpid = do_spawnvp_handles(P_NOWAIT, args_pvs[0], args_pvs, handles)) == -1) { - if (errno == ENOEXEC || errno == ENOENT) { - /* possible shell-builtin, invoke with shell */ - Move(args_pvs, args_pvs+w32_perlshell_items, narg+1, const char *); - Copy(w32_perlshell_vec, args_pvs, w32_perlshell_items, const char *); - if ((childpid = do_spawnvp_handles(P_NOWAIT, args_pvs[0], args_pvs, handles)) == -1) - goto cleanup; - } - else - goto cleanup; + if ((childpid = do_spawnvp_handles(P_NOWAIT, exe_name, args_pvs, handles)) == -1) { + goto cleanup; } } @@ -3550,8 +3547,15 @@ create_command_line(char *cname, STRLEN clen, const char * const *args) return cmd; } +static const char *exe_extensions[] = + { + ".exe", /* this must be first */ + ".cmd", + ".bat" + }; + static char * -qualified_path(const char *cmd) +qualified_path(const char *cmd, bool other_exts) { char *pathstr; char *fullcmd, *curfullcmd; @@ -3590,10 +3594,16 @@ qualified_path(const char *cmd) if (cmd[cmdlen-1] != '.' && (cmdlen < 4 || cmd[cmdlen-4] != '.')) { - strcpy(curfullcmd, ".exe"); - res = GetFileAttributes(fullcmd); - if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY)) - return fullcmd; + int i; + /* first extension is .exe */ + int ext_limit = other_exts ? C_ARRAY_LENGTH(exe_extensions) : 1; + for (i = 0; i < ext_limit; ++i) { + strcpy(curfullcmd, exe_extensions[i]); + res = GetFileAttributes(fullcmd); + if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY)) + return fullcmd; + } + *curfullcmd = '\0'; } @@ -3830,7 +3840,7 @@ RETRY: * jump through our own hoops by picking out the path * we really want it to use. */ if (!fullcmd) { - fullcmd = qualified_path(cname); + fullcmd = qualified_path(cname, FALSE); if (fullcmd) { if (cname != cmdname) Safefree(cname); -- Perl5 Master Repository
