-
Notifications
You must be signed in to change notification settings - Fork 82
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
An API for inter-process communication via Handles
This commit adds the System.Process.CommunicationHandle module, which provides the cross-platform CommunicationHandle abstraction which allows Handles to be passed to child processes for inter-process communication. A high-level API is provided by the function `readCreateProcessWithExitCodeCommunicationHandle`, which can be consulted for further details about how the functionality is meant to be used. To test this functionality, we created a new "cli-child" executable component to the process-tests package. To work around Cabal bug #9854, it was necessary to change the build-type of the package to `Custom`, in order to make the "cli-child" executable visible when running the test-suite. The custom Setup.hs script contains more details about the problem.
- Loading branch information
Showing
14 changed files
with
717 additions
and
69 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,5 +1,6 @@ | ||
module Main (main) where | ||
|
||
-- Cabal | ||
import Distribution.Simple | ||
( defaultMainWithHooks | ||
, autoconfUserHooks | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,142 @@ | ||
{-# LANGUAGE CPP #-} | ||
{-# LANGUAGE RankNTypes #-} | ||
|
||
module System.Process.CommunicationHandle | ||
( -- * 'CommunicationHandle': a 'Handle' that can be serialised, | ||
-- enabling inter-process communication. | ||
CommunicationHandle | ||
-- NB: opaque, as the representation depends on the operating system | ||
, openCommunicationHandleRead | ||
, openCommunicationHandleWrite | ||
, closeCommunicationHandle | ||
-- * Creating 'CommunicationHandle's to communicate with | ||
-- a child process | ||
, createWeReadTheyWritePipe | ||
, createTheyReadWeWritePipe | ||
-- * High-level API | ||
, readCreateProcessWithExitCodeCommunicationHandle | ||
) | ||
where | ||
|
||
import GHC.IO.Handle (Handle) | ||
|
||
import System.Process.CommunicationHandle.Internal | ||
import System.Process.Internals | ||
( CreateProcess(..), ignoreSigPipe, withForkWait ) | ||
import System.Process | ||
( withCreateProcess, waitForProcess ) | ||
|
||
import GHC.IO (evaluate) | ||
import GHC.IO.Handle (hClose) | ||
import System.Exit (ExitCode) | ||
|
||
import Control.DeepSeq (NFData, rnf) | ||
|
||
-------------------------------------------------------------------------------- | ||
-- Communication handles. | ||
|
||
-- | Turn the 'CommunicationHandle' into a 'Handle' that can be read from | ||
-- in the current process. | ||
-- | ||
-- @since 1.6.20.0 | ||
openCommunicationHandleRead :: CommunicationHandle -> IO Handle | ||
openCommunicationHandleRead = useCommunicationHandle True | ||
|
||
-- | Turn the 'CommunicationHandle' into a 'Handle' that can be written to | ||
-- in the current process. | ||
-- | ||
-- @since 1.6.20.0 | ||
openCommunicationHandleWrite :: CommunicationHandle -> IO Handle | ||
openCommunicationHandleWrite = useCommunicationHandle False | ||
|
||
-------------------------------------------------------------------------------- | ||
-- Creating pipes. | ||
|
||
-- | Create a pipe @(weRead,theyWrite)@ that the current process can read from, | ||
-- and whose write end can be passed to a child process in order to receive data from it. | ||
-- | ||
-- See 'CommunicationHandle'. | ||
-- | ||
-- @since 1.6.20.0 | ||
createWeReadTheyWritePipe | ||
:: IO (Handle, CommunicationHandle) | ||
createWeReadTheyWritePipe = | ||
createCommunicationPipe id False | ||
-- safe choice: passAsyncHandleToChild = False, in case the child cannot | ||
-- deal with async I/O (see e.g. https://gitlab.haskell.org/ghc/ghc/-/issues/21610#note_431632) | ||
-- expert users can invoke createCommunicationPipe from | ||
-- System.Process.CommunicationHandle.Internals if they are sure that the | ||
-- child process they will communicate with supports async I/O on Windows | ||
|
||
-- | Create a pipe @(theyRead,weWrite)@ that the current process can write to, | ||
-- and whose read end can be passed to a child process in order to send data to it. | ||
-- | ||
-- See 'CommunicationHandle'. | ||
-- | ||
-- @since 1.6.20.0 | ||
createTheyReadWeWritePipe | ||
:: IO (CommunicationHandle, Handle) | ||
createTheyReadWeWritePipe = | ||
sw <$> createCommunicationPipe sw False | ||
-- safe choice: passAsyncHandleToChild = False, in case the child cannot | ||
-- deal with async I/O (see e.g. https://gitlab.haskell.org/ghc/ghc/-/issues/21610#note_431632) | ||
-- expert users can invoke createCommunicationPipe from | ||
-- System.Process.CommunicationHandle.Internals if they are sure that the | ||
-- child process they will communicate with supports async I/O on Windows | ||
where | ||
sw (a,b) = (b,a) | ||
|
||
-------------------------------------------------------------------------------- | ||
|
||
-- | A version of 'readCreateProcessWithExitCode' that communicates with the | ||
-- child process through a pair of 'CommunicationHandle's. | ||
-- | ||
-- Example usage: | ||
-- | ||
-- > readCreateProcessWithExitCodeCommunicationHandle | ||
-- > (\(chTheyRead, chTheyWrite) -> proc "child-exe" [show chTheyRead, show chTheyWrite]) | ||
-- > (\ hWeRead -> hGetContents hWeRead) | ||
-- > (\ hWeWrite -> hPut hWeWrite "xyz") | ||
-- | ||
-- where @child-exe@ is a separate executable that is implemented as: | ||
-- | ||
-- > main = do | ||
-- > [chRead, chWrite] <- getArgs | ||
-- > hRead <- openCommunicationHandleRead $ read chRead | ||
-- > hWrite <- openCommunicationHandleWrite $ read chWrite | ||
-- > input <- hGetContents hRead | ||
-- > hPut hWrite $ someFn input | ||
-- > hClose hWrite | ||
-- | ||
-- @since 1.6.20.0 | ||
readCreateProcessWithExitCodeCommunicationHandle | ||
:: NFData a | ||
=> ((CommunicationHandle, CommunicationHandle) -> CreateProcess) | ||
-- ^ Process to spawn, given a @(read, write)@ pair of | ||
-- 'CommunicationHandle's that are inherited by the spawned process | ||
-> (Handle -> IO a) | ||
-- ^ read action | ||
-> (Handle -> IO ()) | ||
-- ^ write action | ||
-> IO (ExitCode, a) | ||
readCreateProcessWithExitCodeCommunicationHandle mkProg readAction writeAction = do | ||
(chTheyRead, hWeWrite ) <- createTheyReadWeWritePipe | ||
(hWeRead , chTheyWrite) <- createWeReadTheyWritePipe | ||
let cp = mkProg (chTheyRead, chTheyWrite) | ||
-- The following implementation parallels 'readCreateProcess' | ||
withCreateProcess cp $ \ _ _ _ ph -> do | ||
-- Close the parent's references to the 'CommunicationHandle's after they | ||
-- have been inherited by the child (we don't want to keep pipe ends open). | ||
closeCommunicationHandle chTheyWrite | ||
closeCommunicationHandle chTheyRead | ||
|
||
-- Fork off a thread that waits on the output. | ||
output <- readAction hWeRead | ||
withForkWait (evaluate $ rnf output) $ \ waitOut -> do | ||
ignoreSigPipe $ writeAction hWeWrite | ||
ignoreSigPipe $ hClose hWeWrite | ||
waitOut | ||
hClose hWeRead | ||
|
||
ex <- waitForProcess ph | ||
return (ex, output) |
Oops, something went wrong.