Improve deletion of files from rsync special remotes. Closes: #652849

Rsync is only run once, with include / exclude rules used to specify
exactly what to delete. This is faster, and avoids ugly error messages
from rsync, and doesn't fail if the content already got deleted somehow.

2 files changed, 24 insertions, 16 deletions

diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index c28142077..68566c52a 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -92,11 +92,6 @@ rsyncUrls o k = map use annexHashes
 		use h = rsyncUrl o </> h k </> rsyncEscape o (f </> f)
                 f = keyFile k
 
-rsyncUrlDirs :: RsyncOpts -> Key -> [String]
-rsyncUrlDirs o k = map use annexHashes
-	where
-		use h = rsyncUrl o </> h k </> rsyncEscape o (keyFile k)
-
 store :: RsyncOpts -> Key -> Annex Bool
 store o k = rsyncSend o k =<< inRepo (gitAnnexLocation k)
 
@@ -125,17 +120,29 @@ retrieveEncrypted o (cipher, enck) f = withTmp enck $ \tmp -> do
 		else return res
 
 remove :: RsyncOpts -> Key -> Annex Bool
-remove o k = untilTrue (rsyncUrlDirs o k) $ \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
+remove o k = withRsyncScratchDir $ \tmp -> liftIO $ do
+	{- Send an empty directory to rysnc to make it delete. -}
+	let dummy = tmp </> keyFile k
+	createDirectoryIfMissing True dummy
+	rsync $ rsyncOptions o ++
+		map (\s -> Param $ "--include=" ++ s) includes ++
+		[ Param "--exclude=*" -- exclude everything else
+		, Params "--quiet --delete --recursive"
+		, partialParams
+		, Param $ addTrailingPathSeparator dummy
+		, Param $ rsyncUrl o
+		]
+	where
+		{- Specify include rules to match the directories where the
+		 - content could be. Note that the parent directories have
+		 - to also be explicitly included, due to how rsync
+		 - traverses directories. -}
+		includes = concatMap use annexHashes
+		use h = let dir = h k in
+			[ parentDir dir
+			, dir
+			-- match content directory and anything in it
+			, dir </> keyFile k </> "***"
 			]
 
 checkPresent :: Git.Repo -> RsyncOpts -> Key -> Annex (Either String Bool)
diff --git a/debian/changelog b/debian/changelog
index 62c7d40f2..564e14403 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -6,6 +6,7 @@ git-annex (3.20111212) UNRELEASED; urgency=low
   * Fix the hook special remote, which bitrotted a while ago.
   * map: --fast disables use of dot to display map
   * Test suite improvements. Current top-level test coverage: 75%
+  * Improve deletion of files from rsync special remotes. Closes: #652849
 
  -- Joey Hess <joeyh@debian.org>  Mon, 12 Dec 2011 01:57:49 -0400