From 073f2a99552a75e27c7fbe3fe8c328d2bf7277c6 Mon Sep 17 00:00:00 2001 From: joe Date: Fri, 9 May 2014 23:12:40 -0400 Subject: readKeyFile "PEM" now accepts multiple keys and certs. --- KeyRing.hs | 151 ++++++++++++++++++++++++++++++++++++++++++++++--------------- kiki.hs | 58 ------------------------ 2 files changed, 114 insertions(+), 95 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index fe0f3cd..ad3e2ae 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -80,6 +80,10 @@ module KeyRing , accBindings , isSubkeySignature , torhash + , ParsedCert(..) + , parseCertBlob + , packetFromPublicRSAKey + , decodeBlob ) where import System.Environment @@ -93,7 +97,7 @@ import Data.OpenPGP import Data.Functor import Data.Monoid import Data.Tuple ( swap ) -import Data.Bits ( (.|.) ) +import Data.Bits ( (.|.), (.&.) ) import Control.Applicative ( Applicative, pure, liftA2, (<*>) ) import System.Directory ( getHomeDirectory, doesFileExist, createDirectoryIfMissing ) import Control.Arrow ( first, second ) @@ -107,17 +111,22 @@ import Data.ASN1.Types ( toASN1, ASN1Object, fromASN1 import Data.ASN1.BitArray ( BitArray(..), toBitArray ) import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1, decodeASN1' ) import Data.ASN1.BinaryEncoding ( DER(..) ) -import Data.Time.Clock.POSIX ( POSIXTime ) +import Data.Time.Clock.POSIX ( POSIXTime, utcTimeToPOSIXSeconds ) +import Data.Time.Clock ( UTCTime ) import Data.Bits ( Bits ) import Data.Text.Encoding ( encodeUtf8 ) import qualified Data.Map as Map import qualified Data.ByteString.Lazy as L ( unpack, null, readFile, writeFile - , ByteString, toChunks, hGetContents, hPut, concat, fromChunks ) -import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile) + , ByteString, toChunks, hGetContents, hPut, concat, fromChunks, splitAt + , index ) +import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile, breakSubstring, drop, length, null ) import qualified Crypto.Types.PubKey.ECC as ECC import qualified Codec.Binary.Base32 as Base32 import qualified Codec.Binary.Base64 as Base64 import qualified Crypto.Hash.SHA1 as SHA1 +import qualified Data.X509 as X509 +import qualified Crypto.PubKey.RSA as RSA +import qualified Codec.Compression.GZip as GZip import qualified Data.Text as T ( Text, unpack, pack, strip, reverse, drop, break, dropAround, length ) import qualified System.Posix.Types as Posix @@ -1378,7 +1387,74 @@ try x body = Left e -> return e Right x -> body x -readKeyFromFile :: Bool -> String -> InputFile -> IO Message + +data ParsedCert = ParsedCert + { pcertKey :: Packet + , pcertTimestamp :: UTCTime + , pcertBlob :: L.ByteString + } + deriving (Show,Eq) +data SecretPEMData = PEMPacket Packet | PEMCertificate ParsedCert + +spemPacket (PEMPacket p) = Just p +spemPacket _ = Nothing + +spemCert (PEMCertificate p) = Just p +spemCert _ = Nothing + +parseCertBlob comp bs = do + asn1 <- either (const Nothing) Just + $ decodeASN1 DER bs + let asn1' = drop 2 asn1 + cert <- either (const Nothing) (Just . fst) (fromASN1 asn1') + let _ = cert :: X509.Certificate + (notBefore,_) = X509.certValidity cert + case X509.certPubKey cert of + X509.PubKeyRSA key -> do + let withoutkey = + let ekey = Char8.toStrict $ encodeASN1 DER (toASN1 key []) + (pre,post) = S.breakSubstring ekey $ Char8.toStrict bs + post' = S.drop (S.length ekey) post + len :: Word16 + len = if S.null post then maxBound + else fromIntegral $ S.length pre + in if len < 4096 + then encode len <> GZip.compress (Char8.fromChunks [pre,post']) + else bs + return + ParsedCert { pcertKey = packetFromPublicRSAKey notBefore + (MPI $ RSA.public_n key) + (MPI $ RSA.public_e key) + , pcertTimestamp = notBefore + , pcertBlob = if comp then withoutkey + else bs + } + _ -> Nothing + +packetFromPublicRSAKey notBefore n e = + PublicKeyPacket { version = 4 + , timestamp = round $ utcTimeToPOSIXSeconds notBefore + , key_algorithm = RSA + , key = [('n',n),('e',e)] + , is_subkey = True + , v3_days_of_validity = Nothing + } + +decodeBlob cert = + if 0 /= (bs `L.index` 0) .&. 0x10 + then bs + else let (keypos0,bs') = L.splitAt 2 bs + keypos :: Word16 + keypos = decode keypos0 + ds = GZip.decompress bs' + (prekey,postkey) = L.splitAt (fromIntegral keypos) ds + in prekey <> key <> postkey + where + bs = pcertBlob cert + key = maybe "" (encodeASN1 DER . flip toASN1 []) $ rsaKeyFromPacket $ pcertKey cert + + +readKeyFromFile :: Bool -> String -> InputFile -> IO [SecretPEMData] readKeyFromFile False "PEM" fname = do -- warn $ fname ++ ": reading ..." let ctx = InputFileContext "" "" @@ -1386,37 +1462,37 @@ readKeyFromFile False "PEM" fname = do -- Therefore, we should attempt to preserve it. timestamp <- getInputFileTime ctx fname input <- readInputFileL ctx fname - let dta = fmap pemBlob $ listToMaybe $ scanAndParse (pemParser $ Just "RSA PRIVATE KEY") $ Char8.lines input - -- Char8.putStrLn $ "dta = " <> dta - let rsa = do - e <- decodeASN1 DER <$> dta - asn1 <- either (const Nothing) Just e - k <- either (const Nothing) (Just . fst) (fromASN1 asn1) - let _ = k :: RSAPrivateKey - return k - -- putStrLn $ "rsa = "++ show rsa - return . Message $ do - rsa <- maybeToList rsa - return $ SecretKeyPacket - { version = 4 - , timestamp = toEnum (fromEnum timestamp) - , key_algorithm = RSA - , key = [ -- public fields... - ('n',rsaN rsa) - ,('e',rsaE rsa) - -- secret fields - ,('d',rsaD rsa) - ,('p',rsaQ rsa) -- Note: p & q swapped - ,('q',rsaP rsa) -- Note: p & q swapped - ,('u',rsaCoefficient rsa) - ] - -- , ecc_curve = def - , s2k_useage = 0 - , s2k = S2K 100 "" - , symmetric_algorithm = Unencrypted - , encrypted_data = "" - , is_subkey = True - } + let dta = catMaybes $ scanAndParse pkcs1 $ Char8.lines input + pkcs1 = fmap (parseRSAPrivateKey . pemBlob) + $ pemParser $ Just "RSA PRIVATE KEY" + cert = fmap (fmap (PEMPacket . pcertKey) . parseCertBlob False . pemBlob) + $ pemParser $ Just "CERTIFICATE" + parseRSAPrivateKey dta = do + let e = decodeASN1 DER dta + asn1 <- either (const $ mzero) return e + rsa <- either (const mzero) (return . fst) (fromASN1 asn1) + let _ = rsa :: RSAPrivateKey + return $ PEMPacket $ SecretKeyPacket + { version = 4 + , timestamp = toEnum (fromEnum timestamp) + , key_algorithm = RSA + , key = [ -- public fields... + ('n',rsaN rsa) + ,('e',rsaE rsa) + -- secret fields + ,('d',rsaD rsa) + ,('p',rsaQ rsa) -- Note: p & q swapped + ,('q',rsaP rsa) -- Note: p & q swapped + ,('u',rsaCoefficient rsa) + ] + -- , ecc_curve = def + , s2k_useage = 0 + , s2k = S2K 100 "" + , symmetric_algorithm = Unencrypted + , encrypted_data = "" + , is_subkey = True + } + return dta readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt) doImport @@ -1429,7 +1505,8 @@ doImport doDecrypt db (fname,subspec,ms,_) = do let fetchkey = readKeyFromFile False "PEM" (ArgFile fname) flip (maybe $ return CannotImportMasterKey) subspec $ \tag -> do - Message parsedkey <- fetchkey + ps <- fetchkey + let parsedkey = mapMaybe spemPacket ps flip (maybe $ return $ KikiSuccess (db,[])) (listToMaybe parsedkey) $ \key -> do let (m0,tailms) = splitAt 1 ms diff --git a/kiki.hs b/kiki.hs index 8d1d7cb..063c42c 100644 --- a/kiki.hs +++ b/kiki.hs @@ -325,64 +325,6 @@ show_wip keyspec wkgrip db = do let nwb = maybe 0x80 CryptoCoins.secretByteFromName $ snd s putStrLn $ walletImportFormat nwb k -packetFromPublicRSAKey notBefore n e = - PublicKeyPacket { version = 4 - , timestamp = round $ utcTimeToPOSIXSeconds notBefore - , key_algorithm = RSA - , key = [('n',n),('e',e)] - , is_subkey = True - , v3_days_of_validity = Nothing - } - -data ParsedCert = ParsedCert - { pcertKey :: Packet - , pcertTimestamp :: UTCTime - , pcertBlob :: L.ByteString - } - deriving (Show,Eq) - -parseCertBlob comp bs = do - asn1 <- either (const Nothing) Just - $ decodeASN1 DER bs - let asn1' = drop 2 asn1 - cert <- either (const Nothing) (Just . fst) (fromASN1 asn1') - let _ = cert :: Certificate - (notBefore,_) = certValidity cert - case certPubKey cert of - PubKeyRSA key -> do - let withoutkey = - let ekey = Char8.toStrict $ encodeASN1 DER (toASN1 key []) - (pre,post) = S.breakSubstring ekey $ Char8.toStrict bs - post' = S.drop (S.length ekey) post - len :: Word16 - len = if S.null post then maxBound - else fromIntegral $ S.length pre - in if len < 4096 - then encode len `L.append` GZip.compress (Char8.fromChunks [pre,post']) - else bs - return - ParsedCert { pcertKey = packetFromPublicRSAKey notBefore - (MPI $ public_n key) - (MPI $ public_e key) - , pcertTimestamp = notBefore - , pcertBlob = if comp then withoutkey - else bs - } - _ -> Nothing - -decodeBlob cert = - if 0 /= (bs `L.index` 0) .&. 0x10 - then bs - else let (keypos0,bs') = L.splitAt 2 bs - keypos :: Word16 - keypos = decode keypos0 - ds = GZip.decompress bs' - (prekey,postkey) = L.splitAt (fromIntegral keypos) ds - in prekey <> key <> postkey - where - bs = pcertBlob cert - key = maybe L.empty (encodeASN1 DER . flip toASN1 []) $ rsaKeyFromPacket $ pcertKey cert - show_torhash pubkey _ = do bs <- Char8.readFile pubkey let parsekey f dta = do -- cgit v1.2.3