Working on issue #15 (work in progress) (#16)

* Import and use lock used by System.Process to protect the fork

* Fix bug with return value

* Respond to review

* Bump bound on process

* Revert whitespace introduction.

* Revert switch to unsafe imports.

* Remove redundant include that causes compile warnings.

Co-authored-by: Merijn Verstraaten <merijn@inconsistent.nl>

System/Posix/Pty.hs

@@ -54,6 +54,7 @@ module System.Posix.Pty (
 import Control.Applicative
 #endif
 
+import Control.Concurrent (withMVar)
 import Control.Exception (bracket, throwIO, ErrorCall(..))
 import Control.Monad (when)
 
@@ -74,7 +75,7 @@ import Foreign.C.Types
 import System.IO.Error (mkIOError, eofErrorType)
 import System.Posix.IO (fdReadBuf, fdWriteBuf,closeFd)
 import System.Posix.Types
-import System.Process.Internals (mkProcessHandle, ProcessHandle)
+import System.Process.Internals (mkProcessHandle, runInteractiveProcess_lock, ProcessHandle)
 
 import qualified System.Posix.Terminal as T
 import System.Posix.Terminal hiding
@@ -225,7 +226,8 @@ spawnWithPty env' (fromBool -> search) path' argv' (x, y) = do
         bracket allocLists cleanupLists $ \(argv, env) -> do
             alloca $ \pidPtr -> do
                 fd <- throwErrnoIfMinus1Retry "failed to fork or open pty" $
-                        fork_exec_with_pty x y search path argv env pidPtr
+                        withMVar runInteractiveProcess_lock $ \_ ->
+                          fork_exec_with_pty x y search path argv env pidPtr
 
                 pid <- peek pidPtr
                 handle <- mkProcessHandle (fromIntegral pid) True

cbits/fork_exec_with_pty.c

@@ -21,6 +21,12 @@
 
 #include <HsFFI.h>
 
+#include "Rts.h"
+
+// Rts internal API, not exposed in a public header file
+extern void blockUserSignals(void);
+extern void unblockUserSignals(void);
+
 #include "fork_exec_with_pty.h"
 
 /* Should be exported by unistd.h, but isn't on OSX. */
@@ -48,11 +54,23 @@ fork_exec_with_pty
     ws.ws_row = sy;
 
     /* Fork and exec, returning the master pty. */
+    blockUserSignals();
+    stopTimer();
+
     *child_pid = forkpty(&pty, NULL, NULL, &ws);
+
+    int ret = pty;
+
     switch (*child_pid) {
     case -1:
+        unblockUserSignals();
+        startTimer();
+
         return -1;
     case 0:
+        /* Child process */
+        unblockUserSignals();
+
         /* If an environment is specified, override the old one. */
         if (env) environ = (char**) env;
 
@@ -63,10 +81,15 @@ fork_exec_with_pty
         perror("exec failed");
         exit(EXIT_FAILURE);
     default:
+        /* Parent process */
+
         /* Switch the pty to packet mode, we'll deal with packeting on the
            haskell side of things. */
-        if (ioctl(pty, TIOCPKT, &packet_mode) == -1) return 1;
+        if (ioctl(pty, TIOCPKT, &packet_mode) == -1) ret = 1;
+
+        unblockUserSignals();
+        startTimer();
 
-        return pty;
+        return ret;
     }
 }

posix-pty.cabal

@@ -33,13 +33,13 @@ Library
   Other-Modules:        
 
   C-Sources:            cbits/fork_exec_with_pty.c cbits/pty_size.c
-  CC-Options:           -Wall -Wextra -pedantic -std=c99
+  CC-Options:           -Wall -Wextra -std=c99
   Include-Dirs:         cbits
   Includes:             fork_exec_with_pty.h pty_size.h
 
   Build-Depends:        base >= 4 && < 5
                ,        bytestring >= 0.10
-               ,        process >= 1.2
+               ,        process >= 1.6.6.0
                ,        unix >= 2.6
 
   if os(linux) || os(freebsd)