{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} module Data.OpenPGP.Util.DecryptSecretKey where import qualified Data.OpenPGP as OpenPGP import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LZ import Data.Word (Word16) import Data.Maybe import Control.Monad (foldM) import Data.Binary (get,Binary,Get,encode,put) #if MIN_VERSION_binary(0,6,4) import Data.Binary.Get (runGetOrFail) #else import Control.Exception as Exception (handle,ErrorCall(..)) import System.IO.Unsafe import Data.Binary.Get (runGet) #endif import Control.Exception as Exception (IOException(..),catch) import Data.Binary.Put (runPut) import Control.Applicative ( (<$>) ) import qualified Crypto.Cipher.AES as Vincent import qualified Crypto.Cipher.Blowfish as Vincent import qualified Crypto.Cipher.Types as Vincent #if defined(VERSION_cryptonite) import qualified Data.ByteArray as Bytes import Crypto.Hash.Algorithms import Crypto.Hash import Crypto.Error #else import qualified Data.Byteable as Vincent import Crypto.Hash.SHA1 as SHA1 #endif import qualified Crypto.Random as Vincent import Crypto.Cipher.Cast5 (CAST5_128) import Crypto.Cipher.ThomasToVincent import Data.OpenPGP.Util.Base import Data.OpenPGP.Util.Gen (makeGen) data Enciphered = EncipheredWithIV !LZ.ByteString -- initial vector is appended to front of ByteString | EncipheredZeroIV !LZ.ByteString -- initial vector is zero, ByteString contains only the block withIV :: (Vincent.BlockCipher k) => (Vincent.IV k -> LZ.ByteString -> LZ.ByteString) -> Enciphered -> LZ.ByteString withIV f (EncipheredWithIV s) = f iv bs where Just iv = Vincent.makeIV (toStrictBS ivbs) (ivbs,bs) = LZ.splitAt (fromIntegral ivlen) s #if defined(VERSION_cryptonite) ivlen = Bytes.length iv #else ivlen = Vincent.byteableLength z _ = Vincent.constEqBytes z iv z = Vincent.nullIV #endif withIV f (EncipheredZeroIV s) = f Vincent.nullIV s decryptSecretKey :: BS.ByteString -- ^ Passphrase -> OpenPGP.Packet -- ^ Encrypted SecretKeyPacket -> Maybe OpenPGP.Packet -- ^ Decrypted SecretKeyPacket decryptSecretKey _ k@(OpenPGP.SecretKeyPacket { OpenPGP.symmetric_algorithm = OpenPGP.Unencrypted }) = Just k decryptSecretKey pass k@(OpenPGP.SecretKeyPacket { OpenPGP.version = 4, OpenPGP.key_algorithm = kalgo, OpenPGP.s2k = s2k, OpenPGP.symmetric_algorithm = salgo, OpenPGP.key = existing, OpenPGP.encrypted_data = encd }) | chkF material == toStrictBS chk = fmap (\m -> k { OpenPGP.s2k_useage = 0, OpenPGP.symmetric_algorithm = OpenPGP.Unencrypted, OpenPGP.encrypted_data = LZ.empty, OpenPGP.key = m }) parseMaterial | otherwise = Nothing where parseMaterial = maybeGet (foldM (\m f -> do {mpi <- get; return $ (f,mpi):m}) existing (OpenPGP.secret_key_fields kalgo)) material (material, chk) = LZ.splitAt (LZ.length decd - chkSize) decd (chkSize, chkF) | OpenPGP.s2k_useage k == 254 = (20, sha1 . toStrictBS) | otherwise = (2, toStrictBS . encode . checksum . toStrictBS) -- Words16s are written as 2 bytes in big-endian (network) order decd = withS2K simpleUnCFB salgo s2k (toLazyBS pass) (EncipheredWithIV encd) #if defined(VERSION_cryptonite) sha1 x = Bytes.convert (hash x :: Digest SHA1) #else sha1 = SHA1.hash #endif decryptSecretKey _ _ = Nothing checksum :: BS.ByteString -> Word16 checksum key = fromIntegral $ BS.foldl' (\x y -> x + fromIntegral y) (0::Integer) key `mod` 65536 #if MIN_VERSION_binary(0,6,4) maybeGet :: (Binary a) => Get a -> LZ.ByteString -> Maybe a maybeGet g bs = (\(_,_,x) -> x) <$> hush (runGetOrFail g bs) where hush :: Either a b -> Maybe b hush (Left _) = Nothing hush (Right x) = Just x #else maybeGet :: (Binary a) => Get a -> LZ.ByteString -> Maybe a maybeGet g bs = unsafePerformIO $ handle (\(ErrorCall _)-> return Nothing) $ return . Just $ runGet g bs #endif withS2K :: (forall k. (Vincent.BlockCipher k) => k -> Vincent.IV k -> LZ.ByteString -> LZ.ByteString) -> OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString -> Enciphered -> LZ.ByteString withS2K codec OpenPGP.AES128 s2k s = withIV $ codec (string2key s2k s :: Vincent.AES128) withS2K codec OpenPGP.AES192 s2k s = withIV $ codec (string2key s2k s :: Vincent.AES192) withS2K codec OpenPGP.AES256 s2k s = withIV $ codec (string2key s2k s :: Vincent.AES256) withS2K codec OpenPGP.Blowfish s2k s = withIV $ codec (string2key s2k s :: Vincent.Blowfish128) -- TODO: cast5 support -- withS2K codec OpenPGP.CAST5 s2k s = withIV $ codec (string2key s2k s :: ThomasToVincent CAST5_128) withS2K codec algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.withS2K" withS2K' :: OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString -> (forall b. Vincent.BlockCipher b => b -> x) -> x withS2K' OpenPGP.AES128 s2k s f = f (string2key s2k s :: Vincent.AES128) withS2K' OpenPGP.AES192 s2k s f = f (string2key s2k s :: Vincent.AES192) withS2K' OpenPGP.AES256 s2k s f = f (string2key s2k s :: Vincent.AES256) withS2K' OpenPGP.Blowfish s2k s f = f (string2key s2k s :: Vincent.Blowfish128) -- TODO: cast5 support -- withS2K' OpenPGP.CAST5 s2k s f = f (string2key s2k s :: ThomasToVincent CAST5_128) -- decryption codec for withS2K simpleUnCFB :: (Vincent.BlockCipher k) => k -> Vincent.IV k -> LZ.ByteString -> LZ.ByteString simpleUnCFB k iv = padThenUnpad k (toLazyBS . Vincent.cfbDecrypt k iv . toStrictBS) simpleCFB :: (Vincent.BlockCipher k, RG g) => g -> k -> LZ.ByteString -> (LZ.ByteString, g) simpleCFB g k bs = ( padThenUnpad k (LZ.fromChunks . (ivbs:) . (:[]) . Vincent.cfbEncrypt k iv . toStrictBS) bs , g' ) where Just iv = Vincent.makeIV ivbs #if defined(VERSION_cryptonite) (ivbs,g') = Vincent.randomBytesGenerate ivlen g ivlen = Bytes.length iv #else z = Vincent.nullIV (ivbs,g') = Vincent.cprgGenerate ivlen g ivlen = Vincent.byteableLength z _ = Vincent.constEqBytes z iv #endif -- Apply a function f to a zero-padded bytestring s to a multiple -- of the blocksize for cyper k. -- Then drop the same number of bytes from the result of f. padThenUnpad :: (Vincent.BlockCipher k) => k -> (LZ.ByteString -> LZ.ByteString) -> LZ.ByteString -> LZ.ByteString padThenUnpad k f s = dropPadEnd (f padded) where dropPadEnd s = LZ.take (LZ.length s - padAmount) s padded = s `LZ.append` LZ.replicate padAmount 0 padAmount = blksize - (LZ.length s `mod` blksize) blksize = fromIntegral $ Vincent.blockSize k {- Data/OpenPGP/Util/DecryptSecretKey.hs:172:20: Couldn't match expected type ‘k’ with actual type ‘cryptonite-0.15:Crypto.Error.Types.CryptoFailable cipher0’ ‘k’ is a rigid type variable bound by the type signature for string2key :: Vincent.BlockCipher k => OpenPGP.S2K -> LZ.ByteString -> k at Data/OpenPGP/Util/DecryptSecretKey.hs:171:15 -} string2key :: (Vincent.BlockCipher k) => OpenPGP.S2K -> LZ.ByteString -> k string2key s2k s = cipher where #if defined(VERSION_cryptonite) CryptoPassed cipher = Vincent.cipherInit k k = toStrictBS $ LZ.take ksize $ OpenPGP.string2key hashBySymbol s2k s #else cipher = Vincent.cipherInit k Right k = Vincent.makeKey $ toStrictBS $ LZ.take ksize $ OpenPGP.string2key hashBySymbol s2k s #endif ksize = case Vincent.cipherKeySize cipher of Vincent.KeySizeFixed n -> fromIntegral n Vincent.KeySizeEnum xs -> error $ "Unknown key size in string2key" Vincent.KeySizeRange min max -> error $ "Unknown key size range in string2key" catchIO_ :: IO a -> IO a -> IO a catchIO_ a h = Exception.catch a (\(_ :: IOException) -> h) encryptSecretKey :: BS.ByteString -> OpenPGP.S2K -> OpenPGP.SymmetricAlgorithm -> OpenPGP.Packet -> IO (Maybe OpenPGP.Packet) encryptSecretKey passphrase s2k salgo plain = do flip catchIO_ (return Nothing) $ do g <- makeGen Nothing return $ Just plain { OpenPGP.key = [ x | x <- OpenPGP.key plain , fst x `elem` OpenPGP.public_key_fields (OpenPGP.key_algorithm plain) ] , OpenPGP.symmetric_algorithm = salgo , OpenPGP.s2k = s2k , OpenPGP.s2k_useage = s2k_usage_octet , OpenPGP.encrypted_data = encd g } where material = runPut $ mapM_ put $ do f <- OpenPGP.secret_key_fields (OpenPGP.key_algorithm plain) maybeToList $ lookup f (OpenPGP.key plain) chk = LZ.fromChunks [ chkF material ] decd = LZ.append material chk encd g = fst $ withS2K' salgo s2k (toLazyBS passphrase) (simpleCFB g) decd -- If the string-to-key usage octet is zero or 255, then a two-octet -- checksum of the plaintext of the algorithm-specific portion (sum -- of all octets, mod 65536). If the string-to-key usage octet was -- 254, then a 20-octet SHA-1 hash of the plaintext of the -- algorithm-specific portion. This checksum or hash is encrypted -- together with the algorithm-specific fields (if string-to-key -- usage octet is not zero). Note that for all other values, a -- two-octet checksum is required. s2k_usage_octet = 255 -- chkSize = 2 chkF = toStrictBS . encode . checksum . toStrictBS -- k = string2key s2k passphrase -- OpenPGP.string2key hashBySymbol s2k passphrase