directory, webdav: Fix bug introduced in version 4.20131002 that caused the chunkcount file to not be written. Work around repositories without such a file, so files can still be retreived from them.
This commit is contained in:
parent
06ea92282f
commit
5756636486
5 changed files with 42 additions and 7 deletions
|
@ -109,9 +109,13 @@ withCheckedFiles check (Just _) d k a = go $ locations d k
|
|||
ifM (check chunkcount)
|
||||
( do
|
||||
chunks <- listChunks f <$> readFile chunkcount
|
||||
ifM (and <$> mapM check chunks)
|
||||
ifM (allM check chunks)
|
||||
( a chunks , return False )
|
||||
, go fs
|
||||
, do
|
||||
chunks <- probeChunks f check
|
||||
if null chunks
|
||||
then go fs
|
||||
else a chunks
|
||||
)
|
||||
|
||||
withStoredFiles :: ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool
|
||||
|
|
|
@ -43,6 +43,10 @@ type ChunkExt = String
|
|||
chunkCount :: ChunkExt
|
||||
chunkCount = ".chunkcount"
|
||||
|
||||
{- An infinite stream of extensions to use for chunks. -}
|
||||
chunkStream :: [ChunkExt]
|
||||
chunkStream = map (\n -> ".chunk" ++ show n) [1 :: Integer ..]
|
||||
|
||||
{- Parses the String from the chunkCount file, and returns the files that
|
||||
- are used to store the chunks. -}
|
||||
listChunks :: FilePath -> String -> [FilePath]
|
||||
|
@ -50,9 +54,22 @@ listChunks basedest chunkcount = take count $ map (basedest ++) chunkStream
|
|||
where
|
||||
count = fromMaybe 0 $ readish chunkcount
|
||||
|
||||
{- An infinite stream of extensions to use for chunks. -}
|
||||
chunkStream :: [ChunkExt]
|
||||
chunkStream = map (\n -> ".chunk" ++ show n) [1 :: Integer ..]
|
||||
{- For use when there is no chunkCount file; uses the action to find
|
||||
- chunks, and returns them, or Nothing if none found. Relies on
|
||||
- storeChunks's finalizer atomically moving the chunks into place once all
|
||||
- are written.
|
||||
-
|
||||
- This is only needed to work around a bug that caused the chunkCount file
|
||||
- not to be written.
|
||||
-}
|
||||
probeChunks :: FilePath -> (FilePath -> IO Bool) -> IO [FilePath]
|
||||
probeChunks basedest check = go [] $ map (basedest ++) chunkStream
|
||||
where
|
||||
go l [] = return (reverse l)
|
||||
go l (c:cs) = ifM (check c)
|
||||
( go (c:l) cs
|
||||
, go l []
|
||||
)
|
||||
|
||||
{- Given the base destination to use to store a value,
|
||||
- generates a stream of temporary destinations (just one when not chunking)
|
||||
|
|
|
@ -198,8 +198,14 @@ withStoredFiles
|
|||
withStoredFiles r k baseurl user pass onerr a
|
||||
| isJust $ chunkSize $ config r = do
|
||||
let chunkcount = keyurl ++ chunkCount
|
||||
maybe (onerr chunkcount) (a . listChunks keyurl . L8.toString)
|
||||
=<< davGetUrlContent chunkcount user pass
|
||||
v <- davGetUrlContent chunkcount user pass
|
||||
case v of
|
||||
Just s -> a $ listChunks keyurl $ L8.toString s
|
||||
Nothing -> do
|
||||
chunks <- probeChunks keyurl $ \u -> (== Right True) <$> davUrlExists u user pass
|
||||
if null chunks
|
||||
then onerr chunkcount
|
||||
else a chunks
|
||||
| otherwise = a [keyurl]
|
||||
where
|
||||
keyurl = davLocation baseurl k ++ keyFile k
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue