diff options
author | Joey Hess <joey@kitenet.net> | 2011-11-09 18:33:15 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-11-09 18:33:15 -0400 |
commit | d3e1a3619ff6939367f43cbd46131b7f60ef6bd0 (patch) | |
tree | bc7e29364f11d3369730b0b61ad58e942b95d1cf /Annex | |
parent | 2934a65ac5bbab5ac127c495c8c2492e729c2b67 (diff) |
safer inannex checking
git-annex-shell inannex now returns always 0, 1, or 100 (the last when
it's unclear if content is currently in the index due to it currently being
moved or dropped).
(Actual locking code still not yet written.)
Diffstat (limited to 'Annex')
-rw-r--r-- | Annex/Content.hs | 36 |
1 files changed, 24 insertions, 12 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index dc714276d..efe12bb5d 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -7,8 +7,8 @@ module Annex.Content ( inAnnex, - lockExclusive, - lockShared, + inAnnexSafe, + lockContent, calcGitLink, logStatus, getViaTmp, @@ -36,22 +36,34 @@ import Types.Key import Utility.DataUnits import Config -{- Checks if a given key is currently present in the gitAnnexLocation. -} +{- Checks if a given key's content is currently present. -} inAnnex :: Key -> Annex Bool -inAnnex key = do +inAnnex = inAnnex' doesFileExist +inAnnex' :: (FilePath -> IO a) -> Key -> Annex a +inAnnex' a key = do whenM (fromRepo Git.repoIsUrl) $ error "inAnnex cannot check remote repo" - inRepo $ doesFileExist . gitAnnexLocation key + inRepo $ a . gitAnnexLocation key + +{- A safer check; the key's content must not only be present, but + - is not in the process of being removed. -} +inAnnexSafe :: Key -> Annex (Maybe Bool) +inAnnexSafe = inAnnex' $ \f -> do + e <- doesFileExist f + if e + then do + locked <- testlock f + if locked + then return Nothing + else return $ Just True + else return $ Just False + where + testlock f = return False -- TODO {- Content is exclusively locked to indicate that it's in the process of - being removed. -} -lockExclusive :: Key -> Annex a -> Annex a -lockExclusive key a = a -- TODO - -{- Things that rely on content being present can take a shared lock to - - avoid it vanishing from under them. -} -lockShared :: Key -> Annex a -> Annex a -lockShared key a = a -- TODO +lockContent :: Key -> Annex a -> Annex a +lockContent key a = a -- TODO {- Calculates the relative path to use to link a file to a key. -} calcGitLink :: FilePath -> Key -> Annex FilePath |