diff --git a/System/Process.hs b/System/Process.hs --- a/System/Process.hs +++ b/System/Process.hs @@ -478,7 +478,8 @@ -- -- * The command to run, which must be in the $PATH, or an absolute or relative path -- --- * A list of separate command line arguments to the program +-- * A list of separate command line arguments to the program. See 'RawCommand' for +-- further discussion of Windows semantics. -- -- * A string to pass on standard input to the forked process. -- diff --git a/System/Process/Common.hs b/System/Process/Common.hs --- a/System/Process/Common.hs +++ b/System/Process/Common.hs @@ -160,6 +160,14 @@ -- see the -- -- for the Windows @SearchPath@ API. + -- + -- Windows does not have a mechanism for passing multiple arguments. + -- When using @RawCommand@ on Windows, the command line is serialised + -- into a string, with arguments quoted separately. Command line + -- parsing is up individual programs, so the default behaviour may + -- not work for some programs. If you are not getting the desired + -- results, construct the command line yourself and use 'ShellCommand'. + -- deriving (Show, Eq) diff --git a/System/Process/Windows.hsc b/System/Process/Windows.hsc --- a/System/Process/Windows.hsc +++ b/System/Process/Windows.hsc @@ -25,6 +25,7 @@ import Control.Exception import Control.Monad import Data.Bits +import Data.Char (toLower) import Foreign.C import Foreign.Marshal import Foreign.Ptr @@ -425,8 +426,11 @@ -- which partly works. There seem to be some quoting issues, but -- I don't have the energy to find+fix them right now (ToDo). --SDM -- (later) Now I don't know what the above comment means. sigh. -commandToProcess (RawCommand cmd args) = do - return (cmd, translateInternal cmd ++ concatMap ((' ':) . translateInternal) args) +commandToProcess (RawCommand cmd args) + | map toLower (takeExtension cmd) `elem` [".bat", ".cmd"] + = return (cmd, translateInternal cmd ++ concatMap ((' ':) . translateCmdExeArg) args) + | otherwise + = return (cmd, translateInternal cmd ++ concatMap ((' ':) . translateInternal) args) -- Find CMD.EXE (or COMMAND.COM on Win98). We use the same algorithm as -- system() in the VC++ CRT (Vc7/crt/src/system.c in a VC++ installation). @@ -466,6 +470,30 @@ Nothing -> ioError (mkIOError doesNotExistErrorType "findCommandInterpreter" Nothing Nothing) Just cmd -> return cmd + +-- | Alternative regime used to escape arguments destined for scripts +-- interpreted by @cmd.exe@, (e.g. @.bat@ and @.cmd@ files). +-- +-- This respects the Windows command interpreter's quoting rules: +-- +-- * the entire argument should be surrounded in quotes +-- * the backslash symbol is used to escape quotes and backslashes +-- * the carat symbol is used to escape other special characters with +-- significance to the interpreter +-- +-- It is particularly important that we perform this quoting as +-- unvalidated unquoted command-line arguments can be used to achieve +-- arbitrary user code execution in when passed to a vulnerable batch +-- script. +-- +translateCmdExeArg :: String -> String +translateCmdExeArg xs = "^\"" ++ snd (foldr escape (True,"^\"") xs) + where escape '"' (_, str) = (True, '\\' : '"' : str) + escape '\\' (True, str) = (True, '\\' : '\\' : str) + escape '\\' (False, str) = (False, '\\' : str) + escape c (_, str) + | c `elem` "^<>|&()" = (False, '^' : c : str) + | otherwise = (False, c : str) translateInternal :: String -> String translateInternal xs = '"' : snd (foldr escape (True,"\"") xs) diff --git a/cbits/posix/fork_exec.c b/cbits/posix/fork_exec.c --- a/cbits/posix/fork_exec.c +++ b/cbits/posix/fork_exec.c @@ -282,17 +282,18 @@ #if defined(HAVE_EXECVPE) // XXX Check result execvpe(args[0], args, environment); + child_failed(forkCommunicationFds[1], "execvpe"); #else // XXX Check result execve(exec_path, args, environment); + child_failed(forkCommunicationFds[1], "execve"); #endif } else { // XXX Check result execvp(args[0], args); + child_failed(forkCommunicationFds[1], "execvp"); } - child_failed(forkCommunicationFds[1], "exec"); - default: if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) { setpgid(pid, pid); @@ -334,16 +335,8 @@ // our responsibility to reap here as nobody else can. waitpid(pid, NULL, 0); - // Already closed child ends above - if (stdInHdl->behavior == STD_HANDLE_USE_PIPE) { - close(stdInHdl->use_pipe.parent_end); - } - if (stdOutHdl->behavior == STD_HANDLE_USE_PIPE) { - close(stdOutHdl->use_pipe.parent_end); - } - if (stdErrHdl->behavior == STD_HANDLE_USE_PIPE) { - close(stdErrHdl->use_pipe.parent_end); - } + // No need to close stdin, et al. here as runInteractiveProcess will + // handle this. See #306. pid = -1; } diff --git a/cbits/posix/posix_spawn.c b/cbits/posix/posix_spawn.c --- a/cbits/posix/posix_spawn.c +++ b/cbits/posix/posix_spawn.c @@ -135,12 +135,18 @@ } if (workingDirectory) { -#if defined(HAVE_posix_spawn_file_actions_addchdir_np) - // N.B. this function is broken on macOS. - // See https://github.com/rust-lang/rust/pull/80537. +#if defined(HAVE_posix_spawn_file_actions_addchdir) r = posix_spawn_file_actions_addchdir(&fa, workingDirectory); if (r != 0) { *failed_doing = "posix_spawn_file_actions_addchdir"; + goto fail; + } +#elif defined(HAVE_posix_spawn_file_actions_addchdir_np) + // N.B. this function is broken on macOS. + // See https://github.com/rust-lang/rust/pull/80537. + r = posix_spawn_file_actions_addchdir_np(&fa, workingDirectory); + if (r != 0) { + *failed_doing = "posix_spawn_file_actions_addchdir_np"; goto fail; } #else diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,13 @@ # Changelog for [`process` package](http://hackage.haskell.org/package/process) +## 1.6.19.0 *April 2024* + +* Adjust command-line escaping logic on Windows to ensure that occurrences of + characters with special significance to the Windows batch interpreter are + properly escaped in arguments passed to `.bat` and `.cmd` processes. + This addresses + [HSEC-2024-0003](https://github.com/haskell/security-advisories/tree/main/advisories/hackage/process/HSEC-2024-0003.md). + ## 1.6.18.0 *September 2023* * Fix deadlock when waiting for process completion and process jobs [#273](https://github.com/haskell/process/issues/273) diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ # posix_spawn checks AC_CHECK_HEADERS([spawn.h]) -AC_CHECK_FUNCS([posix_spawnp posix_spawn_file_actions_addchdir],[],[],[ +AC_CHECK_FUNCS([posix_spawnp posix_spawn_file_actions_addchdir_np posix_spawn_file_actions_addchdir],[],[],[ #define _GNU_SOURCE #include ]) diff --git a/process.cabal b/process.cabal --- a/process.cabal +++ b/process.cabal @@ -1,5 +1,5 @@ name: process -version: 1.6.18.0 +version: 1.6.19.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE @@ -58,7 +58,7 @@ c-sources: cbits/win32/runProcess.c other-modules: System.Process.Windows - build-depends: Win32 >=2.4 && < 2.14 + build-depends: Win32 >=2.4 && < 2.15 -- ole32 and rpcrt4 are needed to create GUIDs for unique named pipes -- for process. extra-libraries: kernel32, ole32, rpcrt4 @@ -88,7 +88,7 @@ build-depends: base >= 4.10 && < 4.20, directory >= 1.1 && < 1.4, - filepath >= 1.2 && < 1.5, + filepath >= 1.2 && < 1.6, deepseq >= 1.1 && < 1.6 test-suite test