From fb68a7881f725a7b097f8b0f1b347f24dfea5d59 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 2 Dec 2011 15:50:27 -0400
Subject: [PATCH] convert rsync special backend to using both hash directory
 types

---
 Locations.hs     |  1 +
 Remote/Rsync.hs  | 64 +++++++++++++++++++++++++++++-------------------
 debian/changelog |  9 ++++---
 3 files changed, 45 insertions(+), 29 deletions(-)

diff --git a/Locations.hs b/Locations.hs
index 2f4a9200db..1179886ade 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -21,6 +21,7 @@ module Locations (
 	gitAnnexJournalDir,
 	gitAnnexJournalLock,
 	isLinkToAnnex,
+	annexHashes,
 	hashDirMixed,
 	hashDirLower,
 
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 836b93b314..651ed4de87 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -86,13 +86,26 @@ rsyncEscape o s
 	| rsyncUrlIsShell (rsyncUrl o) = shellEscape s
 	| otherwise = s
 
-rsyncKey :: RsyncOpts -> Key -> String
-rsyncKey o k = rsyncUrl o </> hashDirMixed k </> rsyncEscape o (f </> f)
-        where
+rsyncUrls :: RsyncOpts -> Key -> [String]
+rsyncUrls o k = map use annexHashes
+	where
+		use h = rsyncUrl o </> h k </> rsyncEscape o (f </> f)
                 f = keyFile k
 
-rsyncKeyDir :: RsyncOpts -> Key -> String
-rsyncKeyDir o k = rsyncUrl o </> hashDirMixed k </> rsyncEscape o (keyFile k)
+rsyncUrlDirs :: RsyncOpts -> Key -> [String]
+rsyncUrlDirs o k = map use annexHashes
+	where
+		use h = rsyncUrl o </> h k </> rsyncEscape o (keyFile k)
+
+withRsyncUrl :: RsyncOpts -> Key -> (FilePath -> Annex Bool) -> Annex Bool
+withRsyncUrl o k a = go $ rsyncUrls o k
+	where
+		go [] = return False
+		go (u:us) = do
+			ok <- a u
+			if ok
+				then return ok
+				else go us
 
 store :: RsyncOpts -> Key -> Annex Bool
 store o k = rsyncSend o k =<< inRepo (gitAnnexLocation k)
@@ -104,10 +117,10 @@ storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
 	rsyncSend o enck tmp
 
 retrieve :: RsyncOpts -> Key -> FilePath -> Annex Bool
-retrieve o k f = rsyncRemote o
+retrieve o k f = withRsyncUrl o k $ \u -> rsyncRemote o
 	-- use inplace when retrieving to support resuming
 	[ Param "--inplace"
-	, Param $ rsyncKey o k
+	, Param u
 	, Param f
 	]
 
@@ -121,27 +134,30 @@ retrieveEncrypted o (cipher, enck) f = withTmp enck $ \tmp -> do
 		else return res
 
 remove :: RsyncOpts -> Key -> Annex Bool
-remove o k = withRsyncScratchDir $ \tmp -> do
-	{- Send an empty directory to rysnc as the parent directory
-         - of the file to remove. -}
-	let dummy = tmp </> keyFile k
-	liftIO $ createDirectoryIfMissing True dummy
-	liftIO $ rsync $ rsyncOptions o ++
-		[ Params "--delete --recursive"
-		, partialParams
-		, Param $ addTrailingPathSeparator dummy
-		, Param $ rsyncKeyDir o k
-		]
+remove o k = any (== True) <$> sequence (map go (rsyncUrlDirs o k))
+	where
+		go d = withRsyncScratchDir $ \tmp -> liftIO $ do
+			{- Send an empty directory to rysnc as the
+			 - parent directory of the file to remove. -}
+			let dummy = tmp </> keyFile k
+			createDirectoryIfMissing True dummy
+			rsync $ rsyncOptions o ++
+				[ Params "--quiet --delete --recursive"
+				, partialParams
+				, Param $ addTrailingPathSeparator dummy
+				, Param d
+				]
 
 checkPresent :: Git.Repo -> RsyncOpts -> Key -> Annex (Either String Bool)
 checkPresent r o k = do
 	showAction $ "checking " ++ Git.repoDescribe r
-	-- note: Does not currently differnetiate between rsync failing
+	-- note: Does not currently differentiate between rsync failing
 	-- to connect, and the file not being present.
-	res <- liftIO $ boolSystem "sh" [Param "-c", Param cmd]
-	return $ Right res
+	Right <$> check
 	where
-		cmd = "rsync --quiet " ++ shellEscape (rsyncKey o k) ++ " 2>/dev/null"
+ 		check = withRsyncUrl o k $ \u ->
+			liftIO $ boolSystem "sh" [Param "-c", Param (cmd u)]
+		cmd u = "rsync --quiet " ++ shellEscape u ++ " 2>/dev/null"
 
 {- Rsync params to enable resumes of sending files safely,
  - ensure that files are only moved into place once complete
@@ -182,7 +198,7 @@ rsyncRemote o params = do
    directories. -}
 rsyncSend :: RsyncOpts -> Key -> FilePath -> Annex Bool
 rsyncSend o k src = withRsyncScratchDir $ \tmp -> do
-	let dest = tmp </> hashDirMixed k </> f </> f
+	let dest = tmp </> head (keyPaths k)
 	liftIO $ createDirectoryIfMissing True $ parentDir dest
 	liftIO $ createLink src dest
 	rsyncRemote o
@@ -192,5 +208,3 @@ rsyncSend o k src = withRsyncScratchDir $ \tmp -> do
 		, Param $ addTrailingPathSeparator tmp
 		, Param $ rsyncUrl o
 		]
-	where
-		f = keyFile k
diff --git a/debian/changelog b/debian/changelog
index 45088db522..d038c7849c 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -2,10 +2,11 @@ git-annex (3.20111123) UNRELEASED; urgency=low
 
   * The VFAT filesystem on recent versions of Linux, when mounted with
     shortname=mixed, does not get along well with git-annex's mixed case
-    .git/annex/objects hash directories. To avoid this problem, bare
-    repositories (and the directory special remote) now store new content
-    in all-lowercase hash directories. Mixed case hash directories are
-    still used for non-bare repositories, which cannot be put on FAT.
+    .git/annex/objects hash directories. To avoid this problem, new content
+    is now stored in all-lowercase hash directories. Except for non-bare
+    repositories which would be a pain to transition and cannot be put on FAT.
+    (Old mixed-case hash directories are still tried for backwards
+    compatibility.)
   * Flush json output, avoiding a buffering problem that could result in
     doubled output.
   * Avoid needing haskell98 and other fixes for new ghc. Thanks, Mark Wright.