diff options
-rw-r--r-- | KeyRing.hs | 26 |
1 files changed, 12 insertions, 14 deletions
@@ -645,15 +645,13 @@ cachedContents secring pubring fd = do | |||
645 | let fname = resolveInputFile secring pubring inp | 645 | let fname = resolveInputFile secring pubring inp |
646 | fmap S.concat $ mapM S.readFile fname | 646 | fmap S.concat $ mapM S.readFile fname |
647 | 647 | ||
648 | importPEMKey db' tup = do | 648 | importPEMKey doDecrypt db' tup = do |
649 | try db' $ \(db',report0) -> do | 649 | try db' $ \(db',report0) -> do |
650 | r <- doImport doDecrypt | 650 | r <- doImport doDecrypt |
651 | db' | 651 | db' |
652 | tup | 652 | tup |
653 | try r $ \(db'',report) -> do | 653 | try r $ \(db'',report) -> do |
654 | return $ KikiSuccess (db'', report0 ++ report) | 654 | return $ KikiSuccess (db'', report0 ++ report) |
655 | where doDecrypt = todo | ||
656 | |||
657 | 655 | ||
658 | buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet)) | 656 | buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet)) |
659 | -> FilePath -> FilePath -> Maybe String -> KeyRingData | 657 | -> FilePath -> FilePath -> Maybe String -> KeyRingData |
@@ -720,7 +718,7 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do | |||
720 | cmd = initializer rtyp | 718 | cmd = initializer rtyp |
721 | return (n,subspec,ms,cmd) | 719 | return (n,subspec,ms,cmd) |
722 | imports <- filterM (\(n,_,_,_) -> doesFileExist n) pems | 720 | imports <- filterM (\(n,_,_,_) -> doesFileExist n) pems |
723 | db <- foldM importPEMKey (KikiSuccess (db,[])) imports | 721 | db <- foldM (importPEMKey doDecrypt) (KikiSuccess (db,[])) imports |
724 | try db $ \(db,reportPEMs) -> do | 722 | try db $ \(db,reportPEMs) -> do |
725 | 723 | ||
726 | return $ KikiSuccess ( (db, grip, wk), reportWallets ++ reportPEMs ) | 724 | return $ KikiSuccess ( (db, grip, wk), reportWallets ++ reportPEMs ) |
@@ -1024,8 +1022,8 @@ subkeysForExport subspec (KeyData key _ _ subkeys) = do | |||
1024 | let subs tag = do | 1022 | let subs tag = do |
1025 | e <- Map.elems subkeys | 1023 | e <- Map.elems subkeys |
1026 | guard $ doSearch key tag e | 1024 | guard $ doSearch key tag e |
1027 | return $ subkeyPacket e | 1025 | return $ subkeyMappedPacket e |
1028 | maybe [packet key] subs subspec | 1026 | maybe [key] subs subspec |
1029 | where | 1027 | where |
1030 | doSearch key tag (SubKey sub_mp sigtrusts) = | 1028 | doSearch key tag (SubKey sub_mp sigtrusts) = |
1031 | let (_,v,_) = findTag tag | 1029 | let (_,v,_) = findTag tag |
@@ -1097,10 +1095,11 @@ writeKeyToFile False "PEM" fname packet = | |||
1097 | return [(fname, ExportedSubkey)] | 1095 | return [(fname, ExportedSubkey)] |
1098 | algo -> return [(fname, UnableToExport algo $ fingerprint packet)] | 1096 | algo -> return [(fname, UnableToExport algo $ fingerprint packet)] |
1099 | 1097 | ||
1100 | writePEMKeys :: KeyDB | 1098 | writePEMKeys :: (MappedPacket -> IO (KikiCondition Packet)) |
1101 | -> [(FilePath,Maybe String,[Packet],Maybe Initializer)] | 1099 | -> KeyDB |
1100 | -> [(FilePath,Maybe String,[MappedPacket],Maybe Initializer)] | ||
1102 | -> IO (KikiCondition [(FilePath,KikiReportAction)]) | 1101 | -> IO (KikiCondition [(FilePath,KikiReportAction)]) |
1103 | writePEMKeys db exports = do | 1102 | writePEMKeys doDecrypt db exports = do |
1104 | ds <- mapM decryptKeys exports | 1103 | ds <- mapM decryptKeys exports |
1105 | let ds' = map functorToEither ds | 1104 | let ds' = map functorToEither ds |
1106 | if null (lefts ds') | 1105 | if null (lefts ds') |
@@ -1111,11 +1110,9 @@ writePEMKeys db exports = do | |||
1111 | else do | 1110 | else do |
1112 | return (head $ lefts ds') | 1111 | return (head $ lefts ds') |
1113 | where | 1112 | where |
1114 | doDecrypt = todo | ||
1115 | |||
1116 | decryptKeys (fname,subspec,[p],_) = do | 1113 | decryptKeys (fname,subspec,[p],_) = do |
1117 | pun <- doDecrypt p | 1114 | pun <- doDecrypt p |
1118 | flip (maybe $ return BadPassphrase) pun $ \pun -> do | 1115 | try pun $ \pun -> do |
1119 | return $ KikiSuccess (fname,pun) | 1116 | return $ KikiSuccess (fname,pun) |
1120 | 1117 | ||
1121 | doDecrypt :: IORef (Map.Map KeyKey Packet) | 1118 | doDecrypt :: IORef (Map.Map KeyKey Packet) |
@@ -1235,7 +1232,8 @@ runKeyRing keyring = do | |||
1235 | ExitFailure num -> return (tup,FailedExternal num) | 1232 | ExitFailure num -> return (tup,FailedExternal num) |
1236 | ExitSuccess -> return (tup,ExternallyGeneratedFile) | 1233 | ExitSuccess -> return (tup,ExternallyGeneratedFile) |
1237 | 1234 | ||
1238 | v <- foldM importPEMKey (KikiSuccess (db,[])) $ do | 1235 | v <- foldM (importPEMKey $ doDecrypt unkeysRef pws) |
1236 | (KikiSuccess (db,[])) $ do | ||
1239 | ((f,subspec,ms,cmd),r) <- rs | 1237 | ((f,subspec,ms,cmd),r) <- rs |
1240 | guard $ case r of | 1238 | guard $ case r of |
1241 | ExternallyGeneratedFile -> True | 1239 | ExternallyGeneratedFile -> True |
@@ -1254,7 +1252,7 @@ runKeyRing keyring = do | |||
1254 | r <- writeRingKeys keyring db wk secring pubring | 1252 | r <- writeRingKeys keyring db wk secring pubring |
1255 | try' r $ \report_rings -> do | 1253 | try' r $ \report_rings -> do |
1256 | 1254 | ||
1257 | r <- writePEMKeys db exports | 1255 | r <- writePEMKeys (doDecrypt unkeysRef pws) db exports |
1258 | try' r $ \report_pems -> do | 1256 | try' r $ \report_pems -> do |
1259 | 1257 | ||
1260 | let rt = KeyRingRuntime | 1258 | let rt = KeyRingRuntime |