diff options
-rw-r--r-- | kiki.hs | 38 |
1 files changed, 17 insertions, 21 deletions
@@ -43,7 +43,8 @@ import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds ) | |||
43 | import Data.Time.Clock ( UTCTime ) | 43 | import Data.Time.Clock ( UTCTime ) |
44 | import Data.Monoid ( (<>) ) | 44 | import Data.Monoid ( (<>) ) |
45 | 45 | ||
46 | 46 | import ScanningParser | |
47 | import PEM | ||
47 | import DotLock | 48 | import DotLock |
48 | import LengthPrefixedBE | 49 | import LengthPrefixedBE |
49 | import KeyRing | 50 | import KeyRing |
@@ -324,12 +325,6 @@ show_wip keyspec wkgrip db = do | |||
324 | let nwb = maybe 0x80 CryptoCoins.secretByteFromName $ snd s | 325 | let nwb = maybe 0x80 CryptoCoins.secretByteFromName $ snd s |
325 | putStrLn $ walletImportFormat nwb k | 326 | putStrLn $ walletImportFormat nwb k |
326 | 327 | ||
327 | getSequence depth (Start Sequence:xs) = Start Sequence : getSequence (depth+1) xs | ||
328 | getSequence 1 (End Sequence:_) = [End Sequence] | ||
329 | getSequence depth (End Sequence:xs) = End Sequence : getSequence (depth-1) xs | ||
330 | getSequence depth (x:xs) = x : getSequence depth xs | ||
331 | getSequence _ [] = [] | ||
332 | |||
333 | packetFromPublicRSAKey notBefore n e = | 328 | packetFromPublicRSAKey notBefore n e = |
334 | PublicKeyPacket { version = 4 | 329 | PublicKeyPacket { version = 4 |
335 | , timestamp = round $ utcTimeToPOSIXSeconds notBefore | 330 | , timestamp = round $ utcTimeToPOSIXSeconds notBefore |
@@ -352,7 +347,7 @@ parseCertBlob comp bs = do | |||
352 | let asn1' = drop 2 asn1 | 347 | let asn1' = drop 2 asn1 |
353 | cert <- either (const Nothing) (Just . fst) (fromASN1 asn1') | 348 | cert <- either (const Nothing) (Just . fst) (fromASN1 asn1') |
354 | let _ = cert :: Certificate | 349 | let _ = cert :: Certificate |
355 | (notBefore,notAfter) = certValidity cert | 350 | (notBefore,_) = certValidity cert |
356 | case certPubKey cert of | 351 | case certPubKey cert of |
357 | PubKeyRSA key -> do | 352 | PubKeyRSA key -> do |
358 | let withoutkey = | 353 | let withoutkey = |
@@ -388,9 +383,6 @@ decodeBlob cert = | |||
388 | bs = pcertBlob cert | 383 | bs = pcertBlob cert |
389 | key = maybe L.empty (encodeASN1 DER . flip toASN1 []) $ rsaKeyFromPacket $ pcertKey cert | 384 | key = maybe L.empty (encodeASN1 DER . flip toASN1 []) $ rsaKeyFromPacket $ pcertKey cert |
390 | 385 | ||
391 | parsePEM :: L.ByteString -> L.ByteString -> (Message,L.ByteString) | ||
392 | parsePEM hdr bs = error "todo" | ||
393 | |||
394 | show_torhash pubkey _ = do | 386 | show_torhash pubkey _ = do |
395 | bs <- Char8.readFile pubkey | 387 | bs <- Char8.readFile pubkey |
396 | let parsekey f dta = do | 388 | let parsekey f dta = do |
@@ -398,24 +390,28 @@ show_torhash pubkey _ = do | |||
398 | e <- decodeASN1 DER <$> mdta | 390 | e <- decodeASN1 DER <$> mdta |
399 | asn1 <- either (const Nothing) (Just) e | 391 | asn1 <- either (const Nothing) (Just) e |
400 | k <- either (const Nothing) (Just . fst) (fromASN1 asn1) | 392 | k <- either (const Nothing) (Just . fst) (fromASN1 asn1) |
401 | return $ f (packetFromPublicRSAKey undefined) k -- (MPI n) (MPI e) | 393 | return $ f (packetFromPublicRSAKey undefined) k |
402 | pkcs1 = parsekey (\f (RSAKey n e) -> f n e) | ||
403 | $ extractPEM "RSA PUBLIC KEY" bs | ||
404 | pkcs8 = parsekey (\f (RSAKey8 n e) -> f n e) | ||
405 | $ extractPEM "PUBLIC KEY" bs | ||
406 | addy hsh = take 16 hsh ++ ".onion " ++ hsh | 394 | addy hsh = take 16 hsh ++ ".onion " ++ hsh |
407 | putStrLn $ maybe "" (addy . torhash) $ mplus pkcs1 pkcs8 | 395 | pkcs1 = fmap ( parsekey (\f (RSAKey n e) -> f n e) . pemBlob ) |
396 | $ pemParser (Just "RSA PUBLIC KEY") | ||
397 | pkcs8 = fmap ( parsekey (\f (RSAKey8 n e) -> f n e) . pemBlob ) | ||
398 | $ pemParser (Just "PUBLIC KEY") | ||
399 | keys = catMaybes $ scanAndParse (pkcs1 <> pkcs8) $ Char8.lines bs | ||
400 | mapM_ (putStrLn . addy . torhash) keys | ||
401 | |||
408 | 402 | ||
409 | show_cert certfile _ = do | 403 | show_cert certfile _ = do |
410 | bs <- Char8.readFile certfile | 404 | bs <- Char8.readFile certfile |
411 | let dta = extractPEM "CERTIFICATE" bs | 405 | let dta = scanAndParse (fmap pemBlob $ pemParser $ Just "CERTIFICATE") $ Char8.lines bs |
412 | mdta = L.pack <$> Base64.decode (Char8.unpack dta) | 406 | mdta = do |
407 | dta <- listToMaybe dta | ||
408 | L.pack <$> Base64.decode (Char8.unpack dta) | ||
413 | let c = mdta >>= parseCertBlob True | 409 | let c = mdta >>= parseCertBlob True |
414 | d = mdta >>= parseCertBlob False | 410 | d = mdta >>= parseCertBlob False |
415 | -- e = mdta >>= parseCertBlob 2 | 411 | -- e = mdta >>= parseCertBlob 2 |
416 | b64 = Base64.encode . S.unpack | 412 | -- b64 = Base64.encode . S.unpack |
417 | b64L = Base64.encode . L.unpack | 413 | b64L = Base64.encode . L.unpack |
418 | hex = Base16.encode . S.unpack | 414 | -- hex = Base16.encode . S.unpack |
419 | hexL = Base16.encode . L.unpack | 415 | hexL = Base16.encode . L.unpack |
420 | putStrLn $ maybe "" (fingerprint . pcertKey) c | 416 | putStrLn $ maybe "" (fingerprint . pcertKey) c |
421 | putStrLn $ maybe "" (torhash . pcertKey) c | 417 | putStrLn $ maybe "" (torhash . pcertKey) c |