summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--KeyRing.hs26
1 files changed, 12 insertions, 14 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index bda1958..6fac344 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -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
648importPEMKey db' tup = do 648importPEMKey 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
658buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet)) 656buildKeyDB :: (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
1100writePEMKeys :: KeyDB 1098writePEMKeys :: (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)])
1103writePEMKeys db exports = do 1102writePEMKeys 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
1121doDecrypt :: IORef (Map.Map KeyKey Packet) 1118doDecrypt :: 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