git.iko.soy/typeable/wai
on master help sign in
Merge pull request #250 from anton-dessiatov/windows-blocking-accept

Made runSettingsSocket call interruptible on Windows.

commitc8f1e94c4045a35a089bdf62e28e915708b07f8d authorMichael Snoyman <michael@snoyman.com> dateMon 28 Apr 2014, 13:24 (12 years ago) parentfcb6df8830df1f
4 files changed+34−19
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp/Recv.hs+2−1 warp/Network/Wai/Handler/Warp/Run.hs+7−18 warp/Network/Wai/Handler/Warp/Windows.hs+24 warp/warp.cabal+1
warp/Network/Wai/Handler/Warp/Recv.hs+2−1
@@ -21,6 +21,7 @@ import Network.Wai.Handler.Warp.Buffer
2121
2222#ifdef mingw32_HOST_OS
2323import GHC.IO.FD (FD(..), readRawBufferPtr)
24+import Network.Wai.Handler.Warp.Windows
2425#endif
2526
2627----------------------------------------------------------------
@@ -47,7 +48,7 @@ receiveloop :: CInt -> Ptr CChar -> CSize -> IO CInt
4748#endif
4849receiveloop sock buf size = do
4950#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
5152#else
5253 bytes <- c_recv sock buf size 0
5354#endif
warp/Network/Wai/Handler/Warp/Run.hs+7−18
@@ -23,7 +23,7 @@ import Data.Conduit.Network (bindPort)
2323#define bindPortTCP bindPort
2424#endif
2525import Network (sClose, Socket)
26−import Network.Socket (accept, SockAddr)
26+import Network.Socket (accept, withSocketsDo, SockAddr)
2727import qualified Network.Socket.ByteString as Sock
2828import Network.Wai
2929import qualified Network.Wai.Handler.Warp.Date as D
@@ -40,9 +40,7 @@ import Network.Wai.Handler.Warp.Types
4040import Data.IORef (IORef, newIORef, readIORef, writeIORef)
4141
4242#if WINDOWS
43−import qualified Control.Concurrent.MVar as MV
44−import Network.Socket (withSocketsDo)
45−import Control.Concurrent (forkIO)
43+import Network.Wai.Handler.Warp.Windows
4644#else
4745import System.Posix.IO (FdOption(CloseOnExec), setFdOption)
4846import Network.Socket (fdSocket)
@@ -77,26 +75,13 @@ run p = runSettings defaultSettings { settingsPort = p }
7775
7876-- | Run an 'Application' with the given 'Settings'.
7977runSettings :: Settings -> Application -> IO ()
80−#if WINDOWS
81−runSettings set app = withSocketsDo $ do
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 =
78+runSettings set app = withSocketsDo $
9379 bracket
9480 (bindPortTCP (settingsPort set) (settingsHost set))
9581 sClose
9682 (\socket -> do
9783 setSocketCloseOnExec socket
9884 runSettingsSocket set socket app)
99−#endif
10085
10186-- | Same as 'runSettings', but uses a user-supplied socket instead of opening
10287-- one. This allows the user to provide, for example, Unix named socket, which
@@ -109,7 +94,11 @@ runSettingsSocket set socket app =
10994 runSettingsConnection set getConn app
11095 where
11196 getConn = do
97+#if WINDOWS
98+ (s, sa) <- windowsThreadBlockHack $ accept socket
99+#else
112100 (s, sa) <- accept socket
101+#endif
113102 setSocketCloseOnExec s
114103 conn <- socketConnection s
115104 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
8181 Network.Wai.Handler.Warp.Settings
8282 Network.Wai.Handler.Warp.Thread
8383 Network.Wai.Handler.Warp.Types
84+ Network.Wai.Handler.Warp.Windows
8485 Paths_warp
8586 Ghc-Options: -Wall
8687