From 0aebedadd392e495ffc8f7c2fa74d712f16c2d7d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 4 May 2017 14:02:37 -0400 Subject: include gpg public key export in GpgSigned This makes debug-me not rely on the gpg keyservers at all. Before, it was only working when the user had the developer's public key already. I thought that --verify would download from --keyserver, but seems not. This is a protocol breaking change! Luckily done before any release, so ok. ProtocolBuffers renumbered. This commit was sponsored by Denis Dzyubenko on Patreon. --- ControlWindow.hs | 4 +-- Gpg.hs | 98 +++++++++++++++++++++++++++++++++++++----------------- Hash.hs | 6 +++- ProtocolBuffers.hs | 62 +++++++++++++++++++++------------- Role/Developer.hs | 8 +++-- Role/User.hs | 2 +- Types.hs | 14 ++++++-- 7 files changed, 131 insertions(+), 63 deletions(-) diff --git a/ControlWindow.hs b/ControlWindow.hs index a91adc0..c921fbb 100644 --- a/ControlWindow.hs +++ b/ControlWindow.hs @@ -135,10 +135,10 @@ displayChatMessage _ = return () askToAllow :: TMChan ControlOutput -> PromptChan -> ResponseChan -> PerhapsSigned PublicKey -> IO () askToAllow ochan _ _ (UnSigned pk) = atomically $ writeTMChan ochan $ ControlOutputAction $ SessionKeyRejected pk -askToAllow ochan promptchan responsechan k@(GpgSigned pk _) = do +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 <- gpgVerify k case v of Nothing -> do putStrLn "Unable to download their GnuPG key, or signature verification failed." diff --git a/Gpg.hs b/Gpg.hs index 6995797..e2003d1 100644 --- a/Gpg.hs +++ b/Gpg.hs @@ -17,7 +17,6 @@ import System.IO import System.Posix.IO hiding (createPipe) import System.Process import System.Exit -import Data.List import Control.Exception import System.Directory import Control.Concurrent.Async @@ -34,6 +33,7 @@ myPublicKey (MySessionKey _ epk) (GpgSign gpgsign) = do then gpgSign pk else return (UnSigned pk) +-- | Sign a debug-me session PublicKey with gpg. gpgSign :: PublicKey -> IO (PerhapsSigned PublicKey) gpgSign pk = do putStrLn "Using gpg to sign the debug-me session key." @@ -53,25 +53,75 @@ gpgSign pk = do st <- waitForProcess pid _ <- try (removeFile tmpfile) :: IO (Either IOException ()) case st of - ExitSuccess -> return $ GpgSigned pk sig - ExitFailure _ -> error "gpg failed" + ExitSuccess -> 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 + case v of + Just (gpgkeyid, _) -> do + pubkey <- gpgExportPublicKey gpgkeyid + return $ GpgSigned pk sig pubkey + Nothing -> error "gpg sign verification failed" + ExitFailure _ -> error "gpg sign failed" + +-- | Export gpg public key in minimal form. +gpgExportPublicKey :: GpgKeyId -> IO GpgKeyExport +gpgExportPublicKey (GpgKeyId gpgkeyid) = do + (_, Just hout, _, pid) <- createProcess $ + (proc "gpg" opts) + { std_out = CreatePipe + } + hSetBinaryMode hout True + b <- B.hGetContents hout + st <- waitForProcess pid + if st == ExitSuccess + then return $ GpgKeyExport $ Val b + else error "gpg --export failed" + where + opts = + [ "-a" + , "--export-options", "no-export-attributes,export-minimal" + , "--export", gpgkeyid + ] + +gpgImportPublicKey :: GpgKeyExport -> IO () +gpgImportPublicKey (GpgKeyExport (Val b)) = do + (Just hin, _, _, pid) <- createProcess $ + (proc "gpg" [ "--import"] ) + { std_in = CreatePipe + } + hSetBinaryMode hin True + B.hPut hin b + hClose hin + _ <- 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. --- --- The gpg key will be retrieved from a keyserver if necessary. +gpgVerify :: PerhapsSigned PublicKey -> IO (Maybe GpgKeyId) +gpgVerify (UnSigned _) = return Nothing +gpgVerify (GpgSigned pk gpgsig keyexport) = do + gpgImportPublicKey keyexport + go =<< gpgVerifyClearSigned gpgsig + where + go Nothing = return Nothing + go (Just (gpgkeyid, signeddata)) = 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 + +-- | 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. --- --- This relies on gpgSign using --clearsign, so on successful --- verification, the JSON encoded PublicKey is output to gpg's --- stdout. -gpgVerify :: [String] -> PerhapsSigned PublicKey -> IO (Maybe GpgKeyId) -gpgVerify _ (UnSigned _) = return Nothing -gpgVerify gpgopts (GpgSigned pk (GpgSig (Val sig))) = do +gpgVerifyClearSigned :: GpgSig -> IO (Maybe (GpgKeyId, B.ByteString)) +gpgVerifyClearSigned (GpgSig (Val sig)) = do (statusreadh, statuswriteh) <- createPipe statuswritefd <- handleToFd statuswriteh (Just hin, Just hout, _, pid) <- createProcess $ @@ -83,33 +133,21 @@ gpgVerify gpgopts (GpgSigned pk (GpgSig (Val sig))) = do B.hPut hin sig hClose hin hSetBinaryMode hout True - (signeddata, gpgkeyid) <- B.hGetContents hout + (signeddata, mgpgkeyid) <- B.hGetContents hout `concurrently` (parseStatusFd <$> hGetContents statusreadh) st <- waitForProcess pid - let norm = filter (not . B.null) . B8.lines - let pkissigned = norm (val (hashValue (hash pk))) == norm signeddata - return $ if st == ExitSuccess && pkissigned - then gpgkeyid + return $ if st == ExitSuccess + then case mgpgkeyid of + Just gpgkeyid -> Just (gpgkeyid, signeddata) + Nothing -> Nothing else Nothing where - extraopts = if any ("--keyserver" `isPrefixOf`) gpgopts - then gpgopts - else concatMap (\s -> ["--keyserver", s]) defaultKeyServers - ++ gpgopts - verifyopts statuswritefd = extraopts ++ + verifyopts statuswritefd = [ "--status-fd", show statuswritefd , "--verify" , "--output", "-" ] --- | Default keyservers to use. Note that only gpg 1 needs this; --- gpg 2 has a default keyserver. -defaultKeyServers :: [String] -defaultKeyServers = - [ "pool.sks-keyservers.net" - , "pgpkeys.mit.edu" - ] - parseStatusFd :: String -> Maybe GpgKeyId parseStatusFd = go . map words . lines where diff --git a/Hash.hs b/Hash.hs index bf8e166..6fb5614 100644 --- a/Hash.hs +++ b/Hash.hs @@ -68,8 +68,12 @@ instance Hashable PublicKey where instance Hashable GpgSig where hash (GpgSig v) = hash $ Tagged "GpgSig" v +instance Hashable GpgKeyExport where + hash (GpgKeyExport v) = hash $ Tagged "GpgKeyExport" v + instance Hashable a => Hashable (PerhapsSigned a) where - hash (GpgSigned a sig) = hash $ Tagged "GpgSigned" [hash a, hash sig] + hash (GpgSigned a sig export) = hash $ + Tagged "GpgSigned" [hash a, hash sig, hash export] hash (UnSigned a) = hash $ Tagged "UnSigned" a instance Hashable ElapsedTime where diff --git a/ProtocolBuffers.hs b/ProtocolBuffers.hs index 2d59528..42d3e0b 100644 --- a/ProtocolBuffers.hs +++ b/ProtocolBuffers.hs @@ -48,49 +48,50 @@ data MessageP a data ActivityP a = ActivityP { activityP :: Required 6 (Message a) - , elapsedTimeP :: Required 8 (Message ElapsedTimeP) - , activitySignatureP :: Required 9 (Message SignatureP) + , elapsedTimeP :: Required 7 (Message ElapsedTimeP) + , activitySignatureP :: Required 8 (Message SignatureP) } deriving (Generic) data ControlP = ControlP - { controlP :: Required 10 (Message ControlActionP) - , controlSignatureP ::Required 11 (Message SignatureP) + { controlP :: Required 9 (Message ControlActionP) + , controlSignatureP ::Required 10 (Message SignatureP) } deriving (Generic) data ControlActionP = EnteredRejectedP - { enteredRejectedP :: Required 12 (Message HashP) - , enteredLastAcceptedP :: Optional 13 (Message HashP) + { enteredRejectedP :: Required 11 (Message HashP) + , enteredLastAcceptedP :: Optional 12 (Message HashP) } | SessionKeyP - { sessionKeyP :: Required 14 (Message (PerhapsSignedP PublicKeyP)) } + { sessionKeyP :: Required 13 (Message (PerhapsSignedP PublicKeyP)) } | SessionKeyAcceptedP - { sessionKeyAcceptedP :: Required 15 (Message PublicKeyP) } + { sessionKeyAcceptedP :: Required 14 (Message PublicKeyP) } | SessionKeyRejectedP - { sessionKeyRejectedP :: Required 16 (Message PublicKeyP) } + { sessionKeyRejectedP :: Required 15 (Message PublicKeyP) } | ChatMessageP - { chatMessageSenderName :: Required 17 (Value B.ByteString) - , chatMessage :: Required 18 (Value B.ByteString) + { chatMessageSenderName :: Required 16 (Value B.ByteString) + , chatMessage :: Required 17 (Value B.ByteString) } deriving (Generic) data SignatureP = Ed25519SignatureP - { ed25519SignatureP :: Required 19 (Value B.ByteString) } + { ed25519SignatureP :: Required 18 (Value B.ByteString) } | OtherSignatureP - { otherSignatureP :: Required 20 (Value B.ByteString) } + { otherSignatureP :: Required 19 (Value B.ByteString) } deriving (Generic) data PublicKeyP = PublicKeyP - { mkPublicKeyP :: Required 21 (Value B.ByteString) } + { mkPublicKeyP :: Required 20 (Value B.ByteString) } deriving (Generic) data PerhapsSignedP a = GpgSignedP - { gpgSignedValP :: Required 22 (Message a) - , gpgSigP :: Required 23 (Message GpgSigP) + { gpgSignedValP :: Required 21 (Message a) + , gpgSigP :: Required 22 (Message GpgSigP) + , gpgKeyExportP :: Required 23 (Message GpgKeyExportP) } | UnSignedP { mkUnSignedP :: Required 24 (Message a ) @@ -101,24 +102,28 @@ data GpgSigP = GpgSigP { mkGpgSigP :: Required 25 (Value B.ByteString) } deriving (Generic) +data GpgKeyExportP = GpgKeyExportP + { mkGpgKeyExportP :: Required 26 (Value B.ByteString) } + deriving (Generic) + data ElapsedTimeP = ElapsedTimeP - { mkElapsedTimeP :: Required 26 (Value Double) } + { mkElapsedTimeP :: Required 27 (Value Double) } deriving (Generic) data AnyMessageP - = UserP { mkUserP :: Required 27 (Message (MessageP SeenP)) } - | DeveloperP { mkDeveloperP :: Required 28 (Message (MessageP EnteredP)) } + = UserP { mkUserP :: Required 28 (Message (MessageP SeenP)) } + | DeveloperP { mkDeveloperP :: Required 29 (Message (MessageP EnteredP)) } deriving (Generic) data HashP = HashP - { hashMethodP :: Required 29 (Message HashMethodP) - , hashValueP :: Required 30 (Value B.ByteString) + { hashMethodP :: Required 30 (Message HashMethodP) + , hashValueP :: Required 31 (Value B.ByteString) } deriving (Generic) data HashMethodP - = SHA512P { mkSHA512P :: Required 31 (Value Bool) } - | SHA3P { mkSHA3P :: Required 32 (Value Bool) } + = SHA512P { mkSHA512P :: Required 32 (Value Bool) } + | SHA3P { mkSHA3P :: Required 33 (Value Bool) } deriving (Generic) -- | Conversion between protocol buffer messages and debug-me's main Types. @@ -241,9 +246,10 @@ instance ProtocolBuffer PublicKeyP T.PublicKey where fromProtocolBuffer p = T.PublicKey $ Val $ getField $ mkPublicKeyP p instance ProtocolBuffer p t => ProtocolBuffer (PerhapsSignedP p) (T.PerhapsSigned t) where - toProtocolBuffer (T.GpgSigned tv tg) = GpgSignedP + toProtocolBuffer (T.GpgSigned tv tg tk) = GpgSignedP { gpgSignedValP = putField $ toProtocolBuffer tv , gpgSigP = putField $ toProtocolBuffer tg + , gpgKeyExportP = putField $ toProtocolBuffer tk } toProtocolBuffer (T.UnSigned tv) = UnSignedP { mkUnSignedP = putField $ toProtocolBuffer tv @@ -251,6 +257,7 @@ instance ProtocolBuffer p t => ProtocolBuffer (PerhapsSignedP p) (T.PerhapsSigne fromProtocolBuffer p@(GpgSignedP {}) = T.GpgSigned (fromProtocolBuffer $ getField $ gpgSignedValP p) (fromProtocolBuffer $ getField $ gpgSigP p) + (fromProtocolBuffer $ getField $ gpgKeyExportP p) fromProtocolBuffer p@(UnSignedP {}) = T.UnSigned (fromProtocolBuffer $ getField $ mkUnSignedP p) @@ -259,6 +266,11 @@ instance ProtocolBuffer GpgSigP T.GpgSig where { mkGpgSigP = putField ( val t) } fromProtocolBuffer p = T.GpgSig $ Val $ getField $ mkGpgSigP p +instance ProtocolBuffer GpgKeyExportP T.GpgKeyExport where + toProtocolBuffer (T.GpgKeyExport t) = GpgKeyExportP + { mkGpgKeyExportP = putField ( val t) } + fromProtocolBuffer p = T.GpgKeyExport $ Val $ getField $ mkGpgKeyExportP p + instance ProtocolBuffer ElapsedTimeP T.ElapsedTime where toProtocolBuffer (T.ElapsedTime t) = ElapsedTimeP { mkElapsedTimeP = putField t } @@ -292,6 +304,8 @@ instance Encode PublicKeyP instance Decode PublicKeyP instance Encode GpgSigP instance Decode GpgSigP +instance Encode GpgKeyExportP +instance Decode GpgKeyExportP instance Encode ElapsedTimeP instance Decode ElapsedTimeP instance Encode AnyMessageP diff --git a/Role/Developer.hs b/Role/Developer.hs index 2cc6c1c..2cdf917 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -230,7 +230,9 @@ authUser spk ichan ochan devstate logger = do atomically $ writeTMChan ichan msg logger $ Developer msg waitresp $ case spk of - GpgSigned pk _ -> pk + -- Don't bother verifying the user's gpg public key; + -- normally users send UnSigned. + GpgSigned pk _ _ -> pk UnSigned pk -> pk where waitresp pk = do @@ -291,7 +293,7 @@ getServerMessage ochan devstate ts = do -- When other developers connect, learn their SessionKeys. process (Developer msg@(ControlMessage (Control (SessionKey spk) _))) = do let sigverifier = mkSigVerifier $ case spk of - GpgSigned pk _ -> pk + GpgSigned pk _ _ -> pk UnSigned pk -> pk if verifySigned sigverifier msg then do @@ -421,7 +423,7 @@ processSessionStart sk ochan logger dsv = do sigverifier <- case sessionmsg of User (ControlMessage c@(Control (SessionKey spk) _)) -> do let pk = case spk of - GpgSigned k _ -> k + GpgSigned k _ _ -> k UnSigned k -> k let sv = mkSigVerifier pk if verifySigned sv c diff --git a/Role/User.hs b/Role/User.hs index 49e9edf..6c6fb39 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -250,7 +250,7 @@ getDeveloperMessage' (MissingHashes wiremsg) ochan us now = do case msg of ControlMessage (Control (SessionKey spk) _) -> do let sigverifier = mkSigVerifier $ case spk of - GpgSigned pk _ -> pk + GpgSigned pk _ _ -> pk UnSigned pk -> pk if verifySigned sigverifier msg then return (InputMessage msg) diff --git a/Types.hs b/Types.hs index 8f00793..79ce289 100644 --- a/Types.hs +++ b/Types.hs @@ -159,12 +159,13 @@ instance DataSize PublicKey where -- | A value that may be gpg signed. data PerhapsSigned a - = GpgSigned a GpgSig + = GpgSigned a GpgSig GpgKeyExport | UnSigned a deriving (Show, Generic, Eq) instance DataSize a => DataSize (PerhapsSigned a) where - dataSize (GpgSigned a sig) = dataSize a + dataSize sig + dataSize (GpgSigned a sig export) = + dataSize a + dataSize sig + dataSize export dataSize (UnSigned a) = dataSize a -- | A signature made with a gpg key. @@ -174,6 +175,13 @@ newtype GpgSig = GpgSig Val instance DataSize GpgSig where dataSize (GpgSig s) = dataSize s +-- | An export of a gpg public key. +newtype GpgKeyExport = GpgKeyExport Val + deriving (Show, Generic, Eq) + +instance DataSize GpgKeyExport where + dataSize (GpgKeyExport k) = dataSize k + -- | Elapsed time in seconds. newtype ElapsedTime = ElapsedTime Double deriving (Show, Generic, Eq) @@ -224,6 +232,8 @@ instance ToJSON PublicKey instance FromJSON PublicKey instance ToJSON GpgSig instance FromJSON GpgSig +instance ToJSON GpgKeyExport +instance FromJSON GpgKeyExport instance ToJSON (Message Seen) where toJSON = genericToJSON sumOptions -- cgit v1.2.3