Directory special remotes now check annex.diskreserve.

1 files changed, 30 insertions, 22 deletions

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 3627d9a9a..fd5a6f0b1 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -10,7 +10,7 @@ module Remote.Directory (remote) where
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.ByteString.Char8 as S
 import qualified Data.Map as M
-import Control.Exception (bracket)
+import qualified Control.Exception as E
 
 import Common.Annex
 import Types.Remote
@@ -22,6 +22,7 @@ import Remote.Helper.Encryptable
 import Crypto
 import Utility.DataUnits
 import Data.Int
+import Annex.Content
 
 remote :: RemoteType
 remote = RemoteType {
@@ -125,7 +126,7 @@ store :: FilePath -> ChunkSize -> Key -> Annex Bool
 store d chunksize k = do
 	src <- inRepo $ gitAnnexLocation k
 	metered k $ \meterupdate -> 
-		liftIO $ catchBoolIO $ storeHelper d chunksize k $ \dests ->
+		storeHelper d chunksize k $ \dests ->
 			case chunksize of
 				Nothing -> do
 					let dest = Prelude.head dests
@@ -140,7 +141,7 @@ storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> Annex Bool
 storeEncrypted d chunksize (cipher, enck) k = do
 	src <- inRepo $ gitAnnexLocation k
 	metered k $ \meterupdate ->
-		liftIO $ catchBoolIO $ storeHelper d chunksize enck $ \dests ->
+		storeHelper d chunksize enck $ \dests ->
 			withEncryptedContent cipher (L.readFile src) $ \s ->
 				case chunksize of
 					Nothing -> do
@@ -165,7 +166,7 @@ storeSplit' :: MeterUpdate -> Int64 -> [FilePath] -> [S.ByteString] -> [FilePath
 storeSplit' _ _ [] _ _ = error "ran out of dests"
 storeSplit' _ _  _ [] c = return $ reverse c
 storeSplit' meterupdate chunksize (d:dests) bs c = do
-	bs' <- bracket (openFile d WriteMode) hClose (feed chunksize bs)
+	bs' <- E.bracket (openFile d WriteMode) hClose (feed chunksize bs)
 	storeSplit' meterupdate chunksize dests bs' (d:c)
 	where
 		feed _ [] _ = return []
@@ -190,7 +191,7 @@ meteredWriteFile meterupdate dest b =
  - meter after each chunk. The feeder is called to get more chunks. -}
 meteredWriteFile' :: MeterUpdate -> FilePath -> s -> (s -> IO (s, [S.ByteString])) -> IO ()
 meteredWriteFile' meterupdate dest startstate feeder =
-	bracket (openFile dest WriteMode) hClose (feed startstate [])
+	E.bracket (openFile dest WriteMode) hClose (feed startstate [])
 	where
 		feed state [] h = do
 			(state', cs) <- feeder state
@@ -207,31 +208,38 @@ meteredWriteFile' meterupdate dest startstate feeder =
  - The stored files are only put into their final place once storage is
  - complete.
  -}
-storeHelper :: FilePath -> ChunkSize -> Key -> ([FilePath] -> IO [FilePath]) -> IO Bool
-storeHelper d chunksize key a = do
-	let dir = parentDir desttemplate
-	createDirectoryIfMissing True dir
-	allowWrite dir
-	stored <- a tmpdests
-	forM_ stored $ \f -> do
-		let dest = detmpprefix f
-		renameFile f dest
-		preventWrite dest
-	when (chunksize /= Nothing) $ do
-		let chunkcount = chunkCount desttemplate
-		_ <- tryIO $ allowWrite chunkcount
-		writeFile chunkcount (show $ length stored)
-		preventWrite chunkcount
-	preventWrite dir
-	return (not $ null stored)
+storeHelper :: FilePath -> ChunkSize -> Key -> ([FilePath] -> IO [FilePath]) -> Annex Bool
+storeHelper d chunksize key a = prep <&&> check <&&> go
 	where
 		desttemplate = Prelude.head $ locations d key
+		dir = parentDir desttemplate
 		tmpdests = case chunksize of
 			Nothing -> [desttemplate ++ tmpprefix]
 			Just _ -> map (++ tmpprefix) (chunkStream desttemplate)
 		tmpprefix = ".tmp"
 		detmpprefix f = take (length f - tmpprefixlen) f
 		tmpprefixlen = length tmpprefix
+		prep = liftIO $ catchBoolIO $ do
+			createDirectoryIfMissing True dir
+			allowWrite dir
+			return True
+		{- The size is not exactly known when encrypting the key;
+		 - this assumes that at least the size of the key is
+		 - needed as free space. -}
+		check = checkDiskSpace (Just dir) key 0
+		go = liftIO $ catchBoolIO $ do
+			stored <- a tmpdests
+			forM_ stored $ \f -> do
+				let dest = detmpprefix f
+				renameFile f dest
+				preventWrite dest
+			when (chunksize /= Nothing) $ do
+				let chunkcount = chunkCount desttemplate
+				_ <- tryIO $ allowWrite chunkcount
+				writeFile chunkcount (show $ length stored)
+				preventWrite chunkcount
+			preventWrite dir
+			return (not $ null stored)
 
 retrieve :: FilePath -> ChunkSize -> Key -> FilePath -> Annex Bool
 retrieve d chunksize k f = metered k $ \meterupdate ->