diff options
| -rw-r--r-- | Annex/Content.hs | 34 | ||||
| -rw-r--r-- | Annex/Content/Direct.hs | 14 | ||||
| -rw-r--r-- | Annex/Direct.hs | 3 | ||||
| -rw-r--r-- | Annex/ReplaceFile.hs | 35 | ||||
| -rw-r--r-- | Assistant/Threads/Watcher.hs | 2 | ||||
| -rw-r--r-- | Command/Add.hs | 6 |
6 files changed, 63 insertions, 31 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 5ec3c1b3f..9f8659fb5 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -28,7 +28,6 @@ module Annex.Content ( preseedTmp, freezeContent, thawContent, - replaceFile, cleanObjectLoc, ) where @@ -53,6 +52,7 @@ import Git.SharedRepository import Annex.Perms import Annex.Link import Annex.Content.Direct +import Annex.ReplaceFile {- Checks if a given key's content is currently present. -} inAnnex :: Key -> Annex Bool @@ -256,38 +256,14 @@ moveAnnex key src = withObjectLoc key storeobject storedirect validsymlink f = (==) (Just key) <$> isAnnexLink f storedirect' [] = storeobject =<< calcRepo (gitAnnexLocation key) - storedirect' (dest:fs) = do + storedirect' (f:fs) = do thawContentDir =<< calcRepo (gitAnnexLocation key) updateInodeCache key src thawContent src - replaceFile dest $ liftIO . moveFile src + replaceFile f $ liftIO . moveFile src {- Copy to any other locations. -} - forM_ fs $ \f -> replaceFile f $ - liftIO . void . copyFileExternal dest - -{- Replaces a possibly already existing file with a new version, - - atomically, by running an action. - - - The action is passed a temp file, which it can write to, and once - - done the temp file is moved into place. - -} -replaceFile :: FilePath -> (FilePath -> Annex ()) -> Annex () -replaceFile file a = do - tmpdir <- fromRepo gitAnnexTmpDir - createAnnexDirectory tmpdir - tmpfile <- liftIO $ do - (tmpfile, h) <- openTempFileWithDefaultPermissions tmpdir $ - takeFileName file - hClose h - return tmpfile - a tmpfile - liftIO $ do - r <- tryIO $ rename tmpfile file - case r of - Left _ -> do - createDirectoryIfMissing True $ parentDir file - rename tmpfile file - _ -> noop + forM_ fs $ + addContentWhenNotPresent key f {- Runs an action to transfer an object's content. - diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index b885b5e5b..49d317258 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -23,6 +23,7 @@ module Annex.Content.Direct ( toInodeCache, inodesChanged, createInodeSentinalFile, + addContentWhenNotPresent, ) where import Common.Annex @@ -32,6 +33,9 @@ import qualified Git import Utility.Tmp import Logs.Location import Utility.InodeCache +import Utility.CopyFile +import Annex.ReplaceFile +import Annex.Link {- Absolute FilePaths of Files in the tree that are associated with a key. -} associatedFiles :: Key -> Annex [FilePath] @@ -180,6 +184,16 @@ elemInodeCaches c (l:ls) = ifM (compareInodeCaches c l) compareInodeCachesWith :: Annex InodeComparisonType compareInodeCachesWith = ifM inodesChanged ( return Weakly, return Strongly ) +{- Copies the contentfile to the associated file, if the associated + - file has not content. If the associated file does have content, + - even if the content differs, it's left unchanged. -} +addContentWhenNotPresent :: Key -> FilePath -> FilePath -> Annex () +addContentWhenNotPresent key contentfile associatedfile = do + v <- isAnnexLink associatedfile + when (Just key == v) $ + replaceFile associatedfile $ + liftIO . void . copyFileExternal contentfile + {- Some filesystems get new inodes each time they are mounted. - In order to work on such a filesystem, a sentinal file is used to detect - when the inodes have changed. diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 67822f2d5..02fdb2430 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -26,6 +26,7 @@ import Annex.Link import Utility.InodeCache import Utility.CopyFile import Annex.Perms +import Annex.ReplaceFile {- Uses git ls-files to find files that need to be committed, and stages - them into the index. Returns True if some changes were staged. -} @@ -191,7 +192,7 @@ toDirectGen k f = do {- Move content from annex to direct file. -} thawContentDir loc updateInodeCache k loc - addAssociatedFile k f + void $ addAssociatedFile k f thawContent loc replaceFile f $ liftIO . moveFile loc fromdirect = do diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs new file mode 100644 index 000000000..f0dfa5b27 --- /dev/null +++ b/Annex/ReplaceFile.hs @@ -0,0 +1,35 @@ +{- git-annex file replacing + - + - Copyright 2013 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.ReplaceFile where + +import Common.Annex +import Annex.Perms + +{- Replaces a possibly already existing file with a new version, + - atomically, by running an action. + - + - The action is passed a temp file, which it can write to, and once + - done the temp file is moved into place. + -} +replaceFile :: FilePath -> (FilePath -> Annex ()) -> Annex () +replaceFile file a = do + tmpdir <- fromRepo gitAnnexTmpDir + createAnnexDirectory tmpdir + tmpfile <- liftIO $ do + (tmpfile, h) <- openTempFileWithDefaultPermissions tmpdir $ + takeFileName file + hClose h + return tmpfile + a tmpfile + liftIO $ do + r <- tryIO $ rename tmpfile file + case r of + Left _ -> do + createDirectoryIfMissing True $ parentDir file + rename tmpfile file + _ -> noop diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 88efa39d8..2c124776d 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -30,12 +30,12 @@ import qualified Git import qualified Git.UpdateIndex import qualified Git.LsFiles as LsFiles import qualified Backend -import Annex.Content import Annex.Direct import Annex.Content.Direct import Annex.CatFile import Annex.Link import Annex.FileMatcher +import Annex.ReplaceFile import Git.Types import Config import Utility.ThreadScheduler diff --git a/Command/Add.hs b/Command/Add.hs index 95af72a6f..be7c6e75e 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -30,6 +30,7 @@ import Utility.FileMode import Config import Utility.InodeCache import Annex.FileMatcher +import Annex.ReplaceFile def :: [Command] def = [notBareRepo $ command "add" paramPaths seek SectionCommon @@ -155,6 +156,11 @@ finishIngestDirect key source = do when (contentLocation source /= keyFilename source) $ liftIO $ nukeFile $ contentLocation source + {- Copy to any other locations using the same key. -} + otherfs <- filter (/= keyFilename source) <$> associatedFiles key + forM_ otherfs $ + addContentWhenNotPresent key (keyFilename source) + perform :: FilePath -> CommandPerform perform file = maybe stop (\key -> next $ cleanup file key True) |