From 3ab1e1e46fb158d92dbb73c83b6ead6ddb67dc26 Mon Sep 17 00:00:00 2001 From: joe Date: Thu, 28 Apr 2016 23:24:17 -0400 Subject: Updated "kiki merge" to expose more functoins. --- kiki.hs | 104 +++++++++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 77 insertions(+), 27 deletions(-) (limited to 'kiki.hs') diff --git a/kiki.hs b/kiki.hs index 9b24b91..2cdade6 100644 --- a/kiki.hs +++ b/kiki.hs @@ -1258,12 +1258,42 @@ kiki "merge" [] = do , " ( --home[=HOMEDIR]" , " | --type=(keyring|pem|wallet|hosts|dns)" , " | --access=[auto|secret|public]" - , " | --flow=(fill|spill|sync)[,(subkeys|match=SPEC)]" - , " | --create=CMD" + , " | --flow=(fill|spill|sync)[,(subkeys|signed|match=SPEC)]" + , " | --create=(rsa:SIZE|cmd:CMD)" , " | --autosign[=no]" , " | --delete=FINGERPRINT" + , " | --delete-usage=TAG" , " | --" - , " | FILE ) ..."] + , " | FILE ) ..." + , "" + , "OPERANDS" + , "" + , " --home[=HOMEDIR] A symbolic operand that is a place holder for two files:" + , " HOMEDIR/{secring.gpg,pubring.gpg}" + , " HOMEDIR defaults to your GnuPG home directory." + , "" + , " FILE A path to a key file to read or update." + , "" + , "MODIFIERS" + , "" + , " --type=(keyring|pem|wallet|hosts|dns)" + , " The type of the following file. Unlike other modifiers," + , " This modifier remains in effect accross multiple operands" + , " unless another --type instance is seen. The default type" + , " is keyring." + , "" + , " --access=[auto|secret|public]" + , "" + , " --flow=(fill|spill|sync)[,(subkeys|signed|match=SPEC)]" + , "" + , " --create=(rsa:SIZE|cmd:CMD)" + , "" + , " --autosign[=no]" + , "" + , " --delete=FINGERPRINT" + , "" + , " --delete-usage=TAG" + ] kiki "merge" args | "--help" `elem` args = do kiki "merge" [] -- TODO: more help @@ -1276,14 +1306,14 @@ kiki "merge" args = do forM_ report $ \(fname,act) -> do putStrLn $ fname ++ ": " ++ reportString act where - (_,(_,op)) = foldl' buildOp (True,(flow,noop)) args + (_,(_,op)) = foldl' buildOp (True,(flow0,noop)) args noop = KeyRingOperation { opFiles = Map.empty , opTransforms = [] , opHome = Nothing , opPassphrases = [] } - flow = StreamInfo + flow0 = StreamInfo { access = AutoAccess , typ = KeyRingFile , spill = KF_None @@ -1291,25 +1321,24 @@ kiki "merge" args = do , initializer = NoCreate , transforms = [] } - updateFlow fil spil mtch flow = spill' $ fill' $ flow + updateFlow :: Bool -> Bool -> KeyFilter -> StreamInfo -> StreamInfo + updateFlow fil spil val flow = spill' $ fill' $ flow where - fill' flow = flow { fill = if fil then val else KF_None } - spill' flow = flow { spill = if spil then val else KF_None } - val = either (\subkeys -> if subkeys then KF_Subkeys else KF_All) - KF_Match - mtch - - parseFlow :: String -> Maybe ((Bool,Bool),Either Bool String) - parseFlow spec = - if null bads - then Just ( ( "spill" `elem` goods - || "sync" `elem` goods - , "fill" `elem` goods - || "sync" `elem` goods ) - , maybe (Left $ "subkeys" `elem` goods) - Right - match ) - else Nothing + fill' flow = flow { fill = if fil then val else fill flow } + spill' flow = flow { spill = if spil then val else spill flow } + + parseFlow :: String -> Maybe ((Bool,Bool),KeyFilter) + parseFlow spec = do + guard $ null bads + Just ( ( "spill" `elem` goods + || "sync" `elem` goods + , "fill" `elem` goods + || "sync" `elem` goods ) + , case match of + Just spec -> KF_Match spec + Nothing + | "signed" `elem` goods -> KF_Authentic + | "subkeys" `elem` goods -> KF_Subkeys ) where ws = case groupBy (\_ c->c/=',') spec of w:xs -> w:map (drop 1) xs @@ -1319,6 +1348,7 @@ kiki "merge" args = do acceptable "spill" = True acceptable "fill" = True acceptable "sync" = True + acceptable "signed" = True acceptable "subkeys" = True acceptable s | "match=" `isPrefixOf` s = True acceptable _ = False @@ -1328,13 +1358,17 @@ kiki "merge" args = do doFile :: StreamInfo -> KeyRingOperation -> FilePath -> (StreamInfo,KeyRingOperation) doFile flow op fname = - ( flow + ( flow0 { typ = typ flow } -- everything resets except for --type , op { opFiles= Map.insert (ArgFile fname) flow (opFiles op) }) doDelete :: String -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) doDelete fp flow op = ( flow , op { opTransforms = opTransforms op ++ [DeleteSubkeyByFingerprint fp] } ) + doDeleteUsage :: String -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) + doDeleteUsage tag flow op = ( flow + , op { opTransforms = opTransforms op ++ [DeleteSubkeyByUsage tag] } ) + doAutosign :: Bool -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) doAutosign True flow op = if Map.null (opFiles op) @@ -1364,6 +1398,7 @@ kiki "merge" args = do case parsed of Right fname -> doFile flow op fname Left ("delete",Just fp) -> doDelete fp flow op + Left ("delete-usage",Just tag) -> doDeleteUsage tag flow op Left ("autosign",Nothing) -> doAutosign True flow op Left ("autosign",Just "y") -> doAutosign True flow op Left ("autosign",Just "yes") -> doAutosign True flow op @@ -1372,9 +1407,24 @@ kiki "merge" args = do Left ("autosign",Just "no") -> doAutosign False flow op Left ("autosign",Just "false")-> doAutosign False flow op Left ("passphrase-fd",Just pass) -> doPassphrase flow op pass - Left ("create",Just cmd) -> - ( flow { initializer = if null cmd then NoCreate else External cmd } + Left ("create",Nothing) -> + ( flow { initializer = Internal (GenRSA (4096 `div` 8)) } , op ) + Left ("create",Just cmd) + | "cmd:" `isPrefixOf` cmd + -> ( flow { initializer = case drop 4 cmd of + [] -> NoCreate + extern -> External extern } + , op ) + Left ("create",Just cmd) + | "rsa:" `isPrefixOf` cmd + -> ( flow { initializer = case drop 4 cmd of + [] -> NoCreate + bits -> + case takeWhile isDigit bits of + [] -> NoCreate + digits -> Internal (GenRSA (read digits `div` 8)) } + , op ) Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile } , op ) Left ("type",Just "pem" ) -> ( flow { typ = PEMFile } , op ) Left ("type",Just "wallet" ) -> ( flow { typ = WalletFile } , op ) @@ -1398,7 +1448,7 @@ kiki "merge" args = do Just ( (spil,fil), mtch ) -> ( updateFlow fil spil mtch flow , op ) - Nothing -> error "Valid flow words are: spill,fill,sync,subkeys or match=KEYSPEC" + Nothing -> error "Valid flow words are: spill,fill,sync,signed,subkeys or match=KEYSPEC" Left (option,_) -> error $ "Unrecognized option: " ++ option kiki "init" args | "--help" `elem` args = do -- cgit v1.2.3