summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--KeyRing.hs78
1 files changed, 41 insertions, 37 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 49ddec4..8571482 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -1177,33 +1177,46 @@ writePEMKeys doDecrypt db exports = do
1177 try pun $ \pun -> do 1177 try pun $ \pun -> do
1178 return $ KikiSuccess (fname,pun) 1178 return $ KikiSuccess (fname,pun)
1179 1179
1180doDecrypt :: IORef (Map.Map KeyKey Packet) 1180makeMemoizingDecrypter :: KeyRingOperation -> FilePath -> FilePath
1181 -> Map.Map FilePath (IO S.ByteString) 1181 -> IO (MappedPacket -> IO (KikiCondition Packet))
1182 -> MappedPacket 1182makeMemoizingDecrypter operation secring pubring = do
1183 -> IO (KikiCondition Packet) 1183 pws <-
1184doDecrypt unkeysRef pws mp = do 1184 -- TODO: head will throw an exception if a File Descriptor operation
1185 unkeys <- readIORef unkeysRef 1185 -- file is present. We probably should change OriginMap to use InputFile
1186 let wk = packet mp 1186 -- instead of FilePath.
1187 kk = keykey wk 1187 Traversable.mapM (cachedContents secring pubring . fromJust . pwfile . snd)
1188 fs = Map.keys $ locations mp 1188 (Map.mapKeys (head . resolveInputFile secring pubring)
1189 1189 $ Map.filter (isJust . pwfile . snd) $ kFiles operation)
1190 decryptIt [] = return BadPassphrase 1190 unkeysRef <- newIORef Map.empty
1191 decryptIt (getpw:getpws) = do 1191 return $ doDecrypt unkeysRef pws
1192 pw <- getpw 1192 where
1193 let wkun = maybe wk id $ decryptSecretKey pw wk 1193 doDecrypt :: IORef (Map.Map KeyKey Packet)
1194 case symmetric_algorithm wkun of 1194 -> Map.Map FilePath (IO S.ByteString)
1195 Unencrypted -> do 1195 -> MappedPacket
1196 writeIORef unkeysRef (Map.insert kk wkun unkeys) 1196 -> IO (KikiCondition Packet)
1197 return $ KikiSuccess wkun 1197 doDecrypt unkeysRef pws mp = do
1198 _ -> decryptIt getpws 1198 unkeys <- readIORef unkeysRef
1199 1199 let wk = packet mp
1200 getpws = mapMaybe (flip Map.lookup pws) fs 1200 kk = keykey wk
1201 1201 fs = Map.keys $ locations mp
1202 case symmetric_algorithm wk of 1202
1203 Unencrypted -> return (KikiSuccess wk) 1203 decryptIt [] = return BadPassphrase
1204 _ -> maybe (decryptIt getpws) 1204 decryptIt (getpw:getpws) = do
1205 (return . KikiSuccess) 1205 pw <- getpw
1206 $ Map.lookup kk unkeys 1206 let wkun = maybe wk id $ decryptSecretKey pw wk
1207 case symmetric_algorithm wkun of
1208 Unencrypted -> do
1209 writeIORef unkeysRef (Map.insert kk wkun unkeys)
1210 return $ KikiSuccess wkun
1211 _ -> decryptIt getpws
1212
1213 getpws = mapMaybe (flip Map.lookup pws) fs
1214
1215 case symmetric_algorithm wk of
1216 Unencrypted -> return (KikiSuccess wk)
1217 _ -> maybe (decryptIt getpws)
1218 (return . KikiSuccess)
1219 $ Map.lookup kk unkeys
1207 1220
1208performManipulations :: 1221performManipulations ::
1209 (MappedPacket -> IO (KikiCondition Packet)) 1222 (MappedPacket -> IO (KikiCondition Packet))
@@ -1287,16 +1300,7 @@ runKeyRing operation = do
1287 else do 1300 else do
1288 1301
1289 -- memoizing decrypter 1302 -- memoizing decrypter
1290 decrypt <- do 1303 decrypt <- makeMemoizingDecrypter operation secring pubring
1291 pws <-
1292 -- TODO: head will throw an exception if a File Descriptor operation
1293 -- file is present. We probably should change OriginMap to use InputFile
1294 -- instead of FilePath.
1295 Traversable.mapM (cachedContents secring pubring . fromJust . pwfile . snd)
1296 (Map.mapKeys (head . resolveInputFile secring pubring)
1297 $ Map.filter (isJust . pwfile . snd) $ kFiles operation)
1298 unkeysRef <- newIORef Map.empty
1299 return $ doDecrypt unkeysRef pws
1300 1304
1301 -- merge all keyrings, PEM files, and wallets 1305 -- merge all keyrings, PEM files, and wallets
1302 bresult <- buildKeyDB decrypt secring pubring grip0 operation 1306 bresult <- buildKeyDB decrypt secring pubring grip0 operation