summaryrefslogtreecommitdiff
path: root/lib/GnuPGAgent.hs
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2019-07-02 07:08:34 -0400
committerJoe Crayne <joe@jerkface.net>2019-07-02 07:08:34 -0400
commitec18ca2c86786ff1eb26527a8f53bad3dda50b53 (patch)
treeec9b4968d418698e1aa89f614349467650b0f549 /lib/GnuPGAgent.hs
parent4e87e15398728286efeacdb54d3feba6070ed1b1 (diff)
Find agent-socket in new location.
Diffstat (limited to 'lib/GnuPGAgent.hs')
-rw-r--r--lib/GnuPGAgent.hs17
1 files changed, 16 insertions, 1 deletions
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
14import Debug.Trace 14import Debug.Trace
15import Control.Monad 15import Control.Monad
16import ControlMaybe 16import ControlMaybe
17import Data.Bool
17import Data.Char 18import Data.Char
18import Data.Maybe 19import Data.Maybe
19import Data.OpenPGP 20import Data.OpenPGP
@@ -21,6 +22,7 @@ import Data.OpenPGP.Util
21import Data.Word 22import Data.Word
22import Network.Socket 23import Network.Socket
23import System.Directory 24import System.Directory
25import System.Posix.User
24import System.Environment 26import System.Environment
25import System.IO 27import System.IO
26import Text.Printf 28import Text.Printf
@@ -92,6 +94,18 @@ putenv (GnuPGAgent agent) env = do
92 _ <- hGetLine agent 94 _ <- hGetLine agent
93 return () 95 return ()
94 96
97findAgentSocket :: FilePath -> IO FilePath
98findAgentSocket gpghome = foldr ($) (return "./S.gpg-agent")
99 [ \nope -> do
100 uid <- show <$> getRealUserID
101 let f = "/run/user/"++uid++"/gnupg/S.gpg-agent"
102 b <- doesFileExist f
103 if b then return f else nope
104 , \nope -> do
105 let f = gpghome ++ "/gnupg/S.gpg-agent"
106 doesFileExist f >>= bool nope (return f)
107 ]
108
95session :: IO (Maybe GnuPGAgent) 109session :: IO (Maybe GnuPGAgent)
96session = do 110session = do
97 envhomedir Nothing gpgHomeSpec >>= \case 111 envhomedir Nothing gpgHomeSpec >>= \case
@@ -99,7 +113,8 @@ session = do
99 env <- getDisplay 113 env <- getDisplay
100 handleIO_ (launchAgent gpghome $ Just env) $ do 114 handleIO_ (launchAgent gpghome $ Just env) $ do
101 sock <- socket AF_UNIX Stream defaultProtocol 115 sock <- socket AF_UNIX Stream defaultProtocol
102 connect sock (SockAddrUnix (gpghome ++ "/S.gpg-agent")) 116 agentpath <- findAgentSocket gpghome
117 connect sock (SockAddrUnix agentpath)
103 agent <- socketToHandle sock ReadWriteMode 118 agent <- socketToHandle sock ReadWriteMode
104 hSetBuffering agent LineBuffering 119 hSetBuffering agent LineBuffering
105 putenv (GnuPGAgent agent) env 120 putenv (GnuPGAgent agent) env