Directory special remotes now check annex.diskreserve.
This commit is contained in:
parent
b65e257b13
commit
5cc76098ca
2 changed files with 31 additions and 22 deletions
|
@ -10,7 +10,7 @@ module Remote.Directory (remote) where
|
||||||
import qualified Data.ByteString.Lazy.Char8 as L
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
import qualified Data.ByteString.Char8 as S
|
import qualified Data.ByteString.Char8 as S
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Exception (bracket)
|
import qualified Control.Exception as E
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
|
@ -22,6 +22,7 @@ import Remote.Helper.Encryptable
|
||||||
import Crypto
|
import Crypto
|
||||||
import Utility.DataUnits
|
import Utility.DataUnits
|
||||||
import Data.Int
|
import Data.Int
|
||||||
|
import Annex.Content
|
||||||
|
|
||||||
remote :: RemoteType
|
remote :: RemoteType
|
||||||
remote = RemoteType {
|
remote = RemoteType {
|
||||||
|
@ -125,7 +126,7 @@ store :: FilePath -> ChunkSize -> Key -> Annex Bool
|
||||||
store d chunksize k = do
|
store d chunksize k = do
|
||||||
src <- inRepo $ gitAnnexLocation k
|
src <- inRepo $ gitAnnexLocation k
|
||||||
metered k $ \meterupdate ->
|
metered k $ \meterupdate ->
|
||||||
liftIO $ catchBoolIO $ storeHelper d chunksize k $ \dests ->
|
storeHelper d chunksize k $ \dests ->
|
||||||
case chunksize of
|
case chunksize of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
let dest = Prelude.head dests
|
let dest = Prelude.head dests
|
||||||
|
@ -140,7 +141,7 @@ storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> Annex Bool
|
||||||
storeEncrypted d chunksize (cipher, enck) k = do
|
storeEncrypted d chunksize (cipher, enck) k = do
|
||||||
src <- inRepo $ gitAnnexLocation k
|
src <- inRepo $ gitAnnexLocation k
|
||||||
metered k $ \meterupdate ->
|
metered k $ \meterupdate ->
|
||||||
liftIO $ catchBoolIO $ storeHelper d chunksize enck $ \dests ->
|
storeHelper d chunksize enck $ \dests ->
|
||||||
withEncryptedContent cipher (L.readFile src) $ \s ->
|
withEncryptedContent cipher (L.readFile src) $ \s ->
|
||||||
case chunksize of
|
case chunksize of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
|
@ -165,7 +166,7 @@ storeSplit' :: MeterUpdate -> Int64 -> [FilePath] -> [S.ByteString] -> [FilePath
|
||||||
storeSplit' _ _ [] _ _ = error "ran out of dests"
|
storeSplit' _ _ [] _ _ = error "ran out of dests"
|
||||||
storeSplit' _ _ _ [] c = return $ reverse c
|
storeSplit' _ _ _ [] c = return $ reverse c
|
||||||
storeSplit' meterupdate chunksize (d:dests) bs c = do
|
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)
|
storeSplit' meterupdate chunksize dests bs' (d:c)
|
||||||
where
|
where
|
||||||
feed _ [] _ = return []
|
feed _ [] _ = return []
|
||||||
|
@ -190,7 +191,7 @@ meteredWriteFile meterupdate dest b =
|
||||||
- meter after each chunk. The feeder is called to get more chunks. -}
|
- meter after each chunk. The feeder is called to get more chunks. -}
|
||||||
meteredWriteFile' :: MeterUpdate -> FilePath -> s -> (s -> IO (s, [S.ByteString])) -> IO ()
|
meteredWriteFile' :: MeterUpdate -> FilePath -> s -> (s -> IO (s, [S.ByteString])) -> IO ()
|
||||||
meteredWriteFile' meterupdate dest startstate feeder =
|
meteredWriteFile' meterupdate dest startstate feeder =
|
||||||
bracket (openFile dest WriteMode) hClose (feed startstate [])
|
E.bracket (openFile dest WriteMode) hClose (feed startstate [])
|
||||||
where
|
where
|
||||||
feed state [] h = do
|
feed state [] h = do
|
||||||
(state', cs) <- feeder state
|
(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
|
- The stored files are only put into their final place once storage is
|
||||||
- complete.
|
- complete.
|
||||||
-}
|
-}
|
||||||
storeHelper :: FilePath -> ChunkSize -> Key -> ([FilePath] -> IO [FilePath]) -> IO Bool
|
storeHelper :: FilePath -> ChunkSize -> Key -> ([FilePath] -> IO [FilePath]) -> Annex Bool
|
||||||
storeHelper d chunksize key a = do
|
storeHelper d chunksize key a = prep <&&> check <&&> go
|
||||||
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)
|
|
||||||
where
|
where
|
||||||
desttemplate = Prelude.head $ locations d key
|
desttemplate = Prelude.head $ locations d key
|
||||||
|
dir = parentDir desttemplate
|
||||||
tmpdests = case chunksize of
|
tmpdests = case chunksize of
|
||||||
Nothing -> [desttemplate ++ tmpprefix]
|
Nothing -> [desttemplate ++ tmpprefix]
|
||||||
Just _ -> map (++ tmpprefix) (chunkStream desttemplate)
|
Just _ -> map (++ tmpprefix) (chunkStream desttemplate)
|
||||||
tmpprefix = ".tmp"
|
tmpprefix = ".tmp"
|
||||||
detmpprefix f = take (length f - tmpprefixlen) f
|
detmpprefix f = take (length f - tmpprefixlen) f
|
||||||
tmpprefixlen = length tmpprefix
|
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 :: FilePath -> ChunkSize -> Key -> FilePath -> Annex Bool
|
||||||
retrieve d chunksize k f = metered k $ \meterupdate ->
|
retrieve d chunksize k f = metered k $ \meterupdate ->
|
||||||
|
|
1
debian/changelog
vendored
1
debian/changelog
vendored
|
@ -1,6 +1,7 @@
|
||||||
git-annex (3.20120419) UNRELEASED; urgency=low
|
git-annex (3.20120419) UNRELEASED; urgency=low
|
||||||
|
|
||||||
* Fix use of annex.diskreserve config setting.
|
* Fix use of annex.diskreserve config setting.
|
||||||
|
* Directory special remotes now check annex.diskreserve.
|
||||||
|
|
||||||
-- Joey Hess <joeyh@debian.org> Fri, 20 Apr 2012 16:14:08 -0400
|
-- Joey Hess <joeyh@debian.org> Fri, 20 Apr 2012 16:14:08 -0400
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue