Ticket #8943: 0001-Add-createPipe.patch

File 0001-Add-createPipe.patch, 3.8 KB (added by tibbe, 13 months ago)
  • System/Process.hs

    From 4d0d1fc74ef12275a2fcee3c887c2f8593a59d26 Mon Sep 17 00:00:00 2001
    From: Johan Tibell <[email protected]>
    Date: Sun, 30 Mar 2014 17:18:12 +0200
    Subject: [PATCH 1/1] Add createPipe
    
    Neccesary for implementing 'tee' like behavior.
    ---
     System/Process.hs | 71 +++++++++++++++++++++++++++++++++++++++++++------------
     1 file changed, 56 insertions(+), 15 deletions(-)
    
    diff --git a/System/Process.hs b/System/Process.hs
    index 87e9a41..cbd8ca1 100644
    a b  
    1 {-# LANGUAGE CPP #-} 
     1{-# LANGUAGE CPP, ForeignFunctionInterface #-} 
    22#ifdef __GLASGOW_HASKELL__ 
    33{-# LANGUAGE Trustworthy #-} 
    44{-# LANGUAGE InterruptibleFFI #-} 
     
    2121-- ToDo: 
    2222--      * Flag to control whether exiting the parent also kills the child. 
    2323 
    24 {- NOTES on createPipe: 
    25  
    26    createPipe is no longer exported, because of the following problems: 
    27  
    28         - it wasn't used to implement runInteractiveProcess on Unix, because 
    29           the file descriptors for the unused ends of the pipe need to be closed 
    30           in the child process. 
    31  
    32         - on Windows, a special version of createPipe is needed that sets 
    33           the inheritance flags correctly on the ends of the pipe (see 
    34           mkAnonPipe below). 
    35 -} 
    36  
    3724module System.Process ( 
    3825    -- * Running sub-processes 
    3926    createProcess, 
    module System.Process ( 
    6350    terminateProcess, 
    6451    interruptProcessGroupOf, 
    6552 
     53    -- Interprocess communication 
     54    createPipe, 
     55 
    6656    -- * Old deprecated functions 
    6757    -- | These functions pre-date 'createProcess' which is much more 
    6858    -- flexible. 
    import System.Exit ( ExitCode(..) ) 
    9080import System.IO 
    9181import System.IO.Error (mkIOError, ioeSetErrorString) 
    9282 
    93 #if !defined(mingw32_HOST_OS) 
     83#if defined(mingw32_HOST_OS) 
     84# include <io.h>        /* for _close and _pipe */ 
     85# include <fcntl.h>     /* for _O_BINARY */ 
     86import Control.Exception (onException) 
     87import Foreign.C.Error (throwErrnoIfMinus1_) 
     88import Foreign.C.Types (CInt(..), CUInt(..)) 
     89import Foreign.Ptr (Ptr) 
     90import Foreign.Marshal.Array (allocaArray) 
     91import Foreign.Storable (peek, peekElemOff) 
     92import GHC.IO.FD (mkFD) 
     93import GHC.IO.Device (IODeviceType(Stream)) 
     94import GHC.IO.Handle.FD (mkHandleFromFD) 
     95#else 
    9496import System.Posix.Process (getProcessGroupIDOf) 
     97import qualified System.Posix.IO as Posix 
    9598import System.Posix.Types 
    9699#endif 
    97100 
    rawSystem cmd args = system (showCommandForUser cmd args) 
    895898#else 
    896899rawSystem cmd args = system (showCommandForUser cmd args) 
    897900#endif 
     901 
     902-- --------------------------------------------------------------------------- 
     903-- createPipe 
     904 
     905-- | Create a pipe for interprocess communication and return a 
     906-- @(readEnd, writeEnd)@ `Handle` pair. 
     907createPipe :: IO (Handle, Handle) 
     908#if !mingw32_HOST_OS 
     909createPipe = do 
     910    (readfd, writefd) <- Posix.createPipe 
     911    readh <- Posix.fdToHandle readfd 
     912    writeh <- Posix.fdToHandle writefd 
     913    return (readh, writeh) 
     914#else 
     915createPipe = do 
     916    (readfd, writefd) <- allocaArray 2 $ \ pfds -> do 
     917        throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 (#const _O_BINARY) 
     918        readfd <- peek pfds 
     919        writefd <- peekElemOff pfds 1 
     920        return (readfd, writefd) 
     921    (do readh <- fdToHandle readfd ReadMode 
     922        writeh <- fdToHandle writefd WriteMode 
     923        return (readh, writeh)) `onException` (close readfd >> close writefd) 
     924 
     925fdToHandle :: CInt -> IOMode -> IO Handle 
     926fdToHandle fd mode = do 
     927    (fd', deviceType) <- mkFD fd mode (Just (Stream, 0, 0)) False False 
     928    mkHandleFromFD fd' deviceType "" mode False Nothing 
     929 
     930close :: CInt -> IO () 
     931close = throwErrnoIfMinus1_ "_close" . c__close 
     932 
     933foreign import ccall "io.h _pipe" c__pipe :: 
     934    Ptr CInt -> CUInt -> CInt -> IO CInt 
     935 
     936foreign import ccall "io.h _close" c__close :: 
     937    CInt -> IO CInt 
     938#endif