From 27961dacaf2806581c79d26c287d340d596f890b Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 15 Apr 2014 18:35:00 -0400 Subject: moved doImport to KeyRing.hs --- KeyRing.hs | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- kiki.hs | 113 ------------------------------------------------------ 2 files changed, 123 insertions(+), 116 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index b738a25..e3d41d8 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -14,6 +14,7 @@ import Data.Ord import Data.List import Data.OpenPGP import Data.Functor +import Data.Monoid import Data.Bits ( (.|.) ) import Control.Applicative ( liftA2, (<$>) ) import System.Directory ( getHomeDirectory, doesFileExist ) @@ -27,15 +28,16 @@ import ControlMaybe ( handleIO_ ) import Data.ASN1.Types ( toASN1, ASN1Object, fromASN1 , ASN1(Start,End,IntVal,OID,BitString), ASN1ConstructionType(Sequence) ) import Data.ASN1.BitArray ( BitArray(..), toBitArray ) -import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1' ) +import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1, decodeASN1' ) import Data.ASN1.BinaryEncoding ( DER(..) ) import Data.Time.Clock.POSIX ( getPOSIXTime ) import qualified Data.Map as Map -import qualified Data.ByteString.Lazy as L ( null, readFile, writeFile, ByteString, toChunks ) +import qualified Data.ByteString.Lazy as L ( pack, null, readFile, writeFile, ByteString, toChunks ) import qualified Data.ByteString as S ( unpack, splitAt, concat, cons ) -import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break ) +import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break, concat, lines ) 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.Text as T ( Text, unpack, pack, strip, reverse, drop, break, dropAround ) @@ -168,12 +170,59 @@ data RSAPrivateKey = RSAPrivateKey } deriving Show +instance ASN1Object RSAPrivateKey where + toASN1 rsa@(RSAPrivateKey {}) + = \xs -> Start Sequence + : IntVal 0 + : mpiVal rsaN + : mpiVal rsaE + : mpiVal rsaD + : mpiVal rsaP + : mpiVal rsaQ + : mpiVal rsaDmodP1 + : mpiVal rsaDmodQminus1 + : mpiVal rsaCoefficient + : End Sequence + : xs + where mpiVal f = IntVal x where MPI x = f rsa + + fromASN1 ( Start Sequence + : IntVal _ -- version + : IntVal n + : IntVal e + : IntVal d + : IntVal p + : IntVal q + : IntVal dmodp1 + : IntVal dmodqminus1 + : IntVal coefficient + : ys) = + Right ( privkey, tail $ dropWhile notend ys) + where + notend (End Sequence) = False + notend _ = True + privkey = RSAPrivateKey + { rsaN = MPI n + , rsaE = MPI e + , rsaD = MPI d + , rsaP = MPI p + , rsaQ = MPI q + , rsaDmodP1 = MPI dmodp1 + , rsaDmodQminus1 = MPI dmodqminus1 + , rsaCoefficient = MPI coefficient + } + fromASN1 _ = + Left "fromASN1: RSAPrivateKey: unexpected format" + + data KikiCondition a = KikiSuccess a | FailedToLock [FilePath] | BadPassphrase | FailedToMakeSignature | CantFindHome + | AmbiguousKeySpec + | CannotImportMasterKey deriving ( Functor, Show ) instance FunctorToMaybe KikiCondition where @@ -479,6 +528,10 @@ buildKeyDB secring pubring grip0 keyring = do db <- foldM importWalletKey (KikiSuccess (db_rings,[])) wallet_keys try db $ \(db,report) -> do + + -- todo: import PEMFiles + -- use_db <- foldM (doImport decrypt) use_db0 (map snd imports) + return $ KikiSuccess ( (db, grip, wk), report ) torhash key = maybe "" id $ derToBase32 <$> derRSA key @@ -495,6 +548,73 @@ try x body = Left e -> return e Right x -> body x +readKeyFromFile False "PEM" fname = do + -- warn $ fname ++ ": reading ..." + -- Note: The key's timestamp is included in it's fingerprint. + -- Therefore, we should attempt to preserve it. + timestamp <- handleIO_ (error $ fname++": modificaiton time?") $ + modificationTime <$> getFileStatus fname + input <- L.readFile fname + let dta = extractPEM "RSA PRIVATE KEY" input + -- Char8.putStrLn $ "dta = " <> dta + let rsa = do + e <- decodeASN1 DER . L.pack <$> Base64.decode (Char8.unpack 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 + } +readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt) + +extractPEM typ pem = dta + where + dta = case ys of + _:dta_lines -> Char8.concat dta_lines + [] -> "" + xs = dropWhile (/="-----BEGIN " <> typ <> "-----") (Char8.lines pem) + ys = takeWhile (/="-----END " <> typ <> "-----") xs + + +doImport + :: Ord k => + (Packet -> IO (KikiCondition Packet)) + -> Map.Map k KeyData + -> ([Char], Maybe [Char], [k], t) + -> IO (KikiCondition (Map.Map k KeyData, [(FilePath,KikiReportAction)])) +doImport doDecrypt db (fname,subspec,ms,_) = do + let fetchkey = readKeyFromFile False "PEM" fname + flip (maybe $ return CannotImportMasterKey) + subspec $ \tag -> do + Message parsedkey <- fetchkey + flip (maybe $ return $ KikiSuccess (db,[])) + (listToMaybe parsedkey) $ \key -> do + let (m0,tailms) = splitAt 1 ms + if (not (null tailms) || null m0) + then return AmbiguousKeySpec + else doImportG doDecrypt db m0 tag fname key + doImportG :: Ord k => (Packet -> IO (KikiCondition Packet)) diff --git a/kiki.hs b/kiki.hs index 66e3e4f..b23e304 100644 --- a/kiki.hs +++ b/kiki.hs @@ -110,50 +110,6 @@ RSAPrivateKey ::= SEQUENCE { } -} -instance ASN1Object RSAPrivateKey where - toASN1 rsa@(RSAPrivateKey {}) - = \xs -> Start Sequence - : IntVal 0 - : mpiVal rsaN - : mpiVal rsaE - : mpiVal rsaD - : mpiVal rsaP - : mpiVal rsaQ - : mpiVal rsaDmodP1 - : mpiVal rsaDmodQminus1 - : mpiVal rsaCoefficient - : End Sequence - : xs - where mpiVal f = IntVal x where MPI x = f rsa - - fromASN1 ( Start Sequence - : IntVal _ -- version - : IntVal n - : IntVal e - : IntVal d - : IntVal p - : IntVal q - : IntVal dmodp1 - : IntVal dmodqminus1 - : IntVal coefficient - : ys) = - Right ( privkey, tail $ dropWhile notend ys) - where - notend (End Sequence) = False - notend _ = True - privkey = RSAPrivateKey - { rsaN = MPI n - , rsaE = MPI e - , rsaD = MPI d - , rsaP = MPI p - , rsaQ = MPI q - , rsaDmodP1 = MPI dmodp1 - , rsaDmodQminus1 = MPI dmodqminus1 - , rsaCoefficient = MPI coefficient - } - fromASN1 _ = - Left "fromASN1: RSAPrivateKey: unexpected format" - sshrsa :: Integer -> Integer -> Char8.ByteString sshrsa e n = runPut $ do putWord32be 7 @@ -212,14 +168,6 @@ getPackets = do -} -extractPEM typ pem = dta - where - dta = case ys of - _:dta_lines -> Char8.concat dta_lines - [] -> "" - xs = dropWhile (/="-----BEGIN " <> typ <> "-----") (Char8.lines pem) - ys = takeWhile (/="-----END " <> typ <> "-----") xs - writePEM typ dta = pem where pem = unlines . concat $ @@ -682,46 +630,6 @@ writeKeyToFile False "PEM" fname packet = return () algo -> warn $ fname ++ ": unable to export "++show algo++" key "++fingerprint packet -readKeyFromFile False "PEM" fname = do - -- warn $ fname ++ ": reading ..." - -- Note: The key's timestamp is included in it's fingerprint. - -- Therefore, we should attempt to preserve it. - timestamp <- handleIO_ (error $ fname++": modificaiton time?") $ - modificationTime <$> getFileStatus fname - input <- L.readFile fname - let dta = extractPEM "RSA PRIVATE KEY" input - -- Char8.putStrLn $ "dta = " <> dta - let rsa = do - e <- decodeASN1 DER . L.pack <$> Base64.decode (Char8.unpack 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 - } -readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt) - readPublicKey :: Char8.ByteString -> RSAPublicKey readPublicKey bs = maybe er id $ do let (pre,bs1) = Char8.splitAt 7 bs @@ -1164,27 +1072,6 @@ doBTCImport doDecrypt db (ms,subspec,content) = do $ error "Key specification is ambiguous." doImportG doDecrypt db m0 tag "" key -doImport - :: Ord k => - (Packet -> IO (Maybe Packet)) - -> Map.Map k KeyData - -> ([Char], Maybe [Char], [k], t) - -> IO (Map.Map k KeyData) -doImport doDecrypt db (fname,subspec,ms,_) = do - let fetchkey = readKeyFromFile False "PEM" fname - let error s = do - warn s - exitFailure - flip (maybe $ error "Cannot import master key.") - subspec $ \tag -> do - Message parsedkey <- fetchkey - flip (maybe $ return db) - (listToMaybe parsedkey) $ \key -> do - let (m0,tailms) = splitAt 1 ms - when (not (null tailms) || null m0) - $ error "Key specification is ambiguous." - doImportG doDecrypt db m0 tag fname key - -- We return into IO in case we want to make a signature here. setHostnames :: (SockAddr -> Bool) -> Hosts.Hosts -> KeyData -> IO KeyData setHostnames pred hosts kd@(KeyData topmp topsigs uids subs) = -- cgit v1.2.3