diff options
-rw-r--r-- | KeyRing.hs | 78 |
1 files changed, 41 insertions, 37 deletions
@@ -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 | ||
1180 | doDecrypt :: IORef (Map.Map KeyKey Packet) | 1180 | makeMemoizingDecrypter :: KeyRingOperation -> FilePath -> FilePath |
1181 | -> Map.Map FilePath (IO S.ByteString) | 1181 | -> IO (MappedPacket -> IO (KikiCondition Packet)) |
1182 | -> MappedPacket | 1182 | makeMemoizingDecrypter operation secring pubring = do |
1183 | -> IO (KikiCondition Packet) | 1183 | pws <- |
1184 | doDecrypt 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 | ||
1208 | performManipulations :: | 1221 | performManipulations :: |
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 |