From d9b78f90a9ceafa810d82c46d4eb489aeab8820b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 5 Sep 2013 16:02:39 -0400 Subject: automatically derive an annex-uuid from a gcrypt-uuids --- Git/GCrypt.hs | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 Git/GCrypt.hs (limited to 'Git') 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 + - + - 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 -- cgit v1.2.3