9ff1c62a4d
If a pointer file is being populated and something modifies it at the same time, there was a race there the modified file's InodeCache could get added into the keys database. Note that replaceFile normally renames the temp file into place, so the inode cache caculated for the temp file will still be good. If it has to fall back to a copy, the worktree file won't be put in the inode cache. This has the same result as if the worktree file gets touched, and will be handled the same way. Eg, when dropping, isUnmodified will do an expensive comparison and notice that the worktree file does have the same content, and so drop it. This commit was supported by the NSF-funded DataLad project.
58 lines
1.7 KiB
Haskell
58 lines
1.7 KiB
Haskell
{- git-annex pointer files
|
|
-
|
|
- Copyright 2010-2018 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Annex.Content.PointerFile where
|
|
|
|
import System.PosixCompat.Files
|
|
|
|
import Annex.Common
|
|
import Annex.Perms
|
|
import Annex.Link
|
|
import Annex.ReplaceFile
|
|
import Annex.InodeSentinal
|
|
import Utility.InodeCache
|
|
import Annex.Content.LowLevel
|
|
|
|
{- Populates a pointer file with the content of a key.
|
|
-
|
|
- If the file already has some other content, it is not modified.
|
|
-
|
|
- Returns an InodeCache if it populated the pointer file.
|
|
-}
|
|
populatePointerFile :: Restage -> Key -> FilePath -> FilePath -> Annex (Maybe InodeCache)
|
|
populatePointerFile restage k obj f = go =<< liftIO (isPointerFile f)
|
|
where
|
|
go (Just k') | k == k' = do
|
|
destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f
|
|
liftIO $ nukeFile f
|
|
(ic, populated) <- replaceFile f $ \tmp -> do
|
|
ok <- linkOrCopy k obj tmp destmode
|
|
if ok
|
|
then thawContent tmp
|
|
else liftIO $ writePointerFile tmp k destmode
|
|
ic <- withTSDelta (liftIO . genInodeCache tmp)
|
|
return (ic, ok)
|
|
maybe noop (restagePointerFile restage f) ic
|
|
if populated
|
|
then return ic
|
|
else return Nothing
|
|
go _ = return Nothing
|
|
|
|
{- Removes the content from a pointer file, replacing it with a pointer.
|
|
-
|
|
- Does not check if the pointer file is modified. -}
|
|
depopulatePointerFile :: Key -> FilePath -> Annex ()
|
|
depopulatePointerFile key file = do
|
|
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
|
|
secureErase file
|
|
liftIO $ nukeFile file
|
|
ic <- replaceFile file $ \tmp -> do
|
|
liftIO $ writePointerFile tmp key mode
|
|
withTSDelta (liftIO . genInodeCache tmp)
|
|
maybe noop (restagePointerFile (Restage True) file) ic
|