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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
{- common functions for encryptable remotes
-
- Copyright 2011 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Remote.Helper.Encryptable (
EncryptionIsSetup,
encryptionSetup,
noEncryptionUsed,
encryptionAlreadySetup,
remoteCipher,
remoteCipher',
embedCreds,
cipherKey,
extractCipher,
isEncrypted,
describeEncryption,
) where
import qualified Data.Map as M
import qualified "sandi" Codec.Binary.Base64 as B64
import qualified Data.ByteString as B
import Annex.Common
import Types.Remote
import Crypto
import Types.Crypto
import qualified Annex
import Utility.FileSystemEncoding
-- Used to ensure that encryption has been set up before trying to
-- eg, store creds in the remote config that would need to use the
-- encryption setup.
data EncryptionIsSetup = EncryptionIsSetup | NoEncryption
-- Remotes that don't use encryption can use this instead of
-- encryptionSetup.
noEncryptionUsed :: EncryptionIsSetup
noEncryptionUsed = NoEncryption
-- Using this avoids the type-safe check, so you'd better be sure
-- of what you're doing.
encryptionAlreadySetup :: EncryptionIsSetup
encryptionAlreadySetup = EncryptionIsSetup
{- Encryption setup for a remote. The user must specify whether to use
- an encryption key, or not encrypt. An encrypted cipher is created, or is
- updated to be accessible to an additional encryption key. Or the user
- could opt to use a shared cipher, which is stored unencrypted. -}
encryptionSetup :: RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, EncryptionIsSetup)
encryptionSetup c gc = do
cmd <- gpgCmd <$> Annex.getGitConfig
maybe (genCipher cmd) (updateCipher cmd) (extractCipher c)
where
-- The type of encryption
encryption = M.lookup "encryption" c
-- Generate a new cipher, depending on the chosen encryption scheme
genCipher cmd = case encryption of
_ | hasEncryptionConfig c -> cannotchange
Just "none" -> return (c, NoEncryption)
Just "shared" -> encsetup $ genSharedCipher cmd
-- hybrid encryption is the default when a keyid is
-- specified but no encryption
_ | maybe (M.member "keyid" c) (== "hybrid") encryption ->
encsetup $ genEncryptedCipher cmd (c, gc) key Hybrid
Just "pubkey" -> encsetup $ genEncryptedCipher cmd (c, gc) key PubKey
Just "sharedpubkey" -> encsetup $ genSharedPubKeyCipher cmd key
_ -> giveup $ "Specify " ++ intercalate " or "
(map ("encryption=" ++)
["none","shared","hybrid","pubkey", "sharedpubkey"])
++ "."
key = fromMaybe (giveup "Specify keyid=...") $ M.lookup "keyid" c
newkeys = maybe [] (\k -> [(True,k)]) (M.lookup "keyid+" c) ++
maybe [] (\k -> [(False,k)]) (M.lookup "keyid-" c)
cannotchange = giveup "Cannot set encryption type of existing remotes."
-- Update an existing cipher if possible.
updateCipher cmd v = case v of
SharedCipher _ | maybe True (== "shared") encryption -> return (c', EncryptionIsSetup)
EncryptedCipher _ variant _
| maybe True (== if variant == Hybrid then "hybrid" else "pubkey") encryption -> do
use "encryption update" $ updateCipherKeyIds cmd (c, gc) newkeys v
SharedPubKeyCipher _ _ ->
use "encryption update" $ updateCipherKeyIds cmd (c, gc) newkeys v
_ -> cannotchange
encsetup a = use "encryption setup" . a =<< highRandomQuality
use m a = do
showNote m
cipher <- liftIO a
showNote (describeCipher cipher)
return (storeCipher cipher c', EncryptionIsSetup)
highRandomQuality =
(&&) (maybe True ( /= "false") $ M.lookup "highRandomQuality" c)
<$> fmap not (Annex.getState Annex.fast)
c' = foldr M.delete c
-- git-annex used to remove 'encryption' as well, since
-- it was redundant; we now need to keep it for
-- public-key encryption, hence we leave it on newer
-- remotes (while being backward-compatible).
[ "keyid", "keyid+", "keyid-", "highRandomQuality" ]
remoteCipher :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe Cipher)
remoteCipher c gc = fmap fst <$> remoteCipher' c gc
{- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
- state. -}
remoteCipher' :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, StorableCipher))
remoteCipher' c gc = go $ extractCipher c
where
go Nothing = return Nothing
go (Just encipher) = do
cache <- Annex.getState Annex.ciphers
case M.lookup encipher cache of
Just cipher -> return $ Just (cipher, encipher)
Nothing -> do
cmd <- gpgCmd <$> Annex.getGitConfig
cipher <- liftIO $ decryptCipher cmd (c, gc) encipher
Annex.changeState (\s -> s { Annex.ciphers = M.insert encipher cipher cache })
return $ Just (cipher, encipher)
{- Checks if the remote's config allows storing creds in the remote's config.
-
- embedcreds=yes allows this, and embedcreds=no prevents it.
-
- If not set, the default is to only store creds when it's surely safe:
- When gpg encryption is used and the creds are encrypted using it.
- Not when a shared cipher is used.
-}
embedCreds :: RemoteConfig -> Bool
embedCreds c
| M.lookup "embedcreds" c == Just "yes" = True
| M.lookup "embedcreds" c == Just "no" = False
| isJust (M.lookup "cipherkeys" c) && isJust (M.lookup "cipher" c) = True
| otherwise = False
{- Gets encryption Cipher, and key encryptor. -}
cipherKey :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, EncKey))
cipherKey c gc = fmap make <$> remoteCipher c gc
where
make ciphertext = (ciphertext, encryptKey mac ciphertext)
mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac
{- Stores an StorableCipher in a remote's configuration. -}
storeCipher :: StorableCipher -> RemoteConfig -> RemoteConfig
storeCipher cip = case cip of
(SharedCipher t) -> addcipher t
(EncryptedCipher t _ ks) -> addcipher t . storekeys ks "cipherkeys"
(SharedPubKeyCipher t ks) -> addcipher t . storekeys ks "pubkeys"
where
addcipher t = M.insert "cipher" (toB64bs t)
storekeys (KeyIds l) n = M.insert n (intercalate "," l)
{- Extracts an StorableCipher from a remote's configuration. -}
extractCipher :: RemoteConfig -> Maybe StorableCipher
extractCipher c = case (M.lookup "cipher" c,
M.lookup "cipherkeys" c <|> M.lookup "pubkeys" c,
M.lookup "encryption" c) of
(Just t, Just ks, encryption) | maybe True (== "hybrid") encryption ->
Just $ EncryptedCipher (fromB64bs t) Hybrid (readkeys ks)
(Just t, Just ks, Just "pubkey") ->
Just $ EncryptedCipher (fromB64bs t) PubKey (readkeys ks)
(Just t, Just ks, Just "sharedpubkey") ->
Just $ SharedPubKeyCipher (fromB64bs t) (readkeys ks)
(Just t, Nothing, encryption) | maybe True (== "shared") encryption ->
Just $ SharedCipher (fromB64bs t)
_ -> Nothing
where
readkeys = KeyIds . splitc ','
isEncrypted :: RemoteConfig -> Bool
isEncrypted c = case M.lookup "encryption" c of
Just "none" -> False
Just _ -> True
Nothing -> hasEncryptionConfig c
hasEncryptionConfig :: RemoteConfig -> Bool
hasEncryptionConfig c = M.member "cipher" c || M.member "cipherkeys" c || M.member "pubkeys" c
describeEncryption :: RemoteConfig -> String
describeEncryption c = case extractCipher c of
Nothing -> "none"
Just cip -> nameCipher cip ++ " (" ++ describeCipher cip ++ ")"
nameCipher :: StorableCipher -> String
nameCipher (SharedCipher _) = "shared"
nameCipher (EncryptedCipher _ PubKey _) = "pubkey"
nameCipher (EncryptedCipher _ Hybrid _) = "hybrid"
nameCipher (SharedPubKeyCipher _ _) = "sharedpubkey"
describeCipher :: StorableCipher -> String
describeCipher c = case c of
(SharedCipher _) -> "encryption key stored in git repository"
(EncryptedCipher _ _ ks) -> showkeys ks
(SharedPubKeyCipher _ ks) -> showkeys ks
where
showkeys (KeyIds { keyIds = ks }) = "to gpg keys: " ++ unwords ks
{- Not using Utility.Base64 because these "Strings" are really
- bags of bytes and that would convert to unicode and not round-trip
- cleanly. -}
toB64bs :: String -> String
toB64bs = w82s . B.unpack . B64.encode . B.pack . s2w8
fromB64bs :: String -> String
fromB64bs s = either (const bad) (w82s . B.unpack) (B64.decode $ B.pack $ s2w8 s)
where
bad = error "bad base64 encoded data"
|
