mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

support new style chunking in directory special remote

Browse source 
Only when storing non-encrypted so far, not retrieving or checking if a key
is present or removing.

This commit was sponsored by Renaud Casenave-Péré.
This commit is contained in:
Joey Hess 2014-07-25 16:21:01 -04:00
parent ab4cce4114
commit 9e8a4a0950
1 changed files with 61 additions and 63 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

122
Remote/Directory.hs
View file

@ -43,16 +43,16 @@ gen r u c gc = do
let chunkconfig = chunkConfig c let chunkconfig = chunkConfig c
return $ Just $ encryptableRemote c return $ Just $ encryptableRemote c
(storeEncrypted dir (getGpgEncParams (c,gc)) chunkconfig) (storeEncrypted dir (getGpgEncParams (c,gc)) chunkconfig)
(retrieveEncrypted dir chunkconfig) (retrieveEncrypted u dir chunkconfig)
Remote { Remote {
uuid = u, uuid = u,
cost = cst, cost = cst,
name = Git.repoDescribe r, name = Git.repoDescribe r,
storeKey = store dir chunkconfig, storeKey = store u dir chunkconfig,
retrieveKeyFile = retrieve dir chunkconfig, retrieveKeyFile = retrieve u dir chunkconfig,
retrieveKeyFileCheap = retrieveCheap dir chunkconfig, retrieveKeyFileCheap = retrieveCheap u dir chunkconfig,
removeKey = remove dir, removeKey = remove dir,
hasKey = checkPresent dir chunkconfig, hasKey = checkPresent u dir chunkconfig,
hasKeyCheap = True, hasKeyCheap = True,
whereisKey = Nothing, whereisKey = Nothing,
remoteFsck = Nothing, remoteFsck = Nothing,
@ -97,9 +97,9 @@ storeDir d k = addTrailingPathSeparator $ d </> hashDirLower k </> keyFile k
tmpDir :: FilePath -> Key -> FilePath tmpDir :: FilePath -> Key -> FilePath
tmpDir d k = addTrailingPathSeparator $ d </> "tmp" </> keyFile k tmpDir d k = addTrailingPathSeparator $ d </> "tmp" </> keyFile k
withCheckedFiles :: (FilePath -> IO Bool) -> ChunkConfig -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool withCheckedFiles :: (FilePath -> IO Bool) -> UUID -> ChunkConfig -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool
withCheckedFiles _ _ [] _ _ = return False withCheckedFiles _ _ _ [] _ _ = return False
withCheckedFiles check (LegacyChunks _) d k a = go $ locations d k withCheckedFiles check _ (LegacyChunks _) d k a = go $ locations d k
where where
go [] = return False go [] = return False
go (f:fs) = do go (f:fs) = do
@ -115,33 +115,20 @@ withCheckedFiles check (LegacyChunks _) d k a = go $ locations d k
then go fs then go fs
else a chunks else a chunks
) )
withCheckedFiles check _ d k a = go $ locations d k withCheckedFiles check u chunkconfig d k a =
go $ locations d k
where where
go [] = return False go [] = return False
go (f:fs) = ifM (check f) ( a [f] , go fs ) go (f:fs) = ifM (check f) ( a [f] , go fs )
withStoredFiles :: ChunkConfig -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool withStoredFiles :: UUID -> ChunkConfig -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool
withStoredFiles = withCheckedFiles doesFileExist withStoredFiles = withCheckedFiles doesFileExist
store :: FilePath -> ChunkConfig -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store :: UUID -> FilePath -> ChunkConfig -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
store d chunkconfig k _f p = sendAnnex k (void $ remove d k) $ \src -> store u d chunkconfig k _f p = whenDiskAvail d k $
metered (Just p) k $ \meterupdate -> sendAnnex k (void $ remove d k) $ \src ->
storeHelper d chunkconfig k k $ \dests -> storeChunks u chunkconfig k src p $ \k' b meterupdate ->
case chunkconfig of storeHelper d chunkconfig k' $ \dests ->
LegacyChunks chunksize ->
storeLegacyChunked meterupdate chunksize dests
=<< L.readFile src
_ -> do
let dest = Prelude.head dests
meteredWriteFile meterupdate dest
=<< L.readFile src
return [dest]
storeEncrypted :: FilePath -> [CommandParam] -> ChunkConfig -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
storeEncrypted d gpgOpts chunkconfig (cipher, enck) k p = sendAnnex k (void $ remove d enck) $ \src ->
metered (Just p) k $ \meterupdate ->
storeHelper d chunkconfig enck k $ \dests ->
encrypt gpgOpts cipher (feedFile src) $ readBytes $ \b ->
case chunkconfig of case chunkconfig of
LegacyChunks chunksize -> LegacyChunks chunksize ->
storeLegacyChunked meterupdate chunksize dests b storeLegacyChunked meterupdate chunksize dests b
@ -150,14 +137,27 @@ storeEncrypted d gpgOpts chunkconfig (cipher, enck) k p = sendAnnex k (void $ re
meteredWriteFile meterupdate dest b meteredWriteFile meterupdate dest b
return [dest] return [dest]
storeEncrypted :: FilePath -> [CommandParam] -> ChunkConfig -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
storeEncrypted d gpgOpts chunkconfig (cipher, enck) k p = whenDiskAvail d k $
sendAnnex k (void $ remove d enck) $ \src ->
metered (Just p) k $ \meterupdate ->
storeHelper d chunkconfig enck $ \dests ->
encrypt gpgOpts cipher (feedFile src) $ readBytes $ \b ->
case chunkconfig of
LegacyChunks chunksize ->
storeLegacyChunked meterupdate chunksize dests b
_ -> do
let dest = Prelude.head dests
meteredWriteFile meterupdate dest b
return [dest]
{- Splits a ByteString into chunks and writes to dests, obeying configured {- Splits a ByteString into chunks and writes to dests, obeying configured
- chunk size (not to be confused with the L.ByteString chunk size). - chunk size (not to be confused with the L.ByteString chunk size). -}
- Note: Must always write at least one file, even for empty ByteString. -}
storeLegacyChunked :: MeterUpdate -> ChunkSize -> [FilePath] -> L.ByteString -> IO [FilePath] storeLegacyChunked :: MeterUpdate -> ChunkSize -> [FilePath] -> L.ByteString -> IO [FilePath]
storeLegacyChunked _ _ [] _ = error "bad storeLegacyChunked call" storeLegacyChunked _ _ [] _ = error "bad storeLegacyChunked call"
storeLegacyChunked meterupdate chunksize alldests@(firstdest:_) b storeLegacyChunked meterupdate chunksize alldests@(firstdest:_) b
| L.null b = do | L.null b = do
-- must always write at least one file, even for empty -- always write at least one file, even for empty
L.writeFile firstdest b L.writeFile firstdest b
return [firstdest] return [firstdest]
| otherwise = storeLegacyChunked' meterupdate chunksize alldests (L.toChunks b) [] | otherwise = storeLegacyChunked' meterupdate chunksize alldests (L.toChunks b) []
@ -181,27 +181,24 @@ storeLegacyChunked' meterupdate chunksize (d:dests) bs c = do
feed bytes' (sz - s) ls h feed bytes' (sz - s) ls h
else return (l:ls) else return (l:ls)
storeHelper :: FilePath -> ChunkConfig -> Key -> Key -> ([FilePath] -> IO [FilePath]) -> Annex Bool {- An encrypted key does not have a known size, so the unencrypted
storeHelper d chunkconfig key origkey storer = check <&&> liftIO go - key should always be passed. -}
where whenDiskAvail :: FilePath -> Key -> Annex Bool -> Annex Bool
tmpdir = tmpDir d key whenDiskAvail d k a = checkDiskSpace (Just d) k 0 <&&> a
destdir = storeDir d key
{- An encrypted key does not have a known size, storeHelper :: FilePath -> ChunkConfig -> Key -> ([FilePath] -> IO [FilePath]) -> Annex Bool
- so check that the size of the original key is available as free storeHelper d chunkconfig key storer = liftIO $ do
- space. -} void $ liftIO $ tryIO $ createDirectoryIfMissing True tmpdir
check = do case chunkconfig of
liftIO $ createDirectoryIfMissing True tmpdir LegacyChunks _ -> Legacy.storeChunks key tmpdir destdir storer recorder finalizer
checkDiskSpace (Just tmpdir) origkey 0 _ -> flip catchNonAsync (\e -> print e >> return False) $ do
go = case chunkconfig of
NoChunks -> flip catchNonAsync (\e -> print e >> return False) $ do
let tmpf = tmpdir </> keyFile key let tmpf = tmpdir </> keyFile key
void $ storer [tmpf] void $ storer [tmpf]
finalizer tmpdir destdir finalizer tmpdir destdir
return True return True
UnpaddedChunks _ -> error "TODO: storeHelper with UnpaddedChunks" where
LegacyChunks _ -> Legacy.storeChunks key tmpdir destdir storer recorder finalizer tmpdir = tmpDir d key
destdir = storeDir d key
finalizer tmp dest = do finalizer tmp dest = do
void $ tryIO $ allowWrite dest -- may already exist void $ tryIO $ allowWrite dest -- may already exist
@ -218,16 +215,16 @@ storeHelper d chunkconfig key origkey storer = check <&&> liftIO go
writeFile f s writeFile f s
void $ tryIO $ preventWrite f void $ tryIO $ preventWrite f
retrieve :: FilePath -> ChunkConfig -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool retrieve :: UUID -> FilePath -> ChunkConfig -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
retrieve d chunkconfig k _ f p = metered (Just p) k $ \meterupdate -> retrieve u d chunkconfig k _ f p = metered (Just p) k $ \meterupdate ->
liftIO $ withStoredFiles chunkconfig d k $ \files -> liftIO $ withStoredFiles u chunkconfig d k $ \files ->
catchBoolIO $ do catchBoolIO $ do
meteredWriteFileChunks meterupdate f files L.readFile meteredWriteFileChunks meterupdate f files L.readFile
return True return True
retrieveEncrypted :: FilePath -> ChunkConfig -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool retrieveEncrypted :: UUID -> FilePath -> ChunkConfig -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
retrieveEncrypted d chunkconfig (cipher, enck) k f p = metered (Just p) k $ \meterupdate -> retrieveEncrypted u d chunkconfig (cipher, enck) k f p = metered (Just p) k $ \meterupdate ->
liftIO $ withStoredFiles chunkconfig d enck $ \files -> liftIO $ withStoredFiles u chunkconfig d enck $ \files ->
catchBoolIO $ do catchBoolIO $ do
decrypt cipher (feeder files) $ decrypt cipher (feeder files) $
readBytes $ meteredWriteFile meterupdate f readBytes $ meteredWriteFile meterupdate f
@ -235,17 +232,18 @@ retrieveEncrypted d chunkconfig (cipher, enck) k f p = metered (Just p) k $ \met
where where
feeder files h = forM_ files $ L.hPut h <=< L.readFile feeder files h = forM_ files $ L.hPut h <=< L.readFile
retrieveCheap :: FilePath -> ChunkConfig -> Key -> FilePath -> Annex Bool retrieveCheap :: UUID -> FilePath -> ChunkConfig -> Key -> FilePath -> Annex Bool
-- no cheap retrieval for chunks -- no cheap retrieval for chunks
retrieveCheap _ (UnpaddedChunks _) _ _ = return False retrieveCheap _ _ (UnpaddedChunks _) _ _ = return False
retrieveCheap _ (LegacyChunks _) _ _ = return False retrieveCheap _ _ (LegacyChunks _) _ _ = return False
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
retrieveCheap d ck k f = liftIO $ withStoredFiles ck d k go retrieveCheap u d ck k f = liftIO $ withStoredFiles u ck d k go
where where
go [file] = catchBoolIO $ createSymbolicLink file f >> return True go [file] = catchBoolIO $
createSymbolicLink file f >> return True
go _files = return False go _files = return False
#else #else
retrieveCheap _ _ _ _ = return False retrieveCheap _ _ _ _ _ = return False
#endif #endif
remove :: FilePath -> Key -> Annex Bool remove :: FilePath -> Key -> Annex Bool
@ -262,6 +260,6 @@ remove d k = liftIO $ do
where where
dir = storeDir d k dir = storeDir d k
checkPresent :: FilePath -> ChunkConfig -> Key -> Annex (Either String Bool) checkPresent :: UUID -> FilePath -> ChunkConfig -> Key -> Annex (Either String Bool)
checkPresent d chunkconfig k = liftIO $ catchMsgIO $ withStoredFiles chunkconfig d k $ checkPresent u d chunkconfig k = liftIO $ catchMsgIO $ withStoredFiles u chunkconfig d k $
const $ return True -- withStoredFiles checked that it exists const $ return True -- withStoredFiles checked that it exists