happstack-server 7.3.6 → 7.3.7

raw patch · 3 files changed

+26/−20 lines, 3 filesdep −network-bytestringdep ~networkPVP ok

version bump matches the API change (PVP)

Dependencies removed: network-bytestring

Dependency ranges changed: network

API changes (from Hackage documentation)

Files

• happstack-server.cabal +2/−10
• src/Happstack/Server/Internal/Listen.hs +10/−10
• src/Happstack/Server/Internal/TimeoutManager.hs +14/−0

@@ -1,5 +1,5 @@ Name:                happstack-server-Version:             7.3.6+Version:             7.3.7 Synopsis:            Web related tools and services. Description:         Happstack Server provides an HTTP server and a rich set of functions for routing requests, handling query parameters, generating responses, working with cookies, serving files, and more. For in-depth documentation see the Happstack Crash Course <http://happstack.com/docs/crashcourse/index.html> License:             BSD3@@ -17,10 +17,6 @@     subdir:   happstack-server     location: http://hub.darcs.net/stepcut/happstack -Flag network_2_2_3-    Description: Choose newer network library with merged in network-bytestring.-    Default: True- Flag template_haskell     Description: Template Haskell is available on this system     Default: True@@ -80,6 +76,7 @@                        html,                        monad-control >= 0.3 && < 0.4,                        mtl >= 2 && < 2.3,+                       network >= 2.2.3 && < 2.6,                        old-locale,                        parsec < 4,                        process,@@ -95,11 +92,6 @@                        utf8-string >= 0.3.4 && < 0.4,                        xhtml,                        zlib--  if flag(network_2_2_3)-    Build-Depends:     network >= 2.2.3-  else-    Build-Depends:     network < 2.2.3, network-bytestring    if (flag(template_haskell) && !(arch(arm)))     Build-Depends:     template-haskell

@@ -4,15 +4,15 @@ import Happstack.Server.Internal.Types          (Conf(..), Request, Response) import Happstack.Server.Internal.Handler        (request) import Happstack.Server.Internal.Socket         (acceptLite)-import Happstack.Server.Internal.TimeoutManager (cancel, initialize, register)+import Happstack.Server.Internal.TimeoutManager (cancel, initialize, register, forceTimeoutAll) import Happstack.Server.Internal.TimeoutSocket  as TS import qualified Control.Concurrent.Thread.Group as TG import Control.Exception.Extensible             as E import Control.Concurrent                       (forkIO, killThread, myThreadId) import Control.Monad import Network.BSD                              (getProtocolNumber)-import Network                                  (sClose, Socket)-import Network.Socket as Socket (SocketOption(KeepAlive), setSocketOption,+import Network                                  (Socket)+import Network.Socket as Socket (SocketOption(KeepAlive), close, setSocketOption,                                  socket, Family(..), SockAddr,                                  SocketOption(..), SockAddr(..),                                  iNADDR_ANY, maxListenQueue, SocketType(..),@@ -42,7 +42,7 @@     proto <- getProtocolNumber "tcp"     E.bracketOnError         (socket AF_INET Stream proto)-        (sClose)+        (close)         (\sock -> do             setSocketOption sock ReuseAddr 1             bindSocket sock (SockAddrInet (fromIntegral portm) iNADDR_ANY)@@ -58,7 +58,7 @@     hostAddr <- Socket.inet_addr ip     E.bracketOnError         (socket AF_INET Stream proto)-        (sClose)+        (close)         (\sock -> do             setSocketOption sock ReuseAddr 1             bindSocket sock (SockAddrInet (fromIntegral portm) hostAddr)@@ -70,9 +70,9 @@ listen :: Conf -> (Request -> IO Response) -> IO () listen conf hand = do     let port' = port conf-    socketm <- listenOn port'-    setSocketOption socketm KeepAlive 1-    listen' socketm conf hand+    lsocket <- listenOn port'+    setSocketOption lsocket KeepAlive 1+    listen' lsocket conf hand  -- | Use a previously bind port and listen listen' :: Socket -> Conf -> (Request -> IO Response) -> IO ()@@ -99,14 +99,14 @@              request timeoutIO (logAccess conf) (hn,fromIntegral p) hand `E.catch` eh              -- remove thread from timeout table              cancel thandle-             sClose sock+             close sock       loop = forever $ do w <- acceptLite s                           fork $ work w       pe e = log' ERROR ("ERROR in http accept thread: " ++ show e)       infi :: IO ()       infi = loop `catchSome` pe >> infi -  infi `finally` (sClose s)+  infi `finally` (close s >> forceTimeoutAll tm)  {-- #ifndef mingw32_HOST_OS

@@ -8,6 +8,8 @@     , pause     , resume     , cancel+    , forceTimeout+    , forceTimeoutAll     ) where  import qualified Data.IORef as I@@ -68,3 +70,15 @@ cancel (Handle action iactive) =     do I.writeIORef iactive $! Canceled        I.writeIORef action $! (return ())++forceTimeout :: Handle -> IO ()+forceTimeout (Handle action iactive) =+  do I.writeIORef iactive $! Canceled+     io <- I.atomicModifyIORef action (\io -> (return (), io))+     io `E.catch` ignoreAll++-- | terminate all threads immediately+forceTimeoutAll :: Manager -> IO ()+forceTimeoutAll (Manager ref) =+  do hs <- I.atomicModifyIORef ref (\hs -> ([], hs))+     mapM_ forceTimeout hs