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.

3 files changed, 34 insertions, 7 deletions

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 1a4dbf45c..cee4d6a0a 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -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
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index fcaa6b003..ad3b04d49 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -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)
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index c65118efb..1a722f147 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -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