summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-04-17 23:12:49 -0400
committerjoe <joe@jerkface.net>2014-04-17 23:12:49 -0400
commitbcac8b451fcedd8a4485920d187f36bb9fd3c198 (patch)
tree5a9c27bde4a29f9b3bdb75c7ba49bf33a749c9c3 /KeyRing.hs
parenta64e5974d95ab9f376be2686f019bac4d622567e (diff)
passed doDecrypt to buildKeyDB
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs47
1 files changed, 39 insertions, 8 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 1c68d36..bda1958 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -655,9 +655,10 @@ importPEMKey db' tup = do
655 where doDecrypt = todo 655 where doDecrypt = todo
656 656
657 657
658buildKeyDB :: FilePath -> FilePath -> Maybe String -> KeyRingData 658buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet))
659 -> FilePath -> FilePath -> Maybe String -> KeyRingData
659 -> IO (KikiCondition ((KeyDB,Maybe String,Maybe Packet),[(FilePath,KikiReportAction)])) 660 -> IO (KikiCondition ((KeyDB,Maybe String,Maybe Packet),[(FilePath,KikiReportAction)]))
660buildKeyDB secring pubring grip0 keyring = do 661buildKeyDB doDecrypt secring pubring grip0 keyring = do
661 let 662 let
662 663
663 files isring = do 664 files isring = do
@@ -680,8 +681,6 @@ buildKeyDB secring pubring grip0 keyring = do
680 try r $ \(db'',report) -> do 681 try r $ \(db'',report) -> do
681 return $ KikiSuccess (db'', report0 ++ report) 682 return $ KikiSuccess (db'', report0 ++ report)
682 683
683 doDecrypt = todo
684
685 -- KeyRings (todo: KikiCondition reporting?) 684 -- KeyRings (todo: KikiCondition reporting?)
686 (db_rings,wk,grip) <- do 685 (db_rings,wk,grip) <- do
687 ms <- mapM readp (files isring) 686 ms <- mapM readp (files isring)
@@ -1119,6 +1118,34 @@ writePEMKeys db exports = do
1119 flip (maybe $ return BadPassphrase) pun $ \pun -> do 1118 flip (maybe $ return BadPassphrase) pun $ \pun -> do
1120 return $ KikiSuccess (fname,pun) 1119 return $ KikiSuccess (fname,pun)
1121 1120
1121doDecrypt :: IORef (Map.Map KeyKey Packet)
1122 -> Map.Map FilePath (IO S.ByteString)
1123 -> MappedPacket
1124 -> IO (KikiCondition Packet)
1125doDecrypt unkeysRef pws mp = do
1126 unkeys <- readIORef unkeysRef
1127 let wk = packet mp
1128 kk = keykey wk
1129 fs = Map.keys $ locations mp
1130
1131 decryptIt [] = return BadPassphrase
1132 decryptIt (getpw:getpws) = do
1133 pw <- getpw
1134 let wkun = maybe wk id $ decryptSecretKey pw wk
1135 case symmetric_algorithm wkun of
1136 Unencrypted -> do
1137 writeIORef unkeysRef (Map.insert kk wkun unkeys)
1138 return $ KikiSuccess wkun
1139 _ -> decryptIt getpws
1140
1141 getpws = mapMaybe (flip Map.lookup pws) fs
1142
1143 case symmetric_algorithm wk of
1144 Unencrypted -> return (KikiSuccess wk)
1145 _ -> maybe (decryptIt getpws)
1146 (return . KikiSuccess)
1147 $ Map.lookup kk unkeys
1148
1122 1149
1123runKeyRing :: KeyRingData -> IO (KikiResult KeyRingRuntime) 1150runKeyRing :: KeyRingData -> IO (KikiResult KeyRingRuntime)
1124runKeyRing keyring = do 1151runKeyRing keyring = do
@@ -1146,14 +1173,18 @@ runKeyRing keyring = do
1146 then return $ KikiResult (FailedToLock failed_locks) [] 1173 then return $ KikiResult (FailedToLock failed_locks) []
1147 else do 1174 else do
1148 1175
1149 let doDecrypt = todo
1150
1151 pws <- 1176 pws <-
1177 -- TODO: head will throw an exception if a File Descriptor keyring
1178 -- file is present. We probably should change OriginMap to use InputFile
1179 -- instead of FilePath.
1152 Traversable.mapM (cachedContents secring pubring . pwfile . snd) 1180 Traversable.mapM (cachedContents secring pubring . pwfile . snd)
1153 (Map.filter (isring . snd) $ kFiles keyring) 1181 (Map.mapKeys (head . resolveInputFile secring pubring)
1182 $ Map.filter (isring . snd) $ kFiles keyring)
1183
1184 unkeysRef <- newIORef Map.empty
1154 1185
1155 -- merge all keyrings, PEM files, and wallets 1186 -- merge all keyrings, PEM files, and wallets
1156 bresult <- buildKeyDB secring pubring grip0 keyring 1187 bresult <- buildKeyDB (doDecrypt unkeysRef pws) secring pubring grip0 keyring
1157 1188
1158 try' bresult $ \((db,grip,wk),report_imports) -> do 1189 try' bresult $ \((db,grip,wk),report_imports) -> do
1159 1190