Added new encryption=sharedpubkey mode for special remotes.

This is useful for makking a special remote that anyone with a clone of the
repo and your public keys can upload files to, but only you can decrypt the
files stored in it.

7 files changed, 114 insertions, 63 deletions

diff --git a/Crypto.hs b/Crypto.hs
index 1b0877188..62c807f8e 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -18,8 +18,8 @@ module Crypto (
 	StorableCipher(..),
 	genEncryptedCipher,
 	genSharedCipher,
-	updateEncryptedCipher,
-	describeCipher,
+	genSharedPubKeyCipher,
+	updateCipherKeyIds,
 	decryptCipher,		
 	encryptKey,
 	isEncKey,
@@ -74,7 +74,7 @@ cipherMac (Cipher c) = take cipherBeginning c
 cipherMac (MacOnlyCipher c) = c
 
 {- Creates a new Cipher, encrypted to the specified key id. -}
-genEncryptedCipher :: Gpg.GpgCmd -> String -> EncryptedCipherVariant -> Bool -> IO StorableCipher
+genEncryptedCipher :: Gpg.GpgCmd -> Gpg.KeyId -> EncryptedCipherVariant -> Bool -> IO StorableCipher
 genEncryptedCipher cmd keyid variant highQuality = do
 	ks <- Gpg.findPubKeys cmd keyid
 	random <- Gpg.genRandom cmd highQuality size
@@ -89,35 +89,40 @@ genSharedCipher :: Gpg.GpgCmd -> Bool -> IO StorableCipher
 genSharedCipher cmd highQuality =
 	SharedCipher <$> Gpg.genRandom cmd highQuality cipherSize
 
-{- Updates an existing Cipher, re-encrypting it to add or remove keyids,
- - depending on whether the first component is True or False. -}
-updateEncryptedCipher :: Gpg.GpgCmd -> [(Bool, String)] -> StorableCipher -> IO StorableCipher
-updateEncryptedCipher _ _ SharedCipher{} = error "Cannot update shared cipher"
-updateEncryptedCipher _ [] encipher = return encipher
-updateEncryptedCipher cmd newkeys encipher@(EncryptedCipher _ variant (KeyIds ks)) = do
-	dropKeys <- listKeyIds [ k | (False, k) <- newkeys ]
-	forM_ dropKeys $ \k -> unless (k `elem` ks) $
+{- Creates a new, shared Cipher, and looks up the gpg public key that will
+ - be used for encrypting content. -}
+genSharedPubKeyCipher :: Gpg.GpgCmd -> Gpg.KeyId -> Bool -> IO StorableCipher
+genSharedPubKeyCipher cmd keyid highQuality = do
+	ks <- Gpg.findPubKeys cmd keyid
+	random <- Gpg.genRandom cmd highQuality cipherSize
+	return $ SharedPubKeyCipher random ks
+
+{- Updates an existing Cipher, making changes to its keyids.
+ -
+ - When the Cipher is encrypted, re-encrypts it. -}
+updateCipherKeyIds :: Gpg.GpgCmd -> [(Bool, Gpg.KeyId)] -> StorableCipher -> IO StorableCipher
+updateCipherKeyIds _ _ SharedCipher{} = error "Cannot update shared cipher"
+updateCipherKeyIds _ [] c = return c
+updateCipherKeyIds cmd changes encipher@(EncryptedCipher _ variant ks) = do
+	ks' <- updateCipherKeyIds' cmd changes ks
+	cipher <- decryptCipher cmd encipher
+	encryptCipher cmd cipher variant ks'
+updateCipherKeyIds cmd changes (SharedPubKeyCipher cipher ks) =
+	SharedPubKeyCipher cipher <$> updateCipherKeyIds' cmd changes ks
+
+updateCipherKeyIds' :: Gpg.GpgCmd -> [(Bool, Gpg.KeyId)] -> KeyIds -> IO KeyIds
+updateCipherKeyIds' cmd changes (KeyIds ks) = do
+	dropkeys <- listKeyIds [ k | (False, k) <- changes ]
+	forM_ dropkeys $ \k -> unless (k `elem` ks) $
 		error $ "Key " ++ k ++ " was not present; cannot remove."
-	addKeys <- listKeyIds [ k | (True, k) <- newkeys ]
-	let ks' = (addKeys ++ ks) \\ dropKeys
+	addkeys <- listKeyIds [ k | (True, k) <- changes ]
+	let ks' = (addkeys ++ ks) \\ dropkeys
 	when (null ks') $
 		error "Cannot remove the last key."
-	cipher <- decryptCipher cmd encipher
-	encryptCipher cmd cipher variant $ KeyIds ks'
+	return $ KeyIds ks'
   where
 	listKeyIds = concat <$$> mapM (keyIds <$$> Gpg.findPubKeys cmd)
 
-describeCipher :: StorableCipher -> String
-describeCipher (SharedCipher _) = "shared cipher"
-describeCipher (EncryptedCipher _ variant (KeyIds ks)) =
-	scheme ++ " with gpg " ++ keys ks ++ " " ++ unwords ks
-  where
-	scheme = case variant of
-		Hybrid -> "hybrid cipher"
-		PubKey -> "pubkey crypto"
-	keys [_] = "key"
-	keys _ = "keys"
-
 {- Encrypts a Cipher to the specified KeyIds. -}
 encryptCipher :: Gpg.GpgCmd -> Cipher -> EncryptedCipherVariant -> KeyIds -> IO StorableCipher
 encryptCipher cmd c variant (KeyIds ks) = do
@@ -134,6 +139,7 @@ encryptCipher cmd c variant (KeyIds ks) = do
 {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
 decryptCipher :: Gpg.GpgCmd -> StorableCipher -> IO Cipher
 decryptCipher _ (SharedCipher t) = return $ Cipher t
+decryptCipher _ (SharedPubKeyCipher t _) = return $ MacOnlyCipher t
 decryptCipher cmd (EncryptedCipher t variant _) =
 	mkCipher <$> Gpg.pipeStrict cmd [ Param "--decrypt" ] t
   where
@@ -223,6 +229,7 @@ instance LensGpgEncParams RemoteConfig where
 	 - look up the recipient keys and add them to the option list. -}
 	getGpgEncParams c = case M.lookup "encryption" c of
 		Just "pubkey" -> Gpg.pkEncTo $ maybe [] (split ",") $ M.lookup "cipherkeys" c
+		Just "sharedpubkey" -> Gpg.pkEncTo $ maybe [] (split ",") $ M.lookup "pubkeys" c
 		_ -> []
 	getGpgDecParams _ = []
 
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index eb8172653..38b85d91b 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -297,9 +297,9 @@ shellOrRsync r ashell arsync
 setGcryptEncryption :: RemoteConfig -> String -> Annex ()
 setGcryptEncryption c remotename = do
 	let participants = remoteconfig Git.GCrypt.remoteParticipantConfigKey
-	case extractCipher c of
+	case cipherKeyIds =<< extractCipher c of
 		Nothing -> noCrypto
-		Just (EncryptedCipher _ _ (KeyIds { keyIds = ks})) -> do
+		Just (KeyIds { keyIds = ks}) -> do
 			setConfig participants (unwords ks)
 			let signingkey = ConfigKey $ Git.GCrypt.remoteSigningKey remotename
 			cmd <- gpgCmd <$> Annex.getGitConfig
@@ -307,8 +307,6 @@ setGcryptEncryption c remotename = do
 			case filter (`elem` ks) skeys of
 				[] -> noop
 				(k:_) -> setConfig signingkey k
-		Just (SharedCipher _) ->
-			unsetConfig participants
 	setConfig (remoteconfig Git.GCrypt.remotePublishParticipantConfigKey)
 		(Git.Config.boolConfig True)
   where
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 6d294b915..46ce57dc1 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -14,7 +14,6 @@ module Remote.Helper.Encryptable (
 	remoteCipher',
 	embedCreds,
 	cipherKey,
-	storeCipher,
 	extractCipher,
 	describeEncryption,
 ) where
@@ -58,20 +57,18 @@ encryptionSetup c = do
 	encryption = M.lookup "encryption" c
 	-- Generate a new cipher, depending on the chosen encryption scheme
 	genCipher cmd = case encryption of
-		_ | M.member "cipher" c || M.member "cipherkeys" c -> cannotchange
+		_ | M.member "cipher" c || M.member "cipherkeys" c || M.member "pubkeys" c -> cannotchange
 		Just "none" -> return (c, NoEncryption)
-		Just "shared" -> use "encryption setup" . genSharedCipher cmd
-			=<< highRandomQuality
+		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 ->
-			use "encryption setup" . genEncryptedCipher cmd key Hybrid
-				=<< highRandomQuality
-		Just "pubkey" -> use "encryption setup" . genEncryptedCipher cmd key PubKey
-				=<< highRandomQuality
+			encsetup $ genEncryptedCipher cmd key Hybrid
+		Just "pubkey" -> encsetup $ genEncryptedCipher cmd key PubKey
+		Just "sharedpubkey" -> encsetup $ genSharedPubKeyCipher cmd key
 		_ -> error $ "Specify " ++ intercalate " or "
 			(map ("encryption=" ++)
-				["none","shared","hybrid","pubkey"])
+				["none","shared","hybrid","pubkey", "sharedpubkey"])
 			++ "."
 	key = fromMaybe (error "Specifiy keyid=...") $ M.lookup "keyid" c
 	newkeys = maybe [] (\k -> [(True,k)]) (M.lookup "keyid+" c) ++
@@ -82,13 +79,16 @@ encryptionSetup c = do
 		SharedCipher _ | maybe True (== "shared") encryption -> return (c', EncryptionIsSetup)
 		EncryptedCipher _ variant _
 			| maybe True (== if variant == Hybrid then "hybrid" else "pubkey") encryption ->
-				use "encryption update" $ updateEncryptedCipher cmd newkeys v
+				use "encryption update" $ updateCipherKeyIds cmd newkeys v
+		SharedPubKeyCipher _ _ ->
+			use "encryption update" $ updateCipherKeyIds cmd newkeys v
 		_ -> cannotchange
+	encsetup a = use "encryption setup" . a =<< highRandomQuality
 	use m a = do
 		showNote m
 		cipher <- liftIO a
-		showNote $ describeCipher cipher
-		return (storeCipher c' cipher, EncryptionIsSetup)
+		mapM_ showNote (describeCipher cipher)
+		return (storeCipher cipher c', EncryptionIsSetup)
 	highRandomQuality = 
 		(&&) (maybe True ( /= "false") $ M.lookup "highRandomQuality" c)
 			<$> fmap not (Annex.getState Annex.fast)
@@ -123,8 +123,8 @@ remoteCipher' c = go $ extractCipher c
  - 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, in which case the creds will be encrypted
- - using it. Not when a shared cipher is used.
+ - When gpg encryption is used and the creds are encrypted using it.
+ - Not when a shared cipher is used.
  -}
 embedCreds :: RemoteConfig -> Bool
 embedCreds c
@@ -141,22 +141,26 @@ cipherKey c = fmap make <$> remoteCipher c
 	mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac
 
 {- Stores an StorableCipher in a remote's configuration. -}
-storeCipher :: RemoteConfig -> StorableCipher -> RemoteConfig
-storeCipher c (SharedCipher t) = M.insert "cipher" (toB64bs t) c
-storeCipher c (EncryptedCipher t _ ks) =
-	M.insert "cipher" (toB64bs t) $ M.insert "cipherkeys" (showkeys ks) c
+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
-	showkeys (KeyIds l) = intercalate "," l
+	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 "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
@@ -166,14 +170,25 @@ extractCipher c = case (M.lookup "cipher" c,
 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 ++ ")")
+	Just cip -> "encrypted " ++ unwords (map paren (describeCipher cip))
+  where
+	paren s = "(" ++ s ++ ")"
+
+describeCipher :: StorableCipher -> [String]
+describeCipher c = case c of
+	(SharedCipher _) -> ["encryption key stored in git repository"]
+	(EncryptedCipher _ v ks) -> catMaybes
+		[ Just $ showkeys ks
 		, case v of
 			PubKey -> Nothing
-			Hybrid -> Just "(hybrid mode)"
+			Hybrid -> Just "hybrid mode"
 		]
+	(SharedPubKeyCipher _ ks) ->
+		[ showkeys ks
+		, "shared cipher"
+		]
+  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
diff --git a/Types/Crypto.hs b/Types/Crypto.hs
index 79970c288..c5a00d032 100644
--- a/Types/Crypto.hs
+++ b/Types/Crypto.hs
@@ -10,6 +10,7 @@ module Types.Crypto (
 	StorableCipher(..),
 	EncryptedCipherVariant(..),
 	KeyIds(..),
+	cipherKeyIds,
 	Mac(..),
 	readMac,
 	showMac,
@@ -23,12 +24,19 @@ import Utility.Gpg (KeyIds(..))
 -- XXX ideally, this would be a locked memory region
 data Cipher = Cipher String | MacOnlyCipher String
 
-data StorableCipher = EncryptedCipher String EncryptedCipherVariant KeyIds
-		| SharedCipher String
+data StorableCipher
+	= EncryptedCipher String EncryptedCipherVariant KeyIds
+	| SharedCipher String
+	| SharedPubKeyCipher String KeyIds
 	deriving (Ord, Eq)
 data EncryptedCipherVariant = Hybrid | PubKey
 	deriving (Ord, Eq)
 
+cipherKeyIds :: StorableCipher -> Maybe KeyIds
+cipherKeyIds (EncryptedCipher _ _ ks) = Just ks
+cipherKeyIds (SharedPubKeyCipher _ ks) = Just ks
+cipherKeyIds (SharedCipher _) = Nothing
+
 defaultMac :: Mac
 defaultMac = HmacSha1
 
diff --git a/debian/changelog b/debian/changelog
index 4381f5810..7c02d2a25 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -28,6 +28,10 @@ git-annex (6.20160420) UNRELEASED; urgency=medium
   * In the unusual configuration where annex.crippledfilesystem=true but
     core.symlinks=true, store object contents in mixed case hash
     directories so that symlinks will point to them.
+  * Added new encryption=sharedpubkey mode for special remotes.
+    This is useful for makking a special remote that anyone with a clone
+    of the repo and your public keys can upload files to, but only you can
+    decrypt the files stored in it.
 
  -- Joey Hess <id@joeyh.name>  Thu, 28 Apr 2016 13:17:04 -0400
 
diff --git a/doc/encryption.mdwn b/doc/encryption.mdwn
index bf6a9a229..311511510 100644
--- a/doc/encryption.mdwn
+++ b/doc/encryption.mdwn
@@ -23,8 +23,9 @@ to disable encryption. To use encryption, you run
 * `git annex initremote newremote type=... encryption=hybrid keyid=KEYID ...`
 * `git annex initremote newremote type=... encryption=shared`
 * `git annex initremote newremote type=... encryption=pubkey keyid=KEYID ...`
+* `git annex initremote newremote type=... encryption=sharedpubkey keyid=KEYID ...``
 
-## hybrid encryption keys
+## hybrid encryption keys (encryption=hybrid)
 
 The [[hybrid_key_design|design/encryption]] allows additional
 encryption keys to be added on to a special remote later. Due to this
@@ -53,7 +54,7 @@ probably to replace a revoked key:
 See also [[encryption_design|design/encryption]] for other security
 risks associated with encryption.
 
-## shared encryption key
+## shared encryption key (encryption=shared)
 
 Alternatively, you can configure git-annex to use a shared cipher to
 encrypt data stored in a remote. This shared cipher is stored,
@@ -66,7 +67,7 @@ The advantage is you don't need to set up gpg keys. The disadvantage is
 that this is **insecure** unless you trust every clone of the git
 repository with access to the encrypted data stored in the special remote.
 
-## regular public key encryption
+## regular public key encryption (encryption=pubkey)
 
 This alternative simply encrypts the files in the special remotes to one or
 more public keys. It might be considered more secure due to its simplicity
@@ -88,9 +89,25 @@ key has to be kept around to be able to decrypt those files.
 that the key has been compromised, it is **insecure** to leave files
 encrypted using that old key, and the user should re-encrypt everything.)
 
-(Because filenames are MAC'ed, a cipher still needs to be
-generated (and encrypted to the given key IDs). It is only used for MHAC
-encryption of filenames.)
+(A cipher still needs to be generated (and is encrypted to the given key IDs).
+It is only used for HMAC encryption of filenames.)
+
+## regular public key encryption with shared filename encryption (encryption=sharedpubkey)
+
+This is a variation on encryption=pubkey which lets anyone who
+has access to the gpg public keys store files in the special remote.
+But, only owners of the corresponding private keys can retrieve the files
+from the special remote.
+
+	git annex initremote newremote type=... [encryption=hybrid] keyid=KEYID ...
+
+This might be useful if you want to let others drop off files for you in a
+special remote, so that only you can access them.
+
+The filenames used on the special remote are encrypted using HMAC,
+which prevents the special remote from seeing the filenames. But, anyone
+who can clone the git repository can access the HMAC cipher; it's stored
+**unencrypted** in the git repository.
 
 ## MAC algorithm
 
diff --git a/doc/todo/feature_request__58___pubkey-only_encryption_mode.mdwn b/doc/todo/feature_request__58___pubkey-only_encryption_mode.mdwn
index 2bfc629dd..5a3c10885 100644
--- a/doc/todo/feature_request__58___pubkey-only_encryption_mode.mdwn
+++ b/doc/todo/feature_request__58___pubkey-only_encryption_mode.mdwn
@@ -12,3 +12,5 @@ remotes (S3). In that case, I don't care much about hiding file names, but
 would appreciate the increased security of not having the secret key on the
 backup server. It would only be needed if I wanted to verify or restore
 backups.
+
+> Added "encryption=sharedpubkey" [[done]] --[[Joey]]