Hello community, here is the log from the commit of package ghc-typed-process for openSUSE:Factory checked in at 2019-06-30 10:21:45 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-typed-process (Old) and /work/SRC/openSUSE:Factory/.ghc-typed-process.new.4615 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-typed-process" Sun Jun 30 10:21:45 2019 rev:9 rq:712506 version:0.2.5.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-typed-process/ghc-typed-process.changes 2019-06-12 13:18:54.952562159 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-typed-process.new.4615/ghc-typed-process.changes 2019-06-30 10:21:46.835646227 +0200 @@ -1,0 +2,12 @@ +Thu Jun 27 02:02:48 UTC 2019 - psimons@suse.com + +- Update typed-process to version 0.2.5.0. + # ChangeLog for typed-process + + ## 0.2.5.0 + + * Add a `nullStream` [#24](https://github.com/fpco/typed-process/pull/24) + * Add `withProcessWait`, `withProcessWait_`, `withProcessTerm`, and `withProcessTerm_` + [#25](https://github.com/fpco/typed-process/issues/25) + +------------------------------------------------------------------- Old: ---- typed-process-0.2.4.1.tar.gz New: ---- typed-process-0.2.5.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-typed-process.spec ++++++ --- /var/tmp/diff_new_pack.FuVQeV/_old 2019-06-30 10:21:47.447647178 +0200 +++ /var/tmp/diff_new_pack.FuVQeV/_new 2019-06-30 10:21:47.451647184 +0200 @@ -19,7 +19,7 @@ %global pkg_name typed-process %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.2.4.1 +Version: 0.2.5.0 Release: 0 Summary: Run external processes, with strong typing of streams License: MIT ++++++ typed-process-0.2.4.1.tar.gz -> typed-process-0.2.5.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/typed-process-0.2.4.1/ChangeLog.md new/typed-process-0.2.5.0/ChangeLog.md --- old/typed-process-0.2.4.1/ChangeLog.md 2019-06-05 18:52:45.000000000 +0200 +++ new/typed-process-0.2.5.0/ChangeLog.md 2019-06-26 06:52:47.000000000 +0200 @@ -1,3 +1,11 @@ +# ChangeLog for typed-process + +## 0.2.5.0 + +* Add a `nullStream` [#24](https://github.com/fpco/typed-process/pull/24) +* Add `withProcessWait`, `withProcessWait_`, `withProcessTerm`, and `withProcessTerm_` + [#25](https://github.com/fpco/typed-process/issues/25) + ## 0.2.4.1 * Fix a `Handle` leak in `withProcessInterleave` and its derivatives. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/typed-process-0.2.4.1/src/System/Process/Typed/Internal.hs new/typed-process-0.2.5.0/src/System/Process/Typed/Internal.hs --- old/typed-process-0.2.4.1/src/System/Process/Typed/Internal.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/typed-process-0.2.5.0/src/System/Process/Typed/Internal.hs 2019-06-25 10:03:14.000000000 +0200 @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} +module System.Process.Typed.Internal ( + nullDevice +) where + +-- | The name of the system null device +nullDevice :: FilePath +#if WINDOWS +nullDevice = "\\\\.\\NUL" +#else +nullDevice = "/dev/null" +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/typed-process-0.2.4.1/src/System/Process/Typed.hs new/typed-process-0.2.5.0/src/System/Process/Typed.hs --- old/typed-process-0.2.4.1/src/System/Process/Typed.hs 2019-06-05 18:52:45.000000000 +0200 +++ new/typed-process-0.2.5.0/src/System/Process/Typed.hs 2019-06-26 06:52:47.000000000 +0200 @@ -4,6 +4,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Please see the README.md file for examples of using this API. module System.Process.Typed @@ -44,6 +45,7 @@ -- * Stream specs , mkStreamSpec , inherit + , nullStream , closed , byteStringInput , byteStringOutput @@ -54,6 +56,10 @@ -- * Launch a process , startProcess , stopProcess + , withProcessWait + , withProcessWait_ + , withProcessTerm + , withProcessTerm_ , withProcess , withProcess_ , readProcess @@ -96,12 +102,13 @@ import Control.Monad.IO.Class import qualified System.Process as P import Data.Typeable (Typeable) -import System.IO (Handle, hClose) +import System.IO (Handle, hClose, IOMode(ReadWriteMode), withBinaryFile) import System.IO.Error (isPermissionError) import Control.Concurrent (threadDelay) import Control.Concurrent.Async (async, cancel, waitCatch) import Control.Concurrent.STM (newEmptyTMVarIO, atomically, putTMVar, TMVar, readTMVar, tryReadTMVar, STM, tryPutTMVar, throwSTM, catchSTM) import System.Exit (ExitCode (ExitSuccess)) +import System.Process.Typed.Internal import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8 import Data.String (IsString (fromString)) @@ -205,7 +212,7 @@ -- -- @since 0.1.0.0 data StreamSpec (streamType :: StreamType) a = StreamSpec - { ssStream :: !P.StdStream + { ssStream :: !(forall b. (P.StdStream -> IO b) -> IO b) , ssCreate :: !(ProcessConfig () () () -> Maybe Handle -> Cleanup a) } deriving Functor @@ -490,7 +497,15 @@ mkStreamSpec :: P.StdStream -> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ())) -> StreamSpec streamType a -mkStreamSpec ss f = StreamSpec ss (\pc mh -> Cleanup (f pc mh)) +mkStreamSpec ss f = mkManagedStreamSpec ($ ss) f + +-- | Create a new 'StreamSpec' from a function that accepts a +-- 'P.StdStream' and a helper function. This function is the same as +-- the helper in 'mkStreamSpec' +mkManagedStreamSpec :: (forall b. (P.StdStream -> IO b) -> IO b) + -> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ())) + -> StreamSpec streamType a +mkManagedStreamSpec ss f = StreamSpec ss (\pc mh -> Cleanup (f pc mh)) -- | A stream spec which simply inherits the stream of the parent -- process. @@ -499,7 +514,25 @@ inherit :: StreamSpec anyStreamType () inherit = mkStreamSpec P.Inherit (\_ Nothing -> pure ((), return ())) +-- | A stream spec which is empty when used for for input and discards +-- output. Note this requires your platform's null device to be +-- available when the process is started. +-- +-- @since 0.2.5.0 +nullStream :: StreamSpec anyStreamType () +nullStream = mkManagedStreamSpec opener cleanup + where + opener f = + withBinaryFile nullDevice ReadWriteMode $ \handle -> + f (P.UseHandle handle) + cleanup _ _ = + pure ((), return ()) + -- | A stream spec which will close the stream for the child process. +-- You usually do not want to use this, as it will leave the +-- corresponding file descriptor unassigned and hence available for +-- re-use in the child process. Prefer 'nullStream' unless you're +-- certain you want this behavior. -- -- @since 0.1.0.0 closed :: StreamSpec anyStreamType () @@ -595,100 +628,104 @@ => ProcessConfig stdin stdout stderr -> m (Process stdin stdout stderr) startProcess pConfig'@ProcessConfig {..} = liftIO $ do - let cp0 = - case pcCmdSpec of - P.ShellCommand cmd -> P.shell cmd - P.RawCommand cmd args -> P.proc cmd args - cp = cp0 - { P.std_in = ssStream pcStdin - , P.std_out = ssStream pcStdout - , P.std_err = ssStream pcStderr - , P.cwd = pcWorkingDir - , P.env = pcEnv - , P.close_fds = pcCloseFds - , P.create_group = pcCreateGroup - , P.delegate_ctlc = pcDelegateCtlc + ssStream pcStdin $ \realStdin -> + ssStream pcStdout $ \realStdout -> + ssStream pcStderr $ \realStderr -> do + + let cp0 = + case pcCmdSpec of + P.ShellCommand cmd -> P.shell cmd + P.RawCommand cmd args -> P.proc cmd args + cp = cp0 + { P.std_in = realStdin + , P.std_out = realStdout + , P.std_err = realStderr + , P.cwd = pcWorkingDir + , P.env = pcEnv + , P.close_fds = pcCloseFds + , P.create_group = pcCreateGroup + , P.delegate_ctlc = pcDelegateCtlc #if MIN_VERSION_process(1, 3, 0) - , P.detach_console = pcDetachConsole - , P.create_new_console = pcCreateNewConsole - , P.new_session = pcNewSession + , P.detach_console = pcDetachConsole + , P.create_new_console = pcCreateNewConsole + , P.new_session = pcNewSession #endif #if MIN_VERSION_process(1, 4, 0) && !WINDOWS - , P.child_group = pcChildGroup - , P.child_user = pcChildUser + , P.child_group = pcChildGroup + , P.child_user = pcChildUser #endif - } + } - (minH, moutH, merrH, pHandle) <- P.createProcess_ "startProcess" cp + (minH, moutH, merrH, pHandle) <- P.createProcess_ "startProcess" cp - ((pStdin, pStdout, pStderr), pCleanup1) <- runCleanup $ (,,) - <$> ssCreate pcStdin pConfig minH - <*> ssCreate pcStdout pConfig moutH - <*> ssCreate pcStderr pConfig merrH - - pExitCode <- newEmptyTMVarIO - waitingThread <- async $ do - ec <- - if multiThreadedRuntime - then P.waitForProcess pHandle - else do - switchTime <- fromIntegral . (`div` 1000) . ctxtSwitchTime - <$> getConcFlags - let minDelay = 1 - maxDelay = max minDelay switchTime - loop delay = do - threadDelay delay - mec <- P.getProcessExitCode pHandle - case mec of - Nothing -> loop $ min maxDelay (delay * 2) - Just ec -> pure ec - loop minDelay - atomically $ putTMVar pExitCode ec - return ec - - let pCleanup = pCleanup1 `finally` do - -- First: stop calling waitForProcess, so that we can - -- avoid race conditions where the process is removed from - -- the system process table while we're trying to - -- terminate it. - cancel waitingThread - - -- Now check if the process had already exited - eec <- waitCatch waitingThread - - case eec of - -- Process already exited, nothing to do - Right _ec -> return () - - -- Process didn't exit yet, let's terminate it and - -- then call waitForProcess ourselves - Left _ -> do - eres <- try $ P.terminateProcess pHandle - ec <- - case eres of - Left e - -- On Windows, with the single-threaded runtime, it - -- seems that if a process has already exited, the - -- call to terminateProcess will fail with a - -- permission denied error. To work around this, we - -- catch this exception and then immediately - -- waitForProcess. There's a chance that there may be - -- other reasons for this permission error to appear, - -- in which case this code may allow us to wait too - -- long for a child process instead of erroring out. - -- Recommendation: always use the multi-threaded - -- runtime! - | isPermissionError e && not multiThreadedRuntime && isWindows -> - P.waitForProcess pHandle - | otherwise -> throwIO e - Right () -> P.waitForProcess pHandle - success <- atomically $ tryPutTMVar pExitCode ec - evaluate $ assert success () + ((pStdin, pStdout, pStderr), pCleanup1) <- runCleanup $ (,,) + <$> ssCreate pcStdin pConfig minH + <*> ssCreate pcStdout pConfig moutH + <*> ssCreate pcStderr pConfig merrH + + pExitCode <- newEmptyTMVarIO + waitingThread <- async $ do + ec <- + if multiThreadedRuntime + then P.waitForProcess pHandle + else do + switchTime <- fromIntegral . (`div` 1000) . ctxtSwitchTime + <$> getConcFlags + let minDelay = 1 + maxDelay = max minDelay switchTime + loop delay = do + threadDelay delay + mec <- P.getProcessExitCode pHandle + case mec of + Nothing -> loop $ min maxDelay (delay * 2) + Just ec -> pure ec + loop minDelay + atomically $ putTMVar pExitCode ec + return ec + + let pCleanup = pCleanup1 `finally` do + -- First: stop calling waitForProcess, so that we can + -- avoid race conditions where the process is removed from + -- the system process table while we're trying to + -- terminate it. + cancel waitingThread + + -- Now check if the process had already exited + eec <- waitCatch waitingThread + + case eec of + -- Process already exited, nothing to do + Right _ec -> return () + + -- Process didn't exit yet, let's terminate it and + -- then call waitForProcess ourselves + Left _ -> do + eres <- try $ P.terminateProcess pHandle + ec <- + case eres of + Left e + -- On Windows, with the single-threaded runtime, it + -- seems that if a process has already exited, the + -- call to terminateProcess will fail with a + -- permission denied error. To work around this, we + -- catch this exception and then immediately + -- waitForProcess. There's a chance that there may be + -- other reasons for this permission error to appear, + -- in which case this code may allow us to wait too + -- long for a child process instead of erroring out. + -- Recommendation: always use the multi-threaded + -- runtime! + | isPermissionError e && not multiThreadedRuntime && isWindows -> + P.waitForProcess pHandle + | otherwise -> throwIO e + Right () -> P.waitForProcess pHandle + success <- atomically $ tryPutTMVar pExitCode ec + evaluate $ assert success () - return Process {..} + return Process {..} where pConfig = clearStreams pConfig' @@ -717,27 +754,73 @@ -- | Uses the bracket pattern to call 'startProcess' and ensures that -- 'stopProcess' is called. -- --- In version 0.2.0.0, this function was monomorphized to @IO@ to --- avoid a dependency on the exceptions package. +-- This function is usually /not/ what you want. You're likely better +-- off using 'withProcessWait'. See +-- <https://github.com/fpco/typed-process/issues/25>. +-- +-- @since 0.2.5.0 +withProcessTerm + :: ProcessConfig stdin stdout stderr + -> (Process stdin stdout stderr -> IO a) + -> IO a +withProcessTerm config = bracket (startProcess config) stopProcess + +-- | Uses the bracket pattern to call 'startProcess'. Unlike +-- 'withProcessTerm', this function will wait for the child process to +-- exit, and only kill it with 'stopProcess' in the event that the +-- inner function throws an exception. +-- +-- @since 0.2.5.0 +withProcessWait + :: ProcessConfig stdin stdout stderr + -> (Process stdin stdout stderr -> IO a) + -> IO a +withProcessWait config f = + bracket + (startProcess config) + stopProcess + (\p -> f p <* waitExitCode p) + +-- | Deprecated synonym for 'withProcessTerm'. -- -- @since 0.1.0.0 withProcess :: ProcessConfig stdin stdout stderr -> (Process stdin stdout stderr -> IO a) -> IO a -withProcess config = bracket (startProcess config) stopProcess +withProcess = withProcessTerm +{-# DEPRECATED withProcess "Please consider using withProcessWait, or instead use withProcessTerm" #-} --- | Same as 'withProcess', but also calls 'checkExitCode' +-- | Same as 'withProcessTerm', but also calls 'checkExitCode' -- --- In version 0.2.0.0, this function was monomorphized to @IO@ to --- avoid a dependency on the exceptions package. +-- @since 0.2.5.0 +withProcessTerm_ + :: ProcessConfig stdin stdout stderr + -> (Process stdin stdout stderr -> IO a) + -> IO a +withProcessTerm_ config = bracket + (startProcess config) + (\p -> stopProcess p `finally` checkExitCode p) + +-- | Same as 'withProcessWait', but also calls 'checkExitCode' +-- +-- @since 0.2.5.0 +withProcessWait_ + :: ProcessConfig stdin stdout stderr + -> (Process stdin stdout stderr -> IO a) + -> IO a +withProcessWait_ config f = bracket + (startProcess config) + stopProcess + (\p -> f p <* checkExitCode p) + +-- | Deprecated synonym for 'withProcessTerm_'. -- -- @since 0.1.0.0 withProcess_ :: ProcessConfig stdin stdout stderr -> (Process stdin stdout stderr -> IO a) -> IO a -withProcess_ config = bracket - (startProcess config) - (\p -> stopProcess p `finally` checkExitCode p) +withProcess_ = withProcessTerm_ +{-# DEPRECATED withProcess_ "Please consider using withProcessWait_, or instead use withProcessTerm_" #-} -- | Run a process, capture its standard output and error as a -- 'L.ByteString', wait for it to complete, and then return its exit @@ -762,6 +845,8 @@ -- | Same as 'readProcess', but instead of returning the 'ExitCode', -- checks it with 'checkExitCode'. -- +-- Exceptions thrown by this function will include stdout and stderr. +-- -- @since 0.1.0.0 readProcess_ :: MonadIO m => ProcessConfig stdin stdoutIgnored stderrIgnored @@ -796,6 +881,8 @@ -- | Same as 'readProcessStdout', but instead of returning the -- 'ExitCode', checks it with 'checkExitCode'. -- +-- Exceptions thrown by this function will include stdout. +-- -- @since 0.2.1.0 readProcessStdout_ :: MonadIO m @@ -829,6 +916,8 @@ -- | Same as 'readProcessStderr', but instead of returning the -- 'ExitCode', checks it with 'checkExitCode'. -- +-- Exceptions thrown by this function will include stderr. +-- -- @since 0.2.1.0 readProcessStderr_ :: MonadIO m @@ -883,6 +972,8 @@ -- | Same as 'readProcessInterleaved', but instead of returning the 'ExitCode', -- checks it with 'checkExitCode'. -- +-- Exceptions thrown by this function will include stdout. +-- -- @since 0.2.4.0 readProcessInterleaved_ :: MonadIO m @@ -942,6 +1033,9 @@ -- | Wait for a process to exit, and ensure that it exited -- successfully. If not, throws an 'ExitCodeException'. -- +-- Exceptions thrown by this function will not include stdout or stderr (This prevents unbounded memory usage from reading them into memory). +-- However, some callers such as 'readProcess_' catch the exception, add the stdout and stderr, and rethrow. +-- -- @since 0.1.0.0 checkExitCode :: MonadIO m => Process stdin stdout stderr -> m () checkExitCode = liftIO . atomically . checkExitCodeSTM @@ -991,6 +1085,9 @@ -- exit code. Note that 'checkExitCode' is called by other functions -- as well, like 'runProcess_' or 'readProcess_'. -- +-- Note that several functions that throw an 'ExitCodeException' intentionally do not populate 'eceStdout' or 'eceStderr'. +-- This prevents unbounded memory usage for large stdout and stderrs. +-- -- @since 0.1.0.0 data ExitCodeException = ExitCodeException { eceExitCode :: ExitCode diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/typed-process-0.2.4.1/test/System/Process/TypedSpec.hs new/typed-process-0.2.5.0/test/System/Process/TypedSpec.hs --- old/typed-process-0.2.4.1/test/System/Process/TypedSpec.hs 2019-02-28 12:46:45.000000000 +0100 +++ new/typed-process-0.2.5.0/test/System/Process/TypedSpec.hs 2019-06-26 06:52:47.000000000 +0200 @@ -3,6 +3,7 @@ module System.Process.TypedSpec (spec) where import System.Process.Typed +import System.Process.Typed.Internal import System.IO import Control.Concurrent.Async (Concurrently (..)) import Control.Concurrent.STM (atomically) @@ -21,12 +22,36 @@ spec :: Spec spec = do + -- This is mainly to make sure we use the right device filename on Windows + it "Null device is accessible" $ do + withBinaryFile nullDevice WriteMode $ \fp -> do + hPutStrLn fp "Hello world" + withBinaryFile nullDevice ReadMode $ \fp -> do + atEnd <- hIsEOF fp + atEnd `shouldBe` True + it "bytestring stdin" $ do let bs :: IsString s => s bs = "this is a test" res <- readProcess (setStdin bs "cat") res `shouldBe` (ExitSuccess, bs, "") + it "null stdin" $ do + res <- readProcess (setStdin nullStream "cat") + res `shouldBe` (ExitSuccess, "", "") + + it "null stdout" $ do + -- In particular, writing to that doesn't terminate the process with an error + bs <- readProcessStderr_ $ setStdout nullStream $ setStdin nullStream $ + proc "sh" ["-c", "echo hello; echo world >&2"] + bs `shouldBe` "world\n" + + it "null stderr" $ do + -- In particular, writing to that doesn't terminate the process with an error + bs <- readProcessStdout_ $ setStderr nullStream $ setStdin nullStream $ + proc "sh" ["-c", "echo hello >&2; echo world"] + bs `shouldBe` "world\n" + it "useHandleOpen" $ withSystemTempFile "use-handle-open" $ \fp h -> do let bs :: IsString s => s bs = "this is a test 2" @@ -74,7 +99,7 @@ runProcess_ "false" `shouldThrow` \ExitCodeException{} -> True it "async" $ withSystemTempFile "httpbin" $ \fp h -> do - lbs <- withProcess (setStdin createPipe $ setStdout byteStringOutput "base64") $ \p -> + lbs <- withProcessWait (setStdin createPipe $ setStdout byteStringOutput "base64") $ \p -> runConcurrently $ Concurrently (do bs <- S.readFile "README.md" @@ -87,6 +112,31 @@ raw <- S.readFile fp encoded `shouldBe` B64.encode raw + describe "withProcessWait" $ do + it "succeeds with sleep" $ do + p <- withProcessWait (proc "sleep" ["1"]) pure + checkExitCode p + + describe "withProcessWait_" $ do + it "succeeds with sleep" $ do + withProcessWait_ (proc "sleep" ["1"]) $ const $ pure () + + -- These tests fail on older GHCs/process package versions + -- because, apparently, waitForProcess isn't interruptible. See + -- https://github.com/fpco/typed-process/pull/26#issuecomment-505702573. + + {- + describe "withProcessTerm" $ do + it "fails with sleep" $ do + p <- withProcessTerm (proc "sleep" ["1"]) pure + checkExitCode p `shouldThrow` anyException + + describe "withProcessTerm_" $ do + it "fails with sleep" $ + withProcessTerm_ (proc "sleep" ["1"]) (const $ pure ()) + `shouldThrow` anyException + -} + it "interleaved output" $ withSystemTempFile "interleaved-output" $ \fp h -> do S.hPut h "\necho 'stdout'\n>&2 echo 'stderr'\necho 'stdout'" hClose h diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/typed-process-0.2.4.1/typed-process.cabal new/typed-process-0.2.5.0/typed-process.cabal --- old/typed-process-0.2.4.1/typed-process.cabal 2019-06-07 12:37:33.000000000 +0200 +++ new/typed-process-0.2.5.0/typed-process.cabal 2019-06-25 10:04:51.000000000 +0200 @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1. +-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack -- --- hash: 377b4644a4d63eb0b81f60f4e7ec4b477eae658e463f90a600c923053da58712 +-- hash: ad27eee8ecda9f23b7e99ea05885ad76c916b5210115a132a56a28c79437d01c name: typed-process -version: 0.2.4.1 +version: 0.2.5.0 synopsis: Run external processes, with strong typing of streams description: Please see the tutorial at <https://haskell-lang.org/library/typed-process> category: System @@ -29,6 +29,7 @@ library exposed-modules: System.Process.Typed + System.Process.Typed.Internal other-modules: Paths_typed_process hs-source-dirs: