From e0bfb091bafa1c9fde9f3f87404115ac5219da5d Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Tue, 2 Jul 2019 17:06:44 -0400 Subject: improve clarity in kiki.hs no behavioral changes --- kiki.hs | 81 ++++++++++++++++++++++++++++++----------------------------------- 1 file changed, 37 insertions(+), 44 deletions(-) diff --git a/kiki.hs b/kiki.hs index d59f75b..4ba9b4b 100644 --- a/kiki.hs +++ b/kiki.hs @@ -464,8 +464,8 @@ whoseKey rsakey db = filter matchkey (Map.elems db) -kiki_usage :: Bool -> Bool -> Bool -> String -> IO () -kiki_usage bExport bImport bSecret cmd = putStr $ +kiki_usage :: Export -> Import -> Secret -> String -> IO () +kiki_usage ((== Export) -> bExport) ((== Import) -> bImport) ((== Secret) -> bSecret) cmd = putStr $ case cmd of "show" -> unlines $ ["kiki show [options...]" @@ -1026,11 +1026,13 @@ buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp , initializer =NoCreate , transforms = [] } - +data Export = Export | NoExport deriving Eq +data Import = Import | NoImport deriving Eq +data Secret = Secret | NoSecret deriving Eq -- Flag-specific options -- bSecret: --pems and --wallets -- bImport: --import and --import-if-authentic -sync :: Bool -> Bool -> Bool -> String -> [String] -> IO () +sync :: Export -> Import -> Secret -> String -> [String] -> IO () sync bExport bImport bSecret cmdarg args_raw = do let (sargs,margs) = processArgs sargspec polyVariadicArgs "--pems" args_raw sargspec = [ ("--show-wk",0) @@ -1042,12 +1044,12 @@ sync bExport bImport bSecret cmdarg args_raw = do , ("--show-ssh",1) , ("--show-wip",1) -} ] - ++ do guard bImport + ++ do guard (bImport == Import) [ ("--import",0), ("--import-if-authentic",0) ] polyVariadicArgs = ["--keyrings" ,"--hosts" ,"--pems"] - ++ do guard bSecret + ++ do guard (bSecret == Secret) [ "--wallets" ] -- putStrLn $ "margs = " ++ show (Map.assocs margs) unkeysRef <- newIORef Map.empty @@ -1067,23 +1069,28 @@ sync bExport bImport bSecret cmdarg args_raw = do input_key <- maybe (return Nothing) (const $ fmap (Just . readPublicKey) Char8.getContents) $ Map.lookup "--show-whose-key" margs + moreSync keypairs0 margs passphrase_fd bExport bImport bSecret cmdarg keyrings_ wallets sargs +moreSync :: [Maybe (String, String, String)] -> Map.Map String [FilePath] -> Maybe String -> Export -> Import -> Secret + -> String -> [FilePath] -> [FilePath] -> [[String]] -> IO () +moreSync keypairs0 margs passphrase_fd bExport bImport bSecret cmdarg keyrings_ wallets sargs = do let keypairs = catMaybes keypairs0 homespec = join . take 1 <$> Map.lookup "--homedir" margs passfd = fmap (FileDesc . read) passphrase_fd -- reftyp is used as value for 'fill field' in StreamInfo, walts and rings - reftyp = if bExport then KF_Subkeys -- export to rings when they have master present - else KF_None -- export nothing + reftyp | bExport == Export = KF_Subkeys -- export to rings when they have master present + | otherwise = KF_None -- export nothing + pems = flip map keypairs $ \(usage,path,cmd) -> let cmd' = mfilter (not . null) (Just cmd) - in if bExport + in if bExport == Export then (ArgFile path, StreamInfo { fill = KF_Match usage , spill = KF_Match usage , typ = if "dns-" `isPrefixOf` usage then DNSPresentation else PEMFile - , access = if bSecret then Sec else Pub + , access = if (bSecret == Secret) then Sec else Pub , initializer = maybe NoCreate External cmd' , transforms = [] } ) @@ -1092,41 +1099,38 @@ sync bExport bImport bSecret cmdarg args_raw = do , (buildStreamInfo KF_None PEMFile) { spill = KF_Match usage }) else error "Unexpected PEM file initializer." - walts = map (\fname -> ( ArgFile fname - , (buildStreamInfo reftyp WalletFile) { access = Sec })) - wallets - rings = map (\fname -> ( ArgFile fname - , buildStreamInfo reftyp KeyRingFile )) - keyrings_ + walts = map (\fname -> ( ArgFile fname , (buildStreamInfo reftyp WalletFile) { access = Sec })) wallets + rings = map (\fname -> ( ArgFile fname , buildStreamInfo reftyp KeyRingFile )) keyrings_ hosts = maybe [] (map decorate) $ Map.lookup "--hosts" margs where decorate fname = (ArgFile fname, buildStreamInfo reftyp Hosts) pubfill = maybe KF_Subkeys id -- Note: --import overrides --import-if-authentic $ mplus import_f importifauth_f where - import_f = fmap (const KF_All) - $ Map.lookup "--import" margs - importifauth_f = fmap (const KF_Authentic) - $ Map.lookup "--import-if-authentic" margs + import_f = fmap (const KF_All) $ Map.lookup "--import" margs + importifauth_f = fmap (const KF_Authentic) $ Map.lookup "--import-if-authentic" margs kikiOp = KeyRingOperation { opFiles = Map.fromList $ - [ ( HomeSec, buildStreamInfo (if bSecret && bImport then KF_All + [ ( HomeSec, buildStreamInfo (if (bSecret == Secret) && (bImport == Import) then KF_All else KF_None) KeyRingFile ) - , ( HomePub, buildStreamInfo (if bImport then pubfill + , ( HomePub, buildStreamInfo (if (bImport == Import) then pubfill else KF_None) KeyRingFile ) ] ++ rings ++ pems - ++ if bSecret then walts else [] + ++ if (bSecret == Secret) then walts else [] ++ hosts , opPassphrases = withAgent $ do pfile <- maybeToList passfd return $ PassphraseSpec Nothing Nothing pfile , opTransforms = maybe [] (const [Autosign]) $ Map.lookup "--autosign" margs , opHome = homespec } + let usage f = maybe f (const $ kiki_usage bExport bImport bSecret cmdarg) $ Map.lookup "--help" margs + usage $ moreMoreSync kikiOp sargs - (\f -> maybe f (const $ kiki_usage bExport bImport bSecret cmdarg) $ Map.lookup "--help" margs) $ do +moreMoreSync :: KeyRingOperation -> [[String]] -> IO () +moreMoreSync kikiOp sargs = do KikiResult rt report <- runKeyRing kikiOp case rt of @@ -1176,23 +1180,12 @@ doTransform args mktrans = do err -> putStrLn $ errorString err kiki :: String -> [String] -> IO () -kiki "sync-secret" args_raw = - sync True True True "sync-secret" args_raw - -kiki "sync-public" args_raw = - sync True True False "sync-public" args_raw - -kiki "import-secret" args_raw = - sync False True True "import-secret" args_raw - -kiki "import-public" args_raw = - sync False True False "import-public" args_raw - -kiki "export-secret" args_raw = - sync True False True "export-secret" args_raw - -kiki "export-public" args_raw = - sync True False False "export-public" args_raw +kiki "sync-secret" args_raw = sync Export Import Secret "sync-secret" args_raw +kiki "sync-public" args_raw = sync Export Import NoSecret "sync-public" args_raw +kiki "import-secret" args_raw = sync NoExport Import Secret "import-secret" args_raw +kiki "import-public" args_raw = sync NoExport Import NoSecret "import-public" args_raw +kiki "export-secret" args_raw = sync Export NoImport Secret "export-secret" args_raw +kiki "export-public" args_raw = sync Export Import NoSecret "export-public" args_raw -- Generic help kiki "help" [] = do @@ -1208,8 +1201,8 @@ kiki "help" [] = do return () kiki "help" args = forM_ args $ \arg -> case lookup arg commands of - Nothing | arg == "spec" -> kiki_usage False False False arg - Nothing | arg == "SPEC" -> kiki_usage False False False arg + Nothing | arg == "spec" -> kiki_usage NoExport NoImport NoSecret arg + Nothing | arg == "SPEC" -> kiki_usage NoExport NoImport NoSecret arg Nothing -> putStrLn $ "No help available for commmand '" ++ arg ++ "'." _ -> kiki arg ["--help"] @@ -1259,7 +1252,7 @@ kiki "show" args = do , opHome = homespec } - (\f -> maybe f (const $ kiki_usage False False False "show") $ Map.lookup "--help" margs) $ do + (\f -> maybe f (const $ kiki_usage NoExport NoImport NoSecret "show") $ Map.lookup "--help" margs) $ do KikiResult rt report <- runKeyRing kikiOp input_key <- maybe (return Nothing) -- cgit v1.2.3