This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap-server".
The branch, master has been updated
via 36ebac9a80bc99ef265c294c88b12bc7e2c75939 (commit)
from f49a6947b18dc265ce508247f3a9f58bafed7488 (commit)
Summary of changes:
snap-server.cabal | 5 +++--
src/Snap/Http/Server.hs | 7 +++++++
src/Snap/Internal/Http/Server.hs | 8 +++++++-
src/Snap/Internal/Http/Server/SimpleBackend.hs | 19 ++++++++++++++++---
4 files changed, 33 insertions(+), 6 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 36ebac9a80bc99ef265c294c88b12bc7e2c75939
Author: Gregory Collins <[email protected]>
Date: Tue May 25 21:41:04 2010 -0400
Export snap-server version string
diff --git a/snap-server.cabal b/snap-server.cabal
index b0ad452..4dafb23 100644
--- a/snap-server.cabal
+++ b/snap-server.cabal
@@ -74,7 +74,7 @@ Flag libev
Library
- hs-source-dirs: src
+ hs-source-dirs: dist/build/autogen, src
exposed-modules:
Snap.Http.Server,
@@ -82,8 +82,9 @@ Library
System.FastLogger
other-modules:
+ Paths_snap_server,
Snap.Internal.Http.Parser,
- Snap.Internal.Http.Server,
+ Snap.Internal.Http.Server,
Snap.Internal.Http.Server.Date
build-depends:
diff --git a/src/Snap/Http/Server.hs b/src/Snap/Http/Server.hs
index 5612fa6..bab1a2d 100644
--- a/src/Snap/Http/Server.hs
+++ b/src/Snap/Http/Server.hs
@@ -5,6 +5,7 @@
module Snap.Http.Server
(
httpServe
+, snapServerVersion
) where
import Data.ByteString (ByteString)
@@ -12,6 +13,12 @@ import Snap.Types
import qualified Snap.Internal.Http.Server as Int
+------------------------------------------------------------------------------
+snapServerVersion :: ByteString
+snapServerVersion = Int.snapServerVersion
+
+
+------------------------------------------------------------------------------
-- | Starts serving HTTP requests on the given port using the given handler.
-- This function never returns; to shut down the HTTP server, kill the
-- controlling thread.
diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs
index 128394d..215d120 100644
--- a/src/Snap/Internal/Http/Server.hs
+++ b/src/Snap/Internal/Http/Server.hs
@@ -14,6 +14,7 @@ import Data.Char
import Data.CIByteString
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as SC
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Nums.Careless.Int as Cvt
@@ -22,6 +23,7 @@ import Data.List (foldl')
import qualified Data.Map as Map
import Data.Maybe (fromJust, catMaybes, fromMaybe)
import Data.Monoid
+import Data.Version
import GHC.Conc
import Prelude hiding (catch, show, Show)
import qualified Prelude
@@ -44,6 +46,8 @@ import Snap.Internal.Http.Server.SimpleBackend
(debug)
import Snap.Internal.Http.Server.Date
+import qualified Paths_snap_server as V
+
------------------------------------------------------------------------------
-- | The handler has to return the request object because we have to clear the
-- HTTP request body before we send the response. If the handler consumes the
@@ -269,8 +273,10 @@ runHTTP lh lip lp rip rp alog elog
------------------------------------------------------------------------------
sERVER_HEADER :: [ByteString]
-sERVER_HEADER = ["Snap/0.pre-1"]
+sERVER_HEADER = [S.concat ["Snap/", snapServerVersion]]
+snapServerVersion :: ByteString
+snapServerVersion = SC.pack $ showVersion $ V.version
------------------------------------------------------------------------------
logAccess :: Request -> Response -> ServerMonad ()
diff --git a/src/Snap/Internal/Http/Server/SimpleBackend.hs
b/src/Snap/Internal/Http/Server/SimpleBackend.hs
index 1d71c3d..40599df 100644
--- a/src/Snap/Internal/Http/Server/SimpleBackend.hs
+++ b/src/Snap/Internal/Http/Server/SimpleBackend.hs
@@ -28,11 +28,13 @@ module Snap.Internal.Http.Server.SimpleBackend
------------------------------------------------------------------------------
import Control.Concurrent
import Control.Exception
+import Control.Monad (when)
import Control.Monad.Trans
import Data.ByteString (ByteString)
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString as B
import Data.Iteratee.WrappedByteString
+import Data.Maybe (isNothing)
import Data.Typeable
import Foreign hiding (new)
import GHC.Conc (labelThread, forkOnIO)
@@ -40,6 +42,7 @@ import Network.Socket
import qualified Network.Socket.ByteString as SB
import qualified Network.Socket.SendFile as SF
import Prelude hiding (catch)
+import System.Timeout (timeout)
------------------------------------------------------------------------------
import Snap.Internal.Debug
import Snap.Iteratee
@@ -200,20 +203,30 @@ instance Show TimeoutException where
instance Exception TimeoutException
--- FIXME placeholder
+
tickleTimeout :: Connection -> IO ()
tickleTimeout = const $ return ()
+-- FIXME: fixed 30 seconds
+dEFAULT_TIMEOUT :: Int
+dEFAULT_TIMEOUT = 30000000
+
timeoutRecv :: Connection -> Int -> IO ByteString
timeoutRecv conn n = do
let sock = _socket conn
- SB.recv sock n
+ m <- timeout dEFAULT_TIMEOUT $ SB.recv sock n
+
+ maybe (throwIO TimeoutException)
+ return
+ m
+
timeoutSend :: Connection -> ByteString -> IO ()
timeoutSend conn s = do
let sock = _socket conn
- SB.sendAll sock s
+ m <- timeout dEFAULT_TIMEOUT $ SB.sendAll sock s
+ when (isNothing m) $ throwIO TimeoutException
bLOCKSIZE :: Int
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
