Added shared cipher mode to encryptable special remotes.

This option avoids gpg key distribution, at the expense of flexability, and
with the requirement that all clones of the git repository be equally
trusted.

1 files changed, 33 insertions, 44 deletions

diff --git a/Crypto.hs b/Crypto.hs
index cb1ca40d1..e530bd0e6 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -3,16 +3,17 @@
  - Currently using gpg; could later be modified to support different
  - crypto backends if neccessary.
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module Crypto (
 	Cipher,
-	EncryptedCipher,
-	genCipher,
-	updateCipher,
+	StorableCipher(..),
+	genEncryptedCipher,
+	genSharedCipher,
+	updateEncryptedCipher,
 	describeCipher,
 	storeCipher,
 	extractCipher,
@@ -60,59 +61,55 @@ cipherPassphrase (Cipher c) = drop cipherHalf c
 cipherHmac :: Cipher -> String
 cipherHmac (Cipher c) = take cipherHalf c
 
-{- Creates a new Cipher, encrypted as specified in the remote's configuration -}
-genCipher :: RemoteConfig -> IO EncryptedCipher
-genCipher c = do
-	ks <- configKeyIds c
-	random <- genrandom
+{- Creates a new Cipher, encrypted to the specificed key id. -}
+genEncryptedCipher :: String -> IO StorableCipher
+genEncryptedCipher keyid = do
+	ks <- Gpg.findPubKeys keyid
+	random <- Gpg.genRandom cipherSize
 	encryptCipher (Cipher random) ks
-	where
-		genrandom = Gpg.readStrict
-			-- Armor the random data, to avoid newlines,
-			-- since gpg only reads ciphers up to the first
-			-- newline.
-			[ Params "--gen-random --armor"
-			, Param $ show randomquality
-			, Param $ show cipherSize
-			]
-		-- 1 is /dev/urandom; 2 is /dev/random
-		randomquality = 1 :: Int
-
-{- Updates an existing Cipher, re-encrypting it to add KeyIds specified in
- - the remote's configuration. -}
-updateCipher :: RemoteConfig -> EncryptedCipher -> IO EncryptedCipher
-updateCipher c encipher@(EncryptedCipher _ ks) = do
-	ks' <- configKeyIds c
-	cipher <- decryptCipher c encipher
+
+{- Creates a new, shared Cipher. -}
+genSharedCipher :: IO StorableCipher
+genSharedCipher = SharedCipher <$> Gpg.genRandom cipherSize
+
+{- Updates an existing Cipher, re-encrypting it to add a keyid. -}
+updateEncryptedCipher :: String -> StorableCipher -> IO StorableCipher
+updateEncryptedCipher _ (SharedCipher _) = undefined
+updateEncryptedCipher keyid encipher@(EncryptedCipher _ ks) = do
+	ks' <- Gpg.findPubKeys keyid
+	cipher <- decryptCipher encipher
 	encryptCipher cipher (merge ks ks')
 	where
 		merge (KeyIds a) (KeyIds b) = KeyIds $ a ++ b
 
-describeCipher :: EncryptedCipher -> String
+describeCipher :: StorableCipher -> String
+describeCipher (SharedCipher _) = "shared cipher"
 describeCipher (EncryptedCipher _ (KeyIds ks)) =
 	"with gpg " ++ keys ks ++ " " ++ unwords ks
 	where
 		keys [_] = "key"
 		keys _ = "keys"
 
-{- Stores an EncryptedCipher in a remote's configuration. -}
-storeCipher :: RemoteConfig -> EncryptedCipher -> RemoteConfig
+{- Stores an StorableCipher in a remote's configuration. -}
+storeCipher :: RemoteConfig -> StorableCipher -> RemoteConfig
+storeCipher c (SharedCipher t) = M.insert "cipher" (toB64 t) c
 storeCipher c (EncryptedCipher t ks) = 
 	M.insert "cipher" (toB64 t) $ M.insert "cipherkeys" (showkeys ks) c
 	where
 		showkeys (KeyIds l) = join "," l
 
-{- Extracts an EncryptedCipher from a remote's configuration. -}
-extractCipher :: RemoteConfig -> Maybe EncryptedCipher
+{- Extracts an StorableCipher from a remote's configuration. -}
+extractCipher :: RemoteConfig -> Maybe StorableCipher
 extractCipher c = 
 	case (M.lookup "cipher" c, M.lookup "cipherkeys" c) of
 		(Just t, Just ks) -> Just $ EncryptedCipher (fromB64 t) (readkeys ks)
+		(Just t, Nothing) -> Just $ SharedCipher (fromB64 t)
 		_ -> Nothing
 	where
 		readkeys = KeyIds . split ","
 
 {- Encrypts a Cipher to the specified KeyIds. -}
-encryptCipher :: Cipher -> KeyIds -> IO EncryptedCipher
+encryptCipher :: Cipher -> KeyIds -> IO StorableCipher
 encryptCipher (Cipher c) (KeyIds ks) = do
 	let ks' = nub $ sort ks -- gpg complains about duplicate recipient keyids
 	encipher <- Gpg.pipeStrict (encrypt++recipients ks') c
@@ -126,9 +123,9 @@ encryptCipher (Cipher c) (KeyIds ks) = do
 		force_recipients = Params "--no-encrypt-to --no-default-recipient"
 
 {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
-decryptCipher :: RemoteConfig -> EncryptedCipher -> IO Cipher
-decryptCipher _ (EncryptedCipher encipher _) = 
-	Cipher <$> Gpg.pipeStrict decrypt encipher
+decryptCipher :: StorableCipher -> IO Cipher
+decryptCipher (SharedCipher t) = return $ Cipher t
+decryptCipher (EncryptedCipher t _) = Cipher <$> Gpg.pipeStrict decrypt t
 	where
 		decrypt = [ Param "--decrypt" ]
 
@@ -165,14 +162,6 @@ pass :: (Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a)
       -> Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
 pass to c i a = to c i $ \h -> a =<< L.hGetContents h
 
-configKeyIds :: RemoteConfig -> IO KeyIds
-configKeyIds c = Gpg.findPubKeys $ configGet c "encryption"
-
-configGet :: RemoteConfig -> String -> String
-configGet c key = fromMaybe missing $ M.lookup key c
-	where
-		missing = error $ "missing " ++ key ++ " in remote config"
-
 hmacWithCipher :: Cipher -> String -> String
 hmacWithCipher c = hmacWithCipher' (cipherHmac c) 
 hmacWithCipher' :: String -> String -> String