partially complete gcrypt remote (local send done; rest not)

This is a git-remote-gcrypt encrypted special remote. Only sending files
in to the remote works, and only for local repositories.

Most of the work so far has involved making initremote work. A particular
problem is that remote setup in this case needs to generate its own uuid,
derivied from the gcrypt-id. That required some larger changes in the code
to support.

For ssh remotes, this will probably just reuse Remote.Rsync's code, so
should be easy enough. And for downloading from a web remote, I will need
to factor out the part of Remote.Git that does that.

One particular thing that will need work is supporting hot-swapping a local
gcrypt remote. I think it needs to store the gcrypt-id in the git config of the
local remote, so that it can check it every time, and compare with the
cached annex-uuid for the remote. If there is a mismatch, it can change
both the cached annex-uuid and the gcrypt-id. That should work, and I laid
some groundwork for it by already reading the remote's config when it's
local. (Also needed for other reasons.)

This commit was sponsored by Daniel Callahan.

1 files changed, 31 insertions, 39 deletions

diff --git a/Remote/Git.hs b/Remote/Git.hs
index b3f64bfb8..93c923853 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -13,9 +13,6 @@ module Remote.Git (
 	repoAvail,
 ) where
 
-import qualified Data.Map as M
-import Control.Exception.Extensible
-
 import Common.Annex
 import Utility.Rsync
 import Remote.Helper.Ssh
@@ -47,10 +44,14 @@ import Utility.Metered
 #ifndef mingw32_HOST_OS
 import Utility.CopyFile
 #endif
+import Remote.Helper.Git
+import qualified Remote.GCrypt
 
 import Control.Concurrent
 import Control.Concurrent.MSampleVar
 import System.Process (std_in, std_err)
+import qualified Data.Map as M
+import Control.Exception.Extensible
 
 remote :: RemoteType
 remote = RemoteType {
@@ -91,11 +92,10 @@ configRead r = do
 		(False, _, NoUUID) -> tryGitConfigRead r
 		_ -> return r
 
-repoCheap :: Git.Repo -> Bool
-repoCheap = not . Git.repoIsUrl
-
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
-gen r u _ gc = go <$> remoteCost gc defcst
+gen r u c gc
+	| Git.GCrypt.isEncrypted r = Remote.GCrypt.gen r u c gc
+	| otherwise = go <$> remoteCost gc defcst
   where
 	defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
 	go cst = new
@@ -112,14 +112,12 @@ gen r u _ gc = go <$> remoteCost gc defcst
 			, hasKeyCheap = repoCheap r
 			, whereisKey = Nothing
 			, config = M.empty
-			, localpath = if Git.repoIsLocal r || Git.repoIsLocalUnknown r
-				then Just $ Git.repoPath r
-				else Nothing
+			, localpath = localpathCalc r
 			, repo = r
 			, gitconfig = gc
 				{ remoteGitConfig = Just $ extractGitConfig r }
 			, readonly = Git.repoIsHttp r
-			, globallyAvailable = not $ Git.repoIsLocal r || Git.repoIsLocalUnknown r
+			, globallyAvailable = globallyAvailableCalc r
 			, remotetype = remote
 			}
 
@@ -131,13 +129,6 @@ repoAvail r
 	| 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
@@ -154,8 +145,9 @@ tryGitConfigRead r
 		headers <- getHttpHeaders
 		store $ geturlconfig headers
 	| Git.GCrypt.isEncrypted r = do
+		-- Generate a UUID from the gcrypt-id
 		g <- gitRepo
-		case Git.GCrypt.remoteRepoId g r of
+		case Git.GCrypt.remoteRepoId g (Git.remoteName r) of
 			Nothing -> return r
 			Just v -> store $ liftIO $ setUUID r $
 				genUUIDInNameSpace gCryptNameSpace v
@@ -261,17 +253,6 @@ inAnnex r key
 	unknown = Left $ "unable to check " ++ Git.repoDescribe r
 	showchecking = showAction $ "checking " ++ Git.repoDescribe r
 
-{- Runs an action on a local repository inexpensively, by making an annex
- - monad using that repository. -}
-onLocal :: Git.Repo -> Annex a -> IO a
-onLocal r a = do
-	s <- Annex.new r
-	Annex.eval s $ do
-		-- No need to update the branch; its data is not used
-		-- for anything onLocal is used to do.
-		Annex.BranchState.disableUpdate
-		a
-
 keyUrls :: Git.Repo -> Key -> [String]
 keyUrls r key = map tourl locs
   where
@@ -415,15 +396,16 @@ copyToRemote r key file p
 							(\d -> rsyncOrCopyFile params object d p)
 			)
 
-rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool
-rsyncHelper callback params = do
-	showOutput -- make way for progress bar
-	ifM (liftIO $ (maybe rsync rsyncProgress callback) params)
-		( return True
-		, do
-			showLongNote "rsync failed -- run git annex again to resume file transfer"
-			return False
-		)
+{- Runs an action on a local repository inexpensively, by making an annex
+ - monad using that repository. -}
+onLocal :: Git.Repo -> Annex a -> IO a
+onLocal r a = do
+	s <- Annex.new r
+	Annex.eval s $ do
+		-- No need to update the branch; its data is not used
+		-- for anything onLocal is used to do.
+		Annex.BranchState.disableUpdate
+		a
 
 {- Copys a file with rsync unless both locations are on the same
  - filesystem. Then cp could be faster. -}
@@ -456,6 +438,16 @@ rsyncOrCopyFile rsyncparams src dest p =
 	dorsync = rsyncHelper (Just p) $
 		rsyncparams ++ [File src, File dest]
 
+rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool
+rsyncHelper callback params = do
+	showOutput -- make way for progress bar
+	ifM (liftIO $ (maybe rsync rsyncProgress callback) params)
+		( return True
+		, do
+			showLongNote "rsync failed -- run git annex again to resume file transfer"
+			return False
+		)
+
 {- Generates rsync parameters that ssh to the remote and asks it
  - to either receive or send the key's content. -}
 rsyncParamsRemote :: Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]