Updated "kiki merge" to expose more functoins.

1 files changed, 77 insertions, 27 deletions

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