snap-server 0.6.0.1 → 0.7
raw patch · 7 files changed
+92/−30 lines, 7 filesdep ~attoparsecdep ~attoparsec-enumeratordep ~case-insensitive
Dependency ranges changed: attoparsec, attoparsec-enumerator, case-insensitive, snap-core, time
Files
- snap-server.cabal +11/−11
- src/Snap/Internal/Http/Parser.hs +1/−1
- src/Snap/Internal/Http/Server.hs +13/−2
- src/Snap/Internal/Http/Server/SimpleBackend.hs +16/−1
- src/System/SendFile/Darwin.hsc +9/−1
- test/snap-server-testsuite.cabal +14/−14
- test/suite/Snap/Internal/Http/Server/Tests.hs +28/−0
snap-server.cabal view
@@ -1,5 +1,5 @@ name: snap-server-version: 0.6.0.1+version: 0.7 synopsis: A fast, iteratee-based, epoll-enabled web server for the Snap Framework description: Snap is a simple and fast web development framework and server written in@@ -27,7 +27,7 @@ build-type: Simple cabal-version: >= 1.6 homepage: http://snapframework.com/-category: Web+category: Web, Snap extra-source-files: CONTRIBUTORS,@@ -100,28 +100,28 @@ build-depends: array >= 0.2 && <0.4,- attoparsec >= 0.8.1 && < 0.10,- attoparsec-enumerator >= 0.2.0.1 && < 0.3,+ attoparsec >= 0.10 && < 0.11,+ attoparsec-enumerator >= 0.3 && < 0.4, base >= 4 && < 5, binary >= 0.5 && < 0.6, blaze-builder >= 0.2.1.4 && < 0.4, blaze-builder-enumerator >= 0.2.0 && < 0.3,- bytestring >= 0.9.1 && < 0.10,+ bytestring >= 0.9.1 && < 0.10, bytestring-nums,- case-insensitive >= 0.3 && < 0.4,- containers >= 0.3 && < 0.5,- directory-tree >= 0.10 && < 0.11,+ case-insensitive >= 0.3 && < 0.5,+ containers >= 0.3 && < 0.5,+ directory-tree >= 0.10 && < 0.11, enumerator >= 0.4.13.1 && < 0.5,- filepath >= 1.1 && < 1.3,+ filepath >= 1.1 && < 1.3, MonadCatchIO-transformers >= 0.2.1 && < 0.3, mtl >= 2 && < 3, murmur-hash >= 0.1 && < 0.2, network >= 2.3 && < 2.4, old-locale,- snap-core >= 0.6 && < 0.7,+ snap-core >= 0.7 && < 0.8, template-haskell >= 2.2 && < 2.7, text >= 0.11 && < 0.12,- time >= 1.0 && < 1.4,+ time >= 1.0 && < 1.5, transformers >= 0.2 && < 0.3, unix-compat >= 0.2 && < 0.4, vector >= 0.7 && < 0.10,
src/Snap/Internal/Http/Parser.hs view
@@ -21,7 +21,7 @@ import Control.Exception import Control.Monad (liftM) import Control.Monad.Trans-import Data.Attoparsec hiding (many, Result(..))+import Data.Attoparsec import Data.Attoparsec.Enumerator import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S
src/Snap/Internal/Http/Server.hs view
@@ -18,6 +18,7 @@ , finally , Handler )+import qualified Control.Monad.CatchIO as CatchIO import Control.Monad.State.Strict import Control.Exception hiding (catch, throw) import Data.Char@@ -45,6 +46,7 @@ import System.Locale ------------------------------------------------------------------------------ import System.FastLogger (timestampedLogEntry, combinedLogEntry)+import Snap.Core (EscapeHttpException (..)) import Snap.Internal.Http.Types import Snap.Internal.Debug import Snap.Internal.Http.Parser@@ -371,8 +373,11 @@ logerr <- gets _logError - (req',rspOrig) <- (lift $ handler logerr tickle req) `catch`- errCatch "user hander" req+ (req',rspOrig) <- (lift $ handler logerr tickle req)+ `CatchIO.catches`+ [ CatchIO.Handler $ escapeHttpCatch+ , CatchIO.Handler $ errCatch "user handler" req+ ] debug $ "Server.httpSession: finished running user handler" @@ -430,6 +435,12 @@ return () where+ escapeHttpCatch :: EscapeHttpException -> ServerMonad a+ escapeHttpCatch (EscapeHttpException escapeIter) = do+ lift $ escapeIter tickle writeEnd'+ throw ExceptionAlreadyCaught++ errCatch :: ByteString -> Request -> SomeException -> ServerMonad a errCatch phase req e = do logError $ toByteString $ mconcat [ fromByteString "httpSession caught an exception during "
src/Snap/Internal/Http/Server/SimpleBackend.hs view
@@ -107,14 +107,29 @@ acceptThread defaultTimeout handler tmgr elog cpu sock exitMVar = loop `finally` (tryPutMVar exitMVar () >> return ()) where- loop = do+ acceptAndFork = do debug $ "acceptThread: calling accept() on socket " ++ show sock (s,addr) <- accept $ Listen.listenSocket sock debug $ "acceptThread: accepted connection from remote: " ++ show addr _ <- forkOnIO cpu (go s addr `catches` cleanup)+ return ()++ loop = do+ acceptAndFork `catches` acceptHandler loop go = runSession defaultTimeout handler tmgr sock++ acceptHandler = + [ Handler $ \(e :: AsyncException) -> throwIO e+ , Handler $ \(e :: SomeException) -> do+ elog $ S.concat [ "SimpleBackend.acceptThread: accept threw: "+ , S.pack . map c2w $ show e ]+ -- we're out of file descriptors, and it isn't likely to get+ -- better immediately; sleep for 10ms to avoid spamming the error+ -- log.+ threadDelay $ 10000+ ] cleanup = [
src/System/SendFile/Darwin.hsc view
@@ -1,14 +1,22 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE CPP, ForeignFunctionInterface #-} -- | Darwin system-dependent code for 'sendfile'. module System.SendFile.Darwin (sendFile) where import Data.Int import Foreign.C.Error (eAGAIN, eINTR, getErrno, throwErrno)+#if __GLASGOW_HASKELL__ >= 703+import Foreign.C.Types (CInt(CInt))+#else import Foreign.C.Types (CInt)+#endif import Foreign.Marshal (alloca) import Foreign.Ptr (Ptr, nullPtr) import Foreign.Storable (peek, poke)+#if __GLASGOW_HASKELL__ >= 703+import System.Posix.Types (Fd(Fd), COff(COff))+#else import System.Posix.Types (Fd, COff)+#endif sendFile :: IO () -> Fd -> Fd -> Int64 -> Int64 -> IO Int64 sendFile onBlock out_fd in_fd off count
test/snap-server-testsuite.cabal view
@@ -23,8 +23,8 @@ build-depends: QuickCheck >= 2, array >= 0.3 && <0.4,- attoparsec >= 0.8.1 && < 0.10,- attoparsec-enumerator >= 0.2.0.1 && < 0.3,+ attoparsec >= 0.10 && < 0.11,+ attoparsec-enumerator >= 0.3 && < 0.4, base >= 4 && < 5, base16-bytestring == 0.1.*, binary >= 0.5 && < 0.6,@@ -37,7 +37,7 @@ directory-tree, enumerator >= 0.4.13.1 && <0.5, filepath,- http-enumerator >= 0.7 && <0.8,+ http-enumerator >= 0.7.1.6 && <0.8, HUnit >= 1.2 && < 2, mtl >= 2 && <3, murmur-hash >= 0.1 && < 0.2,@@ -45,14 +45,14 @@ old-locale, parallel > 2, process,- snap-core >= 0.6 && < 0.7,+ snap-core >= 0.7 && < 0.8, template-haskell, test-framework >= 0.4 && < 0.5, test-framework-hunit >= 0.2.5 && < 0.3, test-framework-quickcheck2 >= 0.2.6 && < 0.3, text >= 0.11 && <0.12, time,- tls >= 0.7.1 && <0.9,+ tls >= 0.8.2 && <0.9, transformers, vector >= 0.7 && <0.10, vector-algorithms >= 0.4 && <0.6,@@ -99,8 +99,8 @@ build-depends: QuickCheck >= 2, array >= 0.3 && <0.4,- attoparsec >= 0.8.1 && < 0.10,- attoparsec-enumerator >= 0.2.0.1 && < 0.3,+ attoparsec >= 0.10 && < 0.11,+ attoparsec-enumerator >= 0.3 && < 0.4, base >= 4 && < 5, base16-bytestring == 0.1.*, blaze-builder >= 0.2.1.4 && <0.4,@@ -119,7 +119,7 @@ parallel > 2, MonadCatchIO-transformers >= 0.2.1 && < 0.3, network == 2.3.*,- snap-core >= 0.6 && < 0.7,+ snap-core >= 0.7 && < 0.8, template-haskell, time, transformers,@@ -175,15 +175,15 @@ build-depends: QuickCheck >= 2, array >= 0.3 && <0.4,- attoparsec >= 0.8.1 && < 0.10,- attoparsec-enumerator >= 0.2.0.1 && < 0.3,+ attoparsec >= 0.10 && < 0.11,+ attoparsec-enumerator >= 0.3 && < 0.4, base >= 4 && < 5, binary >= 0.5 && < 0.6, blaze-builder >= 0.2.1.4 && <0.4, blaze-builder-enumerator >= 0.2.0 && <0.3, bytestring, bytestring-nums >= 0.3.1 && < 0.4,- case-insensitive >= 0.3 && < 0.4,+ case-insensitive >= 0.3 && < 0.5, containers, directory-tree, enumerator >= 0.4.7 && <0.5,@@ -195,7 +195,7 @@ network == 2.3.*, old-locale, parallel > 2,- snap-core >= 0.6 && < 0.7,+ snap-core >= 0.7 && < 0.8, template-haskell, test-framework >= 0.4 && < 0.5, test-framework-hunit >= 0.2.5 && < 0.3,@@ -239,6 +239,6 @@ build-depends: base >= 4 && < 5, network == 2.3.*,- http-enumerator >= 0.7 && <0.8,- tls >= 0.7.1 && <0.9,+ http-enumerator >= 0.7.1.6 && <0.8,+ tls >= 0.8.2 && <0.9, criterion >= 0.5 && <0.6
test/suite/Snap/Internal/Http/Server/Tests.hs view
@@ -27,6 +27,8 @@ import Data.ByteString.Internal (c2w) import qualified Data.CaseInsensitive as CI import Data.Char+import qualified Data.Enumerator as E+import qualified Data.Enumerator.List as EL import Data.Int import Data.IORef import Data.List (foldl', sort)@@ -75,6 +77,7 @@ , testHttp2 , testHttp100 , test411+ , testEscapeHttp , testExpectGarbage , testPartialParse , testMethodParsing@@ -846,6 +849,31 @@ assertBool "411 Length Required" ok ++testEscapeHttp :: Test+testEscapeHttp = testCase "server/escapeHttp" $ do+ ref <- newIORef ""+ let (iter,onSendFile) = mkIter ref++ runHTTP 60+ Nothing+ Nothing+ escapeServer+ "localhost"+ (SessionInfo "127.0.0.1" 80 "127.0.0.1" 58384 False)+ (enumBS sampleRequest)+ iter+ onSendFile+ (const $ return ())++ s <- readIORef ref++ assertEqual "escapeHttp" "0123456789" s+ where+ -- Escape HTTP traffic. Read one ByteString and send it back.+ escapeServer = runSnap $ escapeHttp $ \_ sendIter -> do+ Just bs <- EL.head+ liftIO $ E.run_ $ E.enumList 1 [bs] $$ sendIter testExpectGarbage :: Test