From adec571e0f7e7474575303905f109d4348573a00 Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 11 May 2014 19:54:19 -0400 Subject: show --cert, certificate import bug fixes --- KeyRing.hs | 55 ++++++++++++++++++++++++++++++++++++++++++++++--------- PEM.hs | 5 ++--- kiki.hs | 24 ++++++++++++++++++++++-- 3 files changed, 70 insertions(+), 14 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index 68ec843..8864df4 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -84,6 +84,8 @@ module KeyRing , parseCertBlob , packetFromPublicRSAKey , decodeBlob + , selectPublicKeyAndSigs + , x509cert ) where import System.Environment @@ -643,6 +645,14 @@ usage (NotationDataPacket }) = Just u usage _ = Nothing +x509cert :: SignatureSubpacket -> Maybe Char8.ByteString +x509cert (NotationDataPacket + { human_readable = False + , notation_name = "x509cert@" + , notation_value = u + }) = Just (Char8.pack u) +x509cert _ = Nothing + makeInducerSig :: Packet -> Packet -> Packet -> [SignatureSubpacket] -> SignatureOver @@ -811,12 +821,12 @@ keyFlags0 wkun uidsigs = concat isfeatures _ = False -matchSpec :: KeySpec -> (t, KeyData) -> Bool -matchSpec (KeyGrip grip) (_,KeyData p _ _ _) +matchSpec :: KeySpec -> KeyData -> Bool +matchSpec (KeyGrip grip) (KeyData p _ _ _) | matchpr grip (packet p)==grip = True | otherwise = False -matchSpec (KeyTag key tag) (_,KeyData _ sigs _ _) = not . null $ filter match ps +matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps where ps = map (packet .fst) sigs match p = isSignaturePacket p @@ -828,7 +838,7 @@ matchSpec (KeyTag key tag) (_,KeyData _ sigs _ _) = not . null $ filter match ps has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) -matchSpec (KeyUidMatch pat) (_,KeyData _ _ uids _) = not $ null us +matchSpec (KeyUidMatch pat) (KeyData _ _ uids _) = not $ null us where us = filter (isInfixOf pat) $ Map.keys uids @@ -895,6 +905,7 @@ parseSpec grip spec = (topspec,subspec) "fp" | top=="" -> Nothing "" | top=="" && is40digitHex sub -> Nothing "" -> listToMaybe sub >> Just sub + -- "fp" -> ??? TODO: non-ehaustive patterns in case: fp:7/fp: is40digitHex xs = ys == xs && length ys==40 where @@ -913,7 +924,7 @@ parseSpec grip spec = (topspec,subspec) filterMatches :: KeySpec -> [(KeyKey,KeyData)] -> [(KeyKey,KeyData)] -filterMatches spec ks = filter (matchSpec spec) ks +filterMatches spec ks = filter (matchSpec spec . snd) ks filterNewSubs :: FilePath -> (KeySpec,Maybe String) -> KeyData -> KeyData filterNewSubs fname spec (KeyData p sigs uids subs) = KeyData p sigs uids subs' @@ -948,6 +959,31 @@ selectSecretKey (spec,mtag) db = selectKey0 False (spec,mtag) db selectPublicKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet selectPublicKey (spec,mtag) db = selectKey0 True (spec,mtag) db +selectPublicKeyAndSigs :: (KeySpec,Maybe String) -> KeyDB -> [(Packet,[Packet])] +selectPublicKeyAndSigs (spec,mtag) db = + case mtag of + Nothing -> concat $ Map.elems $ fmap (findbyspec spec) db + Just tag -> Map.elems (Map.filter (matchSpec spec) db) >>= findsubs tag + where + topresult kd = (keyPacket kd, map (packet .fst) $ keySigAndTrusts kd) + + findbyspec (KeyGrip g) kd = do + filter ismatch $ + topresult kd + : map (\(SubKey sub sigs)-> (packet sub, map (packet . fst) sigs)) + (Map.elems $ keySubKeys kd) + where + ismatch (p,sigs) = matchpr g p ==g + findbyspec spec kd = if matchSpec spec kd then [topresult kd] else [] + + findsubs tag (KeyData topk _ _ subs) = Map.elems subs >>= gettag + where + gettag (SubKey sub sigs) = do + let (_,mb,_) = findTag [mkUsage tag] (packet topk) (packet sub) sigs + (hastag,_) <- maybeToList mb + guard hastag + return $ (packet sub, map (packet . fst) sigs) + selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet selectKey0 wantPublic (spec,mtag) db = do let Message ps = flattenKeys wantPublic db @@ -1395,6 +1431,7 @@ data ParsedCert = ParsedCert } deriving (Show,Eq) data SecretPEMData = PEMPacket Packet | PEMCertificate ParsedCert + deriving (Show,Eq) spemPacket (PEMPacket p) = Just p spemPacket _ = Nothing @@ -1465,7 +1502,7 @@ readSecretPEMFile fname = do let dta = catMaybes $ scanAndParse (pkcs1 <> cert) $ Char8.lines input pkcs1 = fmap (parseRSAPrivateKey . pemBlob) $ pemParser $ Just "RSA PRIVATE KEY" - cert = fmap (fmap (PEMPacket . pcertKey) . parseCertBlob False . pemBlob) + cert = fmap (fmap PEMCertificate . parseCertBlob False . pemBlob) $ pemParser $ Just "CERTIFICATE" parseRSAPrivateKey dta = do let e = decodeASN1 DER dta @@ -1729,9 +1766,9 @@ isauth rt keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk workingKey grip use_db = listToMaybe $ do fp <- maybeToList grip - elm <- Map.toList use_db + elm <- Map.elems use_db guard $ matchSpec (KeyGrip fp) elm - return $ keyPacket (snd elm) + return $ keyPacket elm writeRingKeys :: KeyRingOperation -> KeyRingRuntime -> Map.Map InputFile Message {- @@ -2583,7 +2620,7 @@ findTag tag topk subkey subsigs = (xs',minsig,ys') $ sig listToMaybe $ map (signature_time . verify (Message [topk])) - (signatures $ Message [wk,subkey,sig]))) + (signatures $ Message [topk,subkey,sig]))) subsigs (xs,ys) = splitAtMinBy (comparing (Down . snd)) vs xs' = map fst xs diff --git a/PEM.hs b/PEM.hs index e6c8259..7b27e04 100644 --- a/PEM.hs +++ b/PEM.hs @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module PEM where -import Data.Maybe import Data.Monoid import qualified Data.ByteString.Lazy as LW import qualified Data.ByteString.Lazy.Char8 as L @@ -30,5 +29,5 @@ pemParser mtyp = ScanningParser (maybe fndany fndtyp mtyp) pbdy (ys,rs) = span (/="-----END " <> typ <> "-----") xs mblob = PEMBlob typ <$> LW.pack <$> Base64.decode (L.unpack dta) dta = case ys of - _:dta_lines -> L.concat dta_lines - [] -> "" + [] -> "" + dta_lines -> L.concat dta_lines diff --git a/kiki.hs b/kiki.hs index 063c42c..f1568aa 100644 --- a/kiki.hs +++ b/kiki.hs @@ -39,7 +39,7 @@ import Data.Binary.Put (putWord32be,runPut,putByteString) import Data.X509 -- (Certificate,SignedCertificate, decodeSignedObject, decodeSignedCertificate ) import Crypto.PubKey.RSA as RSA import qualified Codec.Compression.GZip as GZip -import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds ) +import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds, posixSecondsToUTCTime ) import Data.Time.Clock ( UTCTime ) import Data.Monoid ( (<>) ) @@ -343,7 +343,26 @@ show_torhash pubkey _ = do keys = catMaybes $ scanAndParse (pkcs1 <> pkcs8 <> cert) $ Char8.lines bs mapM_ (putStrLn . addy . torhash) keys +show_cert keyspec wkgrip db = do + let s = parseSpec wkgrip keyspec + putStrLn $ "parsed spec: "++show s + case selectPublicKeyAndSigs s db of + [] -> void $ warn (keyspec ++ ": not found") + [(k,sigs)] -> do + {- + let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k + der = encodeASN1 DER (toASN1 rsa []) + qq = Base64.encode (L.unpack der) + putStrLn $ writePEM "PUBLIC KEY (TODO: CERT)" qq -- ("TODO "++show keyspec) + -} + let cs = mapMaybe x509cert $ (sigs >>= hashed_subpackets) + ds = map decodeBlob $ map (ParsedCert k (posixSecondsToUTCTime $ fromIntegral $ timestamp k)) cs + qqs = map (Base64.encode . L.unpack) ds + pems = map (writePEM "CERTIFICATE") qqs + forM_ pems putStrLn + _ -> void $ warn (keyspec ++ ": ambiguous") +{- show_cert certfile _ = do bs <- Char8.readFile certfile let dta = scanAndParse (fmap pemBlob $ pemParser $ Just "CERTIFICATE") $ Char8.lines bs @@ -385,6 +404,7 @@ show_cert certfile _ = do putStrLn "" putStrLn $ "prefix = " ++ hexL v return () +-} cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8] where @@ -935,7 +955,7 @@ kiki "show" args = do ,("--pem",\[x] -> show_pem x $ fromMaybe "" grip) ,("--ssh",\[x] -> show_ssh x $ fromMaybe "" grip) ,("--wip",\[x] -> show_wip x $ fromMaybe "" grip) - ,("--cert",\[x] -> show_cert x) + ,("--cert",\[x] -> show_cert x $ fromMaybe "" grip) ,("--torhash",\[x] -> show_torhash x) ] shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs -- cgit v1.2.3