diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 146 |
1 files changed, 144 insertions, 2 deletions
@@ -35,6 +35,12 @@ import qualified Data.Map as Map | |||
35 | import Control.Arrow (first,second) | 35 | import Control.Arrow (first,second) |
36 | import Data.Binary.Get (runGet) | 36 | import Data.Binary.Get (runGet) |
37 | import Data.Binary.Put (putWord32be,runPut,putByteString) | 37 | import Data.Binary.Put (putWord32be,runPut,putByteString) |
38 | import Data.X509 -- (Certificate,SignedCertificate, decodeSignedObject, decodeSignedCertificate ) | ||
39 | import Crypto.PubKey.RSA as RSA | ||
40 | import qualified Codec.Compression.GZip as GZip | ||
41 | import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds ) | ||
42 | import Data.Time.Clock ( UTCTime ) | ||
43 | |||
38 | 44 | ||
39 | import DotLock | 45 | import DotLock |
40 | import LengthPrefixedBE | 46 | import LengthPrefixedBE |
@@ -172,7 +178,7 @@ listKeysFiltered grips pkts = do | |||
172 | , formkind | 178 | , formkind |
173 | , " " | 179 | , " " |
174 | , fingerprint sub | 180 | , fingerprint sub |
175 | -- , " " ++ torhash | 181 | , " " ++ (torhash sub) |
176 | -- , " " ++ (concatMap (printf "%02X") $ S.unpack (ecc_curve sub)) | 182 | -- , " " ++ (concatMap (printf "%02X") $ S.unpack (ecc_curve sub)) |
177 | ] -- ++ ppShow hashed | 183 | ] -- ++ ppShow hashed |
178 | : if isCryptoCoinKey sub | 184 | : if isCryptoCoinKey sub |
@@ -316,6 +322,138 @@ show_wip keyspec wkgrip db = do | |||
316 | let nwb = maybe 0x80 CryptoCoins.secretByteFromName $ snd s | 322 | let nwb = maybe 0x80 CryptoCoins.secretByteFromName $ snd s |
317 | putStrLn $ walletImportFormat nwb k | 323 | putStrLn $ walletImportFormat nwb k |
318 | 324 | ||
325 | getSequence depth (Start Sequence:xs) = Start Sequence : getSequence (depth+1) xs | ||
326 | getSequence 1 (End Sequence:_) = [End Sequence] | ||
327 | getSequence depth (End Sequence:xs) = End Sequence : getSequence (depth-1) xs | ||
328 | getSequence depth (x:xs) = x : getSequence depth xs | ||
329 | getSequence _ [] = [] | ||
330 | |||
331 | packetFromPublicRSAKey notBefore n e = | ||
332 | PublicKeyPacket { version = 4 | ||
333 | , timestamp = round $ utcTimeToPOSIXSeconds notBefore | ||
334 | , key_algorithm = RSA | ||
335 | , key = [('n',n),('e',e)] | ||
336 | , is_subkey = True | ||
337 | , v3_days_of_validity = Nothing | ||
338 | } | ||
339 | |||
340 | data ParsedCert = ParsedCert | ||
341 | { pcertKey :: Packet | ||
342 | , pcertTimestamp :: UTCTime | ||
343 | , pcertBlob :: L.ByteString | ||
344 | } | ||
345 | deriving (Show,Eq) | ||
346 | |||
347 | parseCertBlob comp bs = do | ||
348 | asn1 <- either (const Nothing) Just | ||
349 | $ decodeASN1 DER bs | ||
350 | let asn1' = drop 2 asn1 | ||
351 | cert <- either (const Nothing) (Just . fst) (fromASN1 asn1') | ||
352 | let _ = cert :: Certificate | ||
353 | (notBefore,notAfter) = certValidity cert | ||
354 | case certPubKey cert of | ||
355 | PubKeyRSA key -> do | ||
356 | let ex = let ekey = Char8.toStrict $ encodeASN1 DER (toASN1 key []) | ||
357 | (pre,post) = S.breakSubstring ekey $ Char8.toStrict bs | ||
358 | post' = S.drop (S.length ekey) post | ||
359 | len :: Word16 | ||
360 | len = if S.null post then maxBound | ||
361 | else fromIntegral $ S.length pre | ||
362 | in encode len `L.append` GZip.compress (Char8.fromChunks [pre,post']) | ||
363 | return | ||
364 | ParsedCert { pcertKey = packetFromPublicRSAKey notBefore | ||
365 | (MPI $ public_n key) | ||
366 | (MPI $ public_e key) | ||
367 | , pcertTimestamp = notBefore | ||
368 | , pcertBlob = case comp of | ||
369 | 0 -> ex | ||
370 | 1 -> bs | ||
371 | 2 -> GZip.compress bs | ||
372 | } | ||
373 | _ -> Nothing | ||
374 | |||
375 | show_torhash pubkey _ = do | ||
376 | bs <- Char8.readFile pubkey | ||
377 | let parsekey f dta = do | ||
378 | let mdta = L.pack <$> Base64.decode (Char8.unpack dta) | ||
379 | e <- decodeASN1 DER <$> mdta | ||
380 | asn1 <- either (const Nothing) (Just) e | ||
381 | k <- either (const Nothing) (Just . fst) (fromASN1 asn1) | ||
382 | return $ f (packetFromPublicRSAKey undefined) k -- (MPI n) (MPI e) | ||
383 | pkcs1 = parsekey (\f (RSAKey n e) -> f n e) | ||
384 | $ extractPEM "RSA PUBLIC KEY" bs | ||
385 | pkcs8 = parsekey (\f (RSAKey8 n e) -> f n e) | ||
386 | $ extractPEM "PUBLIC KEY" bs | ||
387 | addy hsh = take 16 hsh ++ ".onion " ++ hsh | ||
388 | putStrLn $ maybe "" (addy . torhash) $ mplus pkcs1 pkcs8 | ||
389 | |||
390 | show_cert certfile _ = do | ||
391 | bs <- Char8.readFile certfile | ||
392 | let dta = extractPEM "CERTIFICATE" bs | ||
393 | mdta = L.pack <$> Base64.decode (Char8.unpack dta) | ||
394 | {- | ||
395 | pubkey = RSA.PublicKey | ||
396 | { public_size = 128 | ||
397 | , public_n = 154361684503603802222425703762858923586891027963572326870083767113931020265732747123162809298697685461466566794668728252513238617267841367255306789892103614749619835666015844098056127878039846958283514957904585088494988419964303541700240003254472965884445634980070222782747273430139103311807958905274574715853 | ||
398 | , public_e = 65537} | ||
399 | pubkey2 = RSAKey8 | ||
400 | (MPI 154361684503603802222425703762858923586891027963572326870083767113931020265732747123162809298697685461466566794668728252513238617267841367255306789892103614749619835666015844098056127878039846958283514957904585088494988419964303541700240003254472965884445634980070222782747273430139103311807958905274574715853) | ||
401 | (MPI 65537) | ||
402 | mdta = Base64.decode (Char8.unpack dta) | ||
403 | cert = do | ||
404 | e <- decodeASN1 DER . L.pack <$> mdta | ||
405 | let scert = searchit bs -- decodeSignedCertificate $ Char8.toStrict (Char8.drop 4 bs) | ||
406 | scert :: Either String SignedCertificate | ||
407 | searchit bs | Char8.null bs = Left "thoroughly exhausted" | ||
408 | searchit bs = either (const $ searchit $ Char8.drop 1 bs) Right $ go bs | ||
409 | go bs | Char8.null bs = Left "exhausted" | ||
410 | go bs = either (const $ go $ Char8.init bs) Right $ (decodeSignedCertificate $ Char8.toStrict bs) | ||
411 | asn1 <- either (const Nothing) (Just) e | ||
412 | let asn1' = drop 2 asn1 -- getSequence 0 (drop 1 asn1) -- reverse $ dropWhile (/=End Sequence) $ drop 1 $ reverse asn1 | ||
413 | -- k <- either (Just . Left) (Just . Right . fst) (fromASN1 asn1') | ||
414 | k <- either (const Nothing) (Just . fst) (fromASN1 asn1') | ||
415 | let _ = k :: Certificate -- Either String Certificate | ||
416 | return (k,scert) -- (asn1', k) -- asn1 | ||
417 | ekey = encodeASN1 DER (toASN1 pubkey []) | ||
418 | ekey2 = encodeASN1 DER (toASN1 pubkey2 []) | ||
419 | ekey2_64 = Base64.encode $ L.unpack ekey2 | ||
420 | ex = do | ||
421 | dta <- mdta | ||
422 | let ekey_ = Char8.toStrict ekey | ||
423 | (pre,post) = S.breakSubstring ekey_ (S.pack dta) | ||
424 | post' = S.drop (S.length ekey_) post | ||
425 | return $ ( b64L $ GZip.compress (Char8.fromChunks [pre,post']), (b64 pre, b64 post')) | ||
426 | putStrLn $ show dta | ||
427 | putStrLn $ show (fmap fst cert) | ||
428 | -- putStrLn $ show (fmap snd cert) | ||
429 | putStrLn $ show (Base64.encode $ L.unpack ekey) | ||
430 | putStrLn $ show (Base64.encode $ L.unpack ekey2) | ||
431 | putStrLn $ show ex | ||
432 | -} | ||
433 | let c = mdta >>= parseCertBlob 0 | ||
434 | d = mdta >>= parseCertBlob 1 | ||
435 | e = mdta >>= parseCertBlob 2 | ||
436 | b64 = Base64.encode . S.unpack | ||
437 | b64L = Base64.encode . L.unpack | ||
438 | putStrLn $ maybe "" (fingerprint . pcertKey) c | ||
439 | putStrLn $ maybe "" (torhash . pcertKey) c | ||
440 | putStrLn "" | ||
441 | putStrLn "" | ||
442 | putStrLn $ maybe "" (("key = " ++) . show . pcertKey) c | ||
443 | putStrLn "" | ||
444 | putStrLn $ maybe "" (("small blob length = " ++) . show . L.length . pcertBlob) c | ||
445 | putStrLn "" | ||
446 | putStrLn $ maybe "" (("small blob = " ++) . b64L . pcertBlob) c | ||
447 | putStrLn "" | ||
448 | putStrLn $ maybe "" ((" big blob length = " ++) . show . L.length . pcertBlob) d | ||
449 | putStrLn "" | ||
450 | putStrLn $ maybe "" ((" big blob = " ++) . b64L . pcertBlob) d | ||
451 | putStrLn "" | ||
452 | putStrLn $ maybe "" ((" gzip blob length = " ++) . show . L.length . pcertBlob) e | ||
453 | putStrLn "" | ||
454 | putStrLn $ maybe "" ((" gzip blob = " ++) . b64L . pcertBlob) e | ||
455 | return () | ||
456 | |||
319 | cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8] | 457 | cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8] |
320 | where | 458 | where |
321 | numToBytes n = reverse $ unfoldr getbyte n | 459 | numToBytes n = reverse $ unfoldr getbyte n |
@@ -814,7 +952,9 @@ kiki "show" args = do | |||
814 | , ("--key",1) | 952 | , ("--key",1) |
815 | , ("--pem",1) | 953 | , ("--pem",1) |
816 | , ("--ssh",1) | 954 | , ("--ssh",1) |
817 | , ("--wip",1) | 955 | , ("--wip",1) |
956 | , ("--cert",1) | ||
957 | , ("--torhash",1) | ||
818 | ] | 958 | ] |
819 | polyVariadicArgs = ["--show"] | 959 | polyVariadicArgs = ["--show"] |
820 | let cap = parseCommonArgs margs | 960 | let cap = parseCommonArgs margs |
@@ -863,6 +1003,8 @@ kiki "show" args = do | |||
863 | ,("--pem",\[x] -> show_pem x $ fromMaybe "" grip) | 1003 | ,("--pem",\[x] -> show_pem x $ fromMaybe "" grip) |
864 | ,("--ssh",\[x] -> show_ssh x $ fromMaybe "" grip) | 1004 | ,("--ssh",\[x] -> show_ssh x $ fromMaybe "" grip) |
865 | ,("--wip",\[x] -> show_wip x $ fromMaybe "" grip) | 1005 | ,("--wip",\[x] -> show_wip x $ fromMaybe "" grip) |
1006 | ,("--cert",\[x] -> show_cert x) | ||
1007 | ,("--torhash",\[x] -> show_torhash x) | ||
866 | ] | 1008 | ] |
867 | shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs | 1009 | shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs |
868 | 1010 | ||