From 73d1f889c0b6d63fefcc3296bcd0402b1caed419 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 27 Oct 2013 15:38:59 -0400
Subject: assistant: Support repairing git remotes that are locally accessible
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

(eg, on removable drives)

gcrypt remotes are not yet handled.

This commit was sponsored by Sören Brunk.
---
 Remote/Bup.hs       | 1 +
 Remote/Directory.hs | 1 +
 Remote/GCrypt.hs    | 1 +
 Remote/Git.hs       | 7 +++++++
 Remote/Glacier.hs   | 1 +
 Remote/Hook.hs      | 1 +
 Remote/Rsync.hs     | 1 +
 Remote/S3.hs        | 1 +
 Remote/Web.hs       | 1 +
 Remote/WebDAV.hs    | 1 +
 10 files changed, 16 insertions(+)

(limited to 'Remote')

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index d2c3038af..4e89dcff2 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -64,6 +64,7 @@ gen r u c gc = do
 		, hasKeyCheap = bupLocal buprepo
 		, whereisKey = Nothing
 		, remoteFsck = Nothing
+		, repairRepo = Nothing
 		, config = c
 		, repo = r
 		, gitconfig = gc
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index cee4d6a0a..16535070e 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -55,6 +55,7 @@ gen r u c gc = do
 			hasKeyCheap = True,
 			whereisKey = Nothing,
 			remoteFsck = Nothing,
+			repairRepo = Nothing,
 			config = M.empty,
 			repo = r,
 			gitconfig = gc,
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 89d2c431f..a421668f8 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -108,6 +108,7 @@ gen' r u c gc = do
 		, hasKeyCheap = repoCheap r
 		, whereisKey = Nothing
 		, remoteFsck = Nothing
+		, repairRepo = Nothing
 		, config = M.empty
 		, localpath = localpathCalc r
 		, repo = r
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 480d4f714..ba247078b 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -117,6 +117,9 @@ gen r u c gc
 			, remoteFsck = if Git.repoIsUrl r
 				then Nothing
 				else Just $ fsckOnRemote r
+			, repairRepo = if Git.repoIsUrl r
+				then Nothing
+				else Just $ repairRemote r
 			, config = M.empty
 			, localpath = localpathCalc r
 			, repo = r
@@ -419,6 +422,10 @@ fsckOnRemote r params
 			] ++ env
 		batchCommandEnv program (Param "fsck" : params) (Just env')
 
+{- The passed repair action is run in the Annex monad of the remote. -}
+repairRemote :: Git.Repo -> Annex Bool -> Annex (IO Bool)
+repairRemote r a = return $ Remote.Git.onLocal r a
+
 {- Runs an action on a local repository inexpensively, by making an annex
  - monad using that repository. -}
 onLocal :: Git.Repo -> Annex a -> IO a
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 5cd224d19..300e682a7 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -60,6 +60,7 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
 			hasKeyCheap = False,
 			whereisKey = Nothing,
 			remoteFsck = Nothing,
+			repairRepo = Nothing,
 			config = c,
 			repo = r,
 			gitconfig = gc,
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 88c70e0cf..fdb24d0cb 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -53,6 +53,7 @@ gen r u c gc = do
 			hasKeyCheap = False,
 			whereisKey = Nothing,
 			remoteFsck = Nothing,
+			repairRepo = Nothing,
 			config = M.empty,
 			localpath = Nothing,
 			repo = r,
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index b0ef318d3..6bc5fd78f 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -80,6 +80,7 @@ gen r u c gc = do
 			, hasKeyCheap = False
 			, whereisKey = Nothing
 			, remoteFsck = Nothing
+			, repairRepo = Nothing
 			, config = M.empty
 			, repo = r
 			, gitconfig = gc
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 348b240d4..0933f30de 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -63,6 +63,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			hasKeyCheap = False,
 			whereisKey = Nothing,
 			remoteFsck = Nothing,
+			repairRepo = Nothing,
 			config = c,
 			repo = r,
 			gitconfig = gc,
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 23de73c27..7c98dbf40 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -57,6 +57,7 @@ gen r _ _ gc =
 		hasKeyCheap = False,
 		whereisKey = Just getUrls,
 		remoteFsck = Nothing,
+		repairRepo = Nothing,
 		config = M.empty,
 		gitconfig = gc,
 		localpath = Nothing,
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 1a722f147..738dbde3f 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -66,6 +66,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			hasKeyCheap = False,
 			whereisKey = Nothing,
 			remoteFsck = Nothing,
+			repairRepo = Nothing,
 			config = c,
 			repo = r,
 			gitconfig = gc,
-- 
cgit v1.2.3