summaryrefslogtreecommitdiff
path: root/Presence/Server.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/Server.hs')
-rw-r--r--Presence/Server.hs18
1 files changed, 12 insertions, 6 deletions
diff --git a/Presence/Server.hs b/Presence/Server.hs
index adc3de84..deab779b 100644
--- a/Presence/Server.hs
+++ b/Presence/Server.hs
@@ -24,6 +24,8 @@ import Control.Exception (handle,SomeException(..))
24import Data.HList 24import Data.HList
25import Data.HList.TypeEqGeneric1() 25import Data.HList.TypeEqGeneric1()
26import Data.HList.TypeCastGeneric1() 26import Data.HList.TypeCastGeneric1()
27import System.IO.Error
28import ByteStringOperators
27 29
28 30
29newtype ConnId = ConnId Int 31newtype ConnId = ConnId Int
@@ -50,9 +52,6 @@ doServer port g startCon = runServer2 port (runConn2 g)
50 hSetBuffering h NoBuffering 52 hSetBuffering h NoBuffering
51 st'' <- startCon sock (h .*. st) 53 st'' <- startCon sock (h .*. st)
52 let doException (SomeException e) = Prelude.putStrLn ("\n\nexception: " ++ show e ++ "\n\n") 54 let doException (SomeException e) = Prelude.putStrLn ("\n\nexception: " ++ show e ++ "\n\n")
53 handle doException $ do
54 -- PEER CRED: (0,4294967295,4294967295)
55 -- PEER NAME: 127.0.0.1:37253
56 handle doException $ fix $ \loop -> do 55 handle doException $ fix $ \loop -> do
57 let continue () = hIsEOF h >>= flip when loop . not 56 let continue () = hIsEOF h >>= flip when loop . not
58 packet <- getPacket h 57 packet <- getPacket h
@@ -73,12 +72,19 @@ doServer port g startCon = runServer2 port (runConn2 g)
73 listen sock 2 72 listen sock 2
74 forkIO $ do 73 forkIO $ do
75 mainLoop sock (ConnId 0) go 74 mainLoop sock (ConnId 0) go
76 L.putStrLn $ "quit accept loop" 75 -- L.putStrLn $ "quit accept loop"
77 return sock 76 return sock
78 where 77 where
79 mainLoop sock idnum@(ConnId n) go = do 78 mainLoop sock idnum@(ConnId n) go = do
80 let doException (SomeException e) = do 79 let doException ioerror = do
81 Prelude.putStrLn ("\n\naccept-loop exception: " ++ show e ++ "\n\n") 80 let typ = ioeGetErrorType ioerror
81 if -- typ == InvalidArgument
82 -- but the symbol is not exported :/
83 bshow typ=="invalid argument"
84 then do
85 L.putStrLn $ "quit accept-loop."
86 else do
87 L.putStrLn ("accept-loop exception: " <++> bshow ioerror <++> "\n")
82 return Nothing 88 return Nothing
83 mcon <- handle doException $ fix $ \loop -> do 89 mcon <- handle doException $ fix $ \loop -> do
84 con <- accept sock 90 con <- accept sock