This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap-server".
The branch, master has been updated
via 10c0c083e2bad38600212e5d30b70fe21f6c6d95 (commit)
via 174c84c72cdff6b61fdbff7070a1c9e5b3c13c3b (commit)
from 01ec4881b5ba554edd24533e57810f968ca178ee (commit)
Summary of changes:
snap-server.cabal | 2 +-
src/Snap/Internal/Http/Server/GnuTLS.hs | 31 +++++++++++++++++--------------
test/snap-server-testsuite.cabal | 6 +++---
3 files changed, 21 insertions(+), 18 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 10c0c083e2bad38600212e5d30b70fe21f6c6d95
Author: Gregory Collins <[email protected]>
Date: Sun Feb 20 18:15:26 2011 +0100
Try to fix compile error with gnutls (although this machine doesn't have it
installed)
diff --git a/src/Snap/Internal/Http/Server/GnuTLS.hs
b/src/Snap/Internal/Http/Server/GnuTLS.hs
index d3bf514..6668d56 100644
--- a/src/Snap/Internal/Http/Server/GnuTLS.hs
+++ b/src/Snap/Internal/Http/Server/GnuTLS.hs
@@ -29,8 +29,9 @@ import Snap.Internal.Http.Server.Backend
#ifdef GNUTLS
import Control.Monad (liftM)
import qualified Data.ByteString as B
-import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.ByteString.Internal (w2c)
+import qualified Data.ByteString.Internal as BI
+import qualified Data.ByteString.Unsafe as BI
import Foreign
import qualified Network.Socket as Socket
#endif
@@ -148,8 +149,7 @@ createSession (ListenHttps _ creds _) recvSize socket
on_block =
gnutls_certificate_send_x509_rdn_sequence session 1
gnutls_session_enable_compatibility_mode session
- buffer <- mallocBytes $ fromIntegral recvSize
- let s = NetworkSession socket (castPtr session) buffer $
+ let s = NetworkSession socket (castPtr session) $
fromIntegral recvSize
gnutls_transport_set_ptr session $ intPtrToPtr $ fromIntegral $ socket
@@ -162,10 +162,9 @@ createSession _ _ _ _ = error "Invalid socket"
------------------------------------------------------------------------------
endSession :: NetworkSession -> IO ()
-endSession (NetworkSession _ session buffer _) = do
+endSession (NetworkSession _ session _ _) = do
throwErrorIf "TLS bye" $ gnutls_bye (castPtr session) 1 `finally` do
gnutls_deinit $ castPtr session
- free buffer
------------------------------------------------------------------------------
@@ -182,7 +181,7 @@ handshake s@(NetworkSession { _session = session}) on_block
= do
------------------------------------------------------------------------------
send :: IO () -> IO () -> NetworkSession -> ByteString -> IO ()
send tickleTimeout onBlock (NetworkSession { _session = session}) bs =
- unsafeUseAsCStringLen bs $ uncurry loop
+ BI.unsafeUseAsCStringLen bs $ uncurry loop
where
loop ptr len = do
sent <- gnutls_record_send (castPtr session) ptr $ fromIntegral len
@@ -206,22 +205,26 @@ send tickleTimeout onBlock (NetworkSession { _session =
session}) bs =
-- could be changed to use unsafePackCStringFinalizer if the buffer is at
-- least 3/4 full and packCStringLen otherwise or something like that
recv :: IO b -> NetworkSession -> IO (Maybe ByteString)
-recv onBlock (NetworkSession _ session recvBuf recvLen) = loop
+recv onBlock (NetworkSession _ session recvLen) = do
+ fp <- BI.mallocByteString $ fromEnum recvLen
+ sz <- withForeignPtr fp loop
+ if sz <= 0
+ then return Nothing
+ else return $ Just $ BI.fromForeignPtr fp 0 $ fromEnum sz
+
where
- loop = do
+ loop recvBuf = do
size <- gnutls_record_recv (castPtr session) recvBuf recvLen
let size' = fromIntegral size
case size' of
- x | x == 0 -> return Nothing
- | x > 0 -> liftM Just $ B.packCStringLen (recvBuf, x)
- | isIntrCode x -> loop
- | isAgainCode x -> onBlock >> loop
+ x | x >= 0 -> return x
+ | isIntrCode x -> loop recvBuf
+ | isAgainCode x -> onBlock >> loop recvBuf
| otherwise -> (throwError "TLS recv" $ fromIntegral size')
- >> return Nothing
------------------------------------------------------------------------------
-throwError :: String -> ReturnCode -> IO ()
+throwError :: String -> ReturnCode -> IO a
throwError prefix rc = gnutls_strerror rc >>=
peekCString >>=
throwIO . GnuTLSException . (prefix'++)
commit 174c84c72cdff6b61fdbff7070a1c9e5b3c13c3b
Author: Gregory Collins <[email protected]>
Date: Thu Feb 17 16:36:06 2011 -0800
Bump enumerator version
diff --git a/snap-server.cabal b/snap-server.cabal
index 6639ff3..7260c3a 100644
--- a/snap-server.cabal
+++ b/snap-server.cabal
@@ -111,7 +111,7 @@ Library
bytestring-nums,
containers,
directory-tree,
- enumerator == 0.4.*,
+ enumerator >= 0.4.7 && <0.5,
filepath,
MonadCatchIO-transformers >= 0.2.1 && < 0.3,
mtl == 2.0.*,
diff --git a/test/snap-server-testsuite.cabal b/test/snap-server-testsuite.cabal
index 36333ac..6be7965 100644
--- a/test/snap-server-testsuite.cabal
+++ b/test/snap-server-testsuite.cabal
@@ -35,7 +35,7 @@ Executable testsuite
containers,
directory,
directory-tree,
- enumerator == 0.4.*,
+ enumerator >= 0.4.7 && <0.5,
filepath,
haskell98,
http-enumerator >= 0.2.1.5 && <0.3,
@@ -96,7 +96,7 @@ Executable pongserver
cereal >= 0.3 && < 0.4,
containers,
directory-tree,
- enumerator == 0.4.*,
+ enumerator >= 0.4.7 && <0.5,
filepath,
haskell98,
HUnit >= 1.2 && < 2,
@@ -173,7 +173,7 @@ Executable testserver
bytestring-nums >= 0.3.1 && < 0.4,
containers,
directory-tree,
- enumerator == 0.4.*,
+ enumerator >= 0.4.7 && <0.5,
filepath,
haskell98,
HUnit >= 1.2 && < 2,
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
