Skip to content

Commit

Permalink
Server shouldn't crash when the client dies
Browse files Browse the repository at this point in the history
This commit makes the server not crash when the client dies
in the middle of command execution.
  • Loading branch information
Takano Akio committed Jan 26, 2013
1 parent 59a7624 commit 684defe
Show file tree
Hide file tree
Showing 2 changed files with 9 additions and 4 deletions.
1 change: 1 addition & 0 deletions AUTHORS
@@ -1 +1,2 @@
Bit Connor <mutantlemon@gmail.com>
Takano Akio <aljee@hyper.cx>
12 changes: 8 additions & 4 deletions src/Server.hs
@@ -1,13 +1,14 @@
module Server where

import Control.Exception (bracket, finally, tryJust)
import Control.Exception (bracket, finally, handleJust, tryJust)
import Control.Monad (guard)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import GHC.IO.Exception (IOErrorType(ResourceVanished))
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 (isDoesNotExistError)
import System.IO.Error (ioeGetErrorType, isDoesNotExistError)

import CommandLoop (newCommandLoopState, startCommandLoop)
import Types (ClientDirective(..), Command, ServerDirective(..))
Expand Down Expand Up @@ -44,11 +45,14 @@ clientSend :: IORef (Maybe Handle) -> ClientDirective -> IO ()
clientSend currentClient clientDirective = do
mbH <- readIORef currentClient
case mbH of
Just h -> do
-- TODO catch exception
Just h -> ignoreEPipe $ do
hPutStrLn h (show clientDirective)
hFlush h
Nothing -> error "This is impossible"
where
-- EPIPE means that the client is no longer there.
ignoreEPipe = handleJust (guard . isEPipe) (const $ return ())
isEPipe = (==ResourceVanished) . ioeGetErrorType

getNextCommand :: IORef (Maybe Handle) -> Socket -> IO (Maybe (Command, [String]))
getNextCommand currentClient sock = do
Expand Down

0 comments on commit 684defe

Please sign in to comment.