diff options
Diffstat (limited to 'Presence/Server.hs')
-rw-r--r-- | Presence/Server.hs | 18 |
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(..)) | |||
24 | import Data.HList | 24 | import Data.HList |
25 | import Data.HList.TypeEqGeneric1() | 25 | import Data.HList.TypeEqGeneric1() |
26 | import Data.HList.TypeCastGeneric1() | 26 | import Data.HList.TypeCastGeneric1() |
27 | import System.IO.Error | ||
28 | import ByteStringOperators | ||
27 | 29 | ||
28 | 30 | ||
29 | newtype ConnId = ConnId Int | 31 | newtype 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 |