From 852aa8a2053a7d6c2775df481847926c9baf9292 Mon Sep 17 00:00:00 2001 From: Takano Akio Date: Fri, 15 Feb 2013 17:36:41 +0900 Subject: [PATCH] Don't crash when there is a leftover socket file Previously, when there was a socket file in the current directly and no server was running, 'hdevtools check' would fail with: hdevtools: bind: resource busy (Address already in use) --- src/Server.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/Server.hs b/src/Server.hs index 551e2c4..6a5cf4f 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -8,15 +8,20 @@ import Network (PortID(UnixSocket), Socket, accept, listenOn, sClose) import System.Directory (removeFile) import System.Exit (ExitCode(ExitSuccess)) import System.IO (Handle, hClose, hFlush, hGetLine, hPutStrLn) -import System.IO.Error (ioeGetErrorType, isDoesNotExistError) +import System.IO.Error (ioeGetErrorType, isAlreadyInUseError, isDoesNotExistError) import CommandLoop (newCommandLoopState, startCommandLoop) import Types (ClientDirective(..), Command, ServerDirective(..)) import Util (readMaybe) createListenSocket :: FilePath -> IO Socket -createListenSocket socketPath = - listenOn (UnixSocket socketPath) +createListenSocket socketPath = do + r <- tryJust (guard . isAlreadyInUseError) $ listenOn (UnixSocket socketPath) + case r of + Right socket -> return socket + Left _ -> do + removeFile socketPath + listenOn (UnixSocket socketPath) startServer :: FilePath -> Maybe Socket -> IO () startServer socketPath mbSock = do