diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2019-09-28 10:39:00 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2019-09-28 10:39:00 -0700 |
commit | 242d993ca9e633a840e8a60c566eba02f9a8cad2 (patch) | |
tree | e5431cccd39d837520e25516affd136faf6fde61 | |
parent | 11fe553b8cb6e2aa9bb24ce4f9e4879a58cef6de (diff) | |
parent | 5a818996271da687a21fd6e8d315c4a48ed4bc45 (diff) | |
download | debug-me-242d993ca9e633a840e8a60c566eba02f9a8cad2.tar.gz |
Merge tag '1.20190926'
tagging package debug-me version 1.20190926
# gpg: Signature made Thu 26 Sep 2019 05:05:32 PM MST
# gpg: using RSA key 28A500C35207EAB72F6C0F25DB12DB0FF05F8F38
# gpg: Good signature from "Joey Hess <joeyh@joeyh.name>" [full]
# Primary key fingerprint: E85A 5F63 B31D 24C1 EBF0 D81C C910 D922 2512 E3C7
# Subkey fingerprint: 28A5 00C3 5207 EAB7 2F6C 0F25 DB12 DB0F F05F 8F38
-rw-r--r-- | CHANGELOG | 8 | ||||
-rw-r--r-- | ControlWindow.hs | 13 | ||||
-rw-r--r-- | Role/User.hs | 28 | ||||
-rw-r--r-- | debug-me.cabal | 2 | ||||
-rw-r--r-- | doc/news/version_1.20181208.mdwn | 3 | ||||
-rw-r--r-- | stack.yaml | 6 |
6 files changed, 43 insertions, 17 deletions
@@ -1,3 +1,11 @@ +debug-me (1.20190926) unstable; urgency=medium + + * Avoid a crash when run without a controlling tty, which may happen + in some container environments. + * Update to lts-13.29, support ghc 8.6.5, and aeson 1.4. + + -- Joey Hess <id@joeyh.name> Thu, 26 Sep 2019 20:05:24 -0400 + debug-me (1.20181208) unstable; urgency=medium * Update to lts-12.10, support ghc 8.4, and aeson 1.3. diff --git a/ControlWindow.hs b/ControlWindow.hs index bd79d0f..29c81c9 100644 --- a/ControlWindow.hs +++ b/ControlWindow.hs @@ -98,9 +98,20 @@ type Response = String type PromptChan = TChan Prompt type ResponseChan = TChan Response +-- | Get a name for the debug-me user. When possible this will be the +-- actual username, but failing that, anything reasonable will do, +-- since it's only ever displayed to the person they are communicating +-- with. +getUserName :: IO String +getUserName = do + loginname <- try getLoginName :: IO (Either SomeException String) + case loginname of + Right n -> return n + Left _ -> return "user" + collectOutput :: TMChan ControlOutput -> PromptChan -> ResponseChan -> IO () collectOutput ochan promptchan responsechan = do - myusername <- fromString <$> getLoginName + myusername <- fromString <$> getUserName loop myusername where loop myusername = do diff --git a/Role/User.hs b/Role/User.hs index 6ec0302..987b880 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -247,17 +247,17 @@ getDeveloperMessage ichan ochan us now = maybe getDeveloperMessage' :: MissingHashes (Message Entered) -> TMChan (Message Seen) -> TVar UserState -> POSIXTime -> STM Input getDeveloperMessage' (MissingHashes wiremsg) ochan us now = do st <- readTVar us - Developer msg <- restoreHashes (userStateRecentActivity us) (MissingHashes (Developer wiremsg)) + msg <- restoreHashes (userStateRecentActivity us) (MissingHashes (Developer wiremsg)) case msg of - ControlMessage (Control (SessionKey spk _) _) -> do + Developer cmsg@(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) - _ -> if verifySigned (sigVerifier st) msg - then case msg of + if verifySigned sigverifier cmsg + then return (InputMessage cmsg) + else return (BadlySignedMessage cmsg) + Developer cmsg -> if verifySigned (sigVerifier st) cmsg + then case cmsg of ActivityMessage entered -> do -- Don't need to retain backlog -- before the Activity that entered @@ -266,22 +266,26 @@ getDeveloperMessage' (MissingHashes wiremsg) ochan us now = do truncateBacklog (backLog st) entered if isLegalEntered entered (st { backLog = bl' }) then do - let l = mkLog (Developer msg) now + let l = mkLog (Developer cmsg) now writeTVar us $ st { backLog = l :| toList bl' , lastAcceptedEntered = Just (hash entered) } - return (InputMessage msg) + return (InputMessage cmsg) else do let reject = EnteredRejected { enteredRejected = hash entered , enteredLastAccepted = lastAcceptedEntered st } - RejectedMessage msg + RejectedMessage cmsg <$> sendDeveloper ochan us reject now ControlMessage (Control _ _) -> - return (InputMessage msg) - else return (BadlySignedMessage msg) + return (InputMessage cmsg) + else return (BadlySignedMessage cmsg) + -- This cannot really happen, because restoreHashes is + -- always passed a Developer message, but ghc doesn't know + -- that. + User _ -> error "unexpectedly received User message where Developer message expected" -- | Truncate the Backlog to remove entries older than the one -- that the Activity Entered refers to, but only if the referred diff --git a/debug-me.cabal b/debug-me.cabal index 990a4d7..94af103 100644 --- a/debug-me.cabal +++ b/debug-me.cabal @@ -1,5 +1,5 @@ Name: debug-me -Version: 1.20181208 +Version: 1.20190926 Cabal-Version: >= 1.8 Maintainer: Joey Hess <joey@kitenet.net> Author: Joey Hess diff --git a/doc/news/version_1.20181208.mdwn b/doc/news/version_1.20181208.mdwn new file mode 100644 index 0000000..02a67c0 --- /dev/null +++ b/doc/news/version_1.20181208.mdwn @@ -0,0 +1,3 @@ +debug-me 1.20181208 released with [[!toggle text="these changes"]] +[[!toggleable text=""" + * Update to lts-12.10, support ghc 8.4, and aeson 1.3."""]]
\ No newline at end of file @@ -1,8 +1,8 @@ packages: - '.' -resolver: lts-12.10 +resolver: lts-13.29 extra-deps: -- graphviz-2999.20.0.2 +- graphviz-2999.20.0.3 - posix-pty-0.2.1.1 -- sandi-0.4.2 +- sandi-0.5 explicit-setup-deps: |