enable gpg batch mode when GPG_AGENT_INFO is set
This commit is contained in:
parent
684ad74710
commit
4cbd71b057
1 changed files with 19 additions and 10 deletions
29
Crypto.hs
29
Crypto.hs
|
@ -38,8 +38,9 @@ import System.Posix.IO
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
import System.Posix.Process
|
import System.Posix.Process
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Exception
|
import Control.Exception (finally)
|
||||||
import System.Exit
|
import System.Exit
|
||||||
|
import System.Environment
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
import Key
|
import Key
|
||||||
|
@ -172,18 +173,26 @@ pass :: (Cipher -> L.ByteString -> (Handle -> IO a) -> IO a)
|
||||||
-> Cipher -> L.ByteString -> (L.ByteString -> 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
|
pass to c i a = to c i $ \h -> a =<< L.hGetContents h
|
||||||
|
|
||||||
gpgParams :: [CommandParam] -> [String]
|
gpgParams :: [CommandParam] -> IO [String]
|
||||||
gpgParams params =
|
gpgParams params = do
|
||||||
-- avoid prompting, and be quiet, even about checking the trustdb
|
-- Enable batch mode if GPG_AGENT_INFO is set, to avoid extraneous
|
||||||
["--quiet", "--trust-model", "always"] ++
|
-- gpg output about password prompts.
|
||||||
toCommand params
|
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 :: [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 :: [CommandParam] -> String -> IO String
|
||||||
gpgPipeStrict params input = do
|
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)
|
_ <- forkIO $ finally (hPutStr toh input) (hClose toh)
|
||||||
output <- hGetContentsStrict fromh
|
output <- hGetContentsStrict fromh
|
||||||
forceSuccess pid
|
forceSuccess pid
|
||||||
|
@ -202,8 +211,8 @@ gpgCipherHandle params c input a = do
|
||||||
let Fd passphrasefd = frompipe
|
let Fd passphrasefd = frompipe
|
||||||
let passphrase = [Param "--passphrase-fd", Param $ show passphrasefd]
|
let passphrase = [Param "--passphrase-fd", Param $ show passphrasefd]
|
||||||
|
|
||||||
(pid, fromh, toh) <- hPipeBoth "gpg" $
|
params' <- gpgParams $ passphrase ++ params
|
||||||
gpgParams $ passphrase ++ params
|
(pid, fromh, toh) <- hPipeBoth "gpg" params'
|
||||||
_ <- forkProcess $ do
|
_ <- forkProcess $ do
|
||||||
L.hPut toh input
|
L.hPut toh input
|
||||||
hClose toh
|
hClose toh
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue