git-annex/Git/GCrypt.hs
Joey Hess 7c1a9cdeb9 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.
2013-09-07 18:38:00 -04:00

78 lines
2.3 KiB
Haskell

{- 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 qualified Git.Config as Config
import Utility.Gpg
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"
type RemoteName = String
{- 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 -> Maybe RemoteName -> Maybe String
remoteRepoId = getRemoteConfig "gcrypt-id"
getRemoteConfig :: String -> Repo -> Maybe RemoteName -> Maybe String
getRemoteConfig field repo remotename = do
n <- remotename
Config.getMaybe (remoteConfigKey field n) repo
{- Gpg keys that the remote is encrypted for.
- If empty, gcrypt uses --default-recipient-self -}
getParticiantList :: Maybe Repo -> Repo -> Maybe RemoteName -> KeyIds
getParticiantList globalconfigrepo repo remotename = KeyIds $ parse $ firstJust
[ getRemoteConfig "gcrypt-participants" repo remotename
, Config.getMaybe defaultkey repo
, Config.getMaybe defaultkey =<< globalconfigrepo
]
where
defaultkey = "gcrypt.participants"
parse (Just "simple") = []
parse (Just l) = words l
parse Nothing = []
remoteParticipantConfigKey :: RemoteName -> String
remoteParticipantConfigKey = remoteConfigKey "gcrypt-participants"
remoteConfigKey :: String -> RemoteName -> String
remoteConfigKey key remotename = "remote." ++ remotename ++ "." ++ key