diff options
| -rw-r--r-- | Annex/Content.hs | 31 | ||||
| -rw-r--r-- | Annex/Direct.hs | 8 | ||||
| -rw-r--r-- | Annex/Link.hs | 4 | ||||
| -rw-r--r-- | Assistant/Threads/Watcher.hs | 6 | ||||
| -rw-r--r-- | Backend.hs | 1 | ||||
| -rw-r--r-- | Command/Add.hs | 2 | ||||
| -rw-r--r-- | Locations.hs | 2 | ||||
| -rw-r--r-- | debian/changelog | 1 |
8 files changed, 34 insertions, 21 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index e9d5b6854..2a2b5641b 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -49,6 +49,7 @@ import Config import Annex.Exception import Git.SharedRepository import Annex.Perms +import Annex.Link import Annex.Content.Direct import Backend @@ -256,20 +257,33 @@ moveAnnex key src = withObjectLoc key storeobject storedirect updateInodeCache key src thawContent src replaceFile dest $ liftIO . moveFile src + {- Copy to any other locations. -} forM_ fs $ \f -> replaceFile f $ - void . liftIO . copyFileExternal dest + liftIO . void . copyFileExternal dest -{- Replaces any existing file with a new version, by running an action. - - First, makes sure the file is deleted. Or, if it didn't already exist, - - makes sure the parent directory exists. -} +{- 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 $ removeFile file + r <- tryIO $ rename tmpfile file case r of - Left _ -> createDirectoryIfMissing True $ parentDir file + Left _ -> do + createDirectoryIfMissing True $ parentDir file + rename tmpfile file _ -> noop - a file {- Runs an action to transfer an object's content. - @@ -366,8 +380,7 @@ removeAnnex key = withObjectLoc key remove removedirect cwd <- liftIO getCurrentDirectory let top' = fromMaybe top $ absNormPath cwd top let l' = relPathDirToFile top' (fromMaybe l $ absNormPath top' l) - replaceFile f $ const $ - makeAnnexLink l' f + replaceFile f $ makeAnnexLink l' {- Moves a key's file out of .git/annex/objects/ -} fromAnnex :: Key -> FilePath -> Annex () diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 1bebb2cb7..a88a045e7 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -153,8 +153,7 @@ mergeDirectCleanup d oldsha newsha = do - Symlinks are replaced with their content, if it's available. -} movein k f = do l <- calcGitLink f k - replaceFile f $ - makeAnnexLink l + replaceFile f $ makeAnnexLink l toDirect k f {- Any new, modified, or renamed files were written to the temp @@ -179,15 +178,14 @@ toDirectGen k f = do {- Move content from annex to direct file. -} updateInodeCache k loc thawContent loc - replaceFile f $ - liftIO . moveFile loc + replaceFile f $ liftIO . moveFile loc , return Nothing ) (loc':_) -> ifM (isNothing <$> getAnnexLinkTarget loc') {- Another direct file has the content; copy it. -} ( return $ Just $ replaceFile f $ - void . liftIO . copyFileExternal loc' + liftIO . void . copyFileExternal loc' , return Nothing ) diff --git a/Annex/Link.hs b/Annex/Link.hs index 650fc19a1..931836d31 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -60,7 +60,9 @@ getAnnexLinkTarget file = do -} makeAnnexLink :: LinkTarget -> FilePath -> Annex () makeAnnexLink linktarget file = ifM (coreSymlinks <$> Annex.getGitConfig) - ( liftIO $ createSymbolicLink linktarget file + ( liftIO $ do + void $ tryIO $ removeFile file + createSymbolicLink linktarget file , liftIO $ writeFile file linktarget ) diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index c41b17434..b20a8d4d7 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -222,9 +222,9 @@ onAddSymlink isdirect file filestatus = go =<< liftAnnex (Backend.lookupFile fil ifM ((==) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) ( ensurestaged (Just link) (Just key) =<< getDaemonStatus , do - unless isdirect $ do - liftIO $ removeFile file - liftAnnex $ Backend.makeAnnexLink link file + unless isdirect $ + liftAnnex $ replaceFile file $ + makeAnnexLink link addLink file link (Just key) ) go Nothing = do -- other symlink diff --git a/Backend.hs b/Backend.hs index 6bbf3f75e..8bf29846c 100644 --- a/Backend.hs +++ b/Backend.hs @@ -11,7 +11,6 @@ module Backend ( genKey, lookupFile, isAnnexLink, - makeAnnexLink, chooseBackend, lookupBackendName, maybeLookupBackendName diff --git a/Command/Add.hs b/Command/Add.hs index b90db8ba1..c15f3c51f 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -175,7 +175,7 @@ undo file key e = do link :: FilePath -> Key -> Bool -> Annex String link file key hascontent = handle (undo file key) $ do l <- calcGitLink file key - makeAnnexLink l file + replaceFile file $ makeAnnexLink l #ifndef __ANDROID__ when hascontent $ do diff --git a/Locations.hs b/Locations.hs index 9f892a8f3..1415adbca 100644 --- a/Locations.hs +++ b/Locations.hs @@ -148,7 +148,7 @@ gitAnnexObjectDir r = addTrailingPathSeparator $ Git.localGitDir r </> objectDir gitAnnexTmpDir :: Git.Repo -> FilePath gitAnnexTmpDir r = addTrailingPathSeparator $ gitAnnexDir r </> "tmp" -{- The temp file to use for a given key. -} +{- The temp file to use for a given key's content. -} gitAnnexTmpLocation :: Key -> Git.Repo -> FilePath gitAnnexTmpLocation key r = gitAnnexTmpDir r </> keyFile key diff --git a/debian/changelog b/debian/changelog index dc602e9e2..2e29c2cee 100644 --- a/debian/changelog +++ b/debian/changelog @@ -26,6 +26,7 @@ git-annex (4.20130324) UNRELEASED; urgency=low repositories. * assistant: Fix bug that could cause direct mode files to be unstaged from git. + * Update working tree files fully atomically. -- Joey Hess <joeyh@debian.org> Mon, 25 Mar 2013 10:21:46 -0400 |