summaryrefslogtreecommitdiff
path: root/Crypto.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-04-19 13:40:02 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-04-19 13:40:02 -0400
commit4cbd71b05771479061c3b1a029dc4aabe748d1fb (patch)
tree77b56c8184d59ec9454e7e06123fb54a15382ac6 /Crypto.hs
parent684ad747100ccf5023415ea5e6996bc0e0d97583 (diff)
enable gpg batch mode when GPG_AGENT_INFO is set
Diffstat (limited to 'Crypto.hs')
-rw-r--r--Crypto.hs29
1 files changed, 19 insertions, 10 deletions
diff --git a/Crypto.hs b/Crypto.hs
index 1617f5aad..1f4493b94 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -38,8 +38,9 @@ import System.Posix.IO
import System.Posix.Types
import System.Posix.Process
import Control.Concurrent
-import Control.Exception
+import Control.Exception (finally)
import System.Exit
+import System.Environment
import Types
import Key
@@ -172,18 +173,26 @@ pass :: (Cipher -> L.ByteString -> (Handle -> IO a) -> IO a)
-> Cipher -> L.ByteString -> (L.ByteString -> IO a) -> IO a
pass to c i a = to c i $ \h -> a =<< L.hGetContents h
-gpgParams :: [CommandParam] -> [String]
-gpgParams params =
- -- avoid prompting, and be quiet, even about checking the trustdb
- ["--quiet", "--trust-model", "always"] ++
- toCommand params
+gpgParams :: [CommandParam] -> IO [String]
+gpgParams params = do
+ -- Enable batch mode if GPG_AGENT_INFO is set, to avoid extraneous
+ -- gpg output about password prompts.
+ e <- catch (getEnv "GPG_AGENT_INFO") (const $ return "")
+ let batch = if null e then [] else ["--batch"]
+ return $ batch ++ defaults ++ toCommand params
+ where
+ -- be quiet, even about checking the trustdb
+ defaults = ["--quiet", "--trust-model", "always"]
gpgRead :: [CommandParam] -> IO String
-gpgRead params = pOpen ReadFromPipe "gpg" (gpgParams params) hGetContentsStrict
+gpgRead params = do
+ params' <- gpgParams params
+ pOpen ReadFromPipe "gpg" params' hGetContentsStrict
gpgPipeStrict :: [CommandParam] -> String -> IO String
gpgPipeStrict params input = do
- (pid, fromh, toh) <- hPipeBoth "gpg" (gpgParams params)
+ params' <- gpgParams params
+ (pid, fromh, toh) <- hPipeBoth "gpg" params'
_ <- forkIO $ finally (hPutStr toh input) (hClose toh)
output <- hGetContentsStrict fromh
forceSuccess pid
@@ -202,8 +211,8 @@ gpgCipherHandle params c input a = do
let Fd passphrasefd = frompipe
let passphrase = [Param "--passphrase-fd", Param $ show passphrasefd]
- (pid, fromh, toh) <- hPipeBoth "gpg" $
- gpgParams $ passphrase ++ params
+ params' <- gpgParams $ passphrase ++ params
+ (pid, fromh, toh) <- hPipeBoth "gpg" params'
_ <- forkProcess $ do
L.hPut toh input
hClose toh