diff options
author | joe <joe@jerkface.net> | 2014-04-17 23:12:49 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-04-17 23:12:49 -0400 |
commit | bcac8b451fcedd8a4485920d187f36bb9fd3c198 (patch) | |
tree | 5a9c27bde4a29f9b3bdb75c7ba49bf33a749c9c3 /KeyRing.hs | |
parent | a64e5974d95ab9f376be2686f019bac4d622567e (diff) |
passed doDecrypt to buildKeyDB
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 47 |
1 files changed, 39 insertions, 8 deletions
@@ -655,9 +655,10 @@ importPEMKey db' tup = do | |||
655 | where doDecrypt = todo | 655 | where doDecrypt = todo |
656 | 656 | ||
657 | 657 | ||
658 | buildKeyDB :: FilePath -> FilePath -> Maybe String -> KeyRingData | 658 | buildKeyDB :: (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)])) |
660 | buildKeyDB secring pubring grip0 keyring = do | 661 | buildKeyDB 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 | ||
1121 | doDecrypt :: IORef (Map.Map KeyKey Packet) | ||
1122 | -> Map.Map FilePath (IO S.ByteString) | ||
1123 | -> MappedPacket | ||
1124 | -> IO (KikiCondition Packet) | ||
1125 | doDecrypt 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 | ||
1123 | runKeyRing :: KeyRingData -> IO (KikiResult KeyRingRuntime) | 1150 | runKeyRing :: KeyRingData -> IO (KikiResult KeyRingRuntime) |
1124 | runKeyRing keyring = do | 1151 | runKeyRing 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 | ||