fix: force lazy ByteString evaluation before waitForProcess to avoid deadlock
Build and Deploy / build-and-deploy (push) Successful in 1m45s
Build and Deploy / build-and-deploy (push) Successful in 1m45s
The lazy I/O in LB.hGetContents returns a thunk immediately without reading any data. If waitForProcess is called before the ByteString is forced, the parent blocks on the process while the child blocks on a full pipe buffer (no one is reading). Fix by computing LB.length (which forces full traversal) before calling waitForProcess.
This commit is contained in:
+13
-3
@@ -235,7 +235,11 @@ parseFormBody body =
|
|||||||
in toEnum hexVal : go rest
|
in toEnum hexVal : go rest
|
||||||
go (c : rest) = c : go rest
|
go (c : rest) = c : go rest
|
||||||
|
|
||||||
-- | Run a subprocess and capture stdout/stderr as raw bytes (no locale decoding).
|
{- | Run a subprocess and capture stdout/stderr as raw bytes (no locale decoding).
|
||||||
|
Reads output eagerly to avoid the classic lazy-IO deadlock where
|
||||||
|
the parent blocks on waitForProcess while the child blocks on a
|
||||||
|
full pipe buffer.
|
||||||
|
-}
|
||||||
readProcessBytes :: FilePath -> [String] -> IO (ExitCode, LB.ByteString, LB.ByteString)
|
readProcessBytes :: FilePath -> [String] -> IO (ExitCode, LB.ByteString, LB.ByteString)
|
||||||
readProcessBytes cmd args = do
|
readProcessBytes cmd args = do
|
||||||
let process =
|
let process =
|
||||||
@@ -244,14 +248,20 @@ readProcessBytes cmd args = do
|
|||||||
, std_err = CreatePipe
|
, std_err = CreatePipe
|
||||||
}
|
}
|
||||||
result <- createProcess process
|
result <- createProcess process
|
||||||
-- createProcess returns (stdin, stdout, stderr, process).
|
|
||||||
-- stdin is Inherited → Nothing; stdout/stderr are CreatePipe → Just.
|
|
||||||
case result of
|
case result of
|
||||||
(Nothing, Just outH, Just errH, ph) -> do
|
(Nothing, Just outH, Just errH, ph) -> do
|
||||||
hSetBinaryMode outH True
|
hSetBinaryMode outH True
|
||||||
hSetBinaryMode errH True
|
hSetBinaryMode errH True
|
||||||
|
-- Read stdout and stderr strictly before waiting for the process.
|
||||||
|
-- Using length forces the lazy ByteString, triggering eager reads
|
||||||
|
-- and preventing the pipe buffer from filling up.
|
||||||
|
-- hSetBuffering would also work but requires knowing a buffer size.
|
||||||
out <- LB.hGetContents outH
|
out <- LB.hGetContents outH
|
||||||
err <- LB.hGetContents errH
|
err <- LB.hGetContents errH
|
||||||
|
-- Force full evaluation before waitForProcess to avoid deadlock.
|
||||||
|
let outLen = LB.length out
|
||||||
|
errLen = LB.length err
|
||||||
|
outLen `seq` errLen `seq` do
|
||||||
ec <- waitForProcess ph
|
ec <- waitForProcess ph
|
||||||
pure (ec, out, err)
|
pure (ec, out, err)
|
||||||
_ ->
|
_ ->
|
||||||
|
|||||||
Reference in New Issue
Block a user