From 1ce9a4ca269305fe4b7c66094d0314b82f1eada3 Mon Sep 17 00:00:00 2001 From: joe Date: Thu, 8 May 2014 03:40:49 -0400 Subject: certificate debug foo --- kiki.cabal | 2 +- kiki.hs | 146 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 145 insertions(+), 3 deletions(-) diff --git a/kiki.cabal b/kiki.cabal index f51b77b..da1a0ee 100644 --- a/kiki.cabal +++ b/kiki.cabal @@ -17,7 +17,7 @@ Executable kiki openpgp-util -any, crypto-pubkey (>=0.2.3), cryptohash -any, crypto-pubkey-types -any, - asn1-types -any, asn1-encoding -any, + x509 -any, asn1-types -any, asn1-encoding -any, dataenc -any, text -any, pretty -any, pretty-show -any, bytestring -any, openpgp (>=0.6.1), binary -any, unix, time, diff --git a/kiki.hs b/kiki.hs index 00e458f..3628307 100644 --- a/kiki.hs +++ b/kiki.hs @@ -35,6 +35,12 @@ import qualified Data.Map as Map import Control.Arrow (first,second) import Data.Binary.Get (runGet) 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 ( UTCTime ) + import DotLock import LengthPrefixedBE @@ -172,7 +178,7 @@ listKeysFiltered grips pkts = do , formkind , " " , fingerprint sub - -- , " " ++ torhash + , " " ++ (torhash sub) -- , " " ++ (concatMap (printf "%02X") $ S.unpack (ecc_curve sub)) ] -- ++ ppShow hashed : if isCryptoCoinKey sub @@ -316,6 +322,138 @@ show_wip keyspec wkgrip db = do let nwb = maybe 0x80 CryptoCoins.secretByteFromName $ snd s putStrLn $ walletImportFormat nwb k +getSequence depth (Start Sequence:xs) = Start Sequence : getSequence (depth+1) xs +getSequence 1 (End Sequence:_) = [End Sequence] +getSequence depth (End Sequence:xs) = End Sequence : getSequence (depth-1) xs +getSequence depth (x:xs) = x : getSequence depth xs +getSequence _ [] = [] + +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,notAfter) = certValidity cert + case certPubKey cert of + PubKeyRSA key -> do + let ex = 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 encode len `L.append` GZip.compress (Char8.fromChunks [pre,post']) + return + ParsedCert { pcertKey = packetFromPublicRSAKey notBefore + (MPI $ public_n key) + (MPI $ public_e key) + , pcertTimestamp = notBefore + , pcertBlob = case comp of + 0 -> ex + 1 -> bs + 2 -> GZip.compress bs + } + _ -> Nothing + +show_torhash pubkey _ = do + bs <- Char8.readFile pubkey + let parsekey f dta = do + let mdta = L.pack <$> Base64.decode (Char8.unpack dta) + e <- decodeASN1 DER <$> mdta + asn1 <- either (const Nothing) (Just) e + k <- either (const Nothing) (Just . fst) (fromASN1 asn1) + return $ f (packetFromPublicRSAKey undefined) k -- (MPI n) (MPI e) + pkcs1 = parsekey (\f (RSAKey n e) -> f n e) + $ extractPEM "RSA PUBLIC KEY" bs + pkcs8 = parsekey (\f (RSAKey8 n e) -> f n e) + $ extractPEM "PUBLIC KEY" bs + addy hsh = take 16 hsh ++ ".onion " ++ hsh + putStrLn $ maybe "" (addy . torhash) $ mplus pkcs1 pkcs8 + +show_cert certfile _ = do + bs <- Char8.readFile certfile + let dta = extractPEM "CERTIFICATE" bs + mdta = L.pack <$> Base64.decode (Char8.unpack dta) + {- + pubkey = RSA.PublicKey + { public_size = 128 + , public_n = 154361684503603802222425703762858923586891027963572326870083767113931020265732747123162809298697685461466566794668728252513238617267841367255306789892103614749619835666015844098056127878039846958283514957904585088494988419964303541700240003254472965884445634980070222782747273430139103311807958905274574715853 + , public_e = 65537} + pubkey2 = RSAKey8 + (MPI 154361684503603802222425703762858923586891027963572326870083767113931020265732747123162809298697685461466566794668728252513238617267841367255306789892103614749619835666015844098056127878039846958283514957904585088494988419964303541700240003254472965884445634980070222782747273430139103311807958905274574715853) + (MPI 65537) + mdta = Base64.decode (Char8.unpack dta) + cert = do + e <- decodeASN1 DER . L.pack <$> mdta + let scert = searchit bs -- decodeSignedCertificate $ Char8.toStrict (Char8.drop 4 bs) + scert :: Either String SignedCertificate + searchit bs | Char8.null bs = Left "thoroughly exhausted" + searchit bs = either (const $ searchit $ Char8.drop 1 bs) Right $ go bs + go bs | Char8.null bs = Left "exhausted" + go bs = either (const $ go $ Char8.init bs) Right $ (decodeSignedCertificate $ Char8.toStrict bs) + asn1 <- either (const Nothing) (Just) e + let asn1' = drop 2 asn1 -- getSequence 0 (drop 1 asn1) -- reverse $ dropWhile (/=End Sequence) $ drop 1 $ reverse asn1 + -- k <- either (Just . Left) (Just . Right . fst) (fromASN1 asn1') + k <- either (const Nothing) (Just . fst) (fromASN1 asn1') + let _ = k :: Certificate -- Either String Certificate + return (k,scert) -- (asn1', k) -- asn1 + ekey = encodeASN1 DER (toASN1 pubkey []) + ekey2 = encodeASN1 DER (toASN1 pubkey2 []) + ekey2_64 = Base64.encode $ L.unpack ekey2 + ex = do + dta <- mdta + let ekey_ = Char8.toStrict ekey + (pre,post) = S.breakSubstring ekey_ (S.pack dta) + post' = S.drop (S.length ekey_) post + return $ ( b64L $ GZip.compress (Char8.fromChunks [pre,post']), (b64 pre, b64 post')) + putStrLn $ show dta + putStrLn $ show (fmap fst cert) + -- putStrLn $ show (fmap snd cert) + putStrLn $ show (Base64.encode $ L.unpack ekey) + putStrLn $ show (Base64.encode $ L.unpack ekey2) + putStrLn $ show ex + -} + let c = mdta >>= parseCertBlob 0 + d = mdta >>= parseCertBlob 1 + e = mdta >>= parseCertBlob 2 + b64 = Base64.encode . S.unpack + b64L = Base64.encode . L.unpack + putStrLn $ maybe "" (fingerprint . pcertKey) c + putStrLn $ maybe "" (torhash . pcertKey) c + putStrLn "" + putStrLn "" + putStrLn $ maybe "" (("key = " ++) . show . pcertKey) c + putStrLn "" + putStrLn $ maybe "" (("small blob length = " ++) . show . L.length . pcertBlob) c + putStrLn "" + putStrLn $ maybe "" (("small blob = " ++) . b64L . pcertBlob) c + putStrLn "" + putStrLn $ maybe "" ((" big blob length = " ++) . show . L.length . pcertBlob) d + putStrLn "" + putStrLn $ maybe "" ((" big blob = " ++) . b64L . pcertBlob) d + putStrLn "" + putStrLn $ maybe "" ((" gzip blob length = " ++) . show . L.length . pcertBlob) e + putStrLn "" + putStrLn $ maybe "" ((" gzip blob = " ++) . b64L . pcertBlob) e + return () + cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8] where numToBytes n = reverse $ unfoldr getbyte n @@ -814,7 +952,9 @@ kiki "show" args = do , ("--key",1) , ("--pem",1) , ("--ssh",1) - , ("--wip",1) + , ("--wip",1) + , ("--cert",1) + , ("--torhash",1) ] polyVariadicArgs = ["--show"] let cap = parseCommonArgs margs @@ -863,6 +1003,8 @@ 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) + ,("--torhash",\[x] -> show_torhash x) ] shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs -- cgit v1.2.3