From 3bc450720b526bc0e5b2dbd6775ab7bf89eb8821 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 28 Apr 2017 17:40:15 -0400
Subject: make gpg work when sshed into a host

---
 Crypto.hs | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

(limited to 'Crypto.hs')

diff --git a/Crypto.hs b/Crypto.hs
index 800b0d2..bf136b3 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -15,6 +15,8 @@ import System.IO
 import System.Process
 import System.Exit
 import Data.List
+import Control.Exception
+import System.Directory
 
 dummySignature :: Signature
 dummySignature = OtherSignature (Val mempty)
@@ -97,16 +99,21 @@ myPublicKey (MySessionKey _ epk) (GpgSign gpgsign) = do
 gpgSign :: PublicKey -> IO (PerhapsSigned PublicKey)
 gpgSign pk = do
 	putStrLn "Using gpg to sign the debug-me session key."
-	(Just hin, Just hout, _, pid) <- createProcess $
-		(proc "gpg" ["--clearsign", "-a"])
-			{ std_in = CreatePipe
-			, std_out = CreatePipe
+	-- Write it to a temp file because gpg sometimes is unhappy
+	-- about password prompting when stdin is not connected to
+	-- the console.
+	tmpdir <- getTemporaryDirectory
+	(tmpfile, tmph) <- openTempFile tmpdir "debug-me.tmp"
+	B.hPut tmph $ val $ hashValue $ hash pk
+	hClose tmph
+	(_, Just hout, _, pid) <- createProcess $
+		(proc "gpg" ["--output", "-", "--clearsign", "-a", tmpfile])
+			{ std_out = CreatePipe
 			}
-	B.hPut hin $ val $ hashValue $ hash pk
-	hClose hin
 	hSetBinaryMode hout True
 	sig <- GpgSig . Val <$> B.hGetContents hout
 	st <- waitForProcess pid
+	_ <- try (removeFile tmpfile) :: IO (Either IOException ())
 	case st of
 		ExitSuccess -> return $ GpgSigned pk sig
 		ExitFailure _ -> error "gpg failed"
-- 
cgit v1.2.3