From 699687f503c63541a6e28501fa5f523b89c1915b Mon Sep 17 00:00:00 2001 From: Joey Hess 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. --- ControlWindow.hs | 13 ++++++++----- Gpg.hs | 36 ++++++++++++++++++++++-------------- Gpg/Wot.hs | 8 ++++---- Output.hs | 10 ++++++++++ Verify.hs | 5 ++++- debug-me.cabal | 1 + 6 files changed, 49 insertions(+), 24 deletions(-) create mode 100644 Output.hs diff --git a/ControlWindow.hs b/ControlWindow.hs index c921fbb..99fd4d3 100644 --- a/ControlWindow.hs +++ b/ControlWindow.hs @@ -15,6 +15,7 @@ import ControlSocket import VirtualTerminal import Gpg import Gpg.Wot +import Output import System.IO import System.Environment @@ -24,8 +25,7 @@ import Control.Exception import Control.Concurrent.Async import Control.Concurrent.STM import Control.Concurrent.STM.TMChan -import qualified Data.ByteString as B -import Data.ByteString.UTF8 (fromString) +import Data.ByteString.UTF8 (fromString, toString) import Data.Char import Control.Monad import Data.Monoid @@ -128,7 +128,8 @@ displayInput ochan ichan promptchan responsechan = loop displayChatMessage :: ControlAction -> IO () displayChatMessage (ChatMessage username msg) = do - B.putStr $ "<" <> val username <> "> " <> val msg <> "\n" + putStrLn $ sanitizeForDisplay $ toString $ + "<" <> val username <> "> " <> val msg hFlush stdout displayChatMessage _ = return () @@ -138,7 +139,8 @@ askToAllow ochan _ _ (UnSigned pk) = atomically $ writeTMChan ochan $ askToAllow ochan promptchan responsechan k@(GpgSigned pk _ _) = do putStrLn "Someone wants to connect to this debug-me session." putStrLn "Checking their GnuPG signature ..." - v <- gpgVerify k + (v, gpgoutput) <- gpgVerify k + putStr $ unlines $ map sanitizeForDisplay $ lines $ toString gpgoutput case v of Nothing -> do putStrLn "Unable to download their GnuPG key, or signature verification failed." @@ -147,7 +149,8 @@ askToAllow ochan promptchan responsechan k@(GpgSigned pk _ _) = do putStrLn "Checking the GnuPG web of trust ..." ss <- isInStrongSet gpgkeyid ws <- downloadWotStats gpgkeyid - putStrLn $ describeWot ws ss + putStrLn $ unlines $ map sanitizeForDisplay $ + describeWot ws ss promptconnect where promptconnect :: IO () 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 diff --git a/Gpg/Wot.hs b/Gpg/Wot.hs index f9051e9..b29ccc7 100644 --- a/Gpg/Wot.hs +++ b/Gpg/Wot.hs @@ -95,10 +95,10 @@ isInStrongSet :: GpgKeyId -> IO StrongSetAnalysis isInStrongSet k = maybe (StrongSetAnalysis False) (const $ StrongSetAnalysis True) <$> downloadWotPath k knownKeyInStrongSet -describeWot :: Maybe WotStats -> StrongSetAnalysis -> String +describeWot :: Maybe WotStats -> StrongSetAnalysis -> [String] describeWot (Just ws) (StrongSetAnalysis ss) - | ss == False = theirname ++ "'s identity cannot be verified!" - | otherwise = unlines $ + | ss == False = [theirname ++ "'s identity cannot be verified!"] + | otherwise = [ theirname ++ "'s identity has been verified by as many as " ++ show (length sigs) ++ " people, including:" , intercalate ", " $ take 10 $ nub $ @@ -110,7 +110,7 @@ describeWot (Just ws) (StrongSetAnalysis ss) theirname = stripEmail (uid (key ws)) sigs = cross_sigs ws ++ other_sigs ws bestconnectedsigs = sortOn rank sigs -describeWot Nothing _ = unlines +describeWot Nothing _ = [ "" , "Their identity cannot be verified!" ] diff --git a/Output.hs b/Output.hs new file mode 100644 index 0000000..5aa3072 --- /dev/null +++ b/Output.hs @@ -0,0 +1,10 @@ +module Output where + +import Data.Char + +sanitizeForDisplay :: String -> String +sanitizeForDisplay = map go + where + go c + | isPrint c = c + | otherwise = '?' diff --git a/Verify.hs b/Verify.hs index b2f3805..63e81f6 100644 --- a/Verify.hs +++ b/Verify.hs @@ -12,9 +12,11 @@ import Crypto import Gpg import Hash import PrevActivity +import Output import Control.Concurrent.STM import Data.Maybe +import Data.ByteString.UTF8 (toString) verify :: VerifyOpts -> IO () verify opts = go 1 startState =<< streamLog (verifyLogFile opts) @@ -66,7 +68,8 @@ mkRecentActivity st = return (sigVerifier st, prevHashes st) addSessionKey :: Integer -> PerhapsSigned PublicKey -> State -> IO State addSessionKey lineno p@(GpgSigned pk _ _) st = do - mkid <- gpgVerify p + (mkid, gpgoutput) <- gpgVerify p + putStr $ unlines $ map sanitizeForDisplay $ lines $ toString gpgoutput case mkid of Nothing -> lineError lineno "Bad GnuPG signature." Just _ -> do diff --git a/debug-me.cabal b/debug-me.cabal index 2f77b38..a7d2b15 100644 --- a/debug-me.cabal +++ b/debug-me.cabal @@ -94,6 +94,7 @@ Executable debug-me JSON Log Memory + Output Pty PrevActivity ProtocolBuffers -- cgit v1.2.3