diff options
| -rw-r--r-- | Assistant/ThreadedMonad.hs | 17 | ||||
| -rw-r--r-- | Assistant/Threads/Transferrer.hs | 16 |
2 files changed, 18 insertions, 15 deletions
diff --git a/Assistant/ThreadedMonad.hs b/Assistant/ThreadedMonad.hs index 4e871ab67..16f3a9dd9 100644 --- a/Assistant/ThreadedMonad.hs +++ b/Assistant/ThreadedMonad.hs @@ -12,6 +12,7 @@ import qualified Annex import Control.Concurrent import Data.Tuple +import System.Posix.Types {- The Annex state is stored in a MVar, so that threaded actions can access - it. -} @@ -37,14 +38,14 @@ withThreadState a = do runThreadState :: ThreadState -> Annex a -> IO 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 - - action to perform any necessary shutdown tasks in order for state to not - - be lost. And it's up to the caller to resynchronise with any changes - - the action makes to eg, the git-annex branch. + - It's up to the action to perform any necessary shutdown tasks in order + - for state to not be lost. And it's up to the caller to resynchronise + - with any changes the action makes to eg, the git-annex branch. -} -unsafeRunThreadState :: ThreadState -> Annex a -> IO a -unsafeRunThreadState mvar a = do +unsafeForkProcessThreadState :: ThreadState -> Annex a -> IO ProcessID +unsafeForkProcessThreadState mvar a = do state <- readMVar mvar - Annex.eval state a + forkProcess $ void $ Annex.eval state a diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs index 09c0aa036..f40218c08 100644 --- a/Assistant/Threads/Transferrer.hs +++ b/Assistant/Threads/Transferrer.hs @@ -14,7 +14,6 @@ import Assistant.TransferQueue import Assistant.TransferSlots import Logs.Transfer import Annex.Content -import Utility.ThreadScheduler import Command import qualified Command.Move @@ -27,11 +26,14 @@ maxTransfers = 1 {- Dispatches transfers from the queue. -} transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> TransferSlots -> IO () -transfererThread st dstatus transferqueue slots = runEvery (Seconds 1) $ do - (t, info) <- getNextTransfer transferqueue - whenM (runThreadState st $ shouldTransfer dstatus t) $ - void $ inTransferSlot slots $ - runTransfer st dstatus t info +transfererThread st dstatus transferqueue slots = go + where + go = do + (t, info) <- getNextTransfer transferqueue + whenM (runThreadState st $ shouldTransfer dstatus t) $ + void $ inTransferSlot slots $ + runTransfer st dstatus t info + go {- Checks if the requested transfer is already running, or - the file to download is already present. -} @@ -68,7 +70,7 @@ runTransfer st dstatus t info (_, Nothing) -> noop (Just remote, Just file) -> do now <- getCurrentTime - pid <- forkProcess $ unsafeRunThreadState st $ void $ + pid <- unsafeForkProcessThreadState st $ doCommand $ cmd remote False file (transferKey t) runThreadState st $ adjustTransfers dstatus $ |