From 9d31501d18dfa0ca544840fa713efa4861707df5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 28 Apr 2017 17:30:14 -0400
Subject: avoid crash removing socket that DNE

---
 ControlSocket.hs | 32 ++++++++++++++------------------
 1 file changed, 14 insertions(+), 18 deletions(-)

(limited to 'ControlSocket.hs')

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
-- 
cgit v1.2.3