git.iko.soy/typeable/wai
on master help sign in
Merge pull request #250 from anton-dessiatov/windows-blocking-accept
c8f1e94Michael Snoyman
warp/Network/Wai/Handler/Warp/Recv.hs+2−1
compare with master
unifiedsplit
@@ -21,6 +21,7 @@ import Network.Wai.Handler.Warp.Buffer
21
21
22#ifdef mingw32_HOST_OS
22#ifdef mingw32_HOST_OS
23import GHC.IO.FD (FD(..), readRawBufferPtr)
23import GHC.IO.FD (FD(..), readRawBufferPtr)
24+import Network.Wai.Handler.Warp.Windows
24#endif
25#endif
25
26
26----------------------------------------------------------------
27----------------------------------------------------------------
@@ -47,7 +48,7 @@ receiveloop :: CInt -> Ptr CChar -> CSize -> IO CInt
47#endif
48#endif
48receiveloop sock buf size = do
49receiveloop sock buf size = do
49#ifdef mingw32_HOST_OS
50#ifdef mingw32_HOST_OS
50− bytes <- fmap fromIntegral $ readRawBufferPtr "recv" (FD sock 1) buf 0 size
51+ bytes <- windowsThreadBlockHack $ fmap fromIntegral $ readRawBufferPtr "recv" (FD sock 1) buf 0 size
51#else
52#else
52 bytes <- c_recv sock buf size 0
53 bytes <- c_recv sock buf size 0
53#endif
54#endif
warp/Network/Wai/Handler/Warp/Run.hs+7−18
@@ -23,7 +23,7 @@ import Data.Conduit.Network (bindPort)
23#define bindPortTCP bindPort
23#define bindPortTCP bindPort
24#endif
24#endif
25import Network (sClose, Socket)
25import Network (sClose, Socket)
26−import Network.Socket (accept, SockAddr)
26+import Network.Socket (accept, withSocketsDo, SockAddr)
27import qualified Network.Socket.ByteString as Sock
27import qualified Network.Socket.ByteString as Sock
28import Network.Wai
28import Network.Wai
29import qualified Network.Wai.Handler.Warp.Date as D
29import qualified Network.Wai.Handler.Warp.Date as D
@@ -40,9 +40,7 @@ import Network.Wai.Handler.Warp.Types
40import Data.IORef (IORef, newIORef, readIORef, writeIORef)
40import Data.IORef (IORef, newIORef, readIORef, writeIORef)
41
41
42#if WINDOWS
42#if WINDOWS
43−import qualified Control.Concurrent.MVar as MV
43+import Network.Wai.Handler.Warp.Windows
44−import Network.Socket (withSocketsDo)
45−import Control.Concurrent (forkIO)
46#else
44#else
47import System.Posix.IO (FdOption(CloseOnExec), setFdOption)
45import System.Posix.IO (FdOption(CloseOnExec), setFdOption)
48import Network.Socket (fdSocket)
46import Network.Socket (fdSocket)
@@ -77,26 +75,13 @@ run p = runSettings defaultSettings { settingsPort = p }
77
75
78-- | Run an 'Application' with the given 'Settings'.
76-- | Run an 'Application' with the given 'Settings'.
79runSettings :: Settings -> Application -> IO ()
77runSettings :: Settings -> Application -> IO ()
80−#if WINDOWS
81−runSettings set app = withSocketsDo $ do
78+runSettings set app = withSocketsDo $
82− var <- MV.newMVar Nothing
83− let clean = MV.modifyMVar_ var $ \s -> maybe (return ()) sClose s >> return Nothing
84− void . forkIO $ bracket
85− (bindPortTCP (settingsPort set) (settingsHost set))
86− (const clean)
87− (\s -> do
88− MV.modifyMVar_ var (\_ -> return $ Just s)
89− runSettingsSocket set s app)
90− forever (threadDelay maxBound) `finally` clean
91−#else
92−runSettings set app =
93 bracket
79 bracket
94 (bindPortTCP (settingsPort set) (settingsHost set))
80 (bindPortTCP (settingsPort set) (settingsHost set))
95 sClose
81 sClose
96 (\socket -> do
82 (\socket -> do
97 setSocketCloseOnExec socket
83 setSocketCloseOnExec socket
98 runSettingsSocket set socket app)
84 runSettingsSocket set socket app)
99−#endif
100
85
101-- | Same as 'runSettings', but uses a user-supplied socket instead of opening
86-- | Same as 'runSettings', but uses a user-supplied socket instead of opening
102-- one. This allows the user to provide, for example, Unix named socket, which
87-- one. This allows the user to provide, for example, Unix named socket, which
@@ -109,7 +94,11 @@ runSettingsSocket set socket app =
109 runSettingsConnection set getConn app
94 runSettingsConnection set getConn app
110 where
95 where
111 getConn = do
96 getConn = do
97+#if WINDOWS
98+ (s, sa) <- windowsThreadBlockHack $ accept socket
99+#else
112 (s, sa) <- accept socket
100 (s, sa) <- accept socket
101+#endif
113 setSocketCloseOnExec s
102 setSocketCloseOnExec s
114 conn <- socketConnection s
103 conn <- socketConnection s
115 return (conn, sa)
104 return (conn, sa)
warp/Network/Wai/Handler/Warp/Windows.hsnew file+24
@@ -0,0 +1,24 @@
1+{-# LANGUAGE CPP #-}
2+module Network.Wai.Handler.Warp.Windows
3+ ( windowsThreadBlockHack
4+ ) where
5+
6+#if WINDOWS
7+import Control.Exception
8+import Control.Concurrent.MVar
9+import Control.Concurrent
10+import Control.Monad
11+
12+windowsThreadBlockHack :: IO a -> IO a
13+windowsThreadBlockHack act =
14+ do
15+ var <- newEmptyMVar :: IO (MVar (Either SomeException a))
16+ void . forkIO $ try act >>= putMVar var
17+ res <- takeMVar var
18+ case res of
19+ Left e -> throwIO e
20+ Right r -> return r
21+#else
22+windowsThreadBlockHack :: IO a -> IO a
23+windowsThreadBlockHack = id
24+#endif
warp/warp.cabal+1
@@ -81,6 +81,7 @@ Library
81 Network.Wai.Handler.Warp.Settings
81 Network.Wai.Handler.Warp.Settings
82 Network.Wai.Handler.Warp.Thread
82 Network.Wai.Handler.Warp.Thread
83 Network.Wai.Handler.Warp.Types
83 Network.Wai.Handler.Warp.Types
84+ Network.Wai.Handler.Warp.Windows
84 Paths_warp
85 Paths_warp
85 Ghc-Options: -Wall
86 Ghc-Options: -Wall
86
87