diff options
author | joe <joe@jerkface.net> | 2014-04-20 02:01:59 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-04-20 02:01:59 -0400 |
commit | f9a71c7d34e3f8b595912829dc26f17818a743f6 (patch) | |
tree | 101537eba4597364ab7963ba4c082ea1a3798db0 | |
parent | d521087a7d04f3dd5fdab03abe13994a3a3d6c9e (diff) |
decrypt the working key
-rw-r--r-- | KeyRing.hs | 17 |
1 files changed, 11 insertions, 6 deletions
@@ -687,7 +687,8 @@ importPEMKey doDecrypt db' tup = do | |||
687 | 687 | ||
688 | buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet)) | 688 | buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet)) |
689 | -> FilePath -> FilePath -> Maybe String -> KeyRingOperation | 689 | -> FilePath -> FilePath -> Maybe String -> KeyRingOperation |
690 | -> IO (KikiCondition ((KeyDB,Maybe String,Maybe Packet),[(FilePath,KikiReportAction)])) | 690 | -> IO (KikiCondition ((KeyDB,Maybe String,Maybe MappedPacket) |
691 | ,[(FilePath,KikiReportAction)])) | ||
691 | buildKeyDB doDecrypt secring pubring grip0 keyring = do | 692 | buildKeyDB doDecrypt secring pubring grip0 keyring = do |
692 | let | 693 | let |
693 | 694 | ||
@@ -712,7 +713,7 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do | |||
712 | return $ KikiSuccess (db'', report0 ++ report) | 713 | return $ KikiSuccess (db'', report0 ++ report) |
713 | 714 | ||
714 | -- KeyRings (todo: KikiCondition reporting?) | 715 | -- KeyRings (todo: KikiCondition reporting?) |
715 | (db_rings,wk,grip) <- do | 716 | (db_rings,mwk,grip) <- do |
716 | ms <- mapM readp (files isring) | 717 | ms <- mapM readp (files isring) |
717 | let grip = grip0 `mplus` (fingerprint <$> fstkey) | 718 | let grip = grip0 `mplus` (fingerprint <$> fstkey) |
718 | where | 719 | where |
@@ -726,9 +727,11 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do | |||
726 | fp <- maybeToList grip | 727 | fp <- maybeToList grip |
727 | elm <- Map.toList db_rings | 728 | elm <- Map.toList db_rings |
728 | guard $ matchSpec (KeyGrip fp) elm | 729 | guard $ matchSpec (KeyGrip fp) elm |
729 | return $ keyPacket (snd elm) | 730 | return $ keyMappedPacket (snd elm) |
730 | return (db_rings,wk,grip) | 731 | return (db_rings,wk,grip) |
731 | 732 | ||
733 | let wk = fmap packet mwk | ||
734 | |||
732 | -- Wallets | 735 | -- Wallets |
733 | wms <- mapM (readw wk) (files iswallet) | 736 | wms <- mapM (readw wk) (files iswallet) |
734 | let wallet_keys = do | 737 | let wallet_keys = do |
@@ -753,7 +756,7 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do | |||
753 | db <- foldM (importPEMKey doDecrypt) (KikiSuccess (db,[])) imports | 756 | db <- foldM (importPEMKey doDecrypt) (KikiSuccess (db,[])) imports |
754 | try db $ \(db,reportPEMs) -> do | 757 | try db $ \(db,reportPEMs) -> do |
755 | 758 | ||
756 | return $ KikiSuccess ( (db, grip, wk), reportWallets ++ reportPEMs ) | 759 | return $ KikiSuccess ( (db, grip, mwk), reportWallets ++ reportPEMs ) |
757 | 760 | ||
758 | torhash key = maybe "" id $ derToBase32 <$> derRSA key | 761 | torhash key = maybe "" id $ derToBase32 <$> derRSA key |
759 | 762 | ||
@@ -1251,6 +1254,8 @@ runKeyRing operation = do | |||
1251 | 1254 | ||
1252 | try' bresult $ \((db,grip,wk),report_imports) -> do | 1255 | try' bresult $ \((db,grip,wk),report_imports) -> do |
1253 | 1256 | ||
1257 | let wkun = fmap (doDecrypt unkeysRef pws) wk | ||
1258 | |||
1254 | nonexistents <- | 1259 | nonexistents <- |
1255 | filterM (fmap not . doesFileExist . fst) | 1260 | filterM (fmap not . doesFileExist . fst) |
1256 | $ do (f,t) <- Map.toList (kFiles operation) | 1261 | $ do (f,t) <- Map.toList (kFiles operation) |
@@ -1314,7 +1319,7 @@ runKeyRing operation = do | |||
1314 | { rtPubring = pubring | 1319 | { rtPubring = pubring |
1315 | , rtSecring = secring | 1320 | , rtSecring = secring |
1316 | , rtGrip = grip | 1321 | , rtGrip = grip |
1317 | , rtWorkingKey = wk | 1322 | , rtWorkingKey = fmap packet wk |
1318 | , rtKeyDB = db | 1323 | , rtKeyDB = db |
1319 | } | 1324 | } |
1320 | 1325 | ||
@@ -1358,7 +1363,7 @@ makeInducerSig topk wkun uid extras | |||
1358 | db' <- Traversable.mapM doManips db | 1363 | db' <- Traversable.mapM doManips db |
1359 | -} | 1364 | -} |
1360 | 1365 | ||
1361 | r <- writeWalletKeys operation db wk | 1366 | r <- writeWalletKeys operation db (fmap packet wk) |
1362 | try' r $ \report_wallets -> do | 1367 | try' r $ \report_wallets -> do |
1363 | 1368 | ||
1364 | r <- writeRingKeys operation rt -- db wk secring pubring | 1369 | r <- writeRingKeys operation rt -- db wk secring pubring |