Put a workaround in the directory special remote for strange behavior with VFAT filesystems on Linux (mounted with shortname=mixed)

1 files changed, 49 insertions, 24 deletions

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index b592f41ff..cadd5e759 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -62,56 +62,81 @@ directorySetup u c = do
 	gitConfigSpecialRemote u c' "directory" dir
 	return $ M.delete "directory" c'
 
-dirKey :: FilePath -> Key -> FilePath
-dirKey d k = d </> hashDirMixed k </> f </> f
+{- Where to store a given Key in the Directory.
+ -
+ - There are two possible locations to try; this had to be done because
+ - on Linux, vfat filesystem mounted with shortname=mixed have a
+ - variant of case insensativity that causes miserable failure when
+ - hashDirMixed produces eg, "xx" and "XX". The first directory to be
+ - created wins the namespace, and the second one cannot then be created.
+ - But unlike behavior with shortname=lower, "XX/foo" won't look in
+ - "xx/foo".
+ -}
+locations :: FilePath -> Key -> [FilePath]
+locations d k = [using hashDirMixed, using hashDirLower]
 	where
+		using h = d </> h k </> f </> f
 		f = keyFile k
 
+withCheckedFile :: (FilePath -> IO Bool) -> FilePath -> Key -> (FilePath -> IO Bool) -> IO Bool
+withCheckedFile _ [] _ _ = return False
+withCheckedFile check d k a = go $ locations d k
+	where
+		go [] = return False
+		go (f:fs) = do
+			use <- check f
+			if use
+				then a f
+				else go fs
+
+withStoredFile :: FilePath -> Key -> (FilePath -> IO Bool) -> IO Bool
+withStoredFile = withCheckedFile doesFileExist
+
 store :: FilePath -> Key -> Annex Bool
 store d k = do
 	src <- fromRepo $ gitAnnexLocation k
-	let dest = dirKey d k
-	liftIO $ catchBoolIO $ storeHelper dest $ copyFileExternal src dest
+	liftIO $ catchBoolIO $ storeHelper d k $ copyFileExternal src
 
 storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool
 storeEncrypted d (cipher, enck) k = do
 	src <- fromRepo $ gitAnnexLocation k
-	let dest = dirKey d enck
-	liftIO $ catchBoolIO $ storeHelper dest $ encrypt src dest
+	liftIO $ catchBoolIO $ storeHelper d enck $ encrypt src
 	where
 		encrypt src dest = do
 			withEncryptedContent cipher (L.readFile src) $ L.writeFile dest
 			return True
 
-storeHelper :: FilePath -> IO Bool -> IO Bool
-storeHelper dest a = do
-	let dir = parentDir dest
-	createDirectoryIfMissing True dir
-	allowWrite dir	
-	ok <- a
-	when ok $ do
-		preventWrite dest
-		preventWrite dir
-	return ok
+storeHelper :: FilePath -> Key -> (FilePath -> IO Bool) -> IO Bool
+storeHelper d key a = withCheckedFile check d key go
+	where
+		check dest = isJust <$> mkdir (parentDir dest)
+		mkdir = catchMaybeIO . createDirectoryIfMissing True
+		go dest = do
+			let dir = parentDir dest
+			allowWrite dir
+			ok <- a dest
+			when ok $ do
+				preventWrite dest
+				preventWrite dir
+			return ok
 
 retrieve :: FilePath -> Key -> FilePath -> Annex Bool
-retrieve d k f = liftIO $ copyFileExternal (dirKey d k) f
+retrieve d k f = liftIO $ withStoredFile d k $ \file -> copyFileExternal file f
 
 retrieveEncrypted :: FilePath -> (Cipher, Key) -> FilePath -> Annex Bool
 retrieveEncrypted d (cipher, enck) f =
-	liftIO $ catchBoolIO $ do
-		withDecryptedContent cipher (L.readFile (dirKey d enck)) $ L.writeFile f
+	liftIO $ withStoredFile d enck $ \file -> catchBoolIO $ do
+		withDecryptedContent cipher (L.readFile file) $ L.writeFile f
 		return True
 
 remove :: FilePath -> Key -> Annex Bool
-remove d k = liftIO $ catchBoolIO $ do
+remove d k = liftIO $ withStoredFile d k $ \file -> catchBoolIO $ do
+	let dir = parentDir file
 	allowWrite dir
 	removeFile file
 	removeDirectory dir
 	return True
-	where
-		file = dirKey d k
-		dir = parentDir file
 
 checkPresent :: FilePath -> Key -> Annex (Either String Bool)
-checkPresent d k = liftIO $ catchMsgIO $ doesFileExist (dirKey d k)
+checkPresent d k = liftIO $ catchMsgIO $ withStoredFile d k $
+	const $ return True -- withStoredFile checked that it exists