summaryrefslogtreecommitdiff
path: root/Remote/Helper/Encryptable.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Remote/Helper/Encryptable.hs')
-rw-r--r--Remote/Helper/Encryptable.hs63
1 files changed, 51 insertions, 12 deletions
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 69216a793..4903cffb4 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -5,7 +5,19 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-module Remote.Helper.Encryptable where
+module Remote.Helper.Encryptable (
+ EncryptionIsSetup,
+ encryptionSetup,
+ noEncryptionUsed,
+ encryptionAlreadySetup,
+ remoteCipher,
+ remoteCipher',
+ embedCreds,
+ cipherKey,
+ storeCipher,
+ extractCipher,
+ describeEncryption,
+) where
import qualified Data.Map as M
@@ -16,11 +28,26 @@ import Types.Crypto
import qualified Annex
import Utility.Base64
+-- 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 -> Annex RemoteConfig
+encryptionSetup :: RemoteConfig -> Annex (RemoteConfig, EncryptionIsSetup)
encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
where
-- The type of encryption
@@ -28,11 +55,11 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
-- Generate a new cipher, depending on the chosen encryption scheme
genCipher = case encryption of
_ | M.member "cipher" c || M.member "cipherkeys" c -> cannotchange
- Just "none" -> return c
+ Just "none" -> return (c, NoEncryption)
Just "shared" -> use "encryption setup" . genSharedCipher
=<< highRandomQuality
-- hybrid encryption is the default when a keyid is
- -- specified but no encryption
+ -- specified but no encryption
_ | maybe (M.member "keyid" c) (== "hybrid") encryption ->
use "encryption setup" . genEncryptedCipher key Hybrid
=<< highRandomQuality
@@ -48,7 +75,7 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
cannotchange = error "Cannot set encryption type of existing remotes."
-- Update an existing cipher if possible.
updateCipher v = case v of
- SharedCipher _ | maybe True (== "shared") encryption -> return c'
+ SharedCipher _ | maybe True (== "shared") encryption -> return (c', EncryptionIsSetup)
EncryptedCipher _ variant _
| maybe True (== if variant == Hybrid then "hybrid" else "pubkey") encryption ->
use "encryption update" $ updateEncryptedCipher newkeys v
@@ -57,22 +84,22 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
showNote m
cipher <- liftIO a
showNote $ describeCipher cipher
- return $ storeCipher c' cipher
+ return (storeCipher c' cipher, 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).
+ -- 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" ]
-{- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
- - state. -}
remoteCipher :: RemoteConfig -> Annex (Maybe Cipher)
remoteCipher = fmap fst <$$> remoteCipher'
+{- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
+ - state. -}
remoteCipher' :: RemoteConfig -> Annex (Maybe (Cipher, StorableCipher))
remoteCipher' c = go $ extractCipher c
where
@@ -131,3 +158,15 @@ extractCipher c = case (M.lookup "cipher" c,
_ -> Nothing
where
readkeys = KeyIds . split ","
+
+describeEncryption :: RemoteConfig -> String
+describeEncryption c = case extractCipher c of
+ Nothing -> "not encrypted"
+ (Just (SharedCipher _)) -> "encrypted (encryption key stored in git repository)"
+ (Just (EncryptedCipher _ v (KeyIds { keyIds = ks }))) -> unwords $ catMaybes
+ [ Just "encrypted (to gpg keys:"
+ , Just (unwords ks ++ ")")
+ , case v of
+ PubKey -> Nothing
+ Hybrid -> Just "(hybrid mode)"
+ ]