certificate debug foo

1 files changed, 144 insertions, 2 deletions

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