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 1858e139da23f034e4005eba5d68c9852092a796 (commit)
via 675b514840875d9ef7fcb3e617cae5e3302385be (commit)
from ef83a1387878f0408e21ebbbfd8f04a68fcb507d (commit)
Summary of changes:
src/Snap/Internal/Http/Parser.hs | 24 +++++++++++++++++-------
src/Snap/Internal/Http/Server.hs | 2 ++
src/Snap/Internal/Http/Server/SimpleBackend.hs | 10 ++++++++++
3 files changed, 29 insertions(+), 7 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 1858e139da23f034e4005eba5d68c9852092a796
Author: Gregory Collins <[email protected]>
Date: Fri Apr 29 23:15:52 2011 +0200
Don't be so chatty-cathy about http parse errors
diff --git a/src/Snap/Internal/Http/Parser.hs b/src/Snap/Internal/Http/Parser.hs
index 4ac1ec6..be45bfa 100644
--- a/src/Snap/Internal/Http/Parser.hs
+++ b/src/Snap/Internal/Http/Parser.hs
@@ -1,11 +1,13 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
module Snap.Internal.Http.Parser
( IRequest(..)
+ , HttpParseException
, parseRequest
, readChunkedTransferEncoding
, iterParser
@@ -17,6 +19,7 @@ module Snap.Internal.Http.Parser
------------------------------------------------------------------------------
import Control.Arrow (second)
+import Control.Exception
import Control.Monad (liftM)
import Control.Monad.Trans
import Data.Attoparsec hiding (many, Result(..))
@@ -33,6 +36,7 @@ import Data.Int
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
+import Data.Typeable
import Prelude hiding (head, take, takeWhile)
----------------------------------------------------------------------------
import Snap.Internal.Http.Types
@@ -65,6 +69,10 @@ instance Show IRequest where
------------------------------------------------------------------------------
+data HttpParseException = HttpParseException String deriving (Typeable, Show)
+instance Exception HttpParseException
+
+------------------------------------------------------------------------------
parseRequest :: (Monad m) => Iteratee ByteString m (Maybe IRequest)
parseRequest = do
eof <- isEOF
@@ -101,7 +109,8 @@ parseRequest = do
pLine :: (Monad m) => Iteratee ByteString m ByteString
pLine = continue $ k S.empty
where
- k _ EOF = error "FIXME: parse error: expected line ending in crlf"
+ k _ EOF = throwError $
+ HttpParseException "parse error: expected line ending in crlf"
k !pre (Chunks xs) =
if S.null b
then continue $ k a
@@ -168,7 +177,8 @@ methodFromString "DELETE" = return DELETE
methodFromString "TRACE" = return TRACE
methodFromString "OPTIONS" = return OPTIONS
methodFromString "CONNECT" = return CONNECT
-methodFromString s = fail $ "Bad method '" ++ S.unpack s ++ "'"
+methodFromString s =
+ throwError $ HttpParseException $ "Bad method '" ++ S.unpack s ++ "'"
------------------------------------------------------------------------------
diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs
index 66ec994..51ff3a5 100644
--- a/src/Snap/Internal/Http/Server.hs
+++ b/src/Snap/Internal/Http/Server.hs
@@ -262,6 +262,8 @@ runHTTP defaultTimeout alog elog handler lh sinfo readEnd
writeEnd onSendFile
tickle =
go `catches` [ Handler $ \(_ :: TerminatedBeforeHandlerException) -> do
return ()
+ , Handler $ \(e :: HttpParseException) -> do
+ return ()
, Handler $ \(e :: AsyncException) -> do
throwIO e
, Handler $ \(e :: SomeException) ->
commit 675b514840875d9ef7fcb3e617cae5e3302385be
Author: Gregory Collins <[email protected]>
Date: Fri Apr 29 22:46:32 2011 +0200
Revert "Fix -fportable."
This reverts commit 44e84b0bab6cd681edb71b4d8e94c4249ef40b4e.
diff --git a/src/Snap/Internal/Http/Server/SimpleBackend.hs
b/src/Snap/Internal/Http/Server/SimpleBackend.hs
index 5546789..0175ada 100644
--- a/src/Snap/Internal/Http/Server/SimpleBackend.hs
+++ b/src/Snap/Internal/Http/Server/SimpleBackend.hs
@@ -278,8 +278,13 @@ enumerate port session sock = loop
(Error e) -> throwError e
fd = fdSocket sock
+#ifdef PORTABLE
+ timeoutRecv = Listen.recv port sock (threadWaitRead $
+ fromIntegral fd) session
+#else
timeoutRecv = Listen.recv port (threadWaitRead $
fromIntegral fd) session
+#endif
------------------------------------------------------------------------------
@@ -312,5 +317,10 @@ writeOut port session sock tickle = loop
loop
fd = fdSocket sock
+#ifdef PORTABLE
+ timeoutSend = Listen.send port sock tickle
+ (threadWaitWrite $ fromIntegral fd) session
+#else
timeoutSend = Listen.send port tickle
(threadWaitWrite $ fromIntegral fd) session
+#endif
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
