Merge branch 'master' into assistant

2 files changed, 49 insertions, 26 deletions

diff --git a/Remote/Git.hs b/Remote/Git.hs
index df74a769c..60a881803 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -43,7 +43,7 @@ list :: Annex [Git.Repo]
 list = do
 	c <- fromRepo Git.config
 	rs <- mapM (tweakurl c) =<< fromRepo Git.remotes
-	catMaybes <$> mapM configread rs
+	mapM configread rs
 	where
 		annexurl n = "remote." ++ n ++ ".annexurl"
 		tweakurl c r = do
@@ -61,16 +61,11 @@ list = do
 		configread r = do
 			notignored <- repoNotIgnored r
 			u <- getRepoUUID r
-			r' <- case (repoCheap r, notignored, u) of
+			case (repoCheap r, notignored, u) of
 				(_, False, _) -> return r
 				(True, _, _) -> tryGitConfigRead r
 				(False, _, NoUUID) -> tryGitConfigRead r
 				_ -> return r
-			{- A repo with a LocalUnknown location is not currently
-			 - accessible, so skip it. -}
-			if Git.repoIsLocalUnknown r'
-				then return Nothing
-				else return $ Just r'
 
 repoCheap :: Git.Repo -> Bool
 repoCheap = not . Git.repoIsUrl
@@ -95,6 +90,21 @@ gen r u _ = new <$> remoteCost r defcst
 			remotetype = remote
 		}
 
+{- Checks relatively inexpensively if a repository is available for use. -}
+repoAvail :: Git.Repo -> Annex Bool
+repoAvail r 
+	| Git.repoIsHttp r = return True
+	| Git.repoIsUrl r = return True
+	| Git.repoIsLocalUnknown r = return False
+	| otherwise = liftIO $ catchBoolIO $ onLocal r $ return True
+
+{- Avoids performing an action on a local repository that's not usable.
+ - Does not check that the repository is still available on disk. -}
+guardUsable :: Git.Repo -> a -> Annex a -> Annex a
+guardUsable r onerr a
+	| Git.repoIsLocalUnknown r = return onerr
+	| otherwise = a
+
 {- Tries to read the config for a specified remote, updates state, and
  - returns the updated repo. -}
 tryGitConfigRead :: Git.Repo -> Annex Git.Repo
@@ -166,7 +176,7 @@ inAnnex r key
 				dispatch ExitSuccess = Right True
 				dispatch (ExitFailure 1) = Right False
 				dispatch _ = unknown
-		checklocal = dispatch <$> check
+		checklocal = guardUsable r unknown $ dispatch <$> check
 			where
 				check = liftIO $ catchMsgIO $ onLocal r $
 					Annex.Content.inAnnexSafe key
@@ -175,13 +185,6 @@ inAnnex r key
 				dispatch (Right Nothing) = unknown
 		unknown = Left $ "unable to check " ++ Git.repoDescribe r
 
-{- Checks inexpensively if a repository is available for use. -}
-repoAvail :: Git.Repo -> Annex Bool
-repoAvail r 
-	| Git.repoIsHttp r = return True
-	| Git.repoIsUrl r = return True
-	| otherwise = liftIO $ catchBoolIO $ onLocal r $ return True
-
 {- Runs an action on a local repository inexpensively, by making an annex
  - monad using that repository. -}
 onLocal :: Git.Repo -> Annex a -> IO a
@@ -200,14 +203,15 @@ keyUrls r key = map tourl (annexLocations key)
 
 dropKey :: Git.Repo -> Key -> Annex Bool
 dropKey r key
-	| not $ Git.repoIsUrl r = commitOnCleanup r $ liftIO $ onLocal r $ do
-		ensureInitialized
-		whenM (Annex.Content.inAnnex key) $ do
-			Annex.Content.lockContent key $
-				Annex.Content.removeAnnex key
-			Annex.Content.logStatus key InfoMissing
-			Annex.Content.saveState True
-		return True
+	| not $ Git.repoIsUrl r =
+		guardUsable r False $ commitOnCleanup r $ liftIO $ onLocal r $ do
+			ensureInitialized
+			whenM (Annex.Content.inAnnex key) $ do
+				Annex.Content.lockContent key $
+					Annex.Content.removeAnnex key
+				Annex.Content.logStatus key InfoMissing
+				Annex.Content.saveState True
+			return True
 	| Git.repoIsHttp r = error "dropping from http repo not supported"
 	| otherwise = commitOnCleanup r $ onRemote r (boolSystem, False) "dropkey"
 		[ Params "--quiet --force"
@@ -217,7 +221,7 @@ dropKey r key
 {- Tries to copy a key's content from a remote's annex to a file. -}
 copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
 copyFromRemote r key file
-	| not $ Git.repoIsUrl r = do
+	| not $ Git.repoIsUrl r = guardUsable r False $ do
 		params <- rsyncParams r
 		loc <- liftIO $ gitAnnexLocation key r
 		rsyncOrCopyFile params loc file
@@ -227,7 +231,7 @@ copyFromRemote r key file
 
 copyFromRemoteCheap :: Git.Repo -> Key -> FilePath -> Annex Bool
 copyFromRemoteCheap r key file
-	| not $ Git.repoIsUrl r = do
+	| not $ Git.repoIsUrl r = guardUsable r False $ do
 		loc <- liftIO $ gitAnnexLocation key r
 		liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
 	| Git.repoIsSsh r =
@@ -240,7 +244,7 @@ copyFromRemoteCheap r key file
 {- Tries to copy a key's content to a remote's annex. -}
 copyToRemote :: Git.Repo -> Key -> Annex Bool
 copyToRemote r key
-	| not $ Git.repoIsUrl r = commitOnCleanup r $ do
+	| not $ Git.repoIsUrl r = guardUsable r False $ commitOnCleanup r $ do
 		keysrc <- inRepo $ gitAnnexLocation key
 		params <- rsyncParams r
 		-- run copy from perspective of remote
diff --git a/doc/design/assistant/blog/day_17__push_queue_prune.mdwn b/doc/design/assistant/blog/day_17__push_queue_prune.mdwn
new file mode 100644
index 000000000..54ee75fb8
--- /dev/null
+++ b/doc/design/assistant/blog/day_17__push_queue_prune.mdwn
@@ -0,0 +1,19 @@
+Not much available time today, only a few hours.
+
+Main thing I did was fixed up the failed push tracking to use a better data
+structure. No need for a queue of failed pushes, all it needs is a map of
+remotes that have an outstanding failed push, and a timestamp. Now it
+won't grow in memory use forever anymore. :)
+
+Finding the right thread mutex type for this turned out to be a bit of a
+challenge. I ended up with a STM TMVar, which is left empty when there are
+no pushes to retry, so the thread using it blocks until there are some. And,
+it can be updated transactionally, without races.
+
+I also fixed a bug outside the git-annex assistant code. It was possible to
+crash git-annex if a local git repository was configured as a remote, and
+the repository was not available on startup. git-annex now ignores such
+remotes. This does impact the assistant, since it is a long running process
+and git repositories will come and go. Now it ignores any that
+were not available when it started up. This will need to be dealt with when
+making it support removable drives.