Ticket #8943: 0001-Add-createPipe.patch

File 0001-Add-createPipe.patch, 3.8 KB (added by tibbe, 23 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