diff options
author | 2012-11-16 17:58:08 -0400 | |
---|---|---|
committer | 2012-11-16 17:58:08 -0400 | |
commit | 9fc8fc98a9279b822e5c0104fee8dab00debda90 (patch) | |
tree | 891e5bd35975a312bff502fb0afa5369a32a18cc /Remote/Directory.hs | |
parent | 54399a70122023a5279566080f8ba82f889bccf8 (diff) |
generic chunked content helper
However, directory still uses its optimzed chunked file writer, as it uses
less memory than the generic one in the helper.
Diffstat (limited to 'Remote/Directory.hs')
-rw-r--r-- | Remote/Directory.hs | 76 |
1 files changed, 16 insertions, 60 deletions
diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 006638a2f..6bf725379 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -19,8 +19,8 @@ import Config import Utility.FileMode import Remote.Helper.Special import Remote.Helper.Encryptable +import Remote.Helper.Chunked import Crypto -import Utility.DataUnits import Data.Int import Annex.Content @@ -58,19 +58,6 @@ gen r u c = do remotetype = remote } -type ChunkSize = Maybe Int64 - -chunkSize :: Maybe RemoteConfig -> ChunkSize -chunkSize Nothing = Nothing -chunkSize (Just m) = - case M.lookup "chunksize" m of - Nothing -> Nothing - Just v -> case readSize dataUnits v of - Nothing -> error "bad chunksize" - Just size - | size <= 0 -> error "bad chunksize" - | otherwise -> Just $ fromInteger size - directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig directorySetup u c = do -- verify configuration is sane @@ -89,14 +76,6 @@ directorySetup u c = do locations :: FilePath -> Key -> [FilePath] locations d k = map (d </>) (keyPaths k) -{- An infinite stream of chunks to use for a given file. -} -chunkStream :: FilePath -> [FilePath] -chunkStream f = map (\n -> f ++ ".chunk" ++ show n) [1 :: Integer ..] - -{- A file that records the number of chunks used. -} -chunkCount :: FilePath -> FilePath -chunkCount f = f ++ ".chunkcount" - withCheckedFiles :: (FilePath -> IO Bool) -> ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool withCheckedFiles _ _ [] _ _ = return False withCheckedFiles check Nothing d k a = go $ locations d k @@ -107,18 +86,14 @@ withCheckedFiles check (Just _) d k a = go $ locations d k where go [] = return False go (f:fs) = do - let chunkcount = chunkCount f + let chunkcount = f ++ chunkCount ifM (check chunkcount) ( do - count <- readcount chunkcount - let chunks = take count $ chunkStream f + chunks <- getChunks f <$> readFile chunkcount ifM (all id <$> mapM check chunks) ( a chunks , return False ) , go fs ) - readcount f = fromMaybe (error $ "cannot parse " ++ f) - . (readish :: String -> Maybe Int) - <$> readFile f withStoredFiles :: ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool withStoredFiles = withCheckedFiles doesFileExist @@ -203,45 +178,26 @@ meteredWriteFile' meterupdate dest startstate feeder = meterupdate $ toInteger $ S.length c feed state cs h -{- Generates a list of destinations to write to in order to store a key. - - When chunksize is specified, this list will be a list of chunks. - - The action should store the file, and return a list of the destinations - - it stored it to, or [] on error. - - The stored files are only put into their final place once storage is - - complete. - -} storeHelper :: FilePath -> ChunkSize -> Key -> ([FilePath] -> IO [FilePath]) -> Annex Bool -storeHelper d chunksize key a = prep <&&> check <&&> go +storeHelper d chunksize key storer = 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 + basedest = Prelude.head $ locations d key + dir = parentDir basedest {- 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) + createDirectoryIfMissing True dir + allowWrite dir + preventWrite dir `after` storeChunks basedest chunksize storer recorder finalizer + finalizer f dest = do + renameFile f dest + preventWrite dest + recorder f s = do + void $ tryIO $ allowWrite f + writeFile f s + preventWrite f retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> Annex Bool retrieve d chunksize k _ f = metered Nothing k $ \meterupdate -> |