diff options
-rw-r--r-- | KeyRing.hs | 47 | ||||
-rw-r--r-- | kiki.hs | 13 |
2 files changed, 37 insertions, 23 deletions
@@ -424,7 +424,7 @@ data KeySpec = | |||
424 | 424 | ||
425 | 425 | ||
426 | buildKeyDB :: FilePath -> FilePath -> Maybe String -> KeyRingData | 426 | buildKeyDB :: FilePath -> FilePath -> Maybe String -> KeyRingData |
427 | -> IO (KikiCondition ((KeyDB,Maybe String),[(FilePath,KikiReportAction)])) | 427 | -> IO (KikiCondition ((KeyDB,Maybe String,Maybe Packet),[(FilePath,KikiReportAction)])) |
428 | buildKeyDB secring pubring grip0 keyring = do | 428 | buildKeyDB secring pubring grip0 keyring = do |
429 | let isring (KeyRingFile {}) = True | 429 | let isring (KeyRingFile {}) = True |
430 | isring _ = False | 430 | isring _ = False |
@@ -448,15 +448,15 @@ buildKeyDB secring pubring grip0 keyring = do | |||
448 | where isSecringKey (fn,Message ps) | 448 | where isSecringKey (fn,Message ps) |
449 | | fn==secring = listToMaybe ps | 449 | | fn==secring = listToMaybe ps |
450 | isSecringKey _ = Nothing | 450 | isSecringKey _ = Nothing |
451 | db_rings = foldl' (uncurry . merge) Map.empty ms | ||
451 | wk = listToMaybe $ do | 452 | wk = listToMaybe $ do |
452 | fp <- maybeToList grip | 453 | fp <- maybeToList grip |
453 | elm <- Map.toList db0 | 454 | elm <- Map.toList db_rings |
454 | guard $ matchSpec (KeyGrip fp) elm | 455 | guard $ matchSpec (KeyGrip fp) elm |
455 | return $ keyPacket (snd elm) | 456 | return $ keyPacket (snd elm) |
456 | db0 = foldl' (uncurry . merge) Map.empty ms | ||
457 | 457 | ||
458 | wms <- mapM (readw wk) (files iswallet) | 458 | wms <- mapM (readw wk) (files iswallet) |
459 | let wms' = do | 459 | let wallet_keys = do |
460 | maybeToList wk | 460 | maybeToList wk |
461 | (fname,xs) <- wms | 461 | (fname,xs) <- wms |
462 | (_,sub,(_,m)) <- xs | 462 | (_,sub,(_,m)) <- xs |
@@ -476,9 +476,9 @@ buildKeyDB secring pubring grip0 keyring = do | |||
476 | try r $ \(db'',report) -> do | 476 | try r $ \(db'',report) -> do |
477 | return $ KikiSuccess (db'', report0 ++ report) | 477 | return $ KikiSuccess (db'', report0 ++ report) |
478 | 478 | ||
479 | db <- foldM importWalletKey (KikiSuccess (db0,[])) wms' | 479 | db <- foldM importWalletKey (KikiSuccess (db_rings,[])) wallet_keys |
480 | try db $ \(db,report) -> do | 480 | try db $ \(db,report) -> do |
481 | return $ KikiSuccess ( (db, grip), report ) | 481 | return $ KikiSuccess ( (db, grip, wk), report ) |
482 | 482 | ||
483 | torhash key = maybe "" id $ derToBase32 <$> derRSA key | 483 | torhash key = maybe "" id $ derToBase32 <$> derRSA key |
484 | 484 | ||
@@ -582,7 +582,32 @@ doImportG doDecrypt db m0 tag fname key = do | |||
582 | , report ) | 582 | , report ) |
583 | Just (False,sig) -> doInsert (Just sig) db -- We have a sig, but is missing usage@ tag | 583 | Just (False,sig) -> doInsert (Just sig) db -- We have a sig, but is missing usage@ tag |
584 | 584 | ||
585 | 585 | isCryptoCoinKey p = | |
586 | and [ isKey p | ||
587 | , key_algorithm p == ECDSA | ||
588 | , lookup 'c' (key p) == Just (MPI secp256k1_id) | ||
589 | ] | ||
590 | |||
591 | getCryptoCoinTag p | isSignaturePacket p = do | ||
592 | -- CryptoCoins.secret | ||
593 | let sps = hashed_subpackets p ++ unhashed_subpackets p | ||
594 | u <- listToMaybe $ mapMaybe usage sps | ||
595 | CryptoCoins.lookupNetwork CryptoCoins.network_name u | ||
596 | getCryptoCoinTag _ = Nothing | ||
597 | |||
598 | |||
599 | writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(FilePath,KikiReportAction)]) | ||
600 | writeWalletKeys krd db wk = do | ||
601 | let all_crypto_keys = do | ||
602 | wk <- maybeToList wk | ||
603 | let kk = keykey wk | ||
604 | KeyData top topsigs uids subs <- maybeToList $ Map.lookup kk db | ||
605 | (subkk,SubKey mp sigs) <- Map.toList subs | ||
606 | let sub = packet mp | ||
607 | guard $ isCryptoCoinKey sub | ||
608 | tag <- take 1 $ mapMaybe getCryptoCoinTag (map (packet . fst) sigs) | ||
609 | return (tag,mp) | ||
610 | return $ KikiSuccess [] | ||
586 | 611 | ||
587 | runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a) | 612 | runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a) |
588 | runKeyRing keyring op = do | 613 | runKeyRing keyring op = do |
@@ -606,7 +631,7 @@ runKeyRing keyring op = do | |||
606 | ret <- case functorToEither ret of | 631 | ret <- case functorToEither ret of |
607 | Right {} -> do | 632 | Right {} -> do |
608 | bresult <- buildKeyDB secring pubring grip0 keyring -- build db | 633 | bresult <- buildKeyDB secring pubring grip0 keyring -- build db |
609 | try' bresult $ \((db,grip),report1) -> do | 634 | try' bresult $ \((db,grip,wk),report1) -> do |
610 | a <- return $ op KeyRingRuntime | 635 | a <- return $ op KeyRingRuntime |
611 | { rtPubring = pubring | 636 | { rtPubring = pubring |
612 | , rtSecring = secring | 637 | , rtSecring = secring |
@@ -615,9 +640,11 @@ runKeyRing keyring op = do | |||
615 | , rtGrip = grip | 640 | , rtGrip = grip |
616 | , rtKeyDB = db | 641 | , rtKeyDB = db |
617 | } | 642 | } |
618 | report2 <- todo -- write files | 643 | r <- writeWalletKeys keyring db wk |
644 | try' r $ \report2 -> do | ||
645 | report3 <- todo -- write files | ||
619 | 646 | ||
620 | return $ KikiResult (KikiSuccess a) (report1 ++ report2) | 647 | return $ KikiResult (KikiSuccess a) (report1 ++ report3) |
621 | Left err -> return $ KikiResult err [] | 648 | Left err -> return $ KikiResult err [] |
622 | 649 | ||
623 | forM_ lked $ \(Just lk, fname) -> do dotlock_release lk | 650 | forM_ lked $ \(Just lk, fname) -> do dotlock_release lk |
@@ -89,19 +89,6 @@ import KeyRing | |||
89 | nistp256_id = 0x2a8648ce3d030107 | 89 | nistp256_id = 0x2a8648ce3d030107 |
90 | secp256k1_id = 0x2b8104000a | 90 | secp256k1_id = 0x2b8104000a |
91 | 91 | ||
92 | isCryptoCoinKey p = | ||
93 | and [ isKey p | ||
94 | , key_algorithm p == ECDSA | ||
95 | , lookup 'c' (key p) == Just (MPI secp256k1_id) | ||
96 | ] | ||
97 | |||
98 | getCryptoCoinTag p | isSignaturePacket p = do | ||
99 | -- CryptoCoins.secret | ||
100 | let sps = hashed_subpackets p ++ unhashed_subpackets p | ||
101 | u <- listToMaybe $ mapMaybe usage sps | ||
102 | CryptoCoins.lookupNetwork CryptoCoins.network_name u | ||
103 | getCryptoCoinTag _ = Nothing | ||
104 | |||
105 | warn str = hPutStrLn stderr str | 92 | warn str = hPutStrLn stderr str |
106 | 93 | ||
107 | unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p)) | 94 | unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p)) |