This commit is contained in:
Joey Hess 2015-10-01 14:07:06 -04:00
parent 9e3ac97608
commit 807ba6a903
2 changed files with 17 additions and 25 deletions

View file

@ -14,7 +14,6 @@ module Annex.Content (
inAnnexCheck, inAnnexCheck,
lockContent, lockContent,
getViaTmp, getViaTmp,
getViaTmpChecked,
getViaTmpUnchecked, getViaTmpUnchecked,
prepGetViaTmpChecked, prepGetViaTmpChecked,
prepTmp, prepTmp,
@ -213,21 +212,27 @@ lockContent key a = do
#endif #endif
{- Runs an action, passing it a temporary filename to get, {- Runs an action, passing it a temporary filename to get,
- and if the action succeeds, moves the temp file into - and if the action succeeds, verifies the file matches the key and
- the annex as a key's content. -} - moves the file into the annex as a key's content. -}
getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
getViaTmp = getViaTmpChecked (return True) getViaTmp key action = prepGetViaTmpChecked key False $
getViaTmpUnchecked key action
{- Like getViaTmp, but does not check that there is enough disk space {- Like getViaTmp, but does not check that there is enough disk space
- for the incoming key. For use when the key content is already on disk - for the incoming key. For use when the key content is already on disk
- and not being copied into place. -} - and not being copied into place. -}
getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool
getViaTmpUnchecked = finishGetViaTmp (return True) getViaTmpUnchecked key action = do
tmpfile <- prepTmp key
getViaTmpChecked :: Annex Bool -> Key -> (FilePath -> Annex Bool) -> Annex Bool ifM (action tmpfile)
getViaTmpChecked check key action = ( do
prepGetViaTmpChecked key False $ moveAnnex key tmpfile
finishGetViaTmp check key action logStatus key InfoPresent
return True
-- the tmp file is left behind, in case caller wants
-- to resume its transfer
, return False
)
{- Prepares to download a key via a tmp file, and checks that there is {- Prepares to download a key via a tmp file, and checks that there is
- enough free disk space. - enough free disk space.
@ -253,19 +258,6 @@ prepGetViaTmpChecked key unabletoget getkey = do
, return unabletoget , return unabletoget
) )
finishGetViaTmp :: Annex Bool -> Key -> (FilePath -> Annex Bool) -> Annex Bool
finishGetViaTmp check key action = do
tmpfile <- prepTmp key
ifM (action tmpfile <&&> check)
( do
moveAnnex key tmpfile
logStatus key InfoPresent
return True
-- the tmp file is left behind, in case caller wants
-- to resume its transfer
, return False
)
prepTmp :: Key -> Annex FilePath prepTmp :: Key -> Annex FilePath
prepTmp key = do prepTmp key = do
tmp <- fromRepo $ gitAnnexTmpObjectLocation key tmp <- fromRepo $ gitAnnexTmpObjectLocation key

View file

@ -502,8 +502,8 @@ copyToRemote' r key file p
ensureInitialized ensureInitialized
runTransfer (Transfer Download u key) file noRetry noObserver $ const $ runTransfer (Transfer Download u key) file noRetry noObserver $ const $
Annex.Content.saveState True `after` Annex.Content.saveState True `after`
Annex.Content.getViaTmpChecked (liftIO checksuccessio) key Annex.Content.getViaTmp key
(\dest -> mkCopier hardlink params object dest >>= \a -> a p) (\dest -> mkCopier hardlink params object dest >>= \a -> a p <&&> liftIO checksuccessio)
) )
fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool) fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)