convert rsync special backend to using both hash directory types

Locations.hs

@@ -21,6 +21,7 @@ module Locations (
 	gitAnnexJournalDir,
 	gitAnnexJournalLock,
 	isLinkToAnnex,
+	annexHashes,
 	hashDirMixed,
 	hashDirLower,
 

Remote/Rsync.hs

@@ -86,13 +86,26 @@ rsyncEscape o s
 	| rsyncUrlIsShell (rsyncUrl o) = shellEscape s
 	| otherwise = s
 
-rsyncKey :: RsyncOpts -> Key -> String
+rsyncUrls :: RsyncOpts -> Key -> [String]
-rsyncKey o k = rsyncUrl o </> hashDirMixed k </> rsyncEscape o (f </> f)
+rsyncUrls o k = map use annexHashes
 	where
+		use h = rsyncUrl o </> h k </> rsyncEscape o (f </> f)
                 f = keyFile k
 
-rsyncKeyDir :: RsyncOpts -> Key -> String
+rsyncUrlDirs :: RsyncOpts -> Key -> [String]
-rsyncKeyDir o k = rsyncUrl o </> hashDirMixed k </> rsyncEscape o (keyFile k)
+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
+remove o k = any (== True) <$> sequence (map go (rsyncUrlDirs o k))
-	{- Send an empty directory to rysnc as the parent directory
+	where
-         - of the file to remove. -}
+		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
-	liftIO $ createDirectoryIfMissing True dummy
+			createDirectoryIfMissing True dummy
-	liftIO $ rsync $ rsyncOptions o ++
+			rsync $ rsyncOptions o ++
-		[ Params "--delete --recursive"
+				[ Params "--quiet --delete --recursive"
 				, partialParams
 				, Param $ addTrailingPathSeparator dummy
-		, Param $ rsyncKeyDir o k
+				, 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]
+	Right <$> check
-	return $ Right res
 	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

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
+    .git/annex/objects hash directories. To avoid this problem, new content
-    repositories (and the directory special remote) now store new content
+    is now stored in all-lowercase hash directories. Except for non-bare
-    in all-lowercase hash directories. Mixed case hash directories are
+    repositories which would be a pain to transition and cannot be put on FAT.
-    still used for non-bare repositories, which 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.