diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs index c2990eabf2..fe976f88b1 100644 --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -208,7 +208,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do stageSymlink dest' =<< hashSymlink l replacewithsymlink dest link = withworktree dest $ \f -> - replaceFile f $ makeGitLink link . toRawFilePath + replaceWorkTreeFile f $ makeGitLink link . toRawFilePath makepointer key dest destmode = do unless inoverlay $ @@ -256,7 +256,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do , case selectwant' (LsFiles.unmergedSha u) of Nothing -> noop Just sha -> withworktree item $ \f -> - replaceFile f $ \tmp -> do + replaceWorkTreeFile f $ \tmp -> do c <- catObject sha liftIO $ L.writeFile tmp c ) diff --git a/Annex/Content/PointerFile.hs b/Annex/Content/PointerFile.hs index cf66801d94..91a982014f 100644 --- a/Annex/Content/PointerFile.hs +++ b/Annex/Content/PointerFile.hs @@ -39,7 +39,7 @@ populatePointerFile restage k obj f = go =<< liftIO (isPointerFile f) let f' = fromRawFilePath f destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f' liftIO $ nukeFile f' - (ic, populated) <- replaceFile f' $ \tmp -> do + (ic, populated) <- replaceWorkTreeFile f' $ \tmp -> do let tmp' = toRawFilePath tmp ok <- linkOrCopy k (fromRawFilePath obj) tmp destmode >>= \case Just _ -> thawContent tmp >> return True @@ -62,7 +62,7 @@ depopulatePointerFile key file = do let mode = fmap fileMode st secureErase file' liftIO $ nukeFile file' - ic <- replaceFile file' $ \tmp -> do + ic <- replaceWorkTreeFile file' $ \tmp -> do liftIO $ writePointerFile (toRawFilePath tmp) key mode #if ! defined(mingw32_HOST_OS) -- Don't advance mtime; this avoids unncessary re-smudging diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 48c604ed5e..2a1cf08ed2 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -274,7 +274,7 @@ restoreFile file key e = do makeLink :: FilePath -> Key -> Maybe InodeCache -> Annex String makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do l <- calcRepo $ gitAnnexLink file key - replaceFile file $ makeAnnexLink l . toRawFilePath + replaceWorkTreeFile file $ makeAnnexLink l . toRawFilePath -- touch symlink to have same time as the original file, -- as provided in the InodeCache diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index 129f8f6305..7fc513b59d 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -1,21 +1,48 @@ {- git-annex file replacing - - - Copyright 2013-2015 Joey Hess + - Copyright 2013-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} {-# LANGUAGE CPP #-} -module Annex.ReplaceFile where +module Annex.ReplaceFile ( + replaceGitAnnexDirFile, + replaceGitDirFile, + replaceWorkTreeFile, + replaceFile, +) where import Annex.Common import Annex.Tmp +import Annex.Perms +import Git import Utility.Tmp.Dir #ifndef mingw32_HOST_OS import Utility.Path.Max #endif +{- replaceFile on a file located inside the gitAnnexDir. -} +replaceGitAnnexDirFile :: FilePath -> (FilePath -> Annex a) -> Annex a +replaceGitAnnexDirFile = replaceFile createAnnexDirectory + +{- replaceFile on a file located inside the .git directory. -} +replaceGitDirFile :: FilePath -> (FilePath -> Annex a) -> Annex a +replaceGitDirFile = replaceFile $ \dir -> do + top <- fromRawFilePath <$> fromRepo localGitDir + liftIO $ createDirectoryUnder top dir + +{- replaceFile on a worktree file. -} +replaceWorkTreeFile :: FilePath -> (FilePath -> Annex a) -> Annex a +replaceWorkTreeFile = replaceFile $ \dir -> + fromRepo repoWorkTree >>= liftIO . \case + Just wt -> createDirectoryUnder (fromRawFilePath wt) dir + -- Should never happen, but let the file move be what + -- throws an exception as that would more clearly indicate + -- the problem. + Nothing -> noop + {- Replaces a possibly already existing file with a new version, - atomically, by running an action. - @@ -27,9 +54,12 @@ import Utility.Path.Max - will be deleted, and the existing file will be preserved. - - Throws an IO exception when it was unable to replace the file. + - + - The createdirectory action is only run when moving the file into place + - fails, and can create any parent directory structure needed. -} -replaceFile :: FilePath -> (FilePath -> Annex a) -> Annex a -replaceFile file action = withOtherTmp $ \othertmpdir -> do +replaceFile :: (FilePath -> Annex ()) -> FilePath -> (FilePath -> Annex a) -> Annex a +replaceFile createdirectory file action = withOtherTmp $ \othertmpdir -> do #ifndef mingw32_HOST_OS -- Use part of the filename as the template for the temp -- directory. This does not need to be unique, but it @@ -44,13 +74,13 @@ replaceFile file action = withOtherTmp $ \othertmpdir -> do withTmpDirIn othertmpdir basetmp $ \tmpdir -> do let tmpfile = tmpdir basetmp r <- action tmpfile - liftIO $ replaceFileFrom tmpfile file + replaceFileFrom tmpfile file createdirectory return r -replaceFileFrom :: FilePath -> FilePath -> IO () -replaceFileFrom src dest = go `catchIO` fallback +replaceFileFrom :: FilePath -> FilePath -> (FilePath -> Annex ()) -> Annex () +replaceFileFrom src dest createdirectory = go `catchIO` fallback where - go = moveFile src dest + go = liftIO $ moveFile src dest fallback _ = do - createDirectoryIfMissing True $ parentDir dest + createdirectory (parentDir dest) go diff --git a/Annex/WorkTree.hs b/Annex/WorkTree.hs index e31c143788..9ac59d8eb0 100644 --- a/Annex/WorkTree.hs +++ b/Annex/WorkTree.hs @@ -100,7 +100,7 @@ scanUnlockedFiles = whenM (inRepo Git.Ref.headExists <&&> not <$> isBareRepo) $ Just k' | k' == k -> do destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus f - ic <- replaceFile (fromRawFilePath f) $ \tmp -> do + ic <- replaceWorkTreeFile (fromRawFilePath f) $ \tmp -> do let tmp' = toRawFilePath tmp linkFromAnnex k tmp destmode >>= \case LinkAnnexOk -> diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 602fe893d9..80523b5e55 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -300,7 +300,7 @@ onAddSymlink' linktarget mk file filestatus = go mk if linktarget == Just link then ensurestaged (Just link) =<< getDaemonStatus else do - liftAnnex $ replaceFile file $ + liftAnnex $ replaceWorkTreeFile file $ makeAnnexLink link . toRawFilePath addLink file link (Just key) -- other symlink, not git-annex diff --git a/Command/Fix.hs b/Command/Fix.hs index e26d184092..31ec91e586 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -67,7 +67,7 @@ start fixwhat file key = do breakHardLink :: RawFilePath -> Key -> RawFilePath -> CommandPerform breakHardLink file key obj = do - replaceFile (fromRawFilePath file) $ \tmp -> do + replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file let obj' = fromRawFilePath obj unlessM (checkedCopyFile key obj' tmp mode) $ @@ -79,7 +79,7 @@ breakHardLink file key obj = do makeHardLink :: RawFilePath -> Key -> CommandPerform makeHardLink file key = do - replaceFile (fromRawFilePath file) $ \tmp -> do + replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file linkFromAnnex key tmp mode >>= \case LinkAnnexFailed -> error "unable to make hard link" diff --git a/Command/Fsck.hs b/Command/Fsck.hs index cee57c763b..ead4c4f102 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -332,7 +332,7 @@ verifyWorkTree key file = do case mk of Just k | k == key -> whenM (inAnnex key) $ do showNote "fixing worktree content" - replaceFile (fromRawFilePath file) $ \tmp -> do + replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file ifM (annexThin <$> Annex.getGitConfig) ( void $ linkFromAnnex key tmp mode diff --git a/Command/Lock.hs b/Command/Lock.hs index 6e8a7f4ffb..626d7cbc2d 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -74,7 +74,7 @@ performNew file key = do mfc <- withTSDelta (liftIO . genInodeCache file) unlessM (sameInodeCache obj (maybeToList mfc)) $ do let obj' = fromRawFilePath obj - modifyContent obj' $ replaceFile obj' $ \tmp -> do + modifyContent obj' $ replaceGitAnnexDirFile obj' $ \tmp -> do unlessM (checkedCopyFile key obj' tmp Nothing) $ giveup "unable to lock file" Database.Keys.storeInodeCaches key [obj] diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 52984928bd..068cefe8b9 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -93,7 +93,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file) st <- liftIO $ R.getFileStatus file when (linkCount st > 1) $ do freezeContent oldobj - replaceFile (fromRawFilePath file) $ \tmp -> do + replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $ error "can't lock old key" thawContent tmp diff --git a/Command/Unlock.hs b/Command/Unlock.hs index ce53b1d0bb..473dd0c002 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -29,9 +29,6 @@ mkcmd n d = withGlobalOptions [jsonOptions, annexedMatchingOptions] $ seek :: CmdParams -> CommandSeek seek ps = withFilesInGit (commandAction . whenAnnexed start) =<< workTreeItems ps -{- Before v6, the unlock subcommand replaces the symlink with a copy of - - the file's content. In v6 and above, it converts the file from a symlink - - to a pointer. -} start :: RawFilePath -> Key -> CommandStart start file key = ifM (isJust <$> isAnnexLink file) ( starting "unlock" (mkActionItem (key, AssociatedFile (Just file))) $ @@ -42,7 +39,7 @@ start file key = ifM (isJust <$> isAnnexLink file) perform :: RawFilePath -> Key -> CommandPerform perform dest key = do destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus dest - replaceFile (fromRawFilePath dest) $ \tmp -> + replaceWorkTreeFile (fromRawFilePath dest) $ \tmp -> ifM (inAnnex key) ( do r <- linkFromAnnex key tmp destmode diff --git a/Logs/File.hs b/Logs/File.hs index 72f22fdd24..6e6461a6c0 100644 --- a/Logs/File.hs +++ b/Logs/File.hs @@ -29,7 +29,7 @@ writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c withLogHandle :: FilePath -> (Handle -> Annex a) -> Annex a withLogHandle f a = do createAnnexDirectory (parentDir f) - replaceFile f $ \tmp -> + replaceGitAnnexDirFile f $ \tmp -> bracket (setup tmp) cleanup a where setup tmp = do