Hi,
Am Samstag, den 27.10.2012, 18:50 +0200 schrieb Joachim Breitner:
> Am Sonntag, den 28.10.2012, 00:14 +0900 schrieb YOSHINO Yoshihito:
> > On Sat, Oct 27, 2012 at 11:40 PM, Joachim Breitner <nomeata@debian.org> wrote:
> > > I see. Can you elaborate on the severity of the problem? Do such request
> > > headers occur in common situations, or is it just a theoretical problem?
> >
> > Actually I have stuck in a warp server receiving request from Japanese
> > mobile phones,
> > which send a header with no space between colon and value.
> >
> > >
> > > It seems that we’d have to backport these two patches:
> > > https://github.com/yesodweb/wai/commit/a827f54ac31e2c928144bb8bb5b92ca1249013c5
> > > https://github.com/yesodweb/wai/commit/dc4697c007beaf1846872744b83162e7c9406465
> > > or am I missing something?
> >
> > Looks ok.
>
> I checked, the patches apply cleanly against the version in unstable.
> Unfortunately, I cannot build it because
> libghc-blaze-builder-conduit-doc and libghc-network-conduit-doc are not
> installable in unstable any more.
>
> So basically now my worries have come true. Just the moment we broke
> stuff in unstable in a way that prevents us from uploading a single fix
> to testing via unstable an allegedly release critical bug comes up.
>
> I guess I’ll have to setup a wheezy chroot and see if I can build the
> package there.
Ok, the package builds in a wheezy chroot. Unfortunately, the ABI hash
changes¹, so it is not enough to just upload this package to unstable or
testing-proposed-updates.
@release-team: There is a reportedly grave bug with haskell-warp, and a
fix is available. Unfortunately, the route of updating testing via
unstable is broken, some uploads aimed for experimental have ended up in
unstable²
So how can we get the bugfix into wheezy (if you deem it important
enough to be fixed at this stage of the freeze – do you)?
Can we do binNMUs in testing? If yes, then I guess I could upload the
patched package (diff attached) to testing via t-p-u and once it is
there, schedule binNMUs for all depending packages. If not it would
require sourceful uploads of all depending packages, also via t-p-u
Ah, in this case, things are not so bad; haskell-warp is quite low in
the dependency tree. Packages that would require a binNMU or a souceful
no-change-upload are just:
libghc-warp-tls-dev
libghc-yesod-dev
libghc-yesod-default-dev
Thanks,
Joachim
¹ This could be considered a bug in GHC, but nothing to be fixed easily
and unfortunately also something that is not as bad for everyone else as
it is for us, it seems: http://hackage.haskell.org/trac/ghc/ticket/4012
² haskell-blaze-builder and haskell-network-conduit, to be precise. The
next time we’ll do a staging in experimental I’ll ask for an upload
block to avoid this. Human error just always needs to be accounted for.
--
Joachim "nomeata" Breitner
Debian Developer
nomeata@debian.org | ICQ# 74513189 | GPG-Keyid: 4743206C
JID: nomeata@joachim-breitner.de | http://people.debian.org/~nomeata
diff -Nru haskell-warp-1.2.1.1/debian/changelog haskell-warp-1.2.1.1/debian/changelog
--- haskell-warp-1.2.1.1/debian/changelog 2012-05-20 05:34:27.000000000 +0200
+++ haskell-warp-1.2.1.1/debian/changelog 2012-10-27 18:42:36.000000000 +0200
@@ -1,3 +1,11 @@
+haskell-warp (1.2.1.1-2) UNRELEASED; urgency=low
+
+ * Add backported patches spaces-in-http-version and spaces-in-request
+ Corresponding to dc4697c007beaf1846872744b83162e7c9406465 and
+ a827f54ac31e2c928144bb8bb5b92ca1249013c5 upstream, Closes: 691600
+
+ -- Joachim Breitner <nomeata@debian.org> Sat, 27 Oct 2012 18:41:41 +0200
+
haskell-warp (1.2.1.1-1) unstable; urgency=low
* New upstream version.
diff -Nru haskell-warp-1.2.1.1/debian/patches/series haskell-warp-1.2.1.1/debian/patches/series
--- haskell-warp-1.2.1.1/debian/patches/series 1970-01-01 01:00:00.000000000 +0100
+++ haskell-warp-1.2.1.1/debian/patches/series 2012-10-27 18:45:01.000000000 +0200
@@ -0,0 +1,2 @@
+spaces-in-request
+spaces-in-http-version
diff -Nru haskell-warp-1.2.1.1/debian/patches/spaces-in-http-version haskell-warp-1.2.1.1/debian/patches/spaces-in-http-version
--- haskell-warp-1.2.1.1/debian/patches/spaces-in-http-version 1970-01-01 01:00:00.000000000 +0100
+++ haskell-warp-1.2.1.1/debian/patches/spaces-in-http-version 2012-10-27 18:44:22.000000000 +0200
@@ -0,0 +1,53 @@
+commit a827f54ac31e2c928144bb8bb5b92ca1249013c5
+Author: Michael Snoyman <michael@snoyman.com>
+Date: Thu May 31 12:33:49 2012 +0300
+
+ Spaces in HTTP version (#76)
+
+diff --git a/Network/Wai/Handler/Warp.hs b/Network/Wai/Handler/Warp.hs
+index 52ef3fb..f788b7c 100755
+--- a/Network/Wai/Handler/Warp.hs
++++ b/Network/Wai/Handler/Warp.hs
+@@ -488,9 +488,10 @@ takeUntil c bs =
+ parseFirst :: ByteString
+ -> ResourceT IO (ByteString, ByteString, ByteString, H.HttpVersion)
+ parseFirst s =
+- case filter (not . S.null) $ S.split 32 s of -- ' '
+- [method, query, http'] -> do
+- let (hfirst, hsecond) = B.splitAt 5 http'
++ case filter (not . S.null) $ S.splitWith (\c -> c == 32 || c == 9) s of -- ' '
++ (method:query:http'') -> do
++ let http' = S.concat http''
++ (hfirst, hsecond) = B.splitAt 5 http'
+ if hfirst == "HTTP/"
+ then let (rpath, qstring) = S.breakByte 63 query -- '?'
+ hv =
+diff --git a/test/main.hs b/test/main.hs
+index 432e460..274c22e 100644
+--- a/test/main.hs
++++ b/test/main.hs
+@@ -208,6 +208,24 @@ main = hspecX $ do
+ headers @?=
+ [ ("foo", "bar")
+ ]
++ it "spaces in http version" $ do
++ iversion <- I.newIORef $ error "Version not parsed"
++ port <- getPort
++ tid <- forkIO $ run port $ \req -> do
++ liftIO $ I.writeIORef iversion $ httpVersion req
++ return $ responseLBS status200 [] ""
++ threadDelay 1000
++ handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
++ let input = S.concat
++ [ "GET / HTTP\t/ 1 . 1 \r\nfoo: bar\r\n\r\n"
++ ]
++ hPutStr handle input
++ hFlush handle
++ hClose handle
++ threadDelay 1000
++ killThread tid
++ version <- I.readIORef iversion
++ version @?= http11
+
+ describe "chunked bodies" $ do
+ it "works" $ do
diff -Nru haskell-warp-1.2.1.1/debian/patches/spaces-in-request haskell-warp-1.2.1.1/debian/patches/spaces-in-request
--- haskell-warp-1.2.1.1/debian/patches/spaces-in-request 1970-01-01 01:00:00.000000000 +0100
+++ haskell-warp-1.2.1.1/debian/patches/spaces-in-request 2012-10-27 18:44:32.000000000 +0200
@@ -0,0 +1,147 @@
+commit dc4697c007beaf1846872744b83162e7c9406465
+Author: Michael Snoyman <michael@snoyman.com>
+Date: Thu May 31 11:49:43 2012 +0300
+
+ Multiline HTTP headers (#76)
+
+diff --git a/Network/Wai/Handler/Warp.hs b/Network/Wai/Handler/Warp.hs
+index c1a5aa9..52ef3fb 100755
+--- a/Network/Wai/Handler/Warp.hs
++++ b/Network/Wai/Handler/Warp.hs
+@@ -58,6 +58,7 @@ module Network.Wai.Handler.Warp
+ , T.initialize
+ #if TEST
+ , takeHeaders
++ , parseFirst
+ , readInt
+ #endif
+ ) where
+@@ -487,7 +488,7 @@ takeUntil c bs =
+ parseFirst :: ByteString
+ -> ResourceT IO (ByteString, ByteString, ByteString, H.HttpVersion)
+ parseFirst s =
+- case S.split 32 s of -- ' '
++ case filter (not . S.null) $ S.split 32 s of -- ' '
+ [method, query, http'] -> do
+ let (hfirst, hsecond) = B.splitAt 5 http'
+ if hfirst == "HTTP/"
+@@ -649,11 +650,7 @@ fmap2 _ (C.Done i x) = C.Done i x
+ parseHeaderNoAttr :: ByteString -> H.Header
+ parseHeaderNoAttr s =
+ let (k, rest) = S.breakByte 58 s -- ':'
+- restLen = S.length rest
+- -- FIXME check for colon without following space?
+- rest' = if restLen > 1 && SU.unsafeTake 2 rest == ": "
+- then SU.unsafeDrop 2 rest
+- else rest
++ rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest
+ in (CI.mk k, rest')
+
+ connSource :: Connection -> T.Handle -> C.Source (ResourceT IO) ByteString
+@@ -756,8 +753,15 @@ takeHeaders =
+ prepend' = prepend . S.append bs
+ status = THStatus len' lines prepend'
+ in C.NeedInput (push status) close
++ -- Found a newline, but next line continues as a multiline header
++ Just (end, True) ->
++ let rest = S.drop (end + 1) bs
++ prepend' = prepend . S.append (SU.unsafeTake (checkCR bs end) bs)
++ len' = len + end
++ status = THStatus len' lines prepend'
++ in push status rest
+ -- Found a newline at position end.
+- Just end ->
++ Just (end, False) ->
+ let start = end + 1 -- start of next chunk
+ line
+ -- There were some bytes before the newline, get them
+@@ -786,7 +790,15 @@ takeHeaders =
+ else C.NeedInput (push status) close
+ where
+ bsLen = S.length bs
+- mnl = S.elemIndex 10 bs
++ mnl = do
++ nl <- S.elemIndex 10 bs
++ -- check if there are two more bytes in the bs
++ -- if so, see if the second of those is a horizontal space
++ if bsLen > nl + 1
++ then
++ let c = S.index bs (nl + 1)
++ in Just (nl, c == 32 || c == 9)
++ else Just (nl, False)
+ {-# INLINE takeHeaders #-}
+
+ checkCR :: ByteString -> Int -> Int
+diff --git a/test/main.hs b/test/main.hs
+index 73e66d5..432e460 100644
+--- a/test/main.hs
++++ b/test/main.hs
+@@ -147,6 +147,68 @@ main = hspecX $ do
+ it "ConnectionClosedByPeer" $ runTerminateTest ConnectionClosedByPeer "GET / HTTP/1.1\r\ncontent-length: 10\r\n\r\nhello"
+ it "IncompleteHeaders" $ runTerminateTest IncompleteHeaders "GET / HTTP/1.1\r\ncontent-length: 10\r\n"
+
++ describe "special input" $ do
++ it "multiline headers" $ do
++ iheaders <- I.newIORef []
++ port <- getPort
++ tid <- forkIO $ run port $ \req -> do
++ liftIO $ I.writeIORef iheaders $ requestHeaders req
++ return $ responseLBS status200 [] ""
++ threadDelay 1000
++ handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
++ let input = S.concat
++ [ "GET / HTTP/1.1\r\nfoo: bar\r\n baz\r\n\tbin\r\n\r\n"
++ ]
++ hPutStr handle input
++ hFlush handle
++ hClose handle
++ threadDelay 1000
++ killThread tid
++ headers <- I.readIORef iheaders
++ headers @?=
++ [ ("foo", "bar baz\tbin")
++ ]
++ it "no space between colon and value" $ do
++ iheaders <- I.newIORef []
++ port <- getPort
++ tid <- forkIO $ run port $ \req -> do
++ liftIO $ I.writeIORef iheaders $ requestHeaders req
++ return $ responseLBS status200 [] ""
++ threadDelay 1000
++ handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
++ let input = S.concat
++ [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"
++ ]
++ hPutStr handle input
++ hFlush handle
++ hClose handle
++ threadDelay 1000
++ killThread tid
++ headers <- I.readIORef iheaders
++ headers @?=
++ [ ("foo", "bar")
++ ]
++ it "extra spaces in first line" $ do
++ iheaders <- I.newIORef []
++ port <- getPort
++ tid <- forkIO $ run port $ \req -> do
++ liftIO $ I.writeIORef iheaders $ requestHeaders req
++ return $ responseLBS status200 [] ""
++ threadDelay 1000
++ handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
++ let input = S.concat
++ [ "GET / HTTP/1.1\r\nfoo: bar\r\n\r\n"
++ ]
++ hPutStr handle input
++ hFlush handle
++ hClose handle
++ threadDelay 1000
++ killThread tid
++ headers <- I.readIORef iheaders
++ headers @?=
++ [ ("foo", "bar")
++ ]
++
+ describe "chunked bodies" $ do
+ it "works" $ do
+ ifront <- I.newIORef id
Attachment:
signature.asc
Description: This is a digitally signed message part