process 1.6.20.0 → 1.6.21.0
raw patch · 4 files changed
+97/−31 lines, 4 files
Files
- System/Process/CommunicationHandle.hs +13/−0
- System/Process/CommunicationHandle/Internal.hsc +74/−27
- changelog.md +8/−0
- process.cabal +2/−4
System/Process/CommunicationHandle.hs view
@@ -38,6 +38,9 @@ -- | Turn the 'CommunicationHandle' into a 'Handle' that can be read from -- in the current process. --+-- The returned 'Handle' does not have any finalizers attached to it;+-- use 'hClose' to close it.+-- -- @since 1.6.20.0 openCommunicationHandleRead :: CommunicationHandle -> IO Handle openCommunicationHandleRead = useCommunicationHandle True@@ -45,6 +48,9 @@ -- | Turn the 'CommunicationHandle' into a 'Handle' that can be written to -- in the current process. --+-- The returned 'Handle' does not have any finalizers attached to it;+-- use 'hClose' to close it.+-- -- @since 1.6.20.0 openCommunicationHandleWrite :: CommunicationHandle -> IO Handle openCommunicationHandleWrite = useCommunicationHandle False@@ -55,6 +61,9 @@ -- | 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. --+-- The returned 'Handle' does not have any finalizers attached to it;+-- use 'hClose' to close it.+-- -- See 'CommunicationHandle'. -- -- @since 1.6.20.0@@ -71,6 +80,9 @@ -- | 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. --+-- The returned 'Handle' does not have any finalizers attached to it;+-- use 'hClose' to close it.+-- -- See 'CommunicationHandle'. -- -- @since 1.6.20.0@@ -125,6 +137,7 @@ 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
System/Process/CommunicationHandle/Internal.hsc view
@@ -13,9 +13,9 @@ where import Control.Arrow ( first )-import Foreign.C (CInt(..), throwErrnoIf_)-import GHC.IO.Handle (Handle())+import GHC.IO.Handle (Handle, hClose) #if defined(mingw32_HOST_OS)+import Foreign.C (CInt(..), throwErrnoIf_) import Foreign.Marshal (alloca) import Foreign.Ptr (ptrToWordPtr, wordPtrToPtr) import Foreign.Storable (Storable(peek))@@ -41,28 +41,37 @@ #include <fcntl.h> /* for _O_BINARY */ #else+import GHC.IO.FD+ ( mkFD, setNonBlockingMode )+import GHC.IO.Handle+ ( noNewlineTranslation )+#if MIN_VERSION_base(4,16,0)+import GHC.IO.Handle.Internals+ ( mkFileHandleNoFinalizer )+#else+import GHC.IO.IOMode+ ( IOMode(..) )+import GHC.IO.Handle.Types+ ( HandleType(..) )+import GHC.IO.Handle.Internals+ ( mkHandle )+#endif import System.Posix- ( Fd(..), fdToHandle+ ( Fd(..) , FdOption(..), setFdOption )-import GHC.IO.FD (FD(fdFD))--- NB: we use GHC.IO.Handle.Fd.handleToFd rather than System.Posix.handleToFd,--- as the latter flushes and closes the `Handle`, which is not the behaviour we want.-import GHC.IO.Handle.FD (handleToFd)-#endif--##if !defined(mingw32_HOST_OS)+import System.Posix.Internals+ ( fdGetMode ) import System.Process.Internals- ( createPipe )-##endif--import GHC.IO.Handle (hClose)+ ( createPipeFd )+#endif -------------------------------------------------------------------------------- -- Communication handles. --- | A 'CommunicationHandle' is an operating-system specific representation--- of a 'Handle' that can be communicated through a command-line interface.+-- | A 'CommunicationHandle' is an abstraction over operating-system specific+-- internal representation of a 'Handle', which can be communicated through a+-- command-line interface. -- -- In a typical use case, the parent process creates a pipe, using e.g. -- 'createWeReadTheyWritePipe' or 'createTheyReadWeWritePipe'.@@ -120,10 +129,10 @@ -- | Internal function used to define 'openCommunicationHandleRead' and -- openCommunicationHandleWrite. useCommunicationHandle :: Bool -> CommunicationHandle -> IO Handle-useCommunicationHandle wantToRead (CommunicationHandle ch) = do+useCommunicationHandle _wantToRead (CommunicationHandle ch) = do ##if defined(__IO_MANAGER_WINIO__) return ()- <!> associateHandleWithFallback wantToRead ch+ <!> associateHandleWithFallback _wantToRead ch ##endif getGhcHandle ch @@ -199,7 +208,26 @@ ## endif #else getGhcHandle :: Fd -> IO Handle-getGhcHandle fd = fdToHandle fd+getGhcHandle (Fd fdint) = do+ iomode <- fdGetMode fdint+ (fd0, _) <- mkFD fdint iomode Nothing False True+ -- The following copies over 'mkHandleFromFDNoFinalizer'+ fd <- setNonBlockingMode fd0 True+ let fd_str = "<file descriptor: " ++ show fd ++ ">"+# if MIN_VERSION_base(4,16,0)+ mkFileHandleNoFinalizer fd fd_str iomode Nothing noNewlineTranslation+# else+ mkHandle fd fd_str (ioModeToHandleType iomode) True Nothing noNewlineTranslation+ Nothing Nothing++ioModeToHandleType :: IOMode -> HandleType+ioModeToHandleType mode =+ case mode of+ ReadMode -> ReadHandle+ WriteMode -> WriteHandle+ ReadWriteMode -> ReadWriteHandle+ AppendMode -> AppendHandle+# endif #endif --------------------------------------------------------------------------------@@ -207,21 +235,40 @@ -- | Internal helper function used to define 'createWeReadTheyWritePipe' -- and 'createTheyReadWeWritePipe' while reducing code duplication.+--+-- The returned 'Handle' does not have any finalizers attached to it;+-- use 'hClose' to close it. createCommunicationPipe :: ( forall a. (a, a) -> (a, a) ) -- ^ 'id' (we read, they write) or 'swap' (they read, we write) -> Bool -- ^ whether to pass a handle supporting asynchronous I/O to the child process -- (this flag only has an effect on Windows and when using WinIO) -> IO (Handle, CommunicationHandle)-createCommunicationPipe swapIfTheyReadWeWrite passAsyncHandleToChild = do+createCommunicationPipe swapIfTheyReadWeWrite _passAsyncHandleToChild = do ##if !defined(mingw32_HOST_OS)- (ourHandle, theirHandle) <- swapIfTheyReadWeWrite <$> createPipe+ -- NB: it's important to use 'createPipeFd' here.+ --+ -- Were we to instead use 'createPipe', we would create a Handle for both pipe+ -- ends, including the end we pass to the child.+ -- Such Handle would have a finalizer which closes the underlying file descriptor.+ -- However, we will already close the FD after it is inherited by the child.+ -- This could lead to the following scenario:+ --+ -- - the parent creates a new pipe, e.g. pipe2([7,8]),+ -- - the parent spawns a child process, and lets FD 8 be inherited by the child,+ -- - the parent closes FD 8,+ -- - the parent opens FD 8 for some other purpose, e.g. for writing to a file,+ -- - the finalizer for the Handle wrapping FD 8 runs, closing FD 8, even though+ -- it is now in use for a completely different purpose.+ (ourFd, theirFd) <- swapIfTheyReadWeWrite <$> createPipeFd -- Don't allow the child process to inherit a parent file descriptor -- (such inheritance happens by default on Unix).- ourFD <- Fd . fdFD <$> handleToFd ourHandle- setFdOption ourFD CloseOnExec True- theirFD <- Fd . fdFD <$> handleToFd theirHandle- return (ourHandle, CommunicationHandle theirFD)+ setFdOption (Fd ourFd) CloseOnExec True+ -- NB: we will be closing this handle manually, so don't use 'handleFromFd'+ -- which attaches a finalizer that closes the FD. See the above comment+ -- about 'createPipeFd'.+ ourHandle <- getGhcHandle (Fd ourFd)+ return (ourHandle, CommunicationHandle $ Fd theirFd) ##else trueForWinIO <- return False@@ -236,8 +283,8 @@ -- - make the parent pipe end overlapped, -- - make the child end overlapped if requested, -- Otherwise: make both pipe ends synchronous.- overlappedRead = trueForWinIO && ( passAsyncHandleToChild || not inheritRead )- overlappedWrite = trueForWinIO && ( passAsyncHandleToChild || not inheritWrite )+ overlappedRead = trueForWinIO && ( _passAsyncHandleToChild || not inheritRead )+ overlappedWrite = trueForWinIO && ( _passAsyncHandleToChild || not inheritWrite ) throwErrnoIf_ (==False) "mkNamedPipe" $ mkNamedPipe pfdStdInput inheritRead overlappedRead
changelog.md view
@@ -1,5 +1,13 @@ # Changelog for [`process` package](http://hackage.haskell.org/package/process) +## 1.6.21.0 *July 2024*++* No longer attach finalizers to `Handle`s created by the+ `System.Process.CommunicationHandle` API. Instead, all file descriptors are+ manually closed by the API.++ This fixes a bug in which a file descriptor could be closed multiple times.+ ## 1.6.20.0 *April 2024* * Introduce `System.Process.CommunicationHandle`, allowing for platform-independent
process.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: process-version: 1.6.20.0+version: 1.6.21.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause license-file: LICENSE@@ -82,15 +82,13 @@ build-depends: unix >= 2.5 && < 2.9 include-dirs: include- includes:- runProcess.h install-includes: runProcess.h processFlags.h ghc-options: -Wall - build-depends: base >= 4.10 && < 4.20,+ build-depends: base >= 4.10 && < 4.21, directory >= 1.1 && < 1.4, filepath >= 1.2 && < 1.6, deepseq >= 1.1 && < 1.6