make gpg work when sshed into a host

1 files changed, 13 insertions, 6 deletions

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"