From 3c7d3b3a2088cfe3698c3b055822c2b9fa67468a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 26 Apr 2017 17:31:30 -0400 Subject: gpg sign developer session key And part of what we need to have users verify them. This commit was sponsored by andrea rota. --- CmdLine.hs | 10 +++++-- Crypto.hs | 85 +++++++++++++++++++++++++++++++++++++++++++++++-------- Hash.hs | 7 +++-- Role/Developer.hs | 21 +++++++++----- Role/User.hs | 16 +++++++---- TODO | 3 ++ Types.hs | 24 +++++++++++++--- debug-me.1 | 6 ++++ 8 files changed, 140 insertions(+), 32 deletions(-) diff --git a/CmdLine.hs b/CmdLine.hs index f00f0be..a2f900b 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -18,7 +18,8 @@ data Mode | ServerMode ServerOpts data UserOpts = UserOpts - { cmdToRun :: Maybe (String, [String]) + { gpgOpts :: [String] + , cmdToRun :: Maybe (String, [String]) } type UrlString = String @@ -62,7 +63,12 @@ parseMode = (UserMode <$> parseuser) <|> (ServerMode <$> parseserver) where parseuser = UserOpts - <$> optional ((,) + <$> many (option str + ( long "gpg-opt" + <> short 'g' + <> help "option to pass to gpg" + )) + <*> optional ((,) <$> strArgument (metavar "cmd") <*> many (strArgument (metavar "opts"))) parsegraphviz = GraphvizOpts diff --git a/Crypto.hs b/Crypto.hs index e56db89..b23c8de 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -1,16 +1,22 @@ -{-# LANGUAGE OverloadedStrings, RankNTypes #-} +{-# LANGUAGE OverloadedStrings, RankNTypes, DeriveGeneric #-} module Crypto where import Val import Hash import Types +import Serialization import qualified Crypto.PubKey.Ed25519 as Ed25519 import Crypto.Error import Crypto.Random.Entropy import Data.ByteArray (convert) -import Data.ByteString +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import System.IO +import System.Process +import System.Exit +import Data.List dummySignature :: Signature dummySignature = OtherSignature (Val mempty) @@ -43,7 +49,7 @@ sign :: Signed v => MySessionKey -> v -> Signature sign (MySessionKey sk pk) v = Ed25519Signature $ Val $ convert $ Ed25519.sign sk pk (toSign v) -toSign :: Signed v => v -> ByteString +toSign :: Signed v => v -> B.ByteString toSign = val . hashValue . hashExceptSignature -- | Verifiy the signature of a Signed value. @@ -56,10 +62,10 @@ verifySigned (SigVerifier verifier) v = CryptoFailed _ -> False OtherSignature _ -> False -data SigVerifier = SigVerifier (ByteString -> Ed25519.Signature -> Bool) +data SigVerifier = SigVerifier (B.ByteString -> Ed25519.Signature -> Bool) mkSigVerifier :: PublicKey -> SigVerifier -mkSigVerifier (PublicKey (Val pk) _) = +mkSigVerifier (PublicKey (Val pk)) = case Ed25519.publicKey pk of CryptoPassed pk' -> SigVerifier (Ed25519.verify pk') CryptoFailed _ -> mempty @@ -71,18 +77,73 @@ instance Monoid SigVerifier where data MySessionKey = MySessionKey Ed25519.SecretKey Ed25519.PublicKey --- TODO add gpg signature when available -myPublicKey :: MySessionKey -> IO PublicKey -myPublicKey (MySessionKey _ pk) = do - let gpgsig = Nothing - return $ PublicKey (Val (convert pk)) gpgsig - genMySessionKey :: IO MySessionKey genMySessionKey = do -- Crypto.Random.Entropy may use rdrand, or /dev/random. -- Even if you don't trust rdrand to be free of backdoors, -- it seems safe enough to use it for a session key that -- is only used for signing, not encryption. - rand32 <- getEntropy 32 :: IO ByteString + rand32 <- getEntropy 32 :: IO B.ByteString sk <- throwCryptoErrorIO $ Ed25519.secretKey rand32 return $ MySessionKey sk (Ed25519.toPublic sk) + +newtype GpgSign = GpgSign Bool + +myPublicKey :: MySessionKey -> GpgSign -> IO (PerhapsSigned PublicKey) +myPublicKey (MySessionKey _ epk) (GpgSign gpgsign) = do + let pk = PublicKey (Val $ convert epk) + if gpgsign + then gpgSign pk + else return (UnSigned pk) + +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 + } + L.hPut hin $ encode pk + hClose hin + hSetBinaryMode hout True + sig <- GpgSig . Val <$> B.hGetContents hout + st <- waitForProcess pid + case st of + ExitSuccess -> return $ GpgSigned pk sig + ExitFailure _ -> error "gpg failed" + +-- | Verify the gpg signature. The key will be retrieved from a keyserver +-- if possible. 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. +gpgVerify :: [String] -> PerhapsSigned PublicKey -> IO Bool +gpgVerify _ (UnSigned _) = return False +gpgVerify gpgopts (GpgSigned pk (GpgSig (Val sig))) = do + -- This relies on gpgSign using --clearsign, so on successful + -- verification, the JSON encoded PublicKey is output to gpg's + -- stdout. + (Just hin, Just hout, _, pid) <- createProcess $ + (proc "gpg" (extraopts ++ ["--verify", "--output", "-"])) + { std_in = CreatePipe + , std_out = CreatePipe + } + B.hPut hin sig + hClose hin + hSetBinaryMode hout True + out <- L.hGetContents hout + st <- waitForProcess pid + return $ case st of + ExitFailure _ -> False + ExitSuccess -> Just pk == decode out + where + extraopts = if any ("--keyserver" `isPrefixOf`) gpgopts + then gpgopts + else map ("--keyserver=" ++) defaultKeyServers ++ gpgopts + +-- | Default keyservers to use. +defaultKeyServers :: [String] +defaultKeyServers = + [ "pool.sks-keyservers.net" + , "pgpkeys.mit.edu" + ] diff --git a/Hash.hs b/Hash.hs index c9b45e0..3bfb5a2 100644 --- a/Hash.hs +++ b/Hash.hs @@ -56,12 +56,15 @@ instance Hashable Signature where hash (OtherSignature s) = hash $ Tagged "OtherSignature" s instance Hashable PublicKey where - hash (PublicKey v gpgsig) = hash $ Tagged "PublicKey" - [hash v, hash gpgsig] + hash (PublicKey v) = hash $ Tagged "PublicKey" v instance Hashable GpgSig where hash (GpgSig v) = hash $ Tagged "GpgSig" v +instance Hashable a => Hashable (PerhapsSigned a) where + hash (GpgSigned a sig) = hash $ Tagged "GpgSigned" [hash a, hash sig] + hash (UnSigned a) = hash $ Tagged "UnSigned" a + instance Hashable ElapsedTime where hash (ElapsedTime n) = hash $ Tagged "ElapsedTime" $ C8.pack $ show n diff --git a/Role/Developer.hs b/Role/Developer.hs index 8e27b30..d5c3463 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -122,12 +122,14 @@ sendTtyOutput ochan devstate logger = go authUser :: TMChan (Message Entered) -> TMChan LogMessage -> TVar DeveloperState -> Logger -> IO Bool authUser ichan ochan devstate logger = do ds <- atomically $ readTVar devstate - pk <- myPublicKey (developerSessionKey ds) + spk <- myPublicKey (developerSessionKey ds) (GpgSign True) let msg = ControlMessage $ mkSigned (developerSessionKey ds) - (Control (SessionKey pk)) + (Control (SessionKey spk)) atomically $ writeTMChan ichan msg logger $ Developer msg - waitresp pk + waitresp $ case spk of + GpgSigned pk _ -> pk + UnSigned pk -> pk where waitresp pk = do ts <- getPOSIXTime @@ -180,8 +182,10 @@ getServerMessage ochan devstate ts = do return (Just (o, User msg)) else ignore -- When other developers connect, learn their SessionKeys. - Just (Developer msg@(ControlMessage (Control (SessionKey pk) _))) -> do - let sigverifier = mkSigVerifier pk + Just (Developer msg@(ControlMessage (Control (SessionKey spk) _))) -> do + let sigverifier = mkSigVerifier $ case spk of + GpgSigned pk _ -> pk + UnSigned pk -> pk if verifySigned sigverifier msg then do ds <- readTVar devstate @@ -290,9 +294,12 @@ processSessionStart ochan logger = do <$> atomically (readTMChan ochan) logger sessionmsg sigverifier <- case sessionmsg of - User (ControlMessage c@(Control (SessionKey pk) _)) -> + User (ControlMessage c@(Control (SessionKey spk) _)) -> do + let pk = case spk of + GpgSigned k _ -> k + UnSigned k -> k let sv = mkSigVerifier pk - in if verifySigned sv c + if verifySigned sv c then return sv else error "Badly signed session initialization message" _ -> error $ "Unexpected session initialization message: " ++ show sessionmsg diff --git a/Role/User.hs b/Role/User.hs index fc6eaea..51688af 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -80,7 +80,7 @@ startProtocol starttxt ochan logger = do atomically $ writeTMChan ochan msg logger $ User msg sk <- genMySessionKey - pk <- myPublicKey sk + pk <- myPublicKey sk (GpgSign False) let c = mkSigned sk $ Control (SessionKey pk) initialmessage $ ControlMessage c let starttxt' = rawLine starttxt @@ -209,8 +209,10 @@ getDeveloperMessage' :: Message Entered -> TMChan (Message Seen) -> TVar UserSta getDeveloperMessage' msg ochan us now = do st <- readTVar us case msg of - ControlMessage (Control (SessionKey pk) _) -> do - let sigverifier = mkSigVerifier pk + ControlMessage (Control (SessionKey spk) _) -> do + let sigverifier = mkSigVerifier $ case spk of + GpgSigned pk _ -> pk + UnSigned pk -> pk if verifySigned sigverifier msg then return (InputMessage msg) else return (BadlySignedMessage msg) @@ -236,8 +238,8 @@ getDeveloperMessage' msg ochan us now = do -- | Check if the public key a developer presented is one we want to use, -- and if so, add it to the sigVerifier. -checkDeveloperPublicKey :: TMChan (Message Seen) -> TVar UserState -> Logger -> PublicKey -> IO () -checkDeveloperPublicKey ochan us logger pk = do +checkDeveloperPublicKey :: TMChan (Message Seen) -> TVar UserState -> Logger -> PerhapsSigned PublicKey -> IO () +checkDeveloperPublicKey ochan us logger spk = do now <- getPOSIXTime -- TODO check gpg sig.. msg <- atomically $ do @@ -248,6 +250,10 @@ checkDeveloperPublicKey ochan us logger pk = do writeTVar us st' sendDeveloper ochan us (SessionKeyAccepted pk) now logger $ User msg + where + pk = case spk of + GpgSigned k _ -> k + UnSigned k -> k -- | Truncate the Backlog to remove entries older than the one -- that the Activity Entered refers to, but only if the referred diff --git a/TODO b/TODO index 30f884c..ed0fc45 100644 --- a/TODO +++ b/TODO @@ -35,6 +35,9 @@ Everything else in debug-me checks a session's proof as it goes. And, everything that saves a log file checks the proof as it goes, so perhaps this is not actually necessary? +* Add a mode that, given a log file, displays what developer(s) gpg keys + signed activity in the log file. For use when a developer did something + wrong, to examine the proof of malfesence. * gpg key downloading, web of trust checking, prompting Alternatively, let debug-me be started with a gpg key, this way a project's website can instruct their users to diff --git a/Types.hs b/Types.hs index c202f14..2dc5d28 100644 --- a/Types.hs +++ b/Types.hs @@ -85,7 +85,7 @@ instance DataSize Control where data ControlAction = Rejected (Activity Entered) -- ^ sent by user to indicate when an Entered value was rejected. - | SessionKey PublicKey + | SessionKey (PerhapsSigned PublicKey) -- ^ sent by user at start, and later by developer, -- to indicate their session key | SessionKeyAccepted PublicKey @@ -126,13 +126,22 @@ instance DataSize Signature where dataSize (OtherSignature v) = dataSize v -- | A public key used for a debug-me session. --- It may be signed with a gpg key. -data PublicKey = PublicKey Val (Maybe GpgSig) +data PublicKey = PublicKey Val deriving (Show, Generic, Eq) instance DataSize PublicKey where -- ed25519 public keys are 32 bytes - dataSize (PublicKey _ ms) = 32 + maybe 0 dataSize ms + dataSize (PublicKey _) = 32 + +-- | A value that may be gpg signed. +data PerhapsSigned a + = GpgSigned a GpgSig + | UnSigned a + deriving (Show, Generic, Eq) + +instance DataSize a => DataSize (PerhapsSigned a) where + dataSize (GpgSigned a sig) = dataSize a + dataSize sig + dataSize (UnSigned a) = dataSize a -- | A signature made with a gpg key. newtype GpgSig = GpgSig Val @@ -226,3 +235,10 @@ instance ToJSON ControlAction where toEncoding = genericToEncoding sumOptions instance FromJSON ControlAction where parseJSON = genericParseJSON sumOptions + +instance Binary (PerhapsSigned PublicKey) +instance ToJSON (PerhapsSigned PublicKey) where + toJSON = genericToJSON sumOptions + toEncoding = genericToEncoding sumOptions +instance FromJSON (PerhapsSigned PublicKey) where + parseJSON = genericParseJSON sumOptions diff --git a/debug-me.1 b/debug-me.1 index 130c90c..ee12326 100644 --- a/debug-me.1 +++ b/debug-me.1 @@ -24,6 +24,12 @@ to adjust their reputation. .IP "-- cmd opts" Normally debug-me will run your login shell. To run some other command, pass the command and any options after "--". +.PP +.IP "--gpg-opt=option" +debug-me runs gpg to verify the GPG key of a developer. To pass options to +gpg, use --gpg-opt with the option to pass. For example: +--gpg-opt=--keyserver=pgpkeys.mit.edu +This can be done multiple times. .IP "--debug url" Connect to a debug-me session on the specified url. The developer runs debug-me with this option to see and interact with the user's bug. -- cgit v1.2.3