debug-me 1.20190926 → 1.20200820
raw patch · 4 files changed
+22/−13 lines, 4 files
Files
- CHANGELOG +9/−0
- Server.hs +9/−10
- debug-me.cabal +3/−2
- debug-me.service +1/−1
CHANGELOG view
@@ -1,3 +1,12 @@+debug-me (1.20200820) unstable; urgency=medium++ * debug-me.service: Remove /etc from InaccessiblePaths,+ as that prevents the server sending email using eg postfix,+ which needs to read its config files.+ * Update to lts-14.27, support websockets 0.12.7.++ -- Joey Hess <id@joeyh.name> Thu, 20 Aug 2020 14:04:40 -0400+ debug-me (1.20190926) unstable; urgency=medium * Avoid a crash when run without a controlling tty, which may happen
Server.hs view
@@ -16,7 +16,6 @@ import Network.Wai import Network.Wai.Handler.Warp import Network.Wai.Handler.WebSockets-import Network.WebSockets hiding (Message) import qualified Network.WebSockets as WS import Network.HTTP.Types import Control.Concurrent@@ -124,7 +123,7 @@ websocketApp o ssv pending_conn = do conn <- WS.acceptRequest pending_conn _v <- negotiateWireVersion conn- r <- receiveData conn+ r <- WS.receiveData conn case r of SelectMode ClientSends (InitMode email) -> user email o ssv conn SelectMode ClientSends (ConnectMode t) -> @@ -136,7 +135,7 @@ user :: EmailAddress -> ServerOpts -> TVar ServerState -> WS.Connection -> IO () user email o ssv conn = do sid <- withSessionID (serverDirectory o) $ \(loghv, sid) -> do- sendBinaryData conn (Ready ServerSends sid)+ WS.sendBinaryData conn (Ready ServerSends sid) bracket (setup sid loghv) (cleanup sid) go return sid doneSessionLog email o sid@@ -173,7 +172,7 @@ case v of Just (Broadcast l _from) -> case loggedMessage l of Developer m -> do- sendBinaryData conn (AnyMessage (Developer m))+ WS.sendBinaryData conn (AnyMessage (Developer m)) relaytouser userchan User _ -> relaytouser userchan Nothing -> return ()@@ -188,12 +187,12 @@ sessionLogFile (serverDirectory o) sid if exists then do- sendBinaryData conn (Ready ServerSends sid)+ WS.sendBinaryData conn (Ready ServerSends sid) replayBacklog o sid conn- sendBinaryData conn Done+ WS.sendBinaryData conn Done else protocolError conn "Unknown session ID" go (Just session) = do- sendBinaryData conn (Ready ServerSends sid)+ WS.sendBinaryData conn (Ready ServerSends sid) devchan <- replayBacklogAndListen o sid session conn mytid <- mkWeakThreadId =<< myThreadId _ <- relayfromdeveloper mytid session@@ -216,7 +215,7 @@ v <- atomically $ readTMChan devchan case v of Just (Broadcast l from) -> do- let sendit = sendBinaryData conn+ let sendit = WS.sendBinaryData conn (AnyMessage $ loggedMessage l) case loggedMessage l of User _ -> sendit@@ -231,7 +230,7 @@ else sendit relaytodeveloper mytid devchan Nothing -> do- sendBinaryData conn Done+ WS.sendBinaryData conn Done return () -- | Replay the log of what's happened in the session so far,@@ -253,7 +252,7 @@ replayBacklog o sid conn = do ls <- streamLog (sessionLogFile (serverDirectory o) sid) forM_ ls $ \l -> case loggedMessage <$> l of- Right m -> sendBinaryData conn (AnyMessage m)+ Right m -> WS.sendBinaryData conn (AnyMessage m) Left _ -> return () doneSessionLog :: EmailAddress -> ServerOpts -> SessionID -> IO ()
debug-me.cabal view
@@ -1,6 +1,6 @@ Name: debug-me-Version: 1.20190926-Cabal-Version: >= 1.8+Version: 1.20200820+Cabal-Version: >= 1.10 Maintainer: Joey Hess <joey@kitenet.net> Author: Joey Hess Stability: Experimental@@ -51,6 +51,7 @@ Executable debug-me Main-Is: debug-me.hs GHC-Options: -threaded -Wall -fno-warn-tabs -O2+ Default-Language: Haskell98 Build-Depends: base (>= 4.9 && < 5.0) , network (>= 2.6)
debug-me.service view
@@ -6,7 +6,7 @@ Environment='DAEMON_PARAMS=--server /var/log/debug-me/ --delete-old-logs' EnvironmentFile=-/etc/default/debug-me ExecStart=/usr/bin/debug-me $DAEMON_PARAMS-InaccessiblePaths=/home /etc+InaccessiblePaths=/home ReadWritePaths=/var/log/debug-me User=debug-me Group=debug-me