Find agent-socket in new location.

3 files changed, 27 insertions, 4 deletions

diff --git a/kiki.cabal b/kiki.cabal
index d790af7..d484bb1 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -44,6 +44,7 @@ Executable kiki
                      unix,
                      openpgp-util,
                      network,
+                     pretty-show,
                      kiki
     other-modules: DNSKey
     if !flag(cryptonite)
diff --git a/kiki.hs b/kiki.hs
index ddfb05b..d59f75b 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -23,6 +23,7 @@ import Data.Maybe
 import Data.OpenPGP
 import Data.Ord
 import Data.String
+import Text.Show.Pretty as PP ( ppShow )
 import Data.Text.Encoding
 import System.Posix.Files
 import Foreign.C.Types (CTime(..))
@@ -1309,6 +1310,8 @@ kiki "merge" [] = do
         , "                     HOMEDIR/{secring.gpg,pubring.gpg}"
         , "                   HOMEDIR defaults to your GnuPG home directory."
         , ""
+        , "  --agent          Use gpg-agent."
+        , ""
         , "  FILE             A path to a key file to read or update."
         , ""
         , "MODIFIERS"
@@ -1335,15 +1338,19 @@ kiki "merge" args | "--help" `elem` args = do
     kiki "merge" []
     -- TODO: more help
 kiki "merge" args = do
-    hPutStrLn stderr $ show op
-    KikiResult rt report <- runKeyRing op
+    hPutStrLn stderr $ ppShow op
+    KikiResult rt report <- runKeyRing (mbAgent op)
     case rt of
       KikiSuccess rt -> return ()
       err            -> putStrLn $ errorString err
     forM_ report $ \(fname,act) -> do
         putStrLn $ fname ++ ": " ++ reportString act
  where
-    (_,(_,op)) = foldl' buildOp (True,(flow0,noop)) args
+    (_,(_,op)) = foldl' buildOp (True,(flow0,noop)) args'
+    (args',mbAgent) = case break (=="--agent") args of
+                       (as,[])   -> (args, id)
+                       (as,_:bs) -> ( as++bs
+                                    , \op -> op { opPassphrases = withAgent (opPassphrases op) })
     noop = KeyRingOperation
             { opFiles = Map.empty
             , opTransforms = []
diff --git a/lib/GnuPGAgent.hs b/lib/GnuPGAgent.hs
index 2a68b4e..1e40269 100644
--- a/lib/GnuPGAgent.hs
+++ b/lib/GnuPGAgent.hs
@@ -14,6 +14,7 @@ module GnuPGAgent
 import Debug.Trace
 import Control.Monad
 import ControlMaybe
+import Data.Bool
 import Data.Char
 import Data.Maybe
 import Data.OpenPGP
@@ -21,6 +22,7 @@ import Data.OpenPGP.Util
 import Data.Word
 import Network.Socket
 import System.Directory
+import System.Posix.User
 import System.Environment
 import System.IO
 import Text.Printf
@@ -92,6 +94,18 @@ putenv (GnuPGAgent agent) env = do
         _ <- hGetLine agent
         return ()
 
+findAgentSocket :: FilePath -> IO FilePath
+findAgentSocket gpghome = foldr ($) (return "./S.gpg-agent")
+    [ \nope -> do
+            uid <- show <$> getRealUserID
+            let f = "/run/user/"++uid++"/gnupg/S.gpg-agent"
+            b <- doesFileExist f
+            if b then return f else nope
+    , \nope -> do
+            let f = gpghome ++ "/gnupg/S.gpg-agent"
+            doesFileExist f >>= bool nope (return f)
+    ]
+
 session :: IO (Maybe GnuPGAgent)
 session = do
     envhomedir Nothing gpgHomeSpec >>= \case
@@ -99,7 +113,8 @@ session = do
             env <- getDisplay
             handleIO_ (launchAgent gpghome $ Just env) $ do
             sock <- socket AF_UNIX Stream defaultProtocol
-            connect sock (SockAddrUnix (gpghome ++ "/S.gpg-agent"))
+            agentpath <- findAgentSocket gpghome
+            connect sock (SockAddrUnix agentpath)
             agent <- socketToHandle sock ReadWriteMode
             hSetBuffering agent LineBuffering
             putenv (GnuPGAgent agent) env