@@ -0,0 +1,69 @@
1+{-# LANGUAGE ForeignFunctionInterface #-}
2+
3+-- fixme: windows support
4+
5+module Network.Wai.Handler.Warp.Recv (
6+ ReceiveBuffer
7+ , receive
8+ , allocateRecvBuffer
9+ , freeRecvBuffer
10+ ) where
11+
12+import Control.Applicative ((<$>))
13+import Control.Monad (void)
14+import qualified Data.ByteString as BS (empty)
15+import Data.ByteString.Internal (ByteString(..), mallocByteString)
16+import Data.Word (Word8)
17+import Foreign.C.Error (eAGAIN, getErrno, throwErrno)
18+import Foreign.C.Types
19+import Foreign.ForeignPtr (withForeignPtr)
20+import Foreign.Ptr (Ptr, castPtr)
21+import GHC.Conc (threadWaitRead)
22+import Network.Socket (Socket, fdSocket)
23+import System.Posix.Types (Fd(..))
24+import Foreign.Marshal.Alloc (mallocBytes, free)
25+
26+----------------------------------------------------------------
27+
28+type ReceiveBuffer = Ptr Word8
29+
30+allocateRecvBuffer :: Int -> IO ReceiveBuffer
31+allocateRecvBuffer = mallocBytes
32+
33+freeRecvBuffer :: ReceiveBuffer -> IO ()
34+freeRecvBuffer = free
35+
36+receive :: Socket -> ReceiveBuffer -> Int -> IO ByteString
37+receive sock buf size = do
38+ bytes <- fromIntegral <$> receiveloop sock' buf' size'
39+ if bytes == 0 then
40+ return BS.empty
41+ else do
42+ fptr <- mallocByteString bytes
43+ void $ withForeignPtr fptr $ \ptr ->
44+ c_memcpy ptr buf (fromIntegral bytes)
45+ return $! PS fptr 0 bytes
46+ where
47+ sock' = fdSocket sock
48+ buf' = castPtr buf
49+ size' = fromIntegral size
50+
51+receiveloop :: CInt -> Ptr CChar -> CSize -> IO CInt
52+receiveloop sock buf size = do
53+ bytes <- c_recv sock buf size 0
54+ if bytes == -1 then do
55+ errno <- getErrno
56+ if errno == eAGAIN then do
57+ threadWaitRead (Fd sock)
58+ receiveloop sock buf size
59+ else
60+ throwErrno "receiveloop"
61+ else
62+ return bytes
63+
64+-- fixme: the type of the return value
65+foreign import ccall unsafe "recv"
66+ c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt
67+
68+foreign import ccall unsafe "string.h memcpy"
69+ c_memcpy :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)