fix transferrer thread's use of transfer slots and transfer info files

Check first if a transfer needs to be done, using the location log only
(for speed), and avoid occupying a slot if not. Always write a transfer
info file, and keep it open throughout the tranfer process.

Now transfers to remotes seem reliable.
This commit is contained in:
Joey Hess 2012-07-07 10:50:20 -06:00
parent cc6f660752
commit cd168c6cba

View file

@ -13,9 +13,10 @@ import Assistant.DaemonStatus
import Assistant.TransferQueue
import Assistant.TransferSlots
import Logs.Transfer
import Logs.Presence
import Logs.Location
import Annex.Content
import Command
import qualified Command.Move
import qualified Remote
import Data.Time.Clock
import qualified Data.Map as M
@ -31,8 +32,7 @@ transfererThread st dstatus transferqueue slots = go
go = do
(t, info) <- getNextTransfer transferqueue
whenM (runThreadState st $ shouldTransfer dstatus t) $
void $ inTransferSlot slots $
runTransfer st dstatus t info
runTransfer st dstatus slots t info
go
{- Checks if the requested transfer is already running, or
@ -49,33 +49,54 @@ shouldTransfer dstatus t = go =<< currentTransfers <$> getDaemonStatus dstatus
{- A transfer is run in a separate process, with a *copy* of the Annex
- state. This is necessary to avoid blocking the rest of the assistant
- on the transfer completing, and also to allow multiple transfers to run
- at once.
- at once.
-
- However, it means that the transfer processes are responsible
- for doing any necessary shutdown cleanups, and that the parent
- thread's cache must be invalidated once a transfer completes, as
- changes may have been made to the git-annex branch.
-
- Currently a minimal shutdown is done; the transfer processes are
- effectively running in oneshot mode, without committing changes to the
- git-annex branch, and transfers should never queue git commands to run.
- changes may have been made to the git-annex branch.
-}
runTransfer :: ThreadState -> DaemonStatusHandle -> Transfer -> TransferInfo -> IO ()
runTransfer st dstatus t info
| transferDirection t == Download = go Command.Move.fromStart
| otherwise = go Command.Move.toStart
runTransfer :: ThreadState -> DaemonStatusHandle -> TransferSlots -> Transfer -> TransferInfo -> IO ()
runTransfer st dstatus slots t info = case (transferRemote info, associatedFile info) of
(Nothing, _) -> noop
(_, Nothing) -> noop
(Just remote, Just file) -> whenM (shouldtransfer remote) $ do
pid <- inTransferSlot slots $
unsafeForkProcessThreadState st $
transferprocess remote file
now <- getCurrentTime
runThreadState st $ adjustTransfers dstatus $
M.insertWith' const t info
{ startedTime = Just now
, transferPid = Just pid
, shouldWait = True
}
where
go cmd = case (transferRemote info, associatedFile info) of
(Nothing, _) -> noop
(_, Nothing) -> noop
(Just remote, Just file) -> do
now <- getCurrentTime
pid <- unsafeForkProcessThreadState st $
doCommand $ cmd remote False file (transferKey t)
runThreadState st $
adjustTransfers dstatus $
M.insertWith' const t info
{ startedTime = Just now
, transferPid = Just pid
, shouldWait = True
}
isdownload = transferDirection t == Download
tofrom
| isdownload = "from"
| otherwise = "to"
key = transferKey t
shouldtransfer remote
| isdownload = return True
| otherwise = runThreadState st $
{- Trust the location log to check if the
- remote already has the key. This avoids
- a roundtrip to the remote. -}
notElem (Remote.uuid remote)
<$> loggedLocations key
transferprocess remote file = do
showStart "copy" file
showAction $ tofrom ++ " " ++ Remote.name remote
ok <- transfer t (Just file) $
if isdownload
then getViaTmp key $
Remote.retrieveKeyFile remote key (Just file)
else do
ok <- Remote.storeKey remote key $ Just file
when ok $
Remote.logStatus remote key InfoPresent
return ok
showEndResult ok