mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

convert to withCreateProcess for async exception safety

Browse source 
Not yet 100% done, so far I've grepped for waitForProcess and converted
everything that uses that to start the process with withCreateProcess.

Except for some things like P2P.IO and Assistant.TransferrerPool,
and Utility.CoProcess, that manage a pool of processes. See #2
in https://git-annex.branchable.com/todo/more_extensive_retries_to_mask_transient_failures/#comment-209f8a8c38e63fb3a704e1282cb269c7
for how those will need to be dealt with.

checkSuccessProcess, ignoreFailureProcess, and forceSuccessProcess calls waitForProcess, so
callers of them will also need to be dealt with, and have not been yet.
This commit is contained in:
Joey Hess 2020-06-03 15:48:09 -04:00
parent 1ee5919d1e
commit 92f775eba0
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
9 changed files with 68 additions and 65 deletions
Download patch file Download diff file Expand all files Collapse all files

31
Utility/Process/Transcript.hs
View file

@ -50,31 +50,28 @@ processTranscript'' cp input = do
System.Posix.IO.setFdOption writef System.Posix.IO.CloseOnExec True
readh <- System.Posix.IO.fdToHandle readf
writeh <- System.Posix.IO.fdToHandle writef
p@(_, _, _, pid) <- createProcess $ cp
{ std_in = if isJust input then CreatePipe else Inherit
, std_out = UseHandle writeh
, std_err = UseHandle writeh
}
hClose writeh
withCreateProcess cp $ \hin hout herr pid -> do
hClose writeh
get <- asyncreader readh
writeinput input p
transcript <- wait get
get <- asyncreader readh
writeinput input (hin, hout, herr, pid)
transcript <- wait get
#else
{- This implementation for Windows puts stderr after stdout. -}
p@(_, _, _, pid) <- createProcess $ cp
let cp' = cp
{ std_in = if isJust input then CreatePipe else Inherit
, std_out = CreatePipe
, std_err = CreatePipe
}
getout <- asyncreader (stdoutHandle p)
geterr <- asyncreader (stderrHandle p)
writeinput input p
transcript <- (++) <$> wait getout <*> wait geterr
withCreateProcess cp' \hin hout herr pid -> do
let p = (hin, hout, herr, pid)
getout <- asyncreader (stdoutHandle p)
geterr <- asyncreader (stderrHandle p)
writeinput input p
transcript <- (++) <$> wait getout <*> wait geterr
#endif
code <- waitForProcess pid
return (transcript, code)
code <- waitForProcess pid
return (transcript, code)
where
asyncreader = async . hGetContentsStrict