Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

HTTP-version related improvements & cleanups #133

Open
wants to merge 4 commits into
base: master
Choose a base branch
from
Open

HTTP-version related improvements & cleanups #133

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
97f33f5
Reject HTTP-versions not conforming to RFC 7230
hvr May 31, 2020
0d63e12
Send back a code 400 bad-request response on parsing failures
hvr May 31, 2020
6c5ce64
Reject too new HTTP versions requests with 505-response
hvr May 31, 2020
962ea07
Treat HTTP versions >= 1.1 more appropriately
hvr May 31, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion snap-server.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -99,7 +99,7 @@ Library
attoparsec >= 0.12 && < 0.14,
base >= 4.6 && < 4.15,
blaze-builder >= 0.4 && < 0.5,
bytestring >= 0.9.1 && < 0.11,
bytestring >= 0.10 && < 0.11,
bytestring-builder >= 0.10.4 && < 0.11,
case-insensitive >= 1.1 && < 1.3,
clock >= 0.7.1 && < 0.9,
Expand Down
43 changes: 32 additions & 11 deletions src/Snap/Internal/Http/Server/Parser.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,7 @@ import qualified System.IO.Streams as Streams
import System.IO.Streams.Attoparsec (parseFromStream)
------------------------------------------------------------------------------
import Snap.Internal.Http.Types (Method (..))
import Snap.Internal.Parsing (crlf, parseCookie, parseUrlEncoded, unsafeFromNat)
import Snap.Internal.Parsing (crlf, parseCookie, parseUrlEncoded)
import Snap.Types.Headers (Headers)
import qualified Snap.Types.Headers as H

Expand Down Expand Up @@ -148,13 +148,17 @@ instance Exception HttpParseException
{-# INLINE parseRequest #-}
parseRequest :: InputStream ByteString -> IO IRequest
parseRequest input = do
-- RFC 7230 section 3.1.1 defines the first line of a request as
--
-- request-line = method SP request-target SP HTTP-version CRLF
--
line <- pLine input
let (!mStr, !s) = bSp line
let (!uri, !vStr) = bSp s
let method = methodFromString mStr
let !version = pVer vStr
let (host, uri') = getHost uri
let uri'' = if S.null uri' then "/" else uri'
!version <- pVer vStr

stdHdrs <- newMStandardHeaders
MV.unsafeWrite stdHdrs hostTag host
Expand All @@ -173,18 +177,35 @@ parseRequest input = do
in (Just $! host, uri)
| otherwise = (Nothing, s)

pVer s = if "HTTP/" `S.isPrefixOf` s
then pVers (S.unsafeDrop 5 s)
else (1, 0)
-- RFC 7230 section 2.6 defines
--
-- HTTP-version = HTTP-name "/" DIGIT "." DIGIT
-- HTTP-name = %x48.54.54.50 ; "HTTP", case-sensitive
--
pVer s = case bsStripHttpPrefix s of
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This code is in the core accept loop and so we can't tolerate code that's significantly slower here. E.g. bsStripHttpPrefix can't return Maybe because that's an extra allocation you can't afford; instead you would need to return null string as your empty case.

Nothing -> return (1, 0)
Just "1.1" -> return (1, 1)
Just "1.0" -> return (1, 0)
Just vstr
| [mjs,'.',mns] <- S.unpack vstr
, Just mj <- digitToInt mjs
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Same here with calling digitToInt. We are more okay with a misparse returning version '0.0' than we are with adding another x bytes of allocation overhead to this function

Copy link
Member Author

@hvr hvr Sep 7, 2020 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

even if this is the unhappy path, which would only occur for "bad" clients? NB: in the cases above I've made sure to handle the happy path with lowest overhead by direct matching w/o any dynamic allocations.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

e.g. bsStripHttpPrefix that returns a Maybe - that's in the hot path, so we'd prefer to return ByteString there to save three words and a pointer indirection. Null string is as good as Nothing there. caseing on the resulting bytestrings using string equality in the hot path is probably faster than splitting on . like I was doing before, though.

, Just mn <- digitToInt mns -> return (mj,mn)
| otherwise -> throwIO $
HttpParseException "parse error: invalid HTTP-version in request-line"

-- NB: 'stripPrefix' operation is available in bytestring-0.10.8 and later
bsStripHttpPrefix s
| "HTTP/" `S.isPrefixOf` s = Just $! S.unsafeDrop 5 s
| otherwise = Nothing

digitToInt c
| n >= 0, n <= 9 = Just n
| otherwise = Nothing
where
n = fromEnum c - 0x30

bSp = splitCh ' '

pVers s = (c, d)
where
(!a, !b) = splitCh '.' s
!c = unsafeFromNat a
!d = unsafeFromNat b


------------------------------------------------------------------------------
pLine :: InputStream ByteString -> IO ByteString
Expand Down
52 changes: 46 additions & 6 deletions src/Snap/Internal/Http/Server/Session.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ module Snap.Internal.Http.Server.Session
, snapToServerHandler
, BadRequestException(..)
, LengthRequiredException(..)
, HTTPVersionNotSupportedException(..)
, TerminateSessionException(..)
) where

Expand Down Expand Up @@ -64,7 +65,7 @@ import Snap.Internal.Core (fixupResponse)
import Snap.Internal.Http.Server.Clock (getClockTime)
import Snap.Internal.Http.Server.Common (eatException)
import Snap.Internal.Http.Server.Date (getDateString)
import Snap.Internal.Http.Server.Parser (IRequest (..), getStdConnection, getStdContentLength, getStdContentType, getStdCookie, getStdHost, getStdTransferEncoding, parseCookie, parseRequest, parseUrlEncoded, readChunkedTransferEncoding, writeChunkedTransferEncoding)
import Snap.Internal.Http.Server.Parser (IRequest (..), HttpParseException(..), getStdConnection, getStdContentLength, getStdContentType, getStdCookie, getStdHost, getStdTransferEncoding, parseCookie, parseRequest, parseUrlEncoded, readChunkedTransferEncoding, writeChunkedTransferEncoding)
import Snap.Internal.Http.Server.Thread (SnapThread)
import qualified Snap.Internal.Http.Server.Thread as Thread
import Snap.Internal.Http.Server.TimeoutManager (TimeoutManager)
Expand All @@ -90,6 +91,9 @@ data LengthRequiredException = LengthRequiredException
deriving (Typeable, Show)
instance Exception LengthRequiredException

data HTTPVersionNotSupportedException = HTTPVersionNotSupportedException
deriving (Typeable, Show)
instance Exception HTTPVersionNotSupportedException

------------------------------------------------------------------------------
snapToServerHandler :: Snap a -> ServerHandler hookState
Expand Down Expand Up @@ -300,12 +304,36 @@ httpSession !buffer !serverHandler !config !sessionData = loop
receiveRequest :: IO Request
receiveRequest = {-# SCC "httpSession/receiveRequest" #-} do
readEnd' <- Streams.throwIfProducesMoreThan mAX_HEADERS_SIZE readEnd
parseRequest readEnd' >>= toRequest
(parseRequest readEnd' `E.catch` parseErrHandler) >>= toRequest
where
parseErrHandler (HttpParseException emsg) = do
let msg = mconcat
[ byteString "HTTP/1.1 400 Bad Request\r\n\r\n"
, byteString (S.pack emsg)
, byteString "\r\n"
, flush
]
writeEndB <- mkBuffer
Streams.write (Just msg) writeEndB
Streams.write Nothing writeEndB
terminateSession BadRequestException
{-# INLINE receiveRequest #-}

--------------------------------------------------------------------------
toRequest :: IRequest -> IO Request
toRequest !ireq = {-# SCC "httpSession/toRequest" #-} do
-- RFC 7230 section 2.6: "A server can send a 505 (HTTP
-- Version Not Supported) response if it wishes, for any
-- reason, to refuse service of the client's major protocol
-- version."
--
-- Since HTTP/2 has been released, we *know* that a major
-- version larger than 1 is definitely not supported by
-- snap-server currently and so it's reasonable to reject such
-- doomed to fail requests with the appropriate 505 response
-- code early on.
when (fst version >= 2) return505
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This part is fine and we can do it without modifying the parsing code. If you want you can reject fst version /= 1 because we don't support HTTP 0.x either :)


-- HTTP spec section 14.23: "All Internet-based HTTP/1.1 servers MUST
-- respond with a 400 (Bad Request) status code to any HTTP/1.1 request
-- message which lacks a Host header field."
Expand Down Expand Up @@ -427,6 +455,18 @@ httpSession !buffer !serverHandler !config !sessionData = loop
Streams.write Nothing writeEndB
terminateSession LengthRequiredException

----------------------------------------------------------------------
return505 = do
let resp = mconcat
[ byteString "HTTP/1.1 505 HTTP Version Not Supported\r\n\r\n"
, byteString "HTTP version >= 2 not supported\r\n"
, flush
]
writeEndB <- mkBuffer
Streams.write (Just resp) writeEndB
Streams.write Nothing writeEndB
terminateSession HTTPVersionNotSupportedException

----------------------------------------------------------------------
parseForm readEnd' = if hasForm
then getForm
Expand Down Expand Up @@ -455,7 +495,7 @@ httpSession !buffer !serverHandler !config !sessionData = loop
-- For HTTP/1.0: if there is no explicit Connection: Keep-Alive,
-- close the socket later.
let v = CI.mk <$> connection
when ((version == (1, 1) && v == Just "close") ||
when ((version >= (1, 1) && v == Just "close") ||
(version == (1, 0) && v /= Just "keep-alive")) $
writeIORef forceConnectionClose True

Expand Down Expand Up @@ -619,7 +659,7 @@ httpSession !buffer !serverHandler !config !sessionData = loop
-> ResponseBody
-> (Headers, ResponseBody, Bool)
noCL req hdrs body =
if v == (1,1)
if v >= (1,1)
then let origBody = rspBodyToEnum body
body' = \os -> do
os' <- writeChunkedTransferEncoding os
Expand Down Expand Up @@ -698,7 +738,7 @@ httpSession !buffer !serverHandler !config !sessionData = loop
mkHeaderLine :: HttpVersion -> Response -> FixedPrim ()
mkHeaderLine outVer r =
case outCode of
200 | outVer == (1, 1) ->
200 | outVer >= (1, 1) ->
-- typo in bytestring here
fixedPrim 17 $ const (void . cpBS "HTTP/1.1 200 OK\r\n")
200 | otherwise ->
Expand All @@ -707,7 +747,7 @@ mkHeaderLine outVer r =
where
outCode = rspStatus r

v = if outVer == (1,1) then "HTTP/1.1 " else "HTTP/1.0 "
v = if outVer >= (1,1) then "HTTP/1.1 " else "HTTP/1.0 "

outCodeStr = S.pack $ show outCode
space !op = do
Expand Down