diff options
| -rw-r--r-- | Annex/Content.hs | 52 | ||||
| -rw-r--r-- | debian/changelog | 1 |
2 files changed, 40 insertions, 13 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index efe12bb5d..65dbe43f6 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -23,6 +23,9 @@ module Annex.Content ( saveState ) where +import Control.Exception (bracket_) +import System.Posix.Types + import Common.Annex import Logs.Location import Annex.UUID @@ -35,6 +38,7 @@ import Utility.FileMode import Types.Key import Utility.DataUnits import Config +import Annex.Exception {- Checks if a given key's content is currently present. -} inAnnex :: Key -> Annex Bool @@ -48,22 +52,44 @@ inAnnex' a key = do {- 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 +inAnnexSafe = inAnnex' $ \f -> openForLock f False >>= check where - testlock f = return False -- TODO + check Nothing = return is_missing + check (Just h) = do + v <- getLock h (ReadLock, AbsoluteSeek, 0, 0) + closeFd h + return $ case v of + Just _ -> is_locked + Nothing -> is_unlocked + is_locked = Nothing + is_unlocked = Just True + is_missing = Just False -{- Content is exclusively locked to indicate that it's in the process of - - being removed. -} +{- Content is exclusively locked to indicate that it's in the process + - of being removed. (If the content is not present, no locking is done.) -} lockContent :: Key -> Annex a -> Annex a -lockContent key a = a -- TODO +lockContent key a = do + file <- fromRepo $ gitAnnexLocation key + bracketIO (openForLock file True >>= lock) unlock a + where + lock Nothing = return Nothing + lock (Just l) = do + setLock l (WriteLock, AbsoluteSeek, 0, 0) + return $ Just l + unlock Nothing = return () + unlock (Just l) = closeFd l + +openForLock :: FilePath -> Bool -> IO (Maybe Fd) +openForLock file writelock = bracket_ prep cleanup $ + catch (Just <$> openFd file mode Nothing defaultFileFlags) + (const $ return Nothing) + where + mode = if writelock then ReadWrite else ReadOnly + -- Since files are stored with the write bit disabled, + -- have to fiddle with permissions to open for an + -- exclusive lock. + prep = when writelock $ allowWrite file + cleanup = when writelock $ preventWrite file {- Calculates the relative path to use to link a file to a key. -} calcGitLink :: FilePath -> Key -> Annex FilePath diff --git a/debian/changelog b/debian/changelog index 265a010c4..9fa96e06a 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,6 +2,7 @@ git-annex (3.20111108) UNRELEASED; urgency=low * Handle a case where an annexed file is moved into a gitignored directory, by having fix --force add its change. + * Avoid cyclic drop problems. -- Joey Hess <joeyh@debian.org> Mon, 07 Nov 2011 18:08:42 -0400 |