From dbab71d60e31e27e4331aa6b2c15d2fa9b78fbd8 Mon Sep 17 00:00:00 2001 From: joe Date: Thu, 25 Aug 2016 00:11:46 -0400 Subject: encryptSecretKey --- Data/OpenPGP/Util.hs | 1 + Data/OpenPGP/Util/DecryptSecretKey.hs | 102 ++++++++++++++++++++++++++++------ 2 files changed, 87 insertions(+), 16 deletions(-) diff --git a/Data/OpenPGP/Util.hs b/Data/OpenPGP/Util.hs index 8a1a449..19d98ec 100644 --- a/Data/OpenPGP/Util.hs +++ b/Data/OpenPGP/Util.hs @@ -1,6 +1,7 @@ module Data.OpenPGP.Util ( fingerprint , decryptSecretKey + , encryptSecretKey , verify , pgpSign , GenerateKeyParams(..) diff --git a/Data/OpenPGP/Util/DecryptSecretKey.hs b/Data/OpenPGP/Util/DecryptSecretKey.hs index 6bfc2af..11627d5 100644 --- a/Data/OpenPGP/Util/DecryptSecretKey.hs +++ b/Data/OpenPGP/Util/DecryptSecretKey.hs @@ -1,12 +1,15 @@ +{-# 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) +import Data.Binary (get,Binary,Get,encode,put) #if MIN_VERSION_binary(0,6,4) import Data.Binary.Get (runGetOrFail) #else @@ -14,6 +17,8 @@ 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 Crypto.Hash.SHA1 as SHA1 @@ -24,6 +29,8 @@ import qualified Crypto.Cipher.Blowfish as Vincent import qualified Crypto.Cipher.Types as Vincent import qualified Data.Byteable as Vincent +import qualified Crypto.Random as Vincent + import Crypto.Cipher.Cast5 (CAST5_128) import Crypto.Cipher.ThomasToVincent import Data.OpenPGP.Util.Base (toStrictBS,toLazyBS,hashBySymbol) @@ -70,14 +77,14 @@ decryptSecretKey pass k@(OpenPGP.SecretKeyPacket { | OpenPGP.s2k_useage k == 254 = (20, SHA1.hash . toStrictBS) | otherwise = (2, toStrictBS . encode . checksum . toStrictBS) -- Words16s are written as 2 bytes in big-endian (network) order - decd = string2sdecrypt salgo s2k (toLazyBS pass) (EncipheredWithIV encd) - - checksum :: BS.ByteString -> Word16 - checksum key = fromIntegral $ - BS.foldl' (\x y -> x + fromIntegral y) (0::Integer) key `mod` 65536 + decd = withS2K simpleUnCFB salgo s2k (toLazyBS pass) (EncipheredWithIV encd) 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 @@ -94,20 +101,45 @@ maybeGet g bs = unsafePerformIO $ -string2sdecrypt :: OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString -> Enciphered -> LZ.ByteString -string2sdecrypt OpenPGP.AES128 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES128) -string2sdecrypt OpenPGP.AES192 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES192) -string2sdecrypt OpenPGP.AES256 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES256) -string2sdecrypt OpenPGP.Blowfish s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.Blowfish128) -string2sdecrypt OpenPGP.CAST5 s2k s = withIV $ simpleUnCFB (string2key s2k s :: ThomasToVincent CAST5_128) -string2sdecrypt algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.string2sdecrypt" +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) +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) +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, Vincent.CPRG 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 + (ivbs,g') = Vincent.cprgGenerate ivlen g + ivlen = Vincent.byteableLength z + z = Vincent.nullIV + _ = Vincent.constEqBytes z iv + +-- 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 - 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) @@ -124,3 +156,41 @@ string2key s2k s = cipher 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 <- fmap Vincent.cprgCreate $ Vincent.createEntropyPool + let _ = g :: Vincent.SystemRNG + 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 -- cgit v1.2.3