From 8c065b516ee67fbab860b07d5e81919f7c774a05 Mon Sep 17 00:00:00 2001 From: joe Date: Sat, 12 Apr 2014 01:25:15 -0400 Subject: reorganized cross_merge to use runKeyring --- kiki.hs | 62 +++++++++++++++++++++++++------------------------------------- 1 file changed, 25 insertions(+), 37 deletions(-) (limited to 'kiki.hs') diff --git a/kiki.hs b/kiki.hs index e4c0dc4..ab3faf5 100644 --- a/kiki.hs +++ b/kiki.hs @@ -1269,7 +1269,7 @@ sortByHint fname f = sortBy (comparing gethint) keyMappedPacket (KeyData k _ _ _) = k keyPacket (KeyData k _ _ _) = packet k -writeOutKeyrings :: Map.Map FilePath DotLock -> KeyDB -> IO () +writeOutKeyrings :: Map.Map FilePath t -> KeyDB -> IO () writeOutKeyrings lkmap db = do let ks = Map.elems db fs = Map.keys (foldr unionfiles Map.empty ks) @@ -1307,44 +1307,34 @@ writeOutKeyrings lkmap db = do L.writeFile f (encode m) cross_merge doDecrypt homespec keyrings wallets f = do + + let it = KeyRingData + { filesToLock = HomeSec:HomePub:map ArgFile keyrings + , homeSpec = homespec + , keyringFiles = keyrings + , walletFiles = wallets + , kaction = go + } + runKeyRing it + where + go rt = do let readp n = fmap (n,) (readPacketsFromFile n) readw wk n = fmap (n,) (readPacketsFromWallet wk n) - let relock keyrings = do - (fsns,failed_locks) <- lockFiles keyrings - (wsns,failed_wlocks) <- lockFiles wallets - forM_ (failed_locks++failed_wlocks) $ \f -> warn $ "Failed to lock: " ++ f - return (fsns,wsns,failed_locks,failed_wlocks) - sec_n:_ = keyrings - - (homedir,secring,pubring,grip0) <- getHomeDir homespec - - (fsns0,wsns0,failed_locks0,failed_wlocks0) <- relock [secring,pubring] - db00 <- do - ms0 <- mapM readp (map snd fsns0++failed_locks0) - return $ foldl' (uncurry . merge) Map.empty ms0 - - (fsns,wsns,failed_locks,failed_wlocks) <- relock keyrings - wsns <- return $ wsns0 ++ wsns - failed_locks <- return $ failed_locks0 ++ failed_locks - failed_wlocks <- return $ failed_wlocks0 ++ failed_wlocks - - -- let (lks,fs) = unzip fsns - -- forM_ fs $ \f -> warn $ "locked: " ++ f - let pass n (fsns,failed_locks) = do - ms <- mapM readp (map snd fsns++failed_locks) - let db0 = foldl' (uncurry . merge) db00 ms + let pass n = do + ms <- mapM readp (rtRings rt) + let db0 = foldl' (uncurry . merge) Map.empty ms fstkey = listToMaybe $ mapMaybe isSecringKey ms where isSecringKey (fn,Message ps) - | fn==sec_n = listToMaybe ps + | fn== rtSecring rt = listToMaybe ps isSecringKey _ = Nothing - grip = grip0 `mplus` (fingerprint <$> fstkey) + grip = rtGrip rt `mplus` (fingerprint <$> fstkey) wk = listToMaybe $ do fp <- maybeToList grip elm <- Map.toList db0 guard $ matchSpec (KeyGrip fp) elm return $ keyPacket (snd elm) - wms <- mapM (readw wk) (map snd wsns++failed_wlocks) + wms <- mapM (readw wk) (rtWallets rt) let -- db1= foldl' (uncurry . merge_) db0 wms ts = do maybeToList wk @@ -1373,7 +1363,7 @@ cross_merge doDecrypt homespec keyrings wallets f = do return (tag,mp) -- export wallet keys - forM_ wsns $ \(_,n) -> do + forM_ (rtWallets rt) $ \n -> do let cs' = do (nw,mp) <- cs -- let fns = Map.keys (locations mp) @@ -1389,19 +1379,17 @@ cross_merge doDecrypt homespec keyrings wallets f = do -- unlockFiles fsns ----------- Originally, I did this to enable altering the gpg keyrings ------------------------------- from external tools. - (db',_) <- f (sec_n,grip) db pubring + (db',_) <- f (rtSecring rt,grip) db (rtPubring rt) -- lk <- relock --------------- The design is not quite safe, so it is disabled for now. - let lk = (fsns,failed_locks) -- + let lk = (rtRings rt,[]) ------------------------------- - maybe (if n==0 then pass 1 lk else return (lk,db)) + maybe (if n==0 then pass 1 else return (lk,db)) (return . (lk,)) db' - ((fsns,failed_locks),db) <- pass 0 (fsns,failed_locks) - let lkmap = Map.fromList $ map swap fsns + ((fsns,failed_locks),db) <- pass 0 + + let lkmap = Map.fromList $ map (,()) fsns writeOutKeyrings lkmap db - unlockFiles fsns - unlockFiles wsns - return () {- -- cgit v1.2.3