diff options
-rw-r--r-- | kiki.hs | 81 |
1 files changed, 37 insertions, 44 deletions
@@ -464,8 +464,8 @@ whoseKey rsakey db = filter matchkey (Map.elems db) | |||
464 | 464 | ||
465 | 465 | ||
466 | 466 | ||
467 | kiki_usage :: Bool -> Bool -> Bool -> String -> IO () | 467 | kiki_usage :: Export -> Import -> Secret -> String -> IO () |
468 | kiki_usage bExport bImport bSecret cmd = putStr $ | 468 | kiki_usage ((== Export) -> bExport) ((== Import) -> bImport) ((== Secret) -> bSecret) cmd = putStr $ |
469 | case cmd of | 469 | case cmd of |
470 | "show" -> unlines $ | 470 | "show" -> unlines $ |
471 | ["kiki show [options...]" | 471 | ["kiki show [options...]" |
@@ -1026,11 +1026,13 @@ buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp | |||
1026 | , initializer =NoCreate | 1026 | , initializer =NoCreate |
1027 | , transforms = [] } | 1027 | , transforms = [] } |
1028 | 1028 | ||
1029 | 1029 | data Export = Export | NoExport deriving Eq | |
1030 | data Import = Import | NoImport deriving Eq | ||
1031 | data Secret = Secret | NoSecret deriving Eq | ||
1030 | -- Flag-specific options | 1032 | -- Flag-specific options |
1031 | -- bSecret: --pems and --wallets | 1033 | -- bSecret: --pems and --wallets |
1032 | -- bImport: --import and --import-if-authentic | 1034 | -- bImport: --import and --import-if-authentic |
1033 | sync :: Bool -> Bool -> Bool -> String -> [String] -> IO () | 1035 | sync :: Export -> Import -> Secret -> String -> [String] -> IO () |
1034 | sync bExport bImport bSecret cmdarg args_raw = do | 1036 | sync bExport bImport bSecret cmdarg args_raw = do |
1035 | let (sargs,margs) = processArgs sargspec polyVariadicArgs "--pems" args_raw | 1037 | let (sargs,margs) = processArgs sargspec polyVariadicArgs "--pems" args_raw |
1036 | sargspec = [ ("--show-wk",0) | 1038 | sargspec = [ ("--show-wk",0) |
@@ -1042,12 +1044,12 @@ sync bExport bImport bSecret cmdarg args_raw = do | |||
1042 | , ("--show-ssh",1) | 1044 | , ("--show-ssh",1) |
1043 | , ("--show-wip",1) -} | 1045 | , ("--show-wip",1) -} |
1044 | ] | 1046 | ] |
1045 | ++ do guard bImport | 1047 | ++ do guard (bImport == Import) |
1046 | [ ("--import",0), ("--import-if-authentic",0) ] | 1048 | [ ("--import",0), ("--import-if-authentic",0) ] |
1047 | polyVariadicArgs = ["--keyrings" | 1049 | polyVariadicArgs = ["--keyrings" |
1048 | ,"--hosts" | 1050 | ,"--hosts" |
1049 | ,"--pems"] | 1051 | ,"--pems"] |
1050 | ++ do guard bSecret | 1052 | ++ do guard (bSecret == Secret) |
1051 | [ "--wallets" ] | 1053 | [ "--wallets" ] |
1052 | -- putStrLn $ "margs = " ++ show (Map.assocs margs) | 1054 | -- putStrLn $ "margs = " ++ show (Map.assocs margs) |
1053 | unkeysRef <- newIORef Map.empty | 1055 | unkeysRef <- newIORef Map.empty |
@@ -1067,23 +1069,28 @@ sync bExport bImport bSecret cmdarg args_raw = do | |||
1067 | input_key <- maybe (return Nothing) | 1069 | input_key <- maybe (return Nothing) |
1068 | (const $ fmap (Just . readPublicKey) Char8.getContents) | 1070 | (const $ fmap (Just . readPublicKey) Char8.getContents) |
1069 | $ Map.lookup "--show-whose-key" margs | 1071 | $ Map.lookup "--show-whose-key" margs |
1072 | moreSync keypairs0 margs passphrase_fd bExport bImport bSecret cmdarg keyrings_ wallets sargs | ||
1070 | 1073 | ||
1074 | moreSync :: [Maybe (String, String, String)] -> Map.Map String [FilePath] -> Maybe String -> Export -> Import -> Secret | ||
1075 | -> String -> [FilePath] -> [FilePath] -> [[String]] -> IO () | ||
1076 | moreSync keypairs0 margs passphrase_fd bExport bImport bSecret cmdarg keyrings_ wallets sargs = do | ||
1071 | let keypairs = catMaybes keypairs0 | 1077 | let keypairs = catMaybes keypairs0 |
1072 | homespec = join . take 1 <$> Map.lookup "--homedir" margs | 1078 | homespec = join . take 1 <$> Map.lookup "--homedir" margs |
1073 | passfd = fmap (FileDesc . read) passphrase_fd | 1079 | passfd = fmap (FileDesc . read) passphrase_fd |
1074 | -- reftyp is used as value for 'fill field' in StreamInfo, walts and rings | 1080 | -- reftyp is used as value for 'fill field' in StreamInfo, walts and rings |
1075 | reftyp = if bExport then KF_Subkeys -- export to rings when they have master present | 1081 | reftyp | bExport == Export = KF_Subkeys -- export to rings when they have master present |
1076 | else KF_None -- export nothing | 1082 | | otherwise = KF_None -- export nothing |
1083 | |||
1077 | pems = flip map keypairs | 1084 | pems = flip map keypairs |
1078 | $ \(usage,path,cmd) -> | 1085 | $ \(usage,path,cmd) -> |
1079 | let cmd' = mfilter (not . null) (Just cmd) | 1086 | let cmd' = mfilter (not . null) (Just cmd) |
1080 | in if bExport | 1087 | in if bExport == Export |
1081 | then (ArgFile path, StreamInfo { fill = KF_Match usage | 1088 | then (ArgFile path, StreamInfo { fill = KF_Match usage |
1082 | , spill = KF_Match usage | 1089 | , spill = KF_Match usage |
1083 | , typ = if "dns-" `isPrefixOf` usage | 1090 | , typ = if "dns-" `isPrefixOf` usage |
1084 | then DNSPresentation | 1091 | then DNSPresentation |
1085 | else PEMFile | 1092 | else PEMFile |
1086 | , access = if bSecret then Sec else Pub | 1093 | , access = if (bSecret == Secret) then Sec else Pub |
1087 | , initializer = maybe NoCreate External cmd' | 1094 | , initializer = maybe NoCreate External cmd' |
1088 | , transforms = [] | 1095 | , transforms = [] |
1089 | } ) | 1096 | } ) |
@@ -1092,41 +1099,38 @@ sync bExport bImport bSecret cmdarg args_raw = do | |||
1092 | , (buildStreamInfo KF_None PEMFile) | 1099 | , (buildStreamInfo KF_None PEMFile) |
1093 | { spill = KF_Match usage }) | 1100 | { spill = KF_Match usage }) |
1094 | else error "Unexpected PEM file initializer." | 1101 | else error "Unexpected PEM file initializer." |
1095 | walts = map (\fname -> ( ArgFile fname | 1102 | walts = map (\fname -> ( ArgFile fname , (buildStreamInfo reftyp WalletFile) { access = Sec })) wallets |
1096 | , (buildStreamInfo reftyp WalletFile) { access = Sec })) | 1103 | rings = map (\fname -> ( ArgFile fname , buildStreamInfo reftyp KeyRingFile )) keyrings_ |
1097 | wallets | ||
1098 | rings = map (\fname -> ( ArgFile fname | ||
1099 | , buildStreamInfo reftyp KeyRingFile )) | ||
1100 | keyrings_ | ||
1101 | hosts = maybe [] (map decorate) $ Map.lookup "--hosts" margs | 1104 | hosts = maybe [] (map decorate) $ Map.lookup "--hosts" margs |
1102 | where decorate fname = (ArgFile fname, buildStreamInfo reftyp Hosts) | 1105 | where decorate fname = (ArgFile fname, buildStreamInfo reftyp Hosts) |
1103 | pubfill = maybe KF_Subkeys id -- Note: --import overrides --import-if-authentic | 1106 | pubfill = maybe KF_Subkeys id -- Note: --import overrides --import-if-authentic |
1104 | $ mplus import_f importifauth_f | 1107 | $ mplus import_f importifauth_f |
1105 | where | 1108 | where |
1106 | import_f = fmap (const KF_All) | 1109 | import_f = fmap (const KF_All) $ Map.lookup "--import" margs |
1107 | $ Map.lookup "--import" margs | 1110 | importifauth_f = fmap (const KF_Authentic) $ Map.lookup "--import-if-authentic" margs |
1108 | importifauth_f = fmap (const KF_Authentic) | ||
1109 | $ Map.lookup "--import-if-authentic" margs | ||
1110 | kikiOp = KeyRingOperation | 1111 | kikiOp = KeyRingOperation |
1111 | { opFiles = Map.fromList $ | 1112 | { opFiles = Map.fromList $ |
1112 | [ ( HomeSec, buildStreamInfo (if bSecret && bImport then KF_All | 1113 | [ ( HomeSec, buildStreamInfo (if (bSecret == Secret) && (bImport == Import) then KF_All |
1113 | else KF_None) | 1114 | else KF_None) |
1114 | KeyRingFile ) | 1115 | KeyRingFile ) |
1115 | , ( HomePub, buildStreamInfo (if bImport then pubfill | 1116 | , ( HomePub, buildStreamInfo (if (bImport == Import) then pubfill |
1116 | else KF_None) | 1117 | else KF_None) |
1117 | KeyRingFile ) | 1118 | KeyRingFile ) |
1118 | ] | 1119 | ] |
1119 | ++ rings | 1120 | ++ rings |
1120 | ++ pems | 1121 | ++ pems |
1121 | ++ if bSecret then walts else [] | 1122 | ++ if (bSecret == Secret) then walts else [] |
1122 | ++ hosts | 1123 | ++ hosts |
1123 | , opPassphrases = withAgent $ do pfile <- maybeToList passfd | 1124 | , opPassphrases = withAgent $ do pfile <- maybeToList passfd |
1124 | return $ PassphraseSpec Nothing Nothing pfile | 1125 | return $ PassphraseSpec Nothing Nothing pfile |
1125 | , opTransforms = maybe [] (const [Autosign]) $ Map.lookup "--autosign" margs | 1126 | , opTransforms = maybe [] (const [Autosign]) $ Map.lookup "--autosign" margs |
1126 | , opHome = homespec | 1127 | , opHome = homespec |
1127 | } | 1128 | } |
1129 | let usage f = maybe f (const $ kiki_usage bExport bImport bSecret cmdarg) $ Map.lookup "--help" margs | ||
1130 | usage $ moreMoreSync kikiOp sargs | ||
1128 | 1131 | ||
1129 | (\f -> maybe f (const $ kiki_usage bExport bImport bSecret cmdarg) $ Map.lookup "--help" margs) $ do | 1132 | moreMoreSync :: KeyRingOperation -> [[String]] -> IO () |
1133 | moreMoreSync kikiOp sargs = do | ||
1130 | KikiResult rt report <- runKeyRing kikiOp | 1134 | KikiResult rt report <- runKeyRing kikiOp |
1131 | 1135 | ||
1132 | case rt of | 1136 | case rt of |
@@ -1176,23 +1180,12 @@ doTransform args mktrans = do | |||
1176 | err -> putStrLn $ errorString err | 1180 | err -> putStrLn $ errorString err |
1177 | 1181 | ||
1178 | kiki :: String -> [String] -> IO () | 1182 | kiki :: String -> [String] -> IO () |
1179 | kiki "sync-secret" args_raw = | 1183 | kiki "sync-secret" args_raw = sync Export Import Secret "sync-secret" args_raw |
1180 | sync True True True "sync-secret" args_raw | 1184 | kiki "sync-public" args_raw = sync Export Import NoSecret "sync-public" args_raw |
1181 | 1185 | kiki "import-secret" args_raw = sync NoExport Import Secret "import-secret" args_raw | |
1182 | kiki "sync-public" args_raw = | 1186 | kiki "import-public" args_raw = sync NoExport Import NoSecret "import-public" args_raw |
1183 | sync True True False "sync-public" args_raw | 1187 | kiki "export-secret" args_raw = sync Export NoImport Secret "export-secret" args_raw |
1184 | 1188 | kiki "export-public" args_raw = sync Export Import NoSecret "export-public" args_raw | |
1185 | kiki "import-secret" args_raw = | ||
1186 | sync False True True "import-secret" args_raw | ||
1187 | |||
1188 | kiki "import-public" args_raw = | ||
1189 | sync False True False "import-public" args_raw | ||
1190 | |||
1191 | kiki "export-secret" args_raw = | ||
1192 | sync True False True "export-secret" args_raw | ||
1193 | |||
1194 | kiki "export-public" args_raw = | ||
1195 | sync True False False "export-public" args_raw | ||
1196 | 1189 | ||
1197 | -- Generic help | 1190 | -- Generic help |
1198 | kiki "help" [] = do | 1191 | kiki "help" [] = do |
@@ -1208,8 +1201,8 @@ kiki "help" [] = do | |||
1208 | return () | 1201 | return () |
1209 | 1202 | ||
1210 | kiki "help" args = forM_ args $ \arg -> case lookup arg commands of | 1203 | kiki "help" args = forM_ args $ \arg -> case lookup arg commands of |
1211 | Nothing | arg == "spec" -> kiki_usage False False False arg | 1204 | Nothing | arg == "spec" -> kiki_usage NoExport NoImport NoSecret arg |
1212 | Nothing | arg == "SPEC" -> kiki_usage False False False arg | 1205 | Nothing | arg == "SPEC" -> kiki_usage NoExport NoImport NoSecret arg |
1213 | Nothing -> putStrLn $ "No help available for commmand '" ++ arg ++ "'." | 1206 | Nothing -> putStrLn $ "No help available for commmand '" ++ arg ++ "'." |
1214 | _ -> kiki arg ["--help"] | 1207 | _ -> kiki arg ["--help"] |
1215 | 1208 | ||
@@ -1259,7 +1252,7 @@ kiki "show" args = do | |||
1259 | , opHome = homespec | 1252 | , opHome = homespec |
1260 | } | 1253 | } |
1261 | 1254 | ||
1262 | (\f -> maybe f (const $ kiki_usage False False False "show") $ Map.lookup "--help" margs) $ do | 1255 | (\f -> maybe f (const $ kiki_usage NoExport NoImport NoSecret "show") $ Map.lookup "--help" margs) $ do |
1263 | KikiResult rt report <- runKeyRing kikiOp | 1256 | KikiResult rt report <- runKeyRing kikiOp |
1264 | 1257 | ||
1265 | input_key <- maybe (return Nothing) | 1258 | input_key <- maybe (return Nothing) |