1113caa53e
When dropping an unlocked file, preserve its mtime, which avoids git status unncessarily running the clean filter on the file. If the index file has close to the same mtime as a work tree file, git will not trust the index to be up-to-date, and re-runs the clean filter unncessarily. Preserving the mtime when depopulating a pointer file avoids git status doing a little (or maybe a lot) of unncessary work. There are other places that the mtime could be preserved, including other places where pointer files are written perhaps, but also populatePointerFile. But, I don't know of cases where those lead to git status doing unncessary work, so I just fixed the one I'm aware of for now.
70 lines
2.1 KiB
Haskell
70 lines
2.1 KiB
Haskell
{- git-annex pointer files
|
|
-
|
|
- Copyright 2010-2018 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Annex.Content.PointerFile where
|
|
|
|
#if ! defined(mingw32_HOST_OS)
|
|
import System.Posix.Files
|
|
#else
|
|
import System.PosixCompat.Files
|
|
#endif
|
|
|
|
import Annex.Common
|
|
import Annex.Perms
|
|
import Annex.Link
|
|
import Annex.ReplaceFile
|
|
import Annex.InodeSentinal
|
|
import Annex.Content.LowLevel
|
|
import Utility.InodeCache
|
|
import Utility.Touch
|
|
|
|
{- 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 >>= \case
|
|
Just _ -> thawContent tmp >> return True
|
|
Nothing -> liftIO (writePointerFile tmp k destmode) >> return False
|
|
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
|
|
st <- liftIO $ catchMaybeIO $ getFileStatus file
|
|
let mode = fmap fileMode st
|
|
secureErase file
|
|
liftIO $ nukeFile file
|
|
ic <- replaceFile file $ \tmp -> do
|
|
liftIO $ writePointerFile tmp key mode
|
|
#if ! defined(mingw32_HOST_OS)
|
|
-- Don't advance mtime; this avoids unncessary re-smudging
|
|
-- by git in some cases.
|
|
liftIO $ maybe noop
|
|
(\t -> touch tmp t False)
|
|
(fmap modificationTimeHiRes st)
|
|
#endif
|
|
withTSDelta (liftIO . genInodeCache tmp)
|
|
maybe noop (restagePointerFile (Restage True) file) ic
|