Revert "async exception safety for coprocesses"
This reverts commit 7013798df5
.
This commit is contained in:
parent
6b8c961e1f
commit
d66fc1a464
5 changed files with 32 additions and 48 deletions
|
@ -25,6 +25,8 @@ git-annex (8.20200618) UNRELEASED; urgency=medium
|
||||||
git configs with -c. (Since version 8.20200330.)
|
git configs with -c. (Since version 8.20200330.)
|
||||||
* Bring back git-annex branch read cache. This speeds up some operations;
|
* Bring back git-annex branch read cache. This speeds up some operations;
|
||||||
git-annex sync --content --all gets 20% faster.
|
git-annex sync --content --all gets 20% faster.
|
||||||
|
* Fix a recently introduced bug that could cause a "fork: resource exhausted"
|
||||||
|
after getting several thousand files.
|
||||||
|
|
||||||
-- Joey Hess <id@joeyh.name> Thu, 18 Jun 2020 12:21:14 -0400
|
-- Joey Hess <id@joeyh.name> Thu, 18 Jun 2020 12:21:14 -0400
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
{- Interface for running a shell command as a coprocess,
|
{- Interface for running a shell command as a coprocess,
|
||||||
- sending it queries and getting back results.
|
- sending it queries and getting back results.
|
||||||
-
|
-
|
||||||
- Copyright 2012-2020 Joey Hess <id@joeyh.name>
|
- Copyright 2012-2013 Joey Hess <id@joeyh.name>
|
||||||
-
|
-
|
||||||
- License: BSD-2-clause
|
- License: BSD-2-clause
|
||||||
-}
|
-}
|
||||||
|
@ -62,46 +62,28 @@ stop ch = do
|
||||||
let p = proc (coProcessCmd $ coProcessSpec s) (coProcessParams $ coProcessSpec s)
|
let p = proc (coProcessCmd $ coProcessSpec s) (coProcessParams $ coProcessSpec s)
|
||||||
forceSuccessProcess p (coProcessPid s)
|
forceSuccessProcess p (coProcessPid s)
|
||||||
|
|
||||||
{- Note that concurrent queries are not safe to perform; caller should
|
{- To handle a restartable process, any IO exception thrown by the send and
|
||||||
- serialize calls to query.
|
|
||||||
-
|
|
||||||
- To handle a restartable process, any IO exception thrown by the send and
|
|
||||||
- receive actions are assumed to mean communication with the process
|
- receive actions are assumed to mean communication with the process
|
||||||
- failed, and the query is re-run with a new process.
|
- failed, and the failed action is re-run with a new process. -}
|
||||||
-
|
|
||||||
- If an async exception is received during a query, the state of
|
|
||||||
- communication with the process is unknown, so it is killed, and a new
|
|
||||||
- one started so the CoProcessHandle can continue to be used by other
|
|
||||||
- threads.
|
|
||||||
-}
|
|
||||||
query :: CoProcessHandle -> (Handle -> IO a) -> (Handle -> IO b) -> IO b
|
query :: CoProcessHandle -> (Handle -> IO a) -> (Handle -> IO b) -> IO b
|
||||||
query ch send receive = uninterruptibleMask $ \unmask ->
|
query ch send receive = do
|
||||||
unmask (readMVar ch >>= restartable)
|
s <- readMVar ch
|
||||||
`catchAsync` forcerestart
|
restartable s (send $ coProcessTo s) $ const $
|
||||||
|
restartable s (hFlush $ coProcessTo s) $ const $
|
||||||
|
restartable s (receive $ coProcessFrom s)
|
||||||
|
return
|
||||||
where
|
where
|
||||||
go s = do
|
restartable s a cont
|
||||||
void $ send $ coProcessTo s
|
|
||||||
hFlush $ coProcessTo s
|
|
||||||
receive $ coProcessFrom s
|
|
||||||
|
|
||||||
restartable s
|
|
||||||
| coProcessNumRestarts (coProcessSpec s) > 0 =
|
| coProcessNumRestarts (coProcessSpec s) > 0 =
|
||||||
catchMaybeIO (go s)
|
maybe restart cont =<< catchMaybeIO a
|
||||||
>>= maybe (restart s increstarts restartable) return
|
| otherwise = cont =<< a
|
||||||
| otherwise = go s
|
restart = do
|
||||||
|
s <- takeMVar ch
|
||||||
increstarts s = s { coProcessNumRestarts = coProcessNumRestarts s - 1 }
|
void $ catchMaybeIO $ do
|
||||||
|
|
||||||
restart s f cont = do
|
|
||||||
void $ tryNonAsync $ do
|
|
||||||
hClose $ coProcessTo s
|
hClose $ coProcessTo s
|
||||||
hClose $ coProcessFrom s
|
hClose $ coProcessFrom s
|
||||||
void $ waitForProcess $ coProcessPid s
|
void $ waitForProcess $ coProcessPid s
|
||||||
s' <- withMVarMasked ch $ \_ -> start' (f (coProcessSpec s))
|
s' <- start' $ (coProcessSpec s)
|
||||||
cont s'
|
{ coProcessNumRestarts = coProcessNumRestarts (coProcessSpec s) - 1 }
|
||||||
|
putMVar ch s'
|
||||||
forcerestart ex = do
|
query ch send receive
|
||||||
s <- readMVar ch
|
|
||||||
terminateProcess (coProcessPid s)
|
|
||||||
restart s id $ \s' -> void $ swapMVar ch s'
|
|
||||||
either throwM throwM ex
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- Simple IO exception handling (and some more)
|
{- Simple IO exception handling (and some more)
|
||||||
-
|
-
|
||||||
- Copyright 2011-2020 Joey Hess <id@joeyh.name>
|
- Copyright 2011-2016 Joey Hess <id@joeyh.name>
|
||||||
-
|
-
|
||||||
- License: BSD-2-clause
|
- License: BSD-2-clause
|
||||||
-}
|
-}
|
||||||
|
@ -20,7 +20,6 @@ module Utility.Exception (
|
||||||
bracketIO,
|
bracketIO,
|
||||||
catchNonAsync,
|
catchNonAsync,
|
||||||
tryNonAsync,
|
tryNonAsync,
|
||||||
catchAsync,
|
|
||||||
tryWhenExists,
|
tryWhenExists,
|
||||||
catchIOErrorType,
|
catchIOErrorType,
|
||||||
IOErrorType(..),
|
IOErrorType(..),
|
||||||
|
@ -88,14 +87,6 @@ catchNonAsync a onerr = a `catches`
|
||||||
, M.Handler (\ (e :: SomeException) -> onerr e)
|
, M.Handler (\ (e :: SomeException) -> onerr e)
|
||||||
]
|
]
|
||||||
|
|
||||||
{- Catches only async exceptions. -}
|
|
||||||
catchAsync :: MonadCatch m => m a -> (Either AsyncException SomeAsyncException -> m a) -> m a
|
|
||||||
catchAsync a onerr = a `catches`
|
|
||||||
[ M.Handler (\ (e :: AsyncException) -> onerr (Left e))
|
|
||||||
, M.Handler (\ (e :: SomeAsyncException) -> onerr (Right e))
|
|
||||||
, M.Handler (\ (e :: SomeException) -> throwM e)
|
|
||||||
]
|
|
||||||
|
|
||||||
tryNonAsync :: MonadCatch m => m a -> m (Either SomeException a)
|
tryNonAsync :: MonadCatch m => m a -> m (Either SomeException a)
|
||||||
tryNonAsync a = go `catchNonAsync` (return . Left)
|
tryNonAsync a = go `catchNonAsync` (return . Left)
|
||||||
where
|
where
|
||||||
|
|
|
@ -29,3 +29,12 @@ without a problem. --[[Joey]]
|
||||||
> > is restarting git hash-object due to an IO exception:
|
> > is restarting git hash-object due to an IO exception:
|
||||||
> > "fd:12: hPutStr: illegal operation (handle is closed)
|
> > "fd:12: hPutStr: illegal operation (handle is closed)
|
||||||
> > I can't see anything that would close the handle early.
|
> > I can't see anything that would close the handle early.
|
||||||
|
> >
|
||||||
|
> > Reverted [[!commit 7013798df5a161f00962985ffaea613a87cc4fe4]]
|
||||||
|
> > on a hunch, and that seems to have fixed it. Which is very weird,
|
||||||
|
> > because AFAICS it was not getting an async exception. Even
|
||||||
|
> > removing the `catchAsync forcerestart` is enough to avoid the problem
|
||||||
|
> > though.
|
||||||
|
> >
|
||||||
|
> > [[fixed|done]] though without full understanding of what that commit
|
||||||
|
> > did that caused such strange behavior. --[[Joey]]
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
date="2020-06-04T19:39:23Z"
|
date="2020-06-04T19:39:23Z"
|
||||||
content="""
|
content="""
|
||||||
I've converted everything to withCreateProcess, except for process pools
|
I've converted everything to withCreateProcess, except for process pools
|
||||||
(P2P.IO, Assistant.TransferrerPool, Utility.CoProcess (update: done),
|
(P2P.IO, Assistant.TransferrerPool, Utility.CoProcess,
|
||||||
Remote.External (update: done),
|
Remote.External (update: done),
|
||||||
and P2PSshConnectionPool), which need to be handled as discussed in
|
and P2PSshConnectionPool), which need to be handled as discussed in
|
||||||
comment 8. And also Git.Command.pipeReadLazy may (or may not) need to be
|
comment 8. And also Git.Command.pipeReadLazy may (or may not) need to be
|
||||||
|
|
Loading…
Reference in a new issue