1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
{- git-remote-gcrypt support
-
- https://spwhitton.name/tech/code/git-remote-gcrypt/
-
- Copyright 2013 Joey Hess <id@joeyh.name>
-
- 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 qualified Git.Command as Command
import Utility.Gpg
urlScheme :: String
urlScheme = "gcrypt:"
urlPrefix :: String
urlPrefix = urlScheme ++ ":"
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.
-}
encryptedRemote :: Repo -> Repo -> IO Repo
encryptedRemote 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 = giveup "not a gcrypt encrypted repository"
data ProbeResult = Decryptable | NotDecryptable | NotEncrypted
{- Checks if the git repo at a location uses gcrypt.
-
- Rather expensive -- many need to fetch the entire repo contents.
- (Which is fine if the repo is going to be added as a remote..)
-}
probeRepo :: String -> Repo -> IO ProbeResult
probeRepo loc baserepo = do
let p = proc "git" $ toCommand $ Command.gitCommandLine
[ Param "remote-gcrypt"
, Param "--check"
, Param loc
] baserepo
(_, _, _, pid) <- createProcess p
code <- waitForProcess pid
return $ case code of
ExitSuccess -> Decryptable
ExitFailure 1 -> NotDecryptable
ExitFailure _ -> NotEncrypted
type GCryptId = 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 GCryptId
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"
remotePublishParticipantConfigKey :: RemoteName -> String
remotePublishParticipantConfigKey = remoteConfigKey "gcrypt-publish-participants"
remoteSigningKey :: RemoteName -> String
remoteSigningKey = remoteConfigKey "gcrypt-signingkey"
remoteConfigKey :: String -> RemoteName -> String
remoteConfigKey key remotename = "remote." ++ remotename ++ "." ++ key
|
