diff options
Diffstat (limited to 'Crypto.hs')
| -rw-r--r-- | Crypto.hs | 19 |
1 files changed, 13 insertions, 6 deletions
@@ -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" |