[commit: packages/process] master, new-flags, new-flags-no-f3df9d6: add detach_console flag (908c678)

git at git.haskell.org git at git.haskell.org
Mon Nov 2 06:23:25 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/908c678945b65c71262e8b599b24145c91fcb79f/process

>---------------------------------------------------------------

commit 908c678945b65c71262e8b599b24145c91fcb79f
Author: Joey Hess <joeyh at joeyh.name>
Date:   Wed May 27 14:20:00 2015 -0400

    add detach_console flag
    
    Based on Daniel Brooks's changes, but without adding a new flag
    for CREATE_NO_WINDOW, which turned out to not be necessary.
    And, on unix, setsid is called.
    
    Tested on Linux and Windows.
    
    Fixes #32.


>---------------------------------------------------------------

908c678945b65c71262e8b599b24145c91fcb79f
 System/Process.hsc          |  6 ++++--
 System/Process/Internals.hs | 19 ++++++++++++++-----
 cbits/runProcess.c          |  6 ++++++
 include/processFlags.h      |  1 +
 4 files changed, 25 insertions(+), 7 deletions(-)

diff --git a/System/Process.hsc b/System/Process.hsc
index 32ad6af..419f9f9 100644
--- a/System/Process.hsc
+++ b/System/Process.hsc
@@ -124,7 +124,8 @@ proc cmd args = CreateProcess { cmdspec = RawCommand cmd args,
                                 std_err = Inherit,
                                 close_fds = False,
                                 create_group = False,
-                                delegate_ctlc = False}
+                                delegate_ctlc = False,
+                                detach_console = False }
 
 -- | Construct a 'CreateProcess' record for passing to 'createProcess',
 -- representing a command to be passed to the shell.
@@ -137,7 +138,8 @@ shell str = CreateProcess { cmdspec = ShellCommand str,
                             std_err = Inherit,
                             close_fds = False,
                             create_group = False,
-                            delegate_ctlc = False}
+                            delegate_ctlc = False,
+                            detach_console = 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..152edd7 100644
--- a/System/Process/Internals.hs
+++ b/System/Process/Internals.hs
@@ -177,11 +177,16 @@ 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/
+  detach_console :: Bool                   -- ^ Detach the process from the console, so it has no controlling terminal.
+                                           --
+                                           --   On Unix, this uses setsid, while on Windows, it uses DETACHED_PROCESS.
+                                           --
+                                           --   /Since: 1.3.0.0/
  }
 
 data CmdSpec
@@ -258,7 +263,8 @@ 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,
+                                  detach_console = mb_detach_console }
  = do
   let (cmd,args) = commandToProcess cmdsp
   withFilePathException cmd $
@@ -288,7 +294,8 @@ 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_detach_console then RUN_PROCESS_DETACHED else 0))
                                 pFailedDoing
 
      when (proc_handle == -1) $ do
@@ -419,7 +426,8 @@ 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,
+                                  detach_console = mb_detach_console }
  = do
   (cmd, cmdline) <- commandToProcess cmdsp
   withFilePathException cmd $
@@ -450,7 +458,8 @@ 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_detach_console 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..7ca6be8 100644
--- a/cbits/runProcess.c
+++ b/cbits/runProcess.c
@@ -138,6 +138,9 @@ runInteractiveProcess (char *const args[],
         close(forkCommunicationFds[0]);
         fcntl(forkCommunicationFds[1], F_SETFD, FD_CLOEXEC);
 
+        if ((flags & RUN_PROCESS_DETACHED) != 0) {
+            setsid();
+        }
         if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) {
             setpgid(0, 0);
         }
@@ -553,6 +556,9 @@ runInteractiveProcess (wchar_t *cmd, wchar_t *workingDirectory,
     if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) {
         dwFlags |= CREATE_NEW_PROCESS_GROUP;
     }
+    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..3b984d3 100644
--- a/include/processFlags.h
+++ b/include/processFlags.h
@@ -6,3 +6,4 @@
 
 #define RUN_PROCESS_IN_CLOSE_FDS 0x1
 #define RUN_PROCESS_IN_NEW_GROUP 0x2
+#define RUN_PROCESS_DETACHED     0x4



More information about the ghc-commits mailing list