on master help sign in
Made receiveloop function interruptible on Windows.
commit830df1ff00ed54596c9bbf70645bf63d9c7746b7 authorAnton Dessiatov <anton.dessiatov@gmail.com> dateMon 28 Apr 2014, 16:06 (12 years ago) parentb829a9e
4 files changed+28−15
warp/Network/Wai/Handler/Warp/Recv.hs+2−1 warp/Network/Wai/Handler/Warp/Run.hs+1−14 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+1−14
@@ -40,8 +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 Control.Concurrent (forkIO)
43+import Network.Wai.Handler.Warp.Windows
4544#else
4645import System.Posix.IO (FdOption(CloseOnExec), setFdOption)
4746import Network.Socket (fdSocket)
@@ -84,18 +83,6 @@ runSettings set app = withSocketsDo $
8483 setSocketCloseOnExec socket
8584 runSettingsSocket set socket app)
8685
87−#if WINDOWS
88−windowsThreadBlockHack :: IO a -> IO a
89−windowsThreadBlockHack act =
90− do
91− var <- MV.newEmptyMVar :: IO (MV.MVar (Either SomeException a))
92− void . forkIO $ E.try act >>= MV.putMVar var
93− res <- MV.takeMVar var
94− case res of
95− Left e -> throwIO e
96− Right r -> return r
97−#endif
98−
9986-- | Same as 'runSettings', but uses a user-supplied socket instead of opening
10087-- one. This allows the user to provide, for example, Unix named socket, which
10188-- can be used when reverse HTTP proxying into your application.
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