automatically derive an annex-uuid from a gcrypt-uuids

4 files changed, 90 insertions, 0 deletions

diff --git a/Annex/UUID.hs b/Annex/UUID.hs
index c36861bbe..4e274503b 100644
--- a/Annex/UUID.hs
+++ b/Annex/UUID.hs
@@ -17,8 +17,11 @@ module Annex.UUID (
 	getUncachedUUID,
 	prepUUID,
 	genUUID,
+	genUUIDInNameSpace,
+	gCryptNameSpace,
 	removeRepoUUID,
 	storeUUID,
+	setUUID,
 ) where
 
 import Common.Annex
@@ -27,7 +30,9 @@ import qualified Git.Config
 import Config
 
 import qualified Data.UUID as U
+import qualified Data.UUID.V5 as U5
 import System.Random
+import Data.Bits.Utils
 
 configkey :: ConfigKey
 configkey = annexConfig "uuid"
@@ -36,6 +41,17 @@ configkey = annexConfig "uuid"
 genUUID :: IO UUID
 genUUID = UUID . show <$> (randomIO :: IO U.UUID)
 
+{- Generates a UUID from a given string, using a namespace.
+ - Given the same namespace, the same string will always result
+ - in the same UUID. -}
+genUUIDInNameSpace :: U.UUID -> String -> UUID
+genUUIDInNameSpace namespace = UUID . show . U5.generateNamed namespace . s2w8
+
+{- Namespace used for UUIDs derived from git-remote-gcrypt ids. -}
+gCryptNameSpace :: U.UUID
+gCryptNameSpace = U5.generateNamed U5.namespaceURL $
+	s2w8 "http://git-annex.branchable.com/design/gcrypt/" 
+
 {- Get current repository's UUID. -}
 getUUID :: Annex UUID
 getUUID = getRepoUUID =<< gitRepo
@@ -72,3 +88,9 @@ prepUUID = whenM ((==) NoUUID <$> getUUID) $
 
 storeUUID :: ConfigKey -> UUID -> Annex ()
 storeUUID configfield = setConfig configfield . fromUUID
+
+{- Only sets the configkey in the Repo; does not change .git/config -}
+setUUID :: Git.Repo -> UUID -> IO Git.Repo
+setUUID r u = do
+	let s = show configkey ++ "=" ++ fromUUID u
+	Git.Config.store s r
diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs
new file mode 100644
index 000000000..5f2694806
--- /dev/null
+++ b/Git/GCrypt.hs
@@ -0,0 +1,53 @@
+{- git-remote-gcrypt support
+ -
+ - https://github.com/blake2-ppc/git-remote-gcrypt
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.GCrypt where
+
+import Common
+import Git.Types
+import Git.Construct
+import Git.Config
+
+urlPrefix :: String
+urlPrefix = "gcrypt::"
+
+isEncrypted :: Repo -> Bool
+isEncrypted Repo { location = Url url } = urlPrefix `isPrefixOf` show url
+isEncrypted _ = False
+
+{- The first Repo is the git repository that has the second Repo
+ - as one of its remotes.
+ -
+ - When the remote Repo uses gcrypt, returns the actual underlying
+ - git repository that gcrypt is using to store its data. 
+ -
+ - Throws an exception if an url is invalid or the repo does not use
+ - gcrypt.
+ -}
+encryptedRepo :: Repo -> Repo -> IO Repo
+encryptedRepo baserepo = go
+  where
+  	go Repo { location = Url url }
+		| urlPrefix `isPrefixOf` u =
+			fromRemoteLocation (drop plen u) baserepo
+		| otherwise = notencrypted
+	  where
+  		u = show url
+		plen = length urlPrefix
+	go _ = notencrypted
+	notencrypted = error "not a gcrypt encrypted repository"
+
+{- gcrypt gives each encrypted repository a uique gcrypt-id,
+ - which is stored in the repository (in encrypted form)
+ - and cached in a per-remote gcrypt-id configuration setting. -}
+remoteRepoId :: Repo -> Repo -> Maybe String
+remoteRepoId baserepo remote = do
+	name <- remoteName remote
+	let key = "remote." ++ name ++ ".gcrypt-id"
+	getMaybe key baserepo
diff --git a/Remote/Git.hs b/Remote/Git.hs
index e269b9ad8..b3f64bfb8 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -26,6 +26,7 @@ import qualified Git
 import qualified Git.Config
 import qualified Git.Construct
 import qualified Git.Command
+import qualified Git.GCrypt
 import qualified Annex
 import Logs.Presence
 import Logs.Transfer
@@ -152,6 +153,12 @@ tryGitConfigRead r
 	| Git.repoIsHttp r = do
 		headers <- getHttpHeaders
 		store $ geturlconfig headers
+	| Git.GCrypt.isEncrypted r = do
+		g <- gitRepo
+		case Git.GCrypt.remoteRepoId g r of
+			Nothing -> return r
+			Just v -> store $ liftIO $ setUUID r $
+				genUUIDInNameSpace gCryptNameSpace v
 	| Git.repoIsUrl r = return r
 	| otherwise = store $ safely $ onLocal r $ do 
 		ensureInitialized
diff --git a/doc/design/gcrypt.mdwn b/doc/design/gcrypt.mdwn
new file mode 100644
index 000000000..d5b9c064b
--- /dev/null
+++ b/doc/design/gcrypt.mdwn
@@ -0,0 +1,8 @@
+To integrate with git-remote-gcrypt, a key thing is to have a way to map
+from the gcrypt-id of an encrypted repository to a git-annex repository
+uuid.
+
+To do this, we'll make a v5 UUID, feeding in the gcrypt-id.
+The namespace used is itself a v5 UUID, generated using the URL
+namespace and the URL of this page at the time this scheme was
+developed: "http://git-annex.branchable.com/design/gcrypt/"