From bab88f3596c570346a3d069af9e3c8ed92e473c9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 8 Oct 2015 14:27:37 -0400 Subject: add lockContentShared Also, rename lockContent to lockContentExclusive inAnnexSafe should perhaps be eliminated, and instead use `lockContentShared inAnnex`. However, I'm waiting on that, as there are only 2 call sites for inAnnexSafe and it's fiddly. --- Annex/Content.hs | 118 +++++++++++++++++++++++++++++++------------- Assistant/Unused.hs | 2 +- Command/Drop.hs | 6 +-- Command/DropKey.hs | 2 +- Command/Move.hs | 2 +- Command/TestRemote.hs | 10 ++-- Command/Uninit.hs | 2 +- Remote/Git.hs | 2 +- Utility/LockPool/Posix.hs | 1 + Utility/LockPool/Windows.hs | 1 + 10 files changed, 98 insertions(+), 48 deletions(-) diff --git a/Annex/Content.hs b/Annex/Content.hs index 5032e2691..14dc4d4e5 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -12,7 +12,8 @@ module Annex.Content ( inAnnex', inAnnexSafe, inAnnexCheck, - lockContent, + lockContentShared, + lockContentExclusive, getViaTmp, getViaTmp', checkDiskSpaceToGet, @@ -165,57 +166,104 @@ contentLockFile key = ifM isDirect contentLockFile key = Just <$> calcRepo (gitAnnexContentLock key) #endif -newtype ContentLock = ContentLock Key +{- Prevents the content from being removed while the action is running. + - Uses a shared lock. + - + - Does not actually check if the content is present. Use inAnnex for that. + - However, since the contentLockFile is the content file in indirect mode, + - if the content is not present, locking it will fail. + - + - If locking fails, throws an exception rather than running the action. + - + - Note that, in direct mode, nothing prevents the user from directly + - editing or removing the content, even while it's locked by this. + -} +lockContentShared :: Key -> Annex a -> Annex a +lockContentShared = lockContentUsing lock + where +#ifndef mingw32_HOST_OS + lock contentfile Nothing = liftIO $ tryLockShared Nothing contentfile + lock _ (Just lockfile) = posixLocker tryLockShared lockfile +#else + lock = winLocker lockShared +#endif + +newtype ContentLockExclusive = ContentLockExclusive Key -{- Content is exclusively locked while running an action that might remove - - it. (If the content is not present, no locking is done.) +{- Exclusively locks content, while performing an action that + - might remove it. + - + - (If the content is not present, no locking is done.) -} -lockContent :: Key -> (ContentLock -> Annex a) -> Annex a -lockContent key a = do +lockContentExclusive :: Key -> (ContentLockExclusive -> Annex a) -> Annex a +lockContentExclusive key a = lockContentUsing lock key $ + a $ ContentLockExclusive key + where +#ifndef mingw32_HOST_OS + {- Since content files are stored with the write bit disabled, have + - to fiddle with permissions to open for an exclusive lock. -} + lock contentfile Nothing = bracket_ + (thawContent contentfile) + (freezeContent contentfile) + (liftIO $ tryLockExclusive Nothing contentfile) + lock _ (Just lockfile) = posixLocker tryLockExclusive lockfile +#else + lock = winLocker lockExclusive +#endif + +{- Passed the object content file, and maybe a separate lock file to use, + - when the content file itself should not be locked. -} +type ContentLocker = FilePath -> Maybe LockFile -> Annex (Maybe LockHandle) + +#ifndef mingw32_HOST_OS +posixLocker :: (Maybe FileMode -> LockFile -> IO (Maybe LockHandle)) -> LockFile -> Annex (Maybe LockHandle) +posixLocker takelock lockfile = do + mode <- annexFileMode + modifyContent lockfile $ + liftIO $ takelock (Just mode) lockfile + +#else +winLocker :: (LockFile -> IO (Maybe LockHandle)) -> ContentLocker +winLocker takelock _ (Just lockfile) = do + modifyContent lockfile $ + void $ liftIO $ tryIO $ + writeFile lockfile "" + liftIO $ takelock lockfile +-- never reached; windows always uses a separate lock file +winLocker _ _ Nothing = return Nothing +#endif + +lockContentUsing :: ContentLocker -> Key -> Annex a -> Annex a +lockContentUsing locker key a = do contentfile <- calcRepo $ gitAnnexLocation key lockfile <- contentLockFile key bracket (lock contentfile lockfile) (unlock lockfile) - (const $ a $ ContentLock key ) + (const $ a) where alreadylocked = error "content is locked" - cleanuplockfile lockfile = modifyContent lockfile $ - void $ liftIO $ tryIO $ - nukeFile lockfile -#ifndef mingw32_HOST_OS - {- Since content files are stored with the write bit disabled, have - - to fiddle with permissions to open for an exclusive lock. -} - lock contentfile Nothing = trylock $ bracket_ - (thawContent contentfile) - (freezeContent contentfile) + failedtolock e = error $ "failed to lock content: " ++ show e + + lock contentfile lockfile = (maybe alreadylocked return - =<< liftIO (tryLockExclusive Nothing contentfile)) - lock _ (Just lockfile) = trylock $ do - mode <- annexFileMode - maybe alreadylocked return - =<< modifyContent lockfile - (liftIO $ tryLockExclusive (Just mode) lockfile) + =<< locker contentfile lockfile) + `catchIO` failedtolock + +#ifndef mingw32_HOST_OS unlock mlockfile lck = do maybe noop cleanuplockfile mlockfile liftIO $ dropLock lck - - failedtolock e = error $ "failed to lock content: " ++ show e - trylock locker = locker `catchIO` failedtolock #else - lock _ (Just lockfile) = do - modifyContent lockfile $ - void $ liftIO $ tryIO $ - writeFile lockfile "" - maybe alreadylocked (return . Just) - =<< liftIO (lockExclusive lockfile) - -- never reached; windows always uses a separate lock file - lock _ Nothing = return Nothing unlock mlockfile mlockhandle = do liftIO $ maybe noop dropLock mlockhandle maybe noop cleanuplockfile mlockfile #endif + cleanuplockfile lockfile = modifyContent lockfile $ + void $ liftIO $ tryIO $ + nukeFile lockfile + {- Runs an action, passing it the temp file to get, - and if the action succeeds, verifies the file matches - the key and moves the file into the annex as a key's content. -} @@ -497,8 +545,8 @@ cleanObjectLoc key cleaner = do - In direct mode, deletes the associated files or files, and replaces - them with symlinks. -} -removeAnnex :: ContentLock -> Annex () -removeAnnex (ContentLock key) = withObjectLoc key remove removedirect +removeAnnex :: ContentLockExclusive -> Annex () +removeAnnex (ContentLockExclusive key) = withObjectLoc key remove removedirect where remove file = cleanObjectLoc key $ do secureErase file diff --git a/Assistant/Unused.hs b/Assistant/Unused.hs index 194739367..c71604679 100644 --- a/Assistant/Unused.hs +++ b/Assistant/Unused.hs @@ -77,7 +77,7 @@ expireUnused duration = do forM_ oldkeys $ \k -> do debug ["removing old unused key", key2file k] liftAnnex $ do - lockContent k removeAnnex + lockContentExclusive k removeAnnex logStatus k InfoMissing where boundry = durationToPOSIXTime <$> duration diff --git a/Command/Drop.hs b/Command/Drop.hs index b23f81758..6bbdb58fd 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -88,12 +88,12 @@ startRemote afile numcopies key remote = do showStart' ("drop " ++ Remote.name remote) key afile next $ performRemote key afile numcopies remote --- Note that lockContent is called before checking if the key is present --- on enough remotes to allow removal. This avoids a scenario where two +-- Note that lockContentExclusive is called before checking if the key is +-- present on enough remotes to allow removal. This avoids a scenario where two -- or more remotes are trying to remove a key at the same time, and each -- see the key is present on the other. performLocal :: Key -> AssociatedFile -> NumCopies -> Maybe Remote -> CommandPerform -performLocal key afile numcopies knownpresentremote = lockContent key $ \contentlock -> do +performLocal key afile numcopies knownpresentremote = lockContentExclusive key $ \contentlock -> do (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key let trusteduuids' = case knownpresentremote of Nothing -> trusteduuids diff --git a/Command/DropKey.hs b/Command/DropKey.hs index 5d44f0fcd..cdb19cabb 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -31,7 +31,7 @@ start key = stopUnless (inAnnex key) $ do next $ perform key perform :: Key -> CommandPerform -perform key = lockContent key $ \contentlock -> do +perform key = lockContentExclusive key $ \contentlock -> do removeAnnex contentlock next $ cleanup key diff --git a/Command/Move.hs b/Command/Move.hs index a83ea04dd..072c00663 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -123,7 +123,7 @@ toPerform dest move key afile fastcheck isthere = finish where finish - | move = lockContent key $ \contentlock -> do + | move = lockContentExclusive key $ \contentlock -> do removeAnnex contentlock next $ Command.Drop.cleanupLocal key | otherwise = next $ return True diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index 7ee5f1359..3a44a1bde 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -120,7 +120,7 @@ test st r k = , check "storeKey when already present" store , present True , check "retrieveKeyFile" $ do - lockContent k removeAnnex + lockContentExclusive k removeAnnex get , check "fsck downloaded object" fsck , check "retrieveKeyFile resume from 33%" $ do @@ -130,20 +130,20 @@ test st r k = sz <- hFileSize h L.hGet h $ fromInteger $ sz `div` 3 liftIO $ L.writeFile tmp partial - lockContent k removeAnnex + lockContentExclusive k removeAnnex get , check "fsck downloaded object" fsck , check "retrieveKeyFile resume from 0" $ do tmp <- prepTmp k liftIO $ writeFile tmp "" - lockContent k removeAnnex + lockContentExclusive k removeAnnex get , check "fsck downloaded object" fsck , check "retrieveKeyFile resume from end" $ do loc <- Annex.calcRepo (gitAnnexLocation k) tmp <- prepTmp k void $ liftIO $ copyFileExternal CopyAllMetaData loc tmp - lockContent k removeAnnex + lockContentExclusive k removeAnnex get , check "fsck downloaded object" fsck , check "removeKey when present" remove @@ -189,7 +189,7 @@ testUnavailable st r k = cleanup :: [Remote] -> [Key] -> Bool -> CommandCleanup cleanup rs ks ok = do forM_ rs $ \r -> forM_ ks (Remote.removeKey r) - forM_ ks $ \k -> lockContent k removeAnnex + forM_ ks $ \k -> lockContentExclusive k removeAnnex return ok chunkSizes :: Int -> Bool -> [Int] diff --git a/Command/Uninit.hs b/Command/Uninit.hs index c49cc4ba0..38e062002 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -105,7 +105,7 @@ removeUnannexed = go [] go c [] = return c go c (k:ks) = ifM (inAnnexCheck k $ liftIO . enoughlinks) ( do - lockContent k removeAnnex + lockContentExclusive k removeAnnex go c ks , go (k:c) ks ) diff --git a/Remote/Git.hs b/Remote/Git.hs index f7a0b4a39..8f7e69cbd 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -350,7 +350,7 @@ dropKey r key commitOnCleanup r $ onLocal r $ do ensureInitialized whenM (Annex.Content.inAnnex key) $ do - Annex.Content.lockContent key + Annex.Content.lockContentExclusive key Annex.Content.removeAnnex logStatus key InfoMissing Annex.Content.saveState True diff --git a/Utility/LockPool/Posix.hs b/Utility/LockPool/Posix.hs index 82e0c8e5e..db6b1d3dd 100644 --- a/Utility/LockPool/Posix.hs +++ b/Utility/LockPool/Posix.hs @@ -6,6 +6,7 @@ -} module Utility.LockPool.Posix ( + P.LockFile, LockHandle, lockShared, lockExclusive, diff --git a/Utility/LockPool/Windows.hs b/Utility/LockPool/Windows.hs index 754650c30..a88525a9b 100644 --- a/Utility/LockPool/Windows.hs +++ b/Utility/LockPool/Windows.hs @@ -6,6 +6,7 @@ -} module Utility.LockPool.Windows ( + P.LockFile, LockHandle, lockShared, lockExclusive, -- cgit v1.2.3