directory CoW on store

Not for exports to directory yet though.

diff --git a/CHANGELOG b/CHANGELOG
index ecbf5e288128bad72f5b6b02a4d2221f73e8763f..c626a14f07c570c0c2f2ce1a41d6624582008e77 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -9,8 +9,7 @@ git-annex (8.20210331) UNRELEASED; urgency=medium
     exporttree remotes in some unusual circumstances.
   * fsck: When downloading content from a remote, if the content is able
     to be verified during the transfer, skip checksumming it a second time.
-  * directory: When cp supports reflinks, use it when getting content from
-    a directory special remote.
+  * directory: When cp supports reflinks, use it.
 
  -- Joey Hess <id@joeyh.name>  Thu, 01 Apr 2021 12:17:26 -0400
 

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index cbcbe368e5fbe81382a70d8d1995ce2a275aba22..23d130c22e30ea9bfc951ef6d77be70a5b0d2667 100644 (file)
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -70,7 +70,7 @@ gen r u rc gc rs = do
        let chunkconfig = getChunkConfig c
        cow <- liftIO newCopyCoWTried
        return $ Just $ specialRemote c
-               (storeKeyM dir chunkconfig)
+               (storeKeyM dir chunkconfig cow)
                (retrieveKeyFileM dir chunkconfig cow)
                (removeKeyM dir)
                (checkPresentM dir chunkconfig)
@@ -169,43 +169,51 @@ storeDir d k = P.addTrailingPathSeparator $
 
 {- Check if there is enough free disk space in the remote's directory to
  - store the key. Note that the unencrypted key size is checked. -}
-storeKeyM :: RawFilePath -> ChunkConfig -> Storer
-storeKeyM d chunkconfig k c m = 
+storeKeyM :: RawFilePath -> ChunkConfig -> CopyCoWTried -> Storer
+storeKeyM d chunkconfig cow k c m = 
        ifM (checkDiskSpaceDirectory d k)
-               ( byteStorer (store d chunkconfig) k c m
+               ( do
+                       void $ liftIO $ tryIO $ createDirectoryUnder d tmpdir
+                       store
                , giveup "Not enough free disk space."
                )
-
-checkDiskSpaceDirectory :: RawFilePath -> Key -> Annex Bool
-checkDiskSpaceDirectory d k = do
-       annexdir <- fromRepo gitAnnexObjectDir
-       samefilesystem <- liftIO $ catchDefaultIO False $ 
-               (\a b -> deviceID a == deviceID b)
-                       <$> R.getFileStatus d
-                       <*> R.getFileStatus annexdir
-       checkDiskSpace (Just d) k 0 samefilesystem
-
-store :: RawFilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex ()
-store d chunkconfig k b p = liftIO $ do
-       void $ tryIO $ createDirectoryUnder d tmpdir
-       case chunkconfig of
+  where
+       store = case chunkconfig of
                LegacyChunks chunksize -> 
-                       Legacy.store
+                       let go _k b p = liftIO $ Legacy.store
                                (fromRawFilePath d)
                                chunksize
                                (finalizeStoreGeneric d)
                                k b p
                                (fromRawFilePath tmpdir)
                                (fromRawFilePath destdir)
-               _ -> do
-                       let tmpf = tmpdir P.</> kf
-                       meteredWriteFile p (fromRawFilePath tmpf) b
-                       finalizeStoreGeneric d tmpdir destdir
-  where
+                       in byteStorer go k c m
+               NoChunks ->
+                       let go _k src p = do
+                               (ok, _verification) <- fileCopier cow src tmpf k p (return True) NoVerify
+                               unless ok $ giveup "failed to copy file to remote"
+                               liftIO $ finalizeStoreGeneric d tmpdir destdir
+                       in fileStorer go k c m
+               _ -> 
+                       let go _k b p = liftIO $ do
+                               meteredWriteFile p tmpf b
+                               finalizeStoreGeneric d tmpdir destdir
+                       in byteStorer go k c m
+       
        tmpdir = P.addTrailingPathSeparator $ d P.</> "tmp" P.</> kf
+       tmpf = fromRawFilePath tmpdir </> fromRawFilePath kf
        kf = keyFile k
        destdir = storeDir d k
 
+checkDiskSpaceDirectory :: RawFilePath -> Key -> Annex Bool
+checkDiskSpaceDirectory d k = do
+       annexdir <- fromRepo gitAnnexObjectDir
+       samefilesystem <- liftIO $ catchDefaultIO False $ 
+               (\a b -> deviceID a == deviceID b)
+                       <$> R.getFileStatus d
+                       <*> R.getFileStatus annexdir
+       checkDiskSpace (Just d) k 0 samefilesystem
+
 {- 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