Leverage an ambiguities between Ciphers

Cipher is now a datatype

    data Cipher = Cipher String | MacOnlyCipher String

which makes more precise its interpretation MAC-only vs. MAC + used to
derive a key for symmetric crypto.

4 files changed, 53 insertions, 46 deletions

diff --git a/Crypto.hs b/Crypto.hs
index 0ea12c6c1..8b91c2dea 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -64,20 +64,22 @@ cipherSize = 512
 
 cipherPassphrase :: Cipher -> String
 cipherPassphrase (Cipher c) = drop cipherBeginning c
+cipherPassphrase (MacOnlyCipher _) = error "MAC-only cipher"
 
 cipherMac :: Cipher -> String
 cipherMac (Cipher c) = take cipherBeginning c
+cipherMac (MacOnlyCipher c) = c
 
 {- Creates a new Cipher, encrypted to the specified key id. -}
 genEncryptedCipher :: String -> EncryptedCipherVariant -> Bool -> IO StorableCipher
 genEncryptedCipher keyid variant highQuality = do
 	ks <- Gpg.findPubKeys keyid
 	random <- Gpg.genRandom highQuality size
-	encryptCipher (Cipher random) variant ks
+	encryptCipher (mkCipher random) variant ks
   where
-	size = case variant of
-		HybridCipher -> cipherSize -- used for MAC + symmetric
-		PubKeyCipher -> cipherBeginning -- only used for MAC
+	(mkCipher, size) = case variant of
+		HybridCipher -> (Cipher, cipherSize) -- used for MAC + symmetric
+		PubKeyCipher -> (MacOnlyCipher, cipherBeginning) -- only used for MAC
 
 {- Creates a new, shared Cipher. -}
 genSharedCipher :: Bool -> IO StorableCipher
@@ -89,7 +91,7 @@ genSharedCipher highQuality =
 updateEncryptedCipher :: [(Bool, String)] -> StorableCipher -> IO StorableCipher
 updateEncryptedCipher _ SharedCipher{} = undefined
 updateEncryptedCipher [] encipher = return encipher
-updateEncryptedCipher newkeys encipher@(EncryptedCipher _ symmetric (KeyIds ks)) = do
+updateEncryptedCipher newkeys encipher@(EncryptedCipher _ variant (KeyIds ks)) = do
 	dropKeys <- listKeyIds [ k | (False, k) <- newkeys ]
 	forM_ dropKeys $ \k -> unless (k `elem` ks) $
 		error $ "Key " ++ k ++ " was not present; cannot remove."
@@ -98,7 +100,7 @@ updateEncryptedCipher newkeys encipher@(EncryptedCipher _ symmetric (KeyIds ks))
 	when (null ks') $
 		error "Cannot remove the last key."
 	cipher <- decryptCipher encipher
-	encryptCipher cipher symmetric $ KeyIds ks'
+	encryptCipher cipher variant $ KeyIds ks'
   where
 	listKeyIds = mapM (Gpg.findPubKeys >=*> keyIds) >=*> concat
 
@@ -115,18 +117,26 @@ describeCipher (EncryptedCipher _ variant (KeyIds ks)) =
 
 {- Encrypts a Cipher to the specified KeyIds. -}
 encryptCipher :: Cipher -> EncryptedCipherVariant -> KeyIds -> IO StorableCipher
-encryptCipher (Cipher c) variant (KeyIds ks) = do
+encryptCipher c variant (KeyIds ks) = do
 	-- gpg complains about duplicate recipient keyids
 	let ks' = nub $ sort ks
 	let params = Gpg.pkEncTo ks' ++ Gpg.stdEncryptionParams False
-	encipher <- Gpg.pipeStrict params c
+	encipher <- Gpg.pipeStrict params cipher
 	return $ EncryptedCipher encipher variant (KeyIds ks')
+  where
+	cipher = case c of
+		Cipher x -> x
+		MacOnlyCipher x -> x
 
 {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
 decryptCipher :: StorableCipher -> IO Cipher
 decryptCipher (SharedCipher t) = return $ Cipher t
-decryptCipher (EncryptedCipher t _ _) =
-	Cipher <$> Gpg.pipeStrict [ Param "--decrypt" ] t
+decryptCipher (EncryptedCipher t variant _) =
+	mkCipher <$> Gpg.pipeStrict [ Param "--decrypt" ] t
+  where
+	mkCipher = case variant of
+		HybridCipher -> Cipher
+		PubKeyCipher -> MacOnlyCipher
 
 {- Generates an encrypted form of a Key. The encryption does not need to be
  - reversable, nor does it need to be the same type of encryption used
@@ -158,16 +168,18 @@ readBytes a h = L.hGetContents h >>= a
  - recipients MUST be included in 'params' (for instance using
  - 'getGpgEncParams'). -}
 encrypt :: [CommandParam] -> Cipher -> Feeder -> Reader a -> IO a
-encrypt params cipher = Gpg.feedRead params' pass
-  where
-	pass = cipherPassphrase cipher
-	params' = params ++ Gpg.stdEncryptionParams (not $ null pass)
+encrypt params cipher = case cipher of
+	Cipher{} -> Gpg.feedRead (params ++ Gpg.stdEncryptionParams True) $
+			cipherPassphrase cipher
+	MacOnlyCipher{} -> Gpg.pipeLazy $ params ++ Gpg.stdEncryptionParams False
 
 {- Runs a Feeder action, that generates content that is decrypted with the
  - Cipher (or using a private key if the Cipher is empty), and read by the
  - Reader action. -}
 decrypt :: Cipher -> Feeder -> Reader a -> IO a
-decrypt = Gpg.feedRead [Param "--decrypt"] . cipherPassphrase
+decrypt cipher = case cipher of
+	Cipher{} -> Gpg.feedRead [Param "--decrypt"] $ cipherPassphrase cipher
+	MacOnlyCipher{} -> Gpg.pipeLazy [Param "--decrypt"]
 
 macWithCipher :: Mac -> Cipher -> String -> String
 macWithCipher mac c = macWithCipher' mac (cipherMac c)
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 29e51c002..5c661eaa7 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -133,18 +133,11 @@ embedCreds c
 	| isJust (M.lookup "cipherkeys" c) && isJust (M.lookup "cipher" c) = True
 	| otherwise = False
 
-{- Gets encryption Cipher, and encrypted version of Key. In case we want
- - asymmetric encryption, leave the first empty, but encrypt the Key
- - regardless. (Empty ciphers imply asymmetric encryption.) We could
- - also check how long is the cipher (MAC'ing-only ciphers are shorter),
- - but we don't want to rely on that only. -}
+{- Gets encryption Cipher, and encrypted version of Key. -}
 cipherKey :: RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
 cipherKey c k = fmap make <$> remoteCipher c
   where
-	make ciphertext = (cipContent ciphertext, encryptKey mac ciphertext k)
-	cipContent
-		| M.lookup "encryption" c /= Just "pubkey" = id
-		| otherwise = const $ Cipher ""
+	make ciphertext = (ciphertext, encryptKey mac ciphertext k)
 	mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac
 
 {- Stores an StorableCipher in a remote's configuration. -}
diff --git a/Types/Crypto.hs b/Types/Crypto.hs
index 8a15ead16..487a29391 100644
--- a/Types/Crypto.hs
+++ b/Types/Crypto.hs
@@ -23,7 +23,7 @@ import Data.Digest.Pure.SHA
 import Utility.Gpg (KeyIds(..))
 
 -- XXX ideally, this would be a locked memory region
-newtype Cipher = Cipher String
+data Cipher = Cipher String | MacOnlyCipher String
 
 data StorableCipher = EncryptedCipher String EncryptedCipherVariant KeyIds
 		| SharedCipher String
diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs
index e27de7218..251e4d443 100644
--- a/Utility/Gpg.hs
+++ b/Utility/Gpg.hs
@@ -99,31 +99,33 @@ pipeStrict params input = do
  - Note that to avoid deadlock with the cleanup stage,
  - the reader must fully consume gpg's input before returning. -}
 feedRead :: [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
-feedRead params passphrase feeder reader = if null passphrase
-	then go =<< stdParams (Param "--batch" : params)
-	else do
+feedRead params passphrase feeder reader = do
 #ifndef mingw32_HOST_OS
-		-- pipe the passphrase into gpg on a fd
-		(frompipe, topipe) <- createPipe
-		void $ forkIO $ do
-			toh <- fdToHandle topipe
-			hPutStrLn toh passphrase
-			hClose toh
-		let Fd pfd = frompipe
-		let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
-
-		params' <- stdParams $ Param "--batch" : passphrasefd ++ params
-		closeFd frompipe `after` go params'
+	-- pipe the passphrase into gpg on a fd
+	(frompipe, topipe) <- createPipe
+	void $ forkIO $ do
+		toh <- fdToHandle topipe
+		hPutStrLn toh passphrase
+		hClose toh
+	let Fd pfd = frompipe
+	let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
+	closeFd frompipe `after` go (passphrasefd ++ params)
 #else
-		-- store the passphrase in a temp file for gpg
-		withTmpFile "gpg" $ \tmpfile h -> do
-			hPutStr h passphrase
-			hClose h
-		let passphrasefile = [Param "--passphrase-file", File tmpfile]
-		go =<< stdParams $ Param "--batch" : passphrasefile ++ params
+	-- store the passphrase in a temp file for gpg
+	withTmpFile "gpg" $ \tmpfile h -> do
+		hPutStr h passphrase
+		hClose h
+	let passphrasefile = [Param "--passphrase-file", File tmpfile]
+	go $ passphrasefile ++ params
 #endif
   where
-	go params' = withBothHandles createProcessSuccess (proc gpgcmd params')
+	go params' = pipeLazy params' feeder reader
+
+{- Like feedRead, but without passphrase. -}
+pipeLazy :: [CommandParam] -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
+pipeLazy params feeder reader = do
+	params' <- stdParams $ Param "--batch" : params
+	withBothHandles createProcessSuccess (proc gpgcmd params')
 		$ \(to, from) -> do
 			void $ forkIO $ do
 				feeder to