Hello community,
here is the log from the commit of package ghc-snap-server for openSUSE:Factory
checked in at 2020-11-07 21:01:58
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-snap-server (Old)
and /work/SRC/openSUSE:Factory/.ghc-snap-server.new.11331 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-snap-server"
Sat Nov 7 21:01:58 2020 rev:2 rq:846559 version:1.1.2.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-snap-server/ghc-snap-server.changes
2020-10-27 19:02:38.770904818 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-snap-server.new.11331/ghc-snap-server.changes
2020-11-07 21:03:34.801817193 +0100
@@ -1,0 +2,6 @@
+Sat Oct 31 03:01:25 UTC 2020 - [email protected]
+
+- Update snap-server to version 1.1.2.0.
+ Upstream does not provide a change log file.
+
+-------------------------------------------------------------------
Old:
----
snap-server-1.1.1.2.tar.gz
snap-server.cabal
New:
----
snap-server-1.1.2.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-snap-server.spec ++++++
--- /var/tmp/diff_new_pack.bRrU7I/_old 2020-11-07 21:03:35.401816238 +0100
+++ /var/tmp/diff_new_pack.bRrU7I/_new 2020-11-07 21:03:35.401816238 +0100
@@ -19,13 +19,12 @@
%global pkg_name snap-server
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 1.1.1.2
+Version: 1.1.2.0
Release: 0
Summary: A web server for the Snap Framework
License: BSD-3-Clause
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
-Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-attoparsec-devel
BuildRequires: ghc-blaze-builder-devel
@@ -45,6 +44,7 @@
BuildRequires: ghc-snap-core-devel
BuildRequires: ghc-text-devel
BuildRequires: ghc-time-devel
+BuildRequires: ghc-transformers-devel
BuildRequires: ghc-unix-compat-devel
BuildRequires: ghc-unix-devel
BuildRequires: ghc-vector-devel
@@ -63,7 +63,6 @@
BuildRequires: ghc-test-framework-hunit-devel
BuildRequires: ghc-test-framework-quickcheck2-devel
BuildRequires: ghc-threads-devel
-BuildRequires: ghc-transformers-devel
%endif
%description
@@ -88,7 +87,6 @@
%prep
%autosetup -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
%build
%ghc_lib_build
++++++ snap-server-1.1.1.2.tar.gz -> snap-server-1.1.2.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/snap-server-1.1.1.2/snap-server.cabal
new/snap-server-1.1.2.0/snap-server.cabal
--- old/snap-server-1.1.1.2/snap-server.cabal 2001-09-09 03:46:40.000000000
+0200
+++ new/snap-server-1.1.2.0/snap-server.cabal 2001-09-09 03:46:40.000000000
+0200
@@ -1,5 +1,5 @@
name: snap-server
-version: 1.1.1.2
+version: 1.1.2.0
synopsis: A web server for the Snap Framework
description:
Snap is a simple and fast web development framework and server written in
@@ -114,6 +114,7 @@
snap-core >= 1.0 && < 1.1,
text >= 0.11 && < 1.3,
time >= 1.0 && < 1.11,
+ transformers >= 0.3 && < 0.6,
unix-compat >= 0.2 && < 0.6,
vector >= 0.7 && < 0.13
@@ -213,7 +214,7 @@
build-depends:
attoparsec,
base,
- base16-bytestring >= 0.1 && < 0.2,
+ base16-bytestring >= 0.1 && < 1.1,
blaze-builder,
bytestring-builder,
bytestring,
@@ -229,7 +230,7 @@
mtl,
network,
old-locale,
- random >= 1.0 && < 1.2,
+ random >= 1.0 && < 1.3,
snap-core,
text,
threads >= 0.5 && < 0.6,
@@ -331,6 +332,7 @@
io-streams,
io-streams-haproxy,
snap-core,
+ transformers,
vector
ghc-options: -Wall -fwarn-tabs -funbox-strict-fields
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/snap-server-1.1.1.2/src/Snap/Internal/Http/Server/Parser.hs
new/snap-server-1.1.2.0/src/Snap/Internal/Http/Server/Parser.hs
--- old/snap-server-1.1.1.2/src/Snap/Internal/Http/Server/Parser.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/snap-server-1.1.2.0/src/Snap/Internal/Http/Server/Parser.hs
2001-09-09 03:46:40.000000000 +0200
@@ -29,9 +29,9 @@
import Control.Applicative ((<$>))
#endif
import Control.Exception (Exception, throwIO)
-import qualified Control.Exception as E
import Control.Monad (void, when)
-import Data.Attoparsec.ByteString.Char8 (Parser, hexadecimal,
skipWhile, take)
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Data.Attoparsec.ByteString.Char8 (Parser, hexadecimal,
takeTill)
import qualified Data.ByteString.Char8 as S
import Data.ByteString.Internal (ByteString (..), c2w,
memchr, w2c)
#if MIN_VERSION_bytestring(0, 10, 6)
@@ -40,9 +40,6 @@
import Data.ByteString.Internal (inlinePerformIO)
#endif
import qualified Data.ByteString.Unsafe as S
-#if !MIN_VERSION_io_streams(1,2,0)
-import Data.IORef (newIORef, readIORef,
writeIORef)
-#endif
import Data.List (sort)
import Data.Typeable (Typeable)
import qualified Data.Vector as V
@@ -53,12 +50,12 @@
------------------------------------------------------------------------------
import Blaze.ByteString.Builder.HTTP (chunkedTransferEncoding,
chunkedTransferTerminator)
import Data.ByteString.Builder (Builder)
-import System.IO.Streams (InputStream, OutputStream)
+import System.IO.Streams (InputStream, OutputStream,
Generator)
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, unsafeFromNat)
import Snap.Types.Headers (Headers)
import qualified Snap.Types.Headers as H
@@ -351,13 +348,11 @@
readChunkedTransferEncoding :: InputStream ByteString
-> IO (InputStream ByteString)
readChunkedTransferEncoding input =
- Streams.makeInputStream $ parseFromStream pGetTransferChunk input
-
+ Streams.fromGenerator (consumeChunks input)
------------------------------------------------------------------------------
writeChunkedTransferEncoding :: OutputStream Builder
-> IO (OutputStream Builder)
-#if MIN_VERSION_io_streams(1,2,0)
writeChunkedTransferEncoding os = Streams.makeOutputStream f
where
f Nothing = do
@@ -365,50 +360,77 @@
Streams.write Nothing os
f x = Streams.write (chunkedTransferEncoding `fmap` x) os
-#else
-writeChunkedTransferEncoding os = do
- -- make sure we only send the terminator once.
- eof <- newIORef True
- Streams.makeOutputStream $ f eof
- where
- f eof Nothing = readIORef eof >>= flip when (do
- writeIORef eof True
- Streams.write (Just chunkedTransferTerminator) os
- Streams.write Nothing os)
- f _ x = Streams.write (chunkedTransferEncoding `fmap` x) os
-#endif
-
---------------------
-- parse functions --
---------------------
------------------------------------------------------------------------------
--- We treat chunks larger than this from clients as a denial-of-service attack.
--- 256kB should be enough buffer.
-mAX_CHUNK_SIZE :: Int
-mAX_CHUNK_SIZE = (2::Int)^(18::Int)
+{-
+ For a response body in chunked transfer encoding, iterate over
+ the individual chunks, reading the size parameter, then
+ looping over that chunk in bites of at most bUFSIZ,
+ yielding them to the receiveResponse InputStream accordingly.
+-}
+consumeChunks :: InputStream ByteString -> Generator ByteString ()
+consumeChunks i1 = do
+ !n <- parseSize
+ if n > 0
+ then do
+ -- read one or more bytes, then loop to next chunk
+ go n
+ skipCRLF
+ consumeChunks i1
+ else do
+ -- NB: snap-server doesn't yet support chunked trailer parts
+ -- (see RFC7230#sec4.1.2)
+ -- consume final CRLF
+ skipCRLF
-------------------------------------------------------------------------------
-pGetTransferChunk :: Parser (Maybe ByteString)
-pGetTransferChunk = parser <?> "pGetTransferChunk"
where
- parser = do
- !hex <- hexadecimal <?> "hexadecimal"
- skipWhile (/= '\r') <?> "skipToEOL"
- void crlf <?> "linefeed"
- if hex >= mAX_CHUNK_SIZE
- then return $! E.throw $! HttpParseException $!
- "pGetTransferChunk: chunk of size " ++ show hex ++ " too long."
- else if hex <= 0
- then (crlf >> return Nothing) <?> "terminal crlf after 0 length"
- else do
- -- now safe to take this many bytes.
- !x <- take hex <?> "reading data chunk"
- void crlf <?> "linefeed after data chunk"
- return $! Just x
-
+ go 0 = return ()
+ go !n = do
+ (!x',!r) <- liftIO $ readN n i1
+ Streams.yield x'
+ go r
+
+ parseSize = do
+ liftIO $ parseFromStream transferChunkSize i1
+
+ skipCRLF = do
+ liftIO $ void (parseFromStream crlf i1)
+
+ transferChunkSize :: Parser (Int)
+ transferChunkSize = do
+ !n <- hexadecimal
+ -- skip over any chunk extensions (see RFC7230#sec4.1.1)
+ void (takeTill (== '\r'))
+ void crlf
+ return n
+
+ {-
+ The chunk size coming down from the client is somewhat arbitrary;
+ it's really just an indication of how many bytes need to be read
+ before the next size marker or end marker - neither of which has
+ anything to do with streaming on our side. Instead, we'll feed
+ bytes into our InputStream at an appropriate intermediate size.
+ -}
+ bUFSIZ :: Int
+ bUFSIZ = 32752
+
+ {-
+ Read the specified number of bytes up to a maximum of bUFSIZ,
+ returning a resultant ByteString and the number of bytes remaining.
+ -}
+ readN :: Int -> InputStream ByteString -> IO (ByteString, Int)
+ readN n input = do
+ !x' <- Streams.readExactly p input
+ return (x', r)
+ where
+ !d = n - bUFSIZ
+ !p = if d > 0 then bUFSIZ else n
+ !r = if d > 0 then d else 0
------------------------------------------------------------------------------
toLower :: ByteString -> ByteString
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/snap-server-1.1.1.2/src/Snap/Internal/Http/Server/TLS.hs
new/snap-server-1.1.2.0/src/Snap/Internal/Http/Server/TLS.hs
--- old/snap-server-1.1.1.2/src/Snap/Internal/Http/Server/TLS.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/snap-server-1.1.2.0/src/Snap/Internal/Http/Server/TLS.hs
2001-09-09 03:46:40.000000000 +0200
@@ -25,9 +25,9 @@
import OpenSSL (withOpenSSL)
import OpenSSL.Session (SSL, SSLContext)
import qualified OpenSSL.Session as SSL
-import Prelude (Bool, FilePath, IO, Int,
Maybe (..), Monad (..), Show, flip, fromIntegral, fst, not, ($), ($!), (.))
-import Snap.Internal.Http.Server.Address (getAddress, getSockAddr)
-import Snap.Internal.Http.Server.Socket (acceptAndInitialize)
+import Prelude (Bool, FilePath, IO, Int,
Maybe (..), Monad (..), Show, flip, fromIntegral, not, ($), ($!))
+import Snap.Internal.Http.Server.Address (getAddress)
+import Snap.Internal.Http.Server.Socket (acceptAndInitialize,
bindSocket)
import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.SSL as SStreams
@@ -98,22 +98,14 @@
bindHttps bindAddress bindPort cert chainCert key =
withTLS $
bracketOnError
- (do (family, addr) <- getSockAddr bindPort bindAddress
- sock <- Socket.socket family Socket.Stream 0
- return (sock, addr)
- )
- (Socket.close . fst)
- $ \(sock, addr) -> do
- Socket.setSocketOption sock Socket.ReuseAddr 1
- Socket.bindSocket sock addr
- Socket.listen sock 150
-
+ (bindSocket bindAddress bindPort)
+ Socket.close
+ $ \sock -> do
ctx <- SSL.context
SSL.contextSetPrivateKeyFile ctx key
if chainCert
then SSL.contextSetCertificateChainFile ctx cert
else SSL.contextSetCertificateFile ctx cert
-
certOK <- SSL.contextCheckPrivateKey ctx
when (not certOK) $ do
throwIO $ TLSException certificateError
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/snap-server-1.1.1.2/test/Snap/Internal/Http/Server/Parser/Tests.hs
new/snap-server-1.1.2.0/test/Snap/Internal/Http/Server/Parser/Tests.hs
--- old/snap-server-1.1.1.2/test/Snap/Internal/Http/Server/Parser/Tests.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/snap-server-1.1.2.0/test/Snap/Internal/Http/Server/Parser/Tests.hs
2001-09-09 03:46:40.000000000 +0200
@@ -9,7 +9,6 @@
import Control.Parallel.Strategies (rdeepseq, using)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
-import Data.Int (Int64)
import Data.List (sort)
import qualified Data.Map as Map
import Data.Monoid (mconcat)
@@ -37,7 +36,6 @@
tests = [ testShow
, testCookie
, testChunked
- , testChunkDoS
, testNull
, testPartial
, testParseError
@@ -126,22 +124,6 @@
s <- liftM (toLazyByteString . mconcat) getList
assertEqual "chunked" "002\r\nok\r\n0\r\n\r\n" s
-
-------------------------------------------------------------------------------
--- | ensure that running 'readChunkedTransferEncoding' against
--- 'transferEncodingChunked' returns the original string
-testChunkDoS :: Test
-testChunkDoS = testCase "parser/chunkedTransferEncoding/DoS" $ do
- let n = ((2::Int64)^(18 :: Int64) + 10) :: Int64
- let s = S.concat $ L.toChunks $ L.take n $ L.fromChunks $
- cycle ["OKOKOKOKOKOKOKOK"]
- let ch = transferEncodingChunked $ L.fromChunks [s]
-
- expectException (Streams.fromList (L.toChunks ch) >>=
- readChunkedTransferEncoding >>=
- Streams.toList)
-
-
------------------------------------------------------------------------------
testCookie :: Test
testCookie =
