diff options
Diffstat (limited to 'Crypto.hs')
| -rw-r--r-- | Crypto.hs | 77 |
1 files changed, 33 insertions, 44 deletions
@@ -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 |