diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-04-28 17:30:14 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-04-28 17:30:14 -0400 |
commit | 9d31501d18dfa0ca544840fa713efa4861707df5 (patch) | |
tree | 433bf33619769fd375ff304c57eae5e8da3d45c0 /ControlSocket.hs | |
parent | f4d5ba83fdc484a13809511017989bb401e63c28 (diff) | |
download | debug-me-9d31501d18dfa0ca544840fa713efa4861707df5.tar.gz |
avoid crash removing socket that DNE
Diffstat (limited to 'ControlSocket.hs')
-rw-r--r-- | ControlSocket.hs | 32 |
1 files changed, 14 insertions, 18 deletions
diff --git a/ControlSocket.hs b/ControlSocket.hs index 186d359..8aa68cd 100644 --- a/ControlSocket.hs +++ b/ControlSocket.hs @@ -42,12 +42,18 @@ defaultSocketFile = (</> "control") <$> dotDir -- Returns once either of the TMChans is closed. openControlWindow :: IO (TMChan ControlInput, TMChan ControlOutput) openControlWindow = do - putStrLn "You need to open another shell prompt, and run: debug-me --control" - controlsocket <- defaultSocketFile + socketfile <- defaultSocketFile + -- Delete any existing socket file. + _ <- try (removeLink socketfile) :: IO (Either IOException ()) + soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol + S.bind soc (S.SockAddrUnix socketfile) + setFileMode socketfile (unionFileModes ownerWriteMode ownerReadMode) + S.listen soc 2 ichan <- newTMChanIO ochan <- newTMChanIO - _ <- async $ serveControlSocket controlsocket ichan ochan + _ <- async $ serveControlSocket soc ichan ochan -- Wait for message from control process. + putStrLn "You need to open another shell prompt, and run: debug-me --control" v <- atomically $ readTMChan ochan case v of Just ControlWindowOpened -> return () @@ -58,28 +64,18 @@ openControlWindow = do -- the TMChans. -- -- Returns once either of the TMChans is closed. -serveControlSocket :: FilePath -> TMChan ControlInput -> TMChan ControlOutput -> IO () -serveControlSocket socketfile ichan ochan = do - _ <- bracket setup cleanup serve - `race` waitclose +serveControlSocket :: S.Socket -> TMChan ControlInput -> TMChan ControlOutput -> IO () +serveControlSocket soc ichan ochan = do + _ <- serve `race` waitclose return () where - setup = do - -- Delete any existing socket file. - removeLink socketfile - soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol - S.bind soc (S.SockAddrUnix socketfile) - setFileMode socketfile (unionFileModes ownerWriteMode ownerReadMode) - S.listen soc 2 - return soc - cleanup = S.close - serve soc = do + serve = do (sconn, _) <- S.accept soc conn <- S.socketToHandle sconn ReadWriteMode hSetBinaryMode conn True _ <- async $ sendToConn conn ichan `race` receiveFromConn conn ochan - serve soc + serve waitclose = atomically $ do ic <- isClosedTMChan ichan oc <- isClosedTMChan ochan |