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 - psim...@suse.com + +- 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 =