make local gcrypt storeKey be atomic

Reuse Remote.Directory's code.

2 files changed, 28 insertions, 20 deletions

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 3b54ad200..9b3c15695 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -7,7 +7,11 @@
 
 {-# LANGUAGE CPP #-}
 
-module Remote.Directory (remote, removeDirGeneric) where
+module Remote.Directory (
+	remote,
+	finalizeStoreGeneric,
+	removeDirGeneric,
+) where
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
@@ -114,24 +118,30 @@ store :: FilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex
 store d chunkconfig k b p = liftIO $ do
 	void $ tryIO $ createDirectoryIfMissing True tmpdir
 	case chunkconfig of
-		LegacyChunks chunksize -> Legacy.store chunksize finalizer k b p tmpdir destdir
+		LegacyChunks chunksize -> Legacy.store chunksize finalizeStoreGeneric k b p tmpdir destdir
 		_ -> do
 			let tmpf = tmpdir </> keyFile k
 			meteredWriteFile p tmpf b
-			finalizer tmpdir destdir
+			finalizeStoreGeneric tmpdir destdir
 			return True
   where
 	tmpdir = tmpDir d k
 	destdir = storeDir d k
-	finalizer tmp dest = do
-		void $ tryIO $ allowWrite dest -- may already exist
-		void $ tryIO $ removeDirectoryRecursive dest -- or not exist
-		createDirectoryIfMissing True (parentDir dest)
-		renameDirectory tmp dest
-		-- may fail on some filesystems
-		void $ tryIO $ do
-			mapM_ preventWrite =<< dirContents dest
-			preventWrite dest
+
+{- Passed a temp directory that contains the files that should be placed
+ - in the dest directory, moves it into place. Anything already existing
+ - in the dest directory will be deleted. File permissions will be locked
+ - down. -}
+finalizeStoreGeneric :: FilePath -> FilePath -> IO ()
+finalizeStoreGeneric tmp dest = do
+	void $ tryIO $ allowWrite dest -- may already exist
+	void $ tryIO $ removeDirectoryRecursive dest -- or not exist
+	createDirectoryIfMissing True (parentDir dest)
+	renameDirectory tmp dest
+	-- may fail on some filesystems
+	void $ tryIO $ do
+		mapM_ preventWrite =<< dirContents dest
+		preventWrite dest
 
 retrieve :: FilePath -> ChunkConfig -> Preparer Retriever
 retrieve d (LegacyChunks _) = Legacy.retrieve locations d
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index a0292a954..d969e02f8 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -306,14 +306,12 @@ store :: Remote -> Remote.Rsync.RsyncOpts -> Storer
 store r rsyncopts
 	| not $ Git.repoIsUrl (repo r) = 
 		byteStorer $ \k b p -> guardUsable (repo r) False $ liftIO $ do
-			let f = gCryptLocation r k
-			let d = parentDir f
-			createDirectoryIfMissing True d
-			allowWrite d
-			void $ liftIO $ tryIO $ allowWrite f
-			meteredWriteFile p f b
-			preventWrite f
-			preventWrite d
+			let tmpdir = Git.repoLocation (repo r) </> "tmp" </> keyFile k
+			void $ tryIO $ createDirectoryIfMissing True tmpdir
+			let tmpf = tmpdir </> keyFile k
+			meteredWriteFile p tmpf b
+			let destdir = parentDir $ gCryptLocation r k
+			Remote.Directory.finalizeStoreGeneric tmpdir destdir
 			return True
 	| Git.repoIsSsh (repo r) = if isShell r
 		then fileStorer $ \k f p -> Ssh.rsyncHelper (Just p)