From 699687f503c63541a6e28501fa5f523b89c1915b Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 4 May 2017 18:51:36 -0400
Subject: sanitize gpg output and chat messages

Just in case, only allow printable characters in this, not control
characters.
---
 Gpg.hs | 36 ++++++++++++++++++++++--------------
 1 file changed, 22 insertions(+), 14 deletions(-)

(limited to 'Gpg.hs')

diff --git a/Gpg.hs b/Gpg.hs
index e2003d1..7d98d5c 100644
--- a/Gpg.hs
+++ b/Gpg.hs
@@ -57,7 +57,7 @@ gpgSign pk = do
 			-- Verify the just signed data to determine
 			-- the gpg public key used to sign it. The gpg 
 			-- public key is included in the GpgSigned data.
-			v <- gpgVerifyClearSigned sig
+			v <- fst <$> gpgVerifyClearSigned sig
 			case v of
 				Just (gpgkeyid, _) -> do
 					pubkey <- gpgExportPublicKey gpgkeyid
@@ -87,60 +87,68 @@ gpgExportPublicKey (GpgKeyId gpgkeyid) = do
 
 gpgImportPublicKey :: GpgKeyExport -> IO ()
 gpgImportPublicKey (GpgKeyExport (Val b)) = do
-	(Just hin, _, _, pid) <- createProcess $
+	(Just hin, Just hout, Just herr, pid) <- createProcess $
 		(proc "gpg" [ "--import"] )
 			{ std_in = CreatePipe
+			, std_out = CreatePipe
+			, std_err = CreatePipe
 			}
 	hSetBinaryMode hin True
 	B.hPut hin b
 	hClose hin
+	_ <- B.hGetContents hout
+		`concurrently` B.hGetContents herr
 	_ <- waitForProcess pid
 	return ()
 
 -- | Verify the gpg signature and return the keyid that signed it.
 -- Also makes sure that the gpg signed data is the hash of the 
 -- debug-me PublicKey.
-gpgVerify :: PerhapsSigned PublicKey -> IO (Maybe GpgKeyId)
-gpgVerify (UnSigned _) = return Nothing
+gpgVerify :: PerhapsSigned PublicKey -> IO (Maybe GpgKeyId, SignInfoDesc)
+gpgVerify (UnSigned _) = return (Nothing, mempty)
 gpgVerify (GpgSigned pk gpgsig keyexport) = do
 	gpgImportPublicKey keyexport
 	go =<< gpgVerifyClearSigned gpgsig
   where
-	go Nothing = return Nothing
-	go (Just (gpgkeyid, signeddata)) = do
+	go (Nothing, s) = return (Nothing, s)
+	go (Just (gpgkeyid, signeddata), s) = do
 		let norm = filter (not . B.null) . B8.lines
 		let pkissigned = norm signeddata == norm (val (hashValue (hash pk)))
 		return $ if pkissigned
-			then Just gpgkeyid
-			else Nothing
+			then (Just gpgkeyid, s)
+			else (Nothing, s)
+
+type SignInfoDesc = B.ByteString
 
 -- | Verify a clearsigned GpgSig, returning the key id used to sign it,
 -- and the data that was signed.
 --
 -- Gpg outputs to stderr information about who signed the
--- data, so that will be visible to the user when eg, prompting
--- them if they want to accept a connection from that person.
-gpgVerifyClearSigned :: GpgSig -> IO (Maybe (GpgKeyId, B.ByteString))
+-- data, and that is returned also.
+gpgVerifyClearSigned :: GpgSig -> IO (Maybe (GpgKeyId, B.ByteString), SignInfoDesc)
 gpgVerifyClearSigned (GpgSig (Val sig)) = do
 	(statusreadh, statuswriteh) <- createPipe
 	statuswritefd <- handleToFd statuswriteh
-	(Just hin, Just hout, _, pid) <- createProcess $
+	(Just hin, Just hout, Just herr, pid) <- createProcess $
 		(proc "gpg" (verifyopts statuswritefd))
 			{ std_in = CreatePipe
 			, std_out = CreatePipe
+			, std_err = CreatePipe
 			}
 	closeFd statuswritefd
 	B.hPut hin sig
 	hClose hin
 	hSetBinaryMode hout True
-	(signeddata, mgpgkeyid) <- B.hGetContents hout
+	((signeddata, sigdesc), mgpgkeyid) <- B.hGetContents hout
+		`concurrently` B.hGetContents herr
 		`concurrently` (parseStatusFd <$> hGetContents statusreadh)
 	st <- waitForProcess pid
-	return $ if st == ExitSuccess
+	let siginfo = if st == ExitSuccess
 		then case mgpgkeyid of
 			Just gpgkeyid -> Just (gpgkeyid, signeddata)
 			Nothing -> Nothing
 		else Nothing
+	return (siginfo, sigdesc)
   where
 	verifyopts statuswritefd =
 		[ "--status-fd", show statuswritefd
-- 
cgit v1.2.3