Added --show-key=SPEC command to low-level merge api.

1 files changed, 58 insertions, 39 deletions

diff --git a/kiki.hs b/kiki.hs
index b8d5f14..d64cd0f 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1286,7 +1286,7 @@ kiki "show" args = do
 
 kiki "merge" [] = do
     putStr . unlines $
-        [ "kiki merge [ --passphrase-fd=FD ... ]"
+        [ "kiki merge [ ( --passphrase-fd=FD | --agent | --show-key=SPEC ) ... ]"
         , "           ( --home[=HOMEDIR]"
         , "           | --type=(keyring|pem|wallet|hosts|dns)"
         , "           | --access=[auto|secret|public]"
@@ -1306,6 +1306,9 @@ kiki "merge" [] = do
         , ""
         , "  --agent          Use gpg-agent."
         , ""
+        , "  --show-key=SPEC  After files have been written, show information for the"
+        , "                   key identified by SPEC."
+        , ""
         , "  FILE             A path to a key file to read or update."
         , ""
         , "MODIFIERS"
@@ -1335,12 +1338,14 @@ kiki "merge" args = do
     hPutStrLn stderr $ ppShow op
     KikiResult rt report <- runKeyRing (mbAgent op)
     case rt of
-      KikiSuccess rt -> return ()
+      KikiSuccess rt -> do let db = rtKeyDB rt
+                           forM_ keyspecs $ \keyspec -> do
+                                show_id keyspec (error "show_id wkgrip") db
       err            -> putStrLn $ errorString err
     forM_ report $ \(fname,act) -> do
         putStrLn $ fname ++ ": " ++ reportString act
  where
-    (_,(_,op)) = foldl' buildOp (True,(flow0,noop)) args'
+    (_,((_,keyspecs),op)) = foldl' buildOp (True,((flow0,[]),noop)) args'
     (args',mbAgent) = case break (=="--agent") args of
                        (as,[])   -> (args, id)
                        (as,_:bs) -> ( as++bs
@@ -1395,29 +1400,37 @@ kiki "merge" args = do
             m <- filter ("match=" `isPrefixOf`) goods
             return $ drop 6 m
 
-    doFile :: StreamInfo -> KeyRingOperation -> FilePath -> (StreamInfo,KeyRingOperation)
-    doFile flow op fname =
-        ( flow0 { typ = typ flow } -- everything resets except for --type
+    doFile :: (StreamInfo,[String]) -> KeyRingOperation
+                                    -> FilePath
+                                    -> ((StreamInfo,[String]),KeyRingOperation)
+    doFile (flow,specs) op fname =
+        ( (,) flow0 { typ = typ flow } specs -- everything resets except for --type
         , op { opFiles= Map.insert (ArgFile fname) flow (opFiles op) })
 
-    doDelete :: String -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation)
+    doDelete :: String -> (StreamInfo,[String]) -> KeyRingOperation -> ((StreamInfo,[String]),KeyRingOperation)
     doDelete fp flow op = ( flow
                           , op { opTransforms = opTransforms op ++ [DeleteSubkeyByFingerprint fp] } )
 
-    doDeleteUsage :: String -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation)
+    doDeleteUsage :: String -> (StreamInfo,[String])
+                            -> KeyRingOperation
+                            -> ((StreamInfo,[String]),KeyRingOperation)
     doDeleteUsage tag flow op = ( flow
                                 , op { opTransforms = opTransforms op ++ [DeleteSubkeyByUsage tag] } )
 
-    doAutosign :: Bool -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation)
-    doAutosign True flow op =
+    doAutosign :: Bool -> (StreamInfo,[String])
+                       -> KeyRingOperation
+                       -> ((StreamInfo,[String]),KeyRingOperation)
+    doAutosign True (flow,specs) op =
         if Map.null (opFiles op)
-            then (flow, op { opTransforms = opTransforms op ++ [Autosign] })
-            else (flow { transforms = transforms flow ++ [Autosign] }, op)
-    doAutosign False flow op =
-        ( flow { transforms = filter (/=Autosign) (transforms flow) }
+            then ((,) flow specs, op { opTransforms = opTransforms op ++ [Autosign] })
+            else ((,) flow { transforms = transforms flow ++ [Autosign] } specs, op)
+    doAutosign False (flow,specs) op =
+        ( (,) flow { transforms = filter (/=Autosign) (transforms flow) } specs
         , op { opTransforms = filter (/=Autosign) (opTransforms op) } )
 
-    doPassphrase :: StreamInfo -> KeyRingOperation -> String -> (StreamInfo,KeyRingOperation)
+    doPassphrase :: (StreamInfo,[String]) -> KeyRingOperation
+                                          -> String
+                                          -> ((StreamInfo,[String]),KeyRingOperation)
     doPassphrase flow op pass =
         if Map.null (opFiles op)
             then ( flow
@@ -1427,8 +1440,11 @@ kiki "merge" args = do
      where
         pfd = FileDesc (read pass)
 
+    buildOp :: (Bool,((StreamInfo,[String]),KeyRingOperation))
+                -> String
+                -> (Bool,((StreamInfo,[String]),KeyRingOperation))
     buildOp (False,(flow,op)) fname = (False,doFile flow op fname)
-    buildOp (True,(flow,op)) arg@(splitArg->parsed) =
+    buildOp (True,(flow@(si,specs),op)) arg@(splitArg->parsed) =
         case parsed of
             Left ("",Nothing) -> (False,(flow,op))
             _ -> (True,) dispatch
@@ -1447,37 +1463,38 @@ kiki "merge" args = do
             Left ("autosign",Just "false")-> doAutosign False flow op
             Left ("passphrase-fd",Just pass) -> doPassphrase flow op pass
             Left ("create",Nothing) ->
-                ( flow { initializer = Internal (GenRSA (4096 `div` 8)) }
+                ( (,) si { initializer = Internal (GenRSA (4096 `div` 8)) } specs
                 , op )
             Left ("create",Just cmd)
                 | "cmd:" `isPrefixOf` cmd
-                 -> ( flow { initializer = case drop 4 cmd of
+                 -> ( (,) si { initializer = case drop 4 cmd of
                                             []     -> NoCreate
-                                            extern -> External extern }
+                                            extern -> External extern } specs
                     , 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)) }
+                 -> ( (,) si { initializer = case drop 4 cmd of
+                                    []   -> NoCreate
+                                    bits ->
+                                        case takeWhile isDigit bits of
+                                            []     -> NoCreate
+                                            digits -> Internal (GenRSA (read digits `div` 8)) }
+                          specs
                     , 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 )
-            Left ("type",Just "hosts"  ) -> ( flow { typ = Hosts           } , op )
-            Left ("type",Just "dns"  )   -> ( flow { typ = DNSPresentation } , op )
-            Left ("access",Just "public") -> ( flow { access = Pub }, op )
-            Left ("access",Just "secret") -> ( flow { access = Sec }, op )
-            Left ("access",Just "auto")   -> ( flow { access = AutoAccess }, op )
+            Left ("type",Just "keyring") -> ( (,) si { typ = KeyRingFile     } specs, op )
+            Left ("type",Just "pem"    ) -> ( (,) si { typ = PEMFile         } specs, op )
+            Left ("type",Just "wallet" ) -> ( (,) si { typ = WalletFile      } specs, op )
+            Left ("type",Just "hosts"  ) -> ( (,) si { typ = Hosts           } specs, op )
+            Left ("type",Just "dns"  )   -> ( (,) si { typ = DNSPresentation } specs, op )
+            Left ("access",Just "public") -> ( (,) si { access = Pub } specs, op )
+            Left ("access",Just "secret") -> ( (,) si { access = Sec } specs, op )
+            Left ("access",Just "auto")   -> ( (,) si { access = AutoAccess } specs, op )
             Left ("home",mb) ->
                 ( flow
-                , op { opFiles = Map.insert HomePub (flow { typ=KeyRingFile
-                                                          , access=Pub })
-                                 $ Map.insert HomeSec (flow { typ=KeyRingFile
-                                                            , access=Sec })
+                , op { opFiles = Map.insert HomePub (si { typ=KeyRingFile
+                                                        , access=Pub })
+                                 $ Map.insert HomeSec (si { typ=KeyRingFile
+                                                          , access=Sec })
                                  $ opFiles op
                      , opHome = opHome op `mplus` mb
                      }
@@ -1485,9 +1502,11 @@ kiki "merge" args = do
             Left ("flow",Just flowspec) ->
                 case parseFlow flowspec of
                     Just ( (spil,fil), mtch ) ->
-                        ( updateFlow fil spil mtch flow
+                        ( (,) (updateFlow fil spil mtch si) specs
                         , op )
                     Nothing -> error "Valid flow words are: spill,fill,sync,signed,subkeys or match=KEYSPEC"
+            Left ("show-key",Just keyspec) -> ( (,) si (keyspec:specs)
+                                              , op )
             Left (option,_) -> error $ "Unrecognized option: " ++ option
 
 kiki "init" args | "--help" `elem` args = do
@@ -1718,7 +1737,7 @@ tarC (sargs,margs) = do
 --
 -- single leading hyphen, quits program with "Unrecognized option" error
 --
--- Otherwise, Left (key-value pair) is returend by parsing
+-- Otherwise, Left (key-value pair) is returned by parsing
 -- a string of the form --key=value.
 splitArg :: String -> Either (String,Maybe String) String
 splitArg arg =