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 =


Reply via email to