convert replaceFile to createDirectoryUnder

Since it was used on both worktree and .git/annex files, split into
multiple functions.

In passing, this also improves permissions of created directories in
.git/annex, using createAnnexDirectory on those.

diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs
index c2990eabf294b5dc053c3afeb19f9cc790d3021d..fe976f88b1e253e1ae250994198196aecd92fd72 100644 (file)
--- 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 cf66801d9402fb55d25cadfaa45fdde6baeef8e2..91a982014f4f9a15e875df1acdc27c0b66d6022a 100644 (file)
--- 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 48c604ed5e12ce49b962c9c0583393c5128b6943..2a1cf08ed262d0debec9df6ae598d9d84ccca7e2 100644 (file)
--- 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 129f8f6305a8d640481296783853b416aa0c64bf..7fc513b59dd73d8766f38ea357a63e20fa6561e2 100644 (file)
--- a/Annex/ReplaceFile.hs
+++ b/Annex/ReplaceFile.hs
@@ -1,21 +1,48 @@
 {- git-annex file replacing
  -
- - Copyright 2013-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>
  -
  - 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 e31c1437885f0eafd6f2785fd523f6c8f5882699..9ac59d8eb01875407877e251938e7fb781b0a38f 100644 (file)
--- 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 602fe893d9438ec056427290cb403bc9659be750..80523b5e550317c48c5cd4123664e2a0fefd6f60 100644 (file)
--- 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 e26d184092a7097688a6344d29dab5f87be21540..31ec91e586d224d251f415689c6093cd12ad9b9c 100644 (file)
--- 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 cee57c763b141a1026f53b1f40cb76338d36b593..ead4c4f102237f019b2deaeb54c935d2e881e23e 100644 (file)
--- 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 6e8a7f4ffb6257d40c410ca8cd818c5f8cd64edd..626d7cbc2d3c024af06e741c3eacc196237e9ee2 100644 (file)
--- 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 52984928bdb90e14d92607a15c21f3f7598bce23..068cefe8b9180cca2490446618aa415a7d3dc807 100644 (file)
--- 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 ce53b1d0bb966d08ad8aba78b88a728de2a7f5a9..473dd0c002c13eb9163f06509ec232afb517ff22 100644 (file)
--- 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 72f22fdd24e4abc1a6173943419bcbc7367cd573..6e6461a6c0f74869f3a07a7f93af6d735978351b 100644 (file)
--- 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