[commit: packages/process] master, new-flags, new-flags-no-f3df9d6: (WIP, windows) allow DETACHED_PROCESS and CREATE_NO_WINDOW flags (3331eb5)
git at git.haskell.org
git at git.haskell.org
Mon Nov 2 06:23:21 UTC 2015
Repository : ssh://git@git.haskell.org/process
On branches: master,new-flags,new-flags-no-f3df9d6
Link : http://ghc.haskell.org/trac/ghc/changeset/3331eb574dcf3cedb34b1c665551e7ae37ac42c5/process
>---------------------------------------------------------------
commit 3331eb574dcf3cedb34b1c665551e7ae37ac42c5
Author: Daniel Brooks <db48x at db48x.net>
Date: Tue May 26 17:12:50 2015 -0700
(WIP, windows) allow DETACHED_PROCESS and CREATE_NO_WINDOW flags
not yet tested, needs comments on the new CreateProcess fields
>---------------------------------------------------------------
3331eb574dcf3cedb34b1c665551e7ae37ac42c5
System/Process.hsc | 8 ++++++--
System/Process/Internals.hs | 20 +++++++++++++++-----
cbits/runProcess.c | 6 ++++++
include/processFlags.h | 6 ++++--
4 files changed, 31 insertions(+), 9 deletions(-)
diff --git a/System/Process.hsc b/System/Process.hsc
index 32ad6af..9c36cce 100644
--- a/System/Process.hsc
+++ b/System/Process.hsc
@@ -124,7 +124,9 @@ proc cmd args = CreateProcess { cmdspec = RawCommand cmd args,
std_err = Inherit,
close_fds = False,
create_group = False,
- delegate_ctlc = False}
+ delegate_ctlc = False,
+ without_window = False,
+ run_detached = False }
-- | Construct a 'CreateProcess' record for passing to 'createProcess',
-- representing a command to be passed to the shell.
@@ -137,7 +139,9 @@ shell str = CreateProcess { cmdspec = ShellCommand str,
std_err = Inherit,
close_fds = False,
create_group = False,
- delegate_ctlc = False}
+ delegate_ctlc = False,
+ without_window = False,
+ run_detached = False }
{- |
This is the most general way to spawn an external process. The
diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
index 36265d4..85f4118 100644
--- a/System/Process/Internals.hs
+++ b/System/Process/Internals.hs
@@ -177,11 +177,13 @@ data CreateProcess = CreateProcess{
std_err :: StdStream, -- ^ How to determine stderr
close_fds :: Bool, -- ^ Close all file descriptors except stdin, stdout and stderr in the new process (on Windows, only works if std_in, std_out, and std_err are all Inherit)
create_group :: Bool, -- ^ Create a new process group
- delegate_ctlc:: Bool -- ^ Delegate control-C handling. Use this for interactive console processes to let them handle control-C themselves (see below for details).
+ delegate_ctlc:: Bool, -- ^ Delegate control-C handling. Use this for interactive console processes to let them handle control-C themselves (see below for details).
--
-- On Windows this has no effect.
--
-- /Since: 1.2.0.0/
+ without_window :: Bool,
+ run_detached :: Bool
}
data CmdSpec
@@ -258,7 +260,9 @@ createProcess_ fun CreateProcess{ cmdspec = cmdsp,
std_err = mb_stderr,
close_fds = mb_close_fds,
create_group = mb_create_group,
- delegate_ctlc = mb_delegate_ctlc }
+ delegate_ctlc = mb_delegate_ctlc,
+ without_window = mb_without_window,
+ run_detached = mb_run_detached }
= do
let (cmd,args) = commandToProcess cmdsp
withFilePathException cmd $
@@ -288,7 +292,9 @@ createProcess_ fun CreateProcess{ cmdspec = cmdsp,
pfdStdInput pfdStdOutput pfdStdError
(if mb_delegate_ctlc then 1 else 0)
((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0)
- .|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0))
+ .|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0)
+ .|.(if mb_without_window then RUN_PROCESS_WITHOUT_WINDOW else 0)
+ .|.(if mb_run_detached then RUN_PROCESS_DETACHED else 0))
pFailedDoing
when (proc_handle == -1) $ do
@@ -419,7 +425,9 @@ createProcess_ fun CreateProcess{ cmdspec = cmdsp,
std_err = mb_stderr,
close_fds = mb_close_fds,
create_group = mb_create_group,
- delegate_ctlc = _ignored }
+ delegate_ctlc = _ignored,
+ without_window = mb_without_window,
+ run_detached = mb_run_detached }
= do
(cmd, cmdline) <- commandToProcess cmdsp
withFilePathException cmd $
@@ -450,7 +458,9 @@ createProcess_ fun CreateProcess{ cmdspec = cmdsp,
fdin fdout fderr
pfdStdInput pfdStdOutput pfdStdError
((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0)
- .|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0))
+ .|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0)
+ .|.(if mb_without_window then RUN_PROCESS_WITHOUT_WINDOW else 0)
+ .|.(if mb_run_detached then RUN_PROCESS_DETACHED else 0))
hndStdInput <- mbPipe mb_stdin pfdStdInput WriteMode
hndStdOutput <- mbPipe mb_stdout pfdStdOutput ReadMode
diff --git a/cbits/runProcess.c b/cbits/runProcess.c
index f7828af..c0fd80f 100644
--- a/cbits/runProcess.c
+++ b/cbits/runProcess.c
@@ -553,6 +553,12 @@ runInteractiveProcess (wchar_t *cmd, wchar_t *workingDirectory,
if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) {
dwFlags |= CREATE_NEW_PROCESS_GROUP;
}
+ if ((flags & RUN_PROCESS_WITHOUT_WINDOW) != 0) {
+ dwFlags |= CREATE_NO_WINDOW;
+ }
+ if ((flags & RUN_PROCESS_DETACHED) != 0) {
+ dwFlags |= DETACHED_PROCESS;
+ }
if (!CreateProcess(NULL, cmd, NULL, NULL, inherit, dwFlags, environment, workingDirectory, &sInfo, &pInfo))
{
diff --git a/include/processFlags.h b/include/processFlags.h
index 06d598d..29acf97 100644
--- a/include/processFlags.h
+++ b/include/processFlags.h
@@ -4,5 +4,7 @@
Flags used in runProcess.c and for System.Process.Internals
------------------------------------------------------------------------- */
-#define RUN_PROCESS_IN_CLOSE_FDS 0x1
-#define RUN_PROCESS_IN_NEW_GROUP 0x2
+#define RUN_PROCESS_IN_CLOSE_FDS 0x1
+#define RUN_PROCESS_IN_NEW_GROUP 0x2
+#define RUN_PROCESS_WITHOUT_WINDOW 0x4
+#define RUN_PROCESS_DETACHED 0x8
More information about the ghc-commits
mailing list