From ca8bf4445df08ab09c8c064b862ff038f0011f53 Mon Sep 17 00:00:00 2001 From: joe Date: Thu, 17 Apr 2014 21:09:27 -0400 Subject: cosmetic --- KeyRing.hs | 185 +++++++++++++++++++++++++++++++------------------------------ 1 file changed, 93 insertions(+), 92 deletions(-) (limited to 'KeyRing.hs') diff --git a/KeyRing.hs b/KeyRing.hs index 003317e..5301c86 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -80,7 +80,7 @@ home = HomeDir data InputFile = HomeSec | HomePub | ArgFile FilePath - | FileDesc Int + | FileDesc Posix.Fd type UsageTag = String type Initializer = String @@ -1132,97 +1132,98 @@ runKeyRing keyring = do let (lked, map snd -> failed_locks) = partition (isJust . fst) lks ret <- if not $ null failed_locks - then return $ KikiResult (FailedToLock failed_locks) [] - else do - - let doDecrypt = todo - - -- merge all keyrings, PEM files, and wallets - bresult <- buildKeyDB secring pubring grip0 keyring - - try' bresult $ \((db,grip,wk),report_imports) -> do - - nonexistents <- - filterM (fmap not . doesFileExist . fst) - $ do (f,t) <- Map.toList (kFiles keyring) - f <- resolveInputFile secring pubring f - return (f,t) - - let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do - (fname,(rtyp,ftyp)) <- nonexistents - guard $ isMutable rtyp - (topspec,subspec) <- fmap (parseSpec $ maybe "" id grip) - $ getUsage ftyp - -- ms will contain duplicates if a top key has multiple matching - -- subkeys. This is intentional. - let -- ms = map (keykey . fst) $ selectAll True (topspec,subspec) db - -- ms = filterMatches topspec $ Map.toList db - ns = do - (kk,kd) <- filterMatches topspec $ Map.toList db - return (kk , subkeysForExport subspec kd) - return (fname,subspec,ns,initializer rtyp) - (exports0,ambiguous) = partition (\(_,_,ns,_)->null $ drop 1 $ (ns>>=snd)) - notmissing - exports = map (\(f,subspec,ns,cmd) -> (f,subspec,ns >>= snd,cmd)) exports0 - - - ambiguity (f,topspec,subspec,_) = do - return $ KikiResult (AmbiguousKeySpec f) [] - - ifnotnull (x:xs) f g = f x - ifnotnull _ f g = g - - ifnotnull ambiguous ambiguity $ do - - -- create nonexistent files via external commands - externals_ret <- do - let cmds = mapMaybe getcmd missing - where - getcmd (fname,subspec,ms,mcmd) = do - cmd <- mcmd - return (fname,subspec,ms,cmd) - rs <- forM cmds $ \tup@(fname,subspec,ms,cmd) -> do - e <- systemEnv [ ("file",fname) - , ("usage",maybe "" id subspec) ] - cmd - case e of - ExitFailure num -> return (tup,FailedExternal num) - ExitSuccess -> return (tup,ExternallyGeneratedFile) - - v <- foldM importPEMKey (KikiSuccess (db,[])) $ do - ((f,subspec,ms,cmd),r) <- rs - guard $ case r of - ExternallyGeneratedFile -> True - _ -> False - return (f,subspec,map fst ms,cmd) - - try v $ \(db,import_rs) -> do - return $ KikiSuccess (db, map (\((f,_,_,_),r)->(f,r)) rs - ++ import_rs) - - try' externals_ret $ \(db,report_externals) -> do - - r <- writeWalletKeys keyring db wk - try' r $ \report_wallets -> do - - r <- writeRingKeys keyring db wk secring pubring - try' r $ \report_rings -> do - - r <- writePEMKeys db exports - try' r $ \report_pems -> do - - let rt = KeyRingRuntime - { rtPubring = pubring - , rtSecring = secring - , rtGrip = grip - , rtKeyDB = db - } - return $ KikiResult (KikiSuccess rt) - $ concat [ report_imports - , report_externals - , report_wallets - , report_rings - , report_pems ] + then return $ KikiResult (FailedToLock failed_locks) [] + else do + + let doDecrypt = todo + + + -- merge all keyrings, PEM files, and wallets + bresult <- buildKeyDB secring pubring grip0 keyring + + try' bresult $ \((db,grip,wk),report_imports) -> do + + nonexistents <- + filterM (fmap not . doesFileExist . fst) + $ do (f,t) <- Map.toList (kFiles keyring) + f <- resolveInputFile secring pubring f + return (f,t) + + let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do + (fname,(rtyp,ftyp)) <- nonexistents + guard $ isMutable rtyp + (topspec,subspec) <- fmap (parseSpec $ maybe "" id grip) + $ getUsage ftyp + -- ms will contain duplicates if a top key has multiple matching + -- subkeys. This is intentional. + let -- ms = map (keykey . fst) $ selectAll True (topspec,subspec) db + -- ms = filterMatches topspec $ Map.toList db + ns = do + (kk,kd) <- filterMatches topspec $ Map.toList db + return (kk , subkeysForExport subspec kd) + return (fname,subspec,ns,initializer rtyp) + (exports0,ambiguous) = partition (\(_,_,ns,_)->null $ drop 1 $ (ns>>=snd)) + notmissing + exports = map (\(f,subspec,ns,cmd) -> (f,subspec,ns >>= snd,cmd)) exports0 + + + ambiguity (f,topspec,subspec,_) = do + return $ KikiResult (AmbiguousKeySpec f) [] + + ifnotnull (x:xs) f g = f x + ifnotnull _ f g = g + + ifnotnull ambiguous ambiguity $ do + + -- create nonexistent files via external commands + externals_ret <- do + let cmds = mapMaybe getcmd missing + where + getcmd (fname,subspec,ms,mcmd) = do + cmd <- mcmd + return (fname,subspec,ms,cmd) + rs <- forM cmds $ \tup@(fname,subspec,ms,cmd) -> do + e <- systemEnv [ ("file",fname) + , ("usage",maybe "" id subspec) ] + cmd + case e of + ExitFailure num -> return (tup,FailedExternal num) + ExitSuccess -> return (tup,ExternallyGeneratedFile) + + v <- foldM importPEMKey (KikiSuccess (db,[])) $ do + ((f,subspec,ms,cmd),r) <- rs + guard $ case r of + ExternallyGeneratedFile -> True + _ -> False + return (f,subspec,map fst ms,cmd) + + try v $ \(db,import_rs) -> do + return $ KikiSuccess (db, map (\((f,_,_,_),r)->(f,r)) rs + ++ import_rs) + + try' externals_ret $ \(db,report_externals) -> do + + r <- writeWalletKeys keyring db wk + try' r $ \report_wallets -> do + + r <- writeRingKeys keyring db wk secring pubring + try' r $ \report_rings -> do + + r <- writePEMKeys db exports + try' r $ \report_pems -> do + + let rt = KeyRingRuntime + { rtPubring = pubring + , rtSecring = secring + , rtGrip = grip + , rtKeyDB = db + } + return $ KikiResult (KikiSuccess rt) + $ concat [ report_imports + , report_externals + , report_wallets + , report_rings + , report_pems ] forM_ lked $ \(Just lk, fname) -> dotlock_release lk -- cgit v1.2.3