Update working tree files fully atomically

This avoids commit churn by the assistant when eg,
replacing a file with a symlink.

But, just as importantly, it prevents the working tree being left with a
deleted file if git-annex, or perhaps the whole system, crashes at the
wrong time.

(It also probably avoids confusing displays in file managers.)

diff --git a/Annex/Content.hs b/Annex/Content.hs
index e9d5b6854eaa3b2204d7929e72b2cd68555727da..2a2b5641b6cf7befbdb2af63420b011f0b8443bc 100644 (file)
--- 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 1bebb2cb719807cb5d47eb820fd81d83fe4826eb..a88a045e77d38e2db661f5a7a167bfad2c5665a2 100644 (file)
--- 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 650fc19a1cd6dd2c06c1c1c551a5418819ded64f..931836d31b2458aa29661b2192520cecbd434ab1 100644 (file)
--- 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 c41b17434213fd3a78d7a847839afe2c4e942c0d..b20a8d4d7e261e4e5fe33036c540fc52e5e35cda 100644 (file)
--- 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 6bbf3f75e1965ea80ca09cec0d35a6b1aeb0ddf7..8bf29846c5690f549518c1bbc61ddc6b5cd6fbed 100644 (file)
--- 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 b90db8ba104e8f5e1dd4d576cb6657866b18a627..c15f3c51f30013194b05b73a40fcde4769245ca1 100644 (file)
--- 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 9f892a8f3c120ab88d14a327c3b81eb32e9cf0a6..1415adbcae3f086d687cd93466a2c04b534ae589 100644 (file)
--- 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 dc602e9e2bf6692647821e882d4c33104d91e592..2e29c2cee338fe40175b65b1e36b84595e2dac39 100644 (file)
--- 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