summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-04-20 02:01:59 -0400
committerjoe <joe@jerkface.net>2014-04-20 02:01:59 -0400
commitf9a71c7d34e3f8b595912829dc26f17818a743f6 (patch)
tree101537eba4597364ab7963ba4c082ea1a3798db0
parentd521087a7d04f3dd5fdab03abe13994a3a3d6c9e (diff)
decrypt the working key
-rw-r--r--KeyRing.hs17
1 files changed, 11 insertions, 6 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 8d4f82d..5e55565 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -687,7 +687,8 @@ importPEMKey doDecrypt db' tup = do
687 687
688buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet)) 688buildKeyDB :: (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)]))
691buildKeyDB doDecrypt secring pubring grip0 keyring = do 692buildKeyDB 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
758torhash key = maybe "" id $ derToBase32 <$> derRSA key 761torhash 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