From 370757087d8f987b3a2850300d7c12a8bb1043fc Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 15 Nov 2018 15:38:55 -0400
Subject: [PATCH] catch lockContentForRemoval exception

removeKey should not throw exceptions, so catch exception there

In Assistant.Unused, keep trying to drop other keys if one drop fails
---
 Annex/Content.hs    | 2 ++
 Assistant/Unused.hs | 2 +-
 Remote/Git.hs       | 4 +++-
 3 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/Annex/Content.hs b/Annex/Content.hs
index a42d01cc77..b9163ae44e 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -220,6 +220,8 @@ lockContentShared key a = lockContentUsing lock key $ ifM (inAnnex key)
 
 {- Exclusively locks content, while performing an action that
  - might remove it.
+ -
+ - If locking fails, throws an exception rather than running the action.
  -}
 lockContentForRemoval :: Key -> (ContentRemovalLock -> Annex a) -> Annex a
 lockContentForRemoval key a = lockContentUsing lock key $ 
diff --git a/Assistant/Unused.hs b/Assistant/Unused.hs
index 26d59cf696..b47727cd09 100644
--- a/Assistant/Unused.hs
+++ b/Assistant/Unused.hs
@@ -75,7 +75,7 @@ expireUnused duration = do
 	let oldkeys = M.keys $ M.filter (tooold now) m
 	forM_ oldkeys $ \k -> do
 		debug ["removing old unused key", key2file k]
-		liftAnnex $ do
+		liftAnnex $ tryNonAsync $ do
 			lockContentForRemoval k removeAnnex
 			logStatus k InfoMissing
   where
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 3a9eff2379..3a3af713df 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -377,7 +377,9 @@ keyUrls gc repo r key = map tourl locs'
 dropKey :: Remote -> State -> Key -> Annex Bool
 dropKey r st key = do
 	repo <- getRepo r
-	dropKey' repo r st key
+	catchNonAsync
+		(dropKey' repo r st key)
+		(\e -> warning (show e) >> return False)
 
 dropKey' :: Git.Repo -> Remote -> State -> Key -> Annex Bool
 dropKey' repo r (State connpool duc _) key