diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,19 @@ +debug-me (1.20170520) unstable; urgency=medium + + * debug-me is available in Debian unstable. + * gpg keyrings in /usr/share/debug-me/ will be checked + to see if a connecting person is a known developer of software + installed on the system, and so implicitly trusted already. + Software packages/projects can install keyrings to that location. + (Thanks to Sean Whitton for the idea.) + * make install installs /usr/share/debug-me/a_debug-me_developer.gpg, + which contains the key of Joey Hess. (stack and cabal installs don't + include this file because they typically don't install system-wide) + * debug-me.cabal: Added dependency on time. + * stack.yaml: Update to new posix-pty version. + + -- Joey Hess Sat, 20 May 2017 17:13:11 -0400 + debug-me (1.20170509) unstable; urgency=medium * Server: Use "postmaster" as default --from-email address diff --git a/ControlWindow.hs b/ControlWindow.hs --- a/ControlWindow.hs +++ b/ControlWindow.hs @@ -15,6 +15,7 @@ import VirtualTerminal import Gpg import Gpg.Wot +import Gpg.Keyring import Output import System.IO @@ -163,6 +164,8 @@ ws <- downloadWotStats gpgkeyid putStrLn $ unlines $ map sanitizeForDisplay $ describeWot ws ss + mapM_ (putStrLn . keyringToDeveloperDesc ws) + =<< findKeyringsContaining gpgkeyid promptconnect where promptconnect :: IO () diff --git a/Crypto.hs b/Crypto.hs --- a/Crypto.hs +++ b/Crypto.hs @@ -31,7 +31,7 @@ instance Hashable a => Signed (Activity a) where getSignature = activitySignature hashExceptSignature (Activity a mpa mpe mt _s) = hash $ - Tagged "Activity" [hash a, hash mpa, hash mpe, hash mt] + Tagged "Activity" [hash a, hashOfMaybeUnsafe mpa, hashOfMaybeUnsafe mpe, hash mt] instance Signed Control where getSignature = controlSignature diff --git a/Gpg/Keyring.hs b/Gpg/Keyring.hs new file mode 100644 --- /dev/null +++ b/Gpg/Keyring.hs @@ -0,0 +1,73 @@ +{- Copyright 2017 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +-- | Gpg keyrings for debug-me + +module Gpg.Keyring where + +import Gpg +import qualified Gpg.Wot + +import System.FilePath +import Data.Char +import System.Directory +import Data.Time.Clock +import Data.Time.Format +import System.Process +import System.Exit + +keyringDir :: FilePath +keyringDir = "/usr/share/debug-me/keyring" + +data Keyring = Keyring FilePath UTCTime + +keyringToDeveloperDesc :: Maybe (Gpg.Wot.WotStats) -> Keyring -> String +keyringToDeveloperDesc mws (Keyring f mtime) = + name ++ " is " ++ desc ++ " \t(as of " ++ showtime mtime ++ ")" + where + name = maybe "This person" Gpg.Wot.wotStatName mws + desc = map sanitize $ dropExtension $ takeFileName f + sanitize '_' = ' ' + sanitize c + | isAlphaNum c || c `elem` "-+" = c + | otherwise = '?' + showtime = formatTime defaultTimeLocale "%c" + +findKeyringsContaining :: GpgKeyId -> IO [Keyring] +findKeyringsContaining k = + go [] . map (keyringDir ) =<< getDirectoryContents keyringDir + where + go c [] = return c + go c (f:fs) = do + isfile <- doesFileExist f + if isfile && takeExtension f == ".gpg" + then do + inkeyring <- isInKeyring k f + if inkeyring + then do + mtime <- getModificationTime f + let keyring = Keyring f mtime + go (keyring : c) fs + else go c fs + else go c fs + +-- | Check if the gpg key is included in the keyring file. +-- +-- Similar to gpgv, this does not check if the key is revoked or expired, +-- only if it's included in the keyring. +isInKeyring :: GpgKeyId -> FilePath -> IO Bool +isInKeyring (GpgKeyId k) f = do + -- gpg assumes non-absolute keyring files are relative to ~/.gnupg/ + absf <- makeAbsolute f + let p = proc "gpg" + -- Avoid reading any keyrings except the specified one. + [ "--no-options" + , "--no-default-keyring" + , "--no-auto-check-trustdb" + , "--keyring", absf + , "--list-key", k + ] + (exitcode, _, _) <- readCreateProcessWithExitCode p "" + return (exitcode == ExitSuccess) diff --git a/Gpg/Wot.hs b/Gpg/Wot.hs --- a/Gpg/Wot.hs +++ b/Gpg/Wot.hs @@ -107,13 +107,16 @@ , theirname ++ " is probably a real person." ] where - theirname = stripEmail (uid (key ws)) + theirname = wotStatName ws sigs = cross_sigs ws ++ other_sigs ws bestconnectedsigs = sortOn rank sigs describeWot Nothing _ = [ "" , "Their identity cannot be verified!" ] + +wotStatName :: WotStats -> String +wotStatName ws = stripEmail (uid (key ws)) stripEmail :: String -> String stripEmail = unwords . takeWhile (not . ("<" `isPrefixOf`)) . words diff --git a/Hash.hs b/Hash.hs --- a/Hash.hs +++ b/Hash.hs @@ -41,7 +41,7 @@ instance Hashable a => Hashable (Activity a) where hash (Activity a mps mpe mt s) = hash $ Tagged "Activity" - [hash a, hash mps, hash mpe, hash mt, hash s] + [hash a, hashOfMaybeUnsafe mps, hashOfMaybeUnsafe mpe, hash mt, hash s] instance Hashable Entered where hash v = hash $ Tagged "Entered" @@ -52,7 +52,7 @@ instance Hashable ControlAction where hash (EnteredRejected h1 h2) = hash $ Tagged "EnteredRejected" - [hash h1, hash h2] + [hash h1, hashOfMaybeUnsafe h2] hash (SessionKey pk v) = hash $ Tagged "SessionKey" [hash pk, hash v] hash (SessionKeyAccepted pk) = hash $ Tagged "SessionKeyAccepted" pk hash (SessionKeyRejected pk) = hash $ Tagged "SessionKeyRejected" pk @@ -83,10 +83,21 @@ instance Hashable [Hash] where hash = hash . B.concat . map (val . hashValue) --- | Hash empty string for Nothing +-- | Hash a Maybe Hash, such that +-- hash Nothing /= hash (Just (hash (mempty :: B.ByteString))) instance Hashable (Maybe Hash) where - hash Nothing = hash () - hash (Just v) = hash v + hash (Just v) = hash (val (hashValue v)) + hash Nothing = hash (mempty :: B.ByteString) -instance Hashable () where - hash () = hash (mempty :: B.ByteString) +-- | Hash a Maybe Hash using the Hash value as-is, or the hash of the empty +-- string for Nothing. +-- +-- Note that this is only safe to use when the input value can't possibly +-- itself be the hash of an empty string. For example, the hash of an +-- Activity is safe, because it's the hash of a non-empty string. +-- +-- This is only used to avoid breaking backwards compatability; the +-- above instance for Maybe Hash should be used for anything new. +hashOfMaybeUnsafe :: Maybe Hash -> Hash +hashOfMaybeUnsafe (Just v) = hash v +hashOfMaybeUnsafe Nothing = hash (mempty :: B.ByteString) diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -61,6 +61,9 @@ install -m 0755 debug-me.init $(DESTDIR)$(PREFIX)/etc/init.d/debug-me install -d $(DESTDIR)$(PREFIX)/etc/default install -m 0644 debug-me.default $(DESTDIR)$(PREFIX)/etc/default/debug-me + install -d $(DESTDIR)$(PREFIX)/usr/share/debug-me/keyring + install -m 0655 developer-keyring.gpg \ + $(DESTDIR)$(PREFIX)/usr/share/debug-me/keyring/a_debug-me_developer.gpg install-mans: install -d $(DESTDIR)$(PREFIX)/usr/share/man/man1 diff --git a/Verify.hs b/Verify.hs new file mode 100644 --- /dev/null +++ b/Verify.hs @@ -0,0 +1,110 @@ +{- Copyright 2017 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Verify (verify) where + +import Types +import Log +import CmdLine +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) + where + go _ _ [] = putStrLn "Log file verified. All signatures and hashes are valid." + go lineno st (Right lmsg:rest) = do + -- The log may have hashes removed, as it went over the + -- wire; restore hashes. + let ra = mkRecentActivity st + msg <- atomically $ restoreHashes ra $ + MissingHashes $ loggedMessage lmsg + + -- Learn session keys before verifying signatures. + st' <- case msg of + User (ControlMessage (Control { control = SessionKey sk _ })) -> + addSessionKey lineno sk st + Developer (ControlMessage (Control { control = SessionKey sk _ })) -> + addSessionKey lineno sk st + _ -> return st + + case (verifySigned (sigVerifier st') msg, verifyHashChain msg st') of + (True, True) -> return () + (False, _) -> lineError lineno + "Failed to verify message signature." + (_, False) -> lineError lineno + "Invalid hash chain." + + go (succ lineno) (addPrevHash msg st') rest + go lineno _ (Left l:_) = lineError lineno $ + "Failed to parse a line of the log: " ++ l + +lineError :: Integer -> String -> a +lineError lineno err = error $ "Line " ++ show lineno ++ ": " ++ err + +data State = State + { sigVerifier :: SigVerifier + , prevHashes :: [Hash] + } + deriving (Show) + +startState :: State +startState = State + { sigVerifier = mempty + , prevHashes = mempty -- ^ in reverse order + } + +mkRecentActivity :: State -> RecentActivity +mkRecentActivity st = return (sigVerifier st, prevHashes st) + +addSessionKey :: Integer -> PerhapsSigned PublicKey -> State -> IO State +addSessionKey lineno p@(GpgSigned pk _ _) st = do + (mkid, gpgoutput) <- gpgVerify p + putStr $ unlines $ map sanitizeForDisplay $ lines $ toString gpgoutput + case mkid of + Nothing -> lineError lineno "Bad GnuPG signature." + Just _ -> do + putStrLn "The person above participated in the debug-me session." + addSessionKey lineno (UnSigned pk) st +addSessionKey _lineno (UnSigned pk) st = do + let v = mkSigVerifier pk + return $ st { sigVerifier = sigVerifier st `mappend` v } + +-- | Add the hash of the message to the state. +addPrevHash :: AnyMessage -> State -> State +addPrevHash am s = case mh of + Just h -> s { prevHashes = h : prevHashes s } + Nothing -> s + where + mh = case am of + User (ActivityMessage m) -> Just (hash m) + User (ControlMessage _) -> Nothing + Developer (ActivityMessage m) -> Just (hash m) + Developer (ControlMessage _) -> Nothing + +-- | Verify that prevActivity and prevEntered point to previously +-- seen hashes. +-- +-- While Role.User and Role.Developer enforce rules about which +-- hashes they may point to, here we don't check such rules. If the log +-- continues with other messages referring to this one, then this message +-- must have met the rules, and if it did not, then this message is +-- irrelevant. +verifyHashChain :: AnyMessage -> State -> Bool +verifyHashChain am s = case am of + User (ControlMessage _) -> True + Developer (ControlMessage _) -> True + User (ActivityMessage m) -> checkm m + Developer (ActivityMessage m) -> checkm m + where + checkm m = all (\h -> h `elem` prevHashes s) + (catMaybes [prevActivity m, prevEntered m]) diff --git a/debug-me.1 b/debug-me.1 --- a/debug-me.1 +++ b/debug-me.1 @@ -14,13 +14,16 @@ A debug-me session is logged and signed with the developer's GnuPG key, producing a chain of evidence of what they saw and what they did. So the developer's good reputation is leveraged to make debug-me secure. +If you trust a developer to ship software to your computer, +you can trust them to debug-me. .PP When you start debug-me without any options, it will connect to a debug-me server, and print out an url that you can give to the developer to get them connected to you. Then debug-me will show you their GnuPG key and who -has signed it. If the developer has a good reputation, you can proceed -to let them type into your console in a debug-me session. Once the -session is done, the debug-me server will email you the signed +has signed it, and will let you know if they are a known developer +of software on your computer. If the developer has a good reputation, you +can proceed to let them type into your console in a debug-me session. Once +the session is done, the debug-me server will email you the signed evidence of what the developer did in the session. .PP It's a good idea to watch the debug-me session. The developer should be @@ -101,6 +104,10 @@ .IP "~/.debug-me/log/remote/" When using debug-me to connect to a remote session, the session will be logged to here. +.UP "/usr/share/debug-me/keyring/*.gpg" +When verifying a developer's gpg key, debug-me checks if it's listed in +the keyrings in this directory, which can be provided by software installed +on the computer. .SH SEE ALSO .PP diff --git a/debug-me.cabal b/debug-me.cabal --- a/debug-me.cabal +++ b/debug-me.cabal @@ -1,5 +1,5 @@ Name: debug-me -Version: 1.20170509 +Version: 1.20170510 Cabal-Version: >= 1.8 Maintainer: Joey Hess Author: Joey Hess @@ -20,13 +20,16 @@ A debug-me session is logged and signed with the developer's GnuPG key, producing a chain of evidence of what they saw and what they did. So the developer's good reputation is leveraged to make debug-me secure. + If you trust a developer to ship software to your computer, + you can trust them to debug-me. . When you start debug-me without any options, it will connect to a debug-me server, and print out an url that you can give to the developer to get them connected to you. Then debug-me will show you their GnuPG key and who - has signed it. If the developer has a good reputation, you can proceed - to let them type into your console in a debug-me session. Once the - session is done, the debug-me server will email you the signed + has signed it, and will let you know if they are a known developer + of software on your computer. If the developer has a good reputation, + you can proceed to let them type into your console in a debug-me session. + Once the session is done, the debug-me server will email you the signed evidence of what the developer did in the session. . If the developer did do something bad, you'd have proof that they cannot @@ -40,6 +43,7 @@ debug-me.service debug-me.init debug-me.default + developer-keyring.gpg Executable debug-me Main-Is: debug-me.hs @@ -81,6 +85,7 @@ , utf8-string (>= 1.0) , network-uri (>= 2.6) , mime-mail (>= 0.4) + , time (>= 1.6) Other-Modules: ControlWindow ControlSocket @@ -90,6 +95,7 @@ Graphviz Gpg Gpg.Wot + Gpg.Keyring Hash JSON Log @@ -109,6 +115,7 @@ SessionID Types Val + Verify VirtualTerminal WebSockets diff --git a/developer-keyring.gpg b/developer-keyring.gpg new file mode 100644 Binary files /dev/null and b/developer-keyring.gpg differ