fixed close-together transfer race
The issue involved forking and they trying to read from a MVar. Reading the MVar 1st fixed it.
This commit is contained in:
parent
d6f65aed16
commit
d954a0ce59
2 changed files with 18 additions and 15 deletions
|
@ -12,6 +12,7 @@ import qualified Annex
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Data.Tuple
|
import Data.Tuple
|
||||||
|
import System.Posix.Types
|
||||||
|
|
||||||
{- The Annex state is stored in a MVar, so that threaded actions can access
|
{- The Annex state is stored in a MVar, so that threaded actions can access
|
||||||
- it. -}
|
- it. -}
|
||||||
|
@ -37,14 +38,14 @@ withThreadState a = do
|
||||||
runThreadState :: ThreadState -> Annex a -> IO a
|
runThreadState :: ThreadState -> Annex a -> IO a
|
||||||
runThreadState mvar a = modifyMVar mvar $ \state -> swap <$> Annex.run state a
|
runThreadState mvar a = modifyMVar mvar $ \state -> swap <$> Annex.run state a
|
||||||
|
|
||||||
{- Runs an Annex action, using a copy of the state from the MVar.
|
{- Runs an Annex action in a separate process, using a copy of the state
|
||||||
|
- from the MVar.
|
||||||
-
|
-
|
||||||
- The state modified by the action is thrown away, so it's up to the
|
- It's up to the action to perform any necessary shutdown tasks in order
|
||||||
- action to perform any necessary shutdown tasks in order for state to not
|
- for state to not be lost. And it's up to the caller to resynchronise
|
||||||
- be lost. And it's up to the caller to resynchronise with any changes
|
- with any changes the action makes to eg, the git-annex branch.
|
||||||
- the action makes to eg, the git-annex branch.
|
|
||||||
-}
|
-}
|
||||||
unsafeRunThreadState :: ThreadState -> Annex a -> IO a
|
unsafeForkProcessThreadState :: ThreadState -> Annex a -> IO ProcessID
|
||||||
unsafeRunThreadState mvar a = do
|
unsafeForkProcessThreadState mvar a = do
|
||||||
state <- readMVar mvar
|
state <- readMVar mvar
|
||||||
Annex.eval state a
|
forkProcess $ void $ Annex.eval state a
|
||||||
|
|
|
@ -14,7 +14,6 @@ import Assistant.TransferQueue
|
||||||
import Assistant.TransferSlots
|
import Assistant.TransferSlots
|
||||||
import Logs.Transfer
|
import Logs.Transfer
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import Utility.ThreadScheduler
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Command.Move
|
import qualified Command.Move
|
||||||
|
|
||||||
|
@ -27,11 +26,14 @@ maxTransfers = 1
|
||||||
|
|
||||||
{- Dispatches transfers from the queue. -}
|
{- Dispatches transfers from the queue. -}
|
||||||
transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> TransferSlots -> IO ()
|
transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> TransferSlots -> IO ()
|
||||||
transfererThread st dstatus transferqueue slots = runEvery (Seconds 1) $ do
|
transfererThread st dstatus transferqueue slots = go
|
||||||
(t, info) <- getNextTransfer transferqueue
|
where
|
||||||
whenM (runThreadState st $ shouldTransfer dstatus t) $
|
go = do
|
||||||
void $ inTransferSlot slots $
|
(t, info) <- getNextTransfer transferqueue
|
||||||
runTransfer st dstatus t info
|
whenM (runThreadState st $ shouldTransfer dstatus t) $
|
||||||
|
void $ inTransferSlot slots $
|
||||||
|
runTransfer st dstatus t info
|
||||||
|
go
|
||||||
|
|
||||||
{- Checks if the requested transfer is already running, or
|
{- Checks if the requested transfer is already running, or
|
||||||
- the file to download is already present. -}
|
- the file to download is already present. -}
|
||||||
|
@ -68,7 +70,7 @@ runTransfer st dstatus t info
|
||||||
(_, Nothing) -> noop
|
(_, Nothing) -> noop
|
||||||
(Just remote, Just file) -> do
|
(Just remote, Just file) -> do
|
||||||
now <- getCurrentTime
|
now <- getCurrentTime
|
||||||
pid <- forkProcess $ unsafeRunThreadState st $ void $
|
pid <- unsafeForkProcessThreadState st $
|
||||||
doCommand $ cmd remote False file (transferKey t)
|
doCommand $ cmd remote False file (transferKey t)
|
||||||
runThreadState st $
|
runThreadState st $
|
||||||
adjustTransfers dstatus $
|
adjustTransfers dstatus $
|
||||||
|
|
Loading…
Add table
Reference in a new issue