simple-sendfile 0.0.2 → 0.1.0
raw patch · 5 files changed
+78/−57 lines, 5 filesdep +transformers
Dependencies added: transformers
Files
- Network/Sendfile/BSD.hsc +36/−29
- Network/Sendfile/Fallback.hs +9/−8
- Network/Sendfile/Linux.hsc +14/−8
- Network/Sendfile/MacOS.hsc +17/−10
- simple-sendfile.cabal +2/−2
Network/Sendfile/BSD.hsc view
@@ -19,47 +19,54 @@ Simple binding for sendfile() of BSD. - Used system calls: open(), sendfile(), and close().++ The fourth action argument is called when a file is sent as chunks.+ Chucking is inevitable if the socket is non-blocking (this is the+ default) and the file is large. The action is called after a chunk+ is sent and bofore waiting the socket to be ready for writing. -}-sendfile :: Socket -> FilePath -> FileRange -> IO ()-sendfile sock path range = bracket+sendfile :: Socket -> FilePath -> FileRange -> IO () -> IO ()+sendfile sock path range hook = bracket (openFd path ReadOnly Nothing defaultFileFlags) closeFd sendfile' where dst = Fd $ fdSocket sock- sendfile' fd = alloca $ \lenp -> do+ sendfile' fd = alloca $ \lenp -> case range of- EntireFile -> sendEntire dst fd 0 lenp+ EntireFile -> sendEntire dst fd 0 lenp hook PartOfFile off len -> do let off' = fromInteger off len' = fromInteger len- sendPart dst fd off' len' lenp+ sendPart dst fd off' len' lenp hook -sendEntire :: Fd -> Fd -> COff -> Ptr COff -> IO ()-sendEntire dst src off lenp = do- do rc <- c_sendfile src dst off 0 lenp- when (rc /= 0) $ do- errno <- getErrno- if errno == eAGAIN || errno == eINTR- then do- sent <- peek lenp- threadWaitWrite dst- sendEntire dst src (off + sent) lenp- else throwErrno "Network.SendFile.BSD.sendEntire"+sendEntire :: Fd -> Fd -> COff -> Ptr COff -> IO () -> IO ()+sendEntire dst src off lenp hook = do+ rc <- c_sendfile src dst off 0 lenp+ when (rc /= 0) $ do+ errno <- getErrno+ if errno `elem` [eAGAIN, eINTR]+ then do+ sent <- peek lenp+ hook+ threadWaitWrite dst+ sendEntire dst src (off + sent) lenp hook+ else throwErrno "Network.SendFile.BSD.sendEntire" -sendPart :: Fd -> Fd -> COff -> CSize -> Ptr COff -> IO ()-sendPart dst src off len lenp = do- do rc <- c_sendfile src dst off len lenp- when (rc /= 0) $ do- errno <- getErrno- if errno == eAGAIN || errno == eINTR- then do- sent <- peek lenp- threadWaitWrite dst- let off' = off + sent- len' = len - fromIntegral sent- sendPart dst src off' len' lenp- else throwErrno "Network.SendFile.BSD.sendPart"+sendPart :: Fd -> Fd -> COff -> CSize -> Ptr COff -> IO () -> IO ()+sendPart dst src off len lenp hook = do+ rc <- c_sendfile src dst off len lenp+ when (rc /= 0) $ do+ errno <- getErrno+ if errno `elem` [eAGAIN, eINTR]+ then do+ sent <- peek lenp+ let off' = off + sent+ len' = len - fromIntegral sent+ hook+ threadWaitWrite dst+ sendPart dst src off' len' lenp hook+ else throwErrno "Network.SendFile.BSD.sendPart" c_sendfile :: Fd -> Fd -> COff -> CSize -> Ptr COff -> IO CInt c_sendfile fd s offset len lenp = c_sendfile' fd s offset len nullPtr lenp 0
Network/Sendfile/Fallback.hs view
@@ -16,20 +16,21 @@ - Used system calls: open(), stat(), read(), send() and close(). -}-sendfile :: Socket -> FilePath -> FileRange -> IO ()-sendfile s fp EntireFile =- run_ $ enumFile fp $$ sendIter s-sendfile s fp (PartOfFile off len) =- run_ $ EB.enumFileRange fp (Just off) (Just len) $$ sendIter s+sendfile :: Socket -> FilePath -> FileRange -> IO () -> IO ()+sendfile s fp EntireFile hook =+ run_ $ enumFile fp $$ sendIter s hook+sendfile s fp (PartOfFile off len) hook =+ run_ $ EB.enumFileRange fp (Just off) (Just len) $$ sendIter s hook -sendIter :: Socket -> Iteratee ByteString IO ()-sendIter s = do+sendIter :: Socket -> IO () -> Iteratee ByteString IO ()+sendIter s hook = do mb <- EL.head case mb of Nothing -> return () Just bs -> do liftIO $ sendLoop s bs (BS.length bs)- sendIter s+ liftIO hook -- FIXME: Is this a right place to call the hook?+ sendIter s hook sendLoop :: Socket -> ByteString -> Int -> IO () sendLoop s bs len = do
Network/Sendfile/Linux.hsc view
@@ -25,11 +25,16 @@ - EntireFile -- open(), stat(), sendfile(), and close() - PartOfFile -- open(), sendfile(), and close() - If the size of the file is unknown when sending the entire file,+ If the size of the file is unknown when sending the entire file, specifying PartOfFile is much faster.++ The fourth action argument is called when a file is sent as chunks.+ Chucking is inevitable if the socket is non-blocking (this is the+ default) and the file is large. The action is called after a chunk+ is sent and bofore waiting the socket to be ready for writing. -}-sendfile :: Socket -> FilePath -> FileRange -> IO ()-sendfile sock path range = bracket+sendfile :: Socket -> FilePath -> FileRange -> IO () -> IO ()+sendfile sock path range hook = bracket (openFd path ReadOnly Nothing defaultFileFlags) closeFd sendfile'@@ -42,22 +47,23 @@ -- System call is very slow. Use PartOfFile instead. len <- fileSize <$> getFdStatus fd let len' = fromIntegral len- sendPart dst fd offp len'+ sendPart dst fd offp len' hook PartOfFile off len -> do poke offp (fromIntegral off) let len' = fromIntegral len- sendPart dst fd offp len'+ sendPart dst fd offp len' hook -sendPart :: Fd -> Fd -> Ptr (#type off_t) -> (#type size_t) -> IO ()-sendPart dst src offp len = do+sendPart :: Fd -> Fd -> Ptr (#type off_t) -> (#type size_t) -> IO () -> IO ()+sendPart dst src offp len hook = do do bytes <- c_sendfile dst src offp len if bytes == -1 then throwErrno "Network.SendFile.Linux.sendPart" else do let left = len - fromIntegral bytes when (left /= 0) $ do+ hook threadWaitWrite dst- sendPart dst src offp left+ sendPart dst src offp left hook -- Dst Src in order. take care foreign import ccall unsafe "sendfile64" c_sendfile
Network/Sendfile/MacOS.hsc view
@@ -20,9 +20,14 @@ Simple binding for sendfile() of MacOS. - Used system calls: open(), sendfile(), and close().++ The fourth action argument is called when a file is sent as chunks.+ Chucking is inevitable if the socket is non-blocking (this is the+ default) and the file is large. The action is called after a chunk+ is sent and bofore waiting the socket to be ready for writing. -}-sendfile :: Socket -> FilePath -> FileRange -> IO ()-sendfile sock path range = bracket+sendfile :: Socket -> FilePath -> FileRange -> IO () -> IO ()+sendfile sock path range hook = bracket (openFd path ReadOnly Nothing defaultFileFlags) closeFd sendfile'@@ -32,14 +37,14 @@ case range of EntireFile -> do poke lenp 0- sendEntire dst fd 0 lenp+ sendEntire dst fd 0 lenp hook PartOfFile off len -> do let off' = fromInteger off poke lenp (fromInteger len)- sendPart dst fd off' lenp+ sendPart dst fd off' lenp hook -sendEntire :: Fd -> Fd -> (#type off_t) -> Ptr (#type off_t) -> IO ()-sendEntire dst src off lenp = do+sendEntire :: Fd -> Fd -> (#type off_t) -> Ptr (#type off_t) -> IO () -> IO ()+sendEntire dst src off lenp hook = do do rc <- c_sendfile src dst off lenp when (rc /= 0) $ do errno <- getErrno@@ -47,12 +52,13 @@ then do sent <- peek lenp poke lenp 0+ hook threadWaitWrite dst- sendEntire dst src (off + sent) lenp+ sendEntire dst src (off + sent) lenp hook else throwErrno "Network.SendFile.MacOS.sendEntire" -sendPart :: Fd -> Fd -> (#type off_t) -> Ptr (#type off_t) -> IO ()-sendPart dst src off lenp = do+sendPart :: Fd -> Fd -> (#type off_t) -> Ptr (#type off_t) -> IO () -> IO ()+sendPart dst src off lenp hook = do do len <- peek lenp rc <- c_sendfile src dst off lenp when (rc /= 0) $ do@@ -61,8 +67,9 @@ then do sent <- peek lenp poke lenp (len - sent)+ hook threadWaitWrite dst- sendPart dst src (off + sent) lenp+ sendPart dst src (off + sent) lenp hook else throwErrno "Network.SendFile.MacOS.sendPart" c_sendfile :: Fd -> Fd -> (#type off_t) -> Ptr (#type off_t) -> IO CInt
simple-sendfile.cabal view
@@ -1,5 +1,5 @@ Name: simple-sendfile-Version: 0.0.2+Version: 0.1.0 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -37,7 +37,7 @@ Build-Depends: unix else Other-Modules: Network.Sendfile.Fallback- Build-Depends: bytestring, enumerator+ Build-Depends: bytestring, enumerator, transformers Source-Repository head Type: git