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

async proto fully tested and working

Browse source 
Including with a concurrent capable remote program.

However, this is not quite ready to merge, there's a TODO in the code.
This commit is contained in:
Joey Hess 2020-08-13 16:11:38 -04:00
parent 7546e686a2
commit 59cbb42ee2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 14 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
Remote/External/AsyncExtension.hs vendored
View file

@ -85,26 +85,21 @@ receiveloop external st newconns jidmap mapjid sendq = externalReceive st >>= \c
Just (_n, c) -> do
relayto c msg
loop
Nothing -> abort "unexpected RESULT-ASYNC"
Nothing -> protoerr "unexpected RESULT-ASYNC"
Just (START_ASYNC jid) -> getnext newconns >>= \case
Just v@(n, _c) -> do
atomically $ do
modifyTVar' jidmap $ M.insert jid v
modifyTVar' mapjid $ M.insert n jid
loop
Nothing -> abort "unexpected START-ASYNC"
Nothing -> protoerr "unexpected START-ASYNC"
Just (ASYNC jid msg) -> getjid jid >>= \case
Just (_n, c) -> do
relayto c msg
loop
Nothing -> abort "ASYNC with unknown jobid"
_ -> abort "unexpected non-async message"
Nothing -> do
-- Unable to receive anything more from the
-- process, so it's not usable any longer.
m <- readTVarIO jidmap
forM_ (M.elems m) (closerelayto . snd)
shutdown external st sendq True
Nothing -> protoerr "ASYNC with unknown jobid"
_ -> protoerr "unexpected non-async message"
Nothing -> closeandshutdown
where
loop = receiveloop external st newconns jidmap mapjid sendq
@ -120,9 +115,16 @@ receiveloop external st newconns jidmap mapjid sendq = externalReceive st >>= \c
getjid jid = M.lookup jid <$> readTVarIO jidmap
abort s = do
warningIO (protoerr s)
protoerr s = do
warningIO $ "async external special remote protocol error: " ++ s
closeandshutdown
closeandshutdown = do
shutdown external st sendq True
(m, l) <- atomically $ (,)
<$> readTVar jidmap
<*> readTVar newconns
forM_ (M.elems m ++ l) (closerelayto . snd)
sendloop :: ExternalState -> NewConns -> MapJid -> JidMap -> SendQueue -> IO ()
sendloop st newconns mapjid jidmap sendq = atomically (readTBMChan sendq) >>= \case
@ -168,6 +170,3 @@ shutdown external st sendq b = do
Just (ExternalAsync _) -> externalShutdown st b
_ -> noop
atomically $ closeTBMChan sendq
protoerr :: String -> String
protoerr s = "async external special remote protocol error: " ++ s