diff options
| -rw-r--r-- | Annex/UUID.hs | 22 | ||||
| -rw-r--r-- | Git/GCrypt.hs | 53 | ||||
| -rw-r--r-- | Remote/Git.hs | 7 | ||||
| -rw-r--r-- | doc/design/gcrypt.mdwn | 8 |
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/" |