Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-simple-sendfile for
openSUSE:Factory checked in at 2026-11-06 19:49:59
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-simple-sendfile (Old)
and /work/SRC/openSUSE:Factory/.ghc-simple-sendfile.new.3759290 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-simple-sendfile"
Fri Nov 6 19:49:59 2026 rev:8 rq:1395562 version:0.2.33
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-simple-sendfile/ghc-simple-sendfile.changes
2023-06-22 23:26:03.085838623 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-simple-sendfile.new.3759290/ghc-simple-sendfile.changes
2026-11-06 19:57:01.332784060 +0100
@@ -1,0 +2,8 @@
+Wed Nov 4 22:38:59 UTC 2026 - Peter Simons <[email protected]>
+
+- Update simple-sendfile to version 0.2.33.
+ Upstream added a new change log file in this release. With no
+ previous version to compare against, the automatic updater cannot
+ reliable determine the relevante entries for this release.
+
+-------------------------------------------------------------------
Old:
----
simple-sendfile-0.2.32.tar.gz
New:
----
simple-sendfile-0.2.33.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-simple-sendfile.spec ++++++
--- /var/tmp/diff_new_pack.49r27f/_old 2026-11-06 19:57:02.387828225 +0100
+++ /var/tmp/diff_new_pack.49r27f/_new 2026-11-06 19:57:02.391828392 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-simple-sendfile
#
-# Copyright (c) 2023 SUSE LLC
+# Copyright (c) 2026 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -20,7 +20,7 @@
%global pkgver %{pkg_name}-%{version}
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.2.32
+Version: 0.2.33
Release: 0
Summary: Cross platform library for the sendfile system call
License: BSD-3-Clause
@@ -109,6 +109,7 @@
%license LICENSE
%files devel -f %{name}-devel.files
+%doc ChangeLog.md
%files -n ghc-%{pkg_name}-doc -f ghc-%{pkg_name}-doc.files
%license LICENSE
++++++ simple-sendfile-0.2.32.tar.gz -> simple-sendfile-0.2.33.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/simple-sendfile-0.2.32/ChangeLog.md
new/simple-sendfile-0.2.33/ChangeLog.md
--- old/simple-sendfile-0.2.32/ChangeLog.md 1970-01-01 01:00:00.000000000
+0100
+++ new/simple-sendfile-0.2.33/ChangeLog.md 2001-09-09 03:46:40.000000000
+0200
@@ -0,0 +1,20 @@
+# ChangeLog for simple-sendfile
+
+## 0.2.33
+
+GHC 9.2 or later is required.
+
+* Don't send the entire file for zero-length ranges on BSD/macOS
+ [#43](https://github.com/kazu-yamamoto/simple-sendfile/pull/43)
+* Fallback: open the file before sending the header
+ [#44](https://github.com/kazu-yamamoto/simple-sendfile/pull/44)
+* Reject negative offsets and lengths in FileRange
+ [#45](https://github.com/kazu-yamamoto/simple-sendfile/pull/45)
+* Fix the header path of BSD/macOS (IOV_MAX, EINTR, hook)
+ [#47](https://github.com/kazu-yamamoto/simple-sendfile/pull/47)
+* Linux: open the file before the header, handle EINTR and 64-bit off_t
+ [#48](https://github.com/kazu-yamamoto/simple-sendfile/pull/48)
+* Document how FileRange is handled
+ [#49](https://github.com/kazu-yamamoto/simple-sendfile/pull/49)
+* Add FreeBSD to CI and fix BSD error messages
+ [#50](https://github.com/kazu-yamamoto/simple-sendfile/pull/50)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/simple-sendfile-0.2.32/Network/Sendfile/BSD.hsc
new/simple-sendfile-0.2.33/Network/Sendfile/BSD.hsc
--- old/simple-sendfile-0.2.32/Network/Sendfile/BSD.hsc 2001-09-09
03:46:40.000000000 +0200
+++ new/simple-sendfile-0.2.33/Network/Sendfile/BSD.hsc 2001-09-09
03:46:40.000000000 +0200
@@ -63,19 +63,15 @@
sendfileFd :: Socket -> Fd -> FileRange -> IO () -> IO ()
sendfileFd sock fd range hook = do
-#if MIN_VERSION_network(3,1,0)
+ checkRange range
withFdSocket sock $ \s -> do
let dst = Fd s
-#elif MIN_VERSION_network(3,0,0)
- dst <- Fd <$> fdSocket sock
-#else
- let dst = Fd $ fdSocket sock
-#endif
- alloca $ \sentp -> do
- let (off,len) = case range of
- EntireFile -> (0, entire)
- PartOfFile off' len' -> (fromInteger off', fromInteger len')
- sendloop dst fd off len sentp hook
+ alloca $ \sentp -> case range of
+ EntireFile -> sendloop dst fd 0 entire sentp hook
+ -- 0 means the entire file for BSD sendfile(), so skip it.
+ PartOfFile off len
+ | len <= 0 -> return ()
+ | otherwise -> sendloop dst fd (fromInteger off) (fromInteger len)
sentp hook
sendloop :: Fd -> Fd -> COff -> COff -> Ptr COff -> IO () -> IO ()
sendloop dst src off len sentp hook = do
@@ -85,14 +81,16 @@
if errno `elem` [eAGAIN, eINTR] then do
sent <- peek sentp
hook
- -- Parallel IO manager use edge-trigger mode.
- -- So, calling threadWaitWrite only when errnor is eAGAIN.
- when (errno == eAGAIN) $ threadWaitWrite dst
let newoff = off + sent
newlen = if len == entire then entire else len - sent
- sendloop dst src newoff newlen sentp hook
+ -- newlen must not reach 0, which means the entire file.
+ unless (len /= entire && newlen <= 0) $ do
+ -- Parallel IO manager use edge-trigger mode.
+ -- So, calling threadWaitWrite only when errnor is eAGAIN.
+ when (errno == eAGAIN) $ threadWaitWrite dst
+ sendloop dst src newoff newlen sentp hook
else
- throwErrno "Network.SendFile.MacOS.sendloop"
+ throwErrno "Network.Sendfile.BSD.sendloop"
----------------------------------------------------------------
@@ -135,16 +133,14 @@
sendfileFdWithHeader :: Socket -> Fd -> FileRange -> IO () -> [ByteString] ->
IO ()
sendfileFdWithHeader sock fd range hook hdr = do
-#if MIN_VERSION_network(3,1,0)
+ checkRange range
withFdSocket sock $ \s -> do
let dst = Fd s
-#elif MIN_VERSION_network(3,0,0)
- dst <- Fd <$> fdSocket sock
-#else
- let dst = Fd $ fdSocket sock
-#endif
alloca $ \sentp ->
- if isFreeBSD && hlen >= 8192 then do
+ if isEmptyPart then
+ -- 0 means the entire file for BSD sendfile(), so skip it.
+ sendMany sock hdr
+ else if isFreeBSD && hlen >= 8192 then do
-- If the length of the header is larger than 8191,
-- threadWaitWrite does not come back on FreeBSD, sigh.
-- We use writev() for the header and sendfile() for the file.
@@ -158,17 +154,18 @@
EntireFile -> (0,entire)
PartOfFile off' len' -> (fromInteger off'
,fromInteger len' + hlen)
- mrc <- sendloopHeader dst fd off len sentp hdr hlen
+ mrc <- sendloopHeader dst fd off len sentp hdr hlen hook
case mrc of
Nothing -> return ()
- Just (newoff,newlen) -> do
- threadWaitWrite dst
- sendloop dst fd newoff newlen sentp hook
+ Just (newoff,newlen) -> sendloop dst fd newoff newlen sentp
hook
where
hlen = fromIntegral . sum . map BS.length $ hdr
+ isEmptyPart = case range of
+ PartOfFile _ len -> len <= 0
+ EntireFile -> False
-sendloopHeader :: Fd -> Fd -> COff -> COff -> Ptr COff -> [ByteString] -> COff
-> IO (Maybe (COff, COff))
-sendloopHeader dst src off len sentp hdr hlen = do
+sendloopHeader :: Fd -> Fd -> COff -> COff -> Ptr COff -> [ByteString] -> COff
-> IO () -> IO (Maybe (COff, COff))
+sendloopHeader dst src off len sentp hdr hlen hook = do
rc <- withSfHdtr hdr $ sendFile src dst off len sentp
if rc == 0 then
return Nothing
@@ -176,22 +173,27 @@
errno <- getErrno
if errno `elem` [eAGAIN, eINTR] then do
sent <- peek sentp
+ hook
+ -- Parallel IO manager use edge-trigger mode.
+ -- So, calling threadWaitWrite only when errnor is eAGAIN.
+ let wait = when (errno == eAGAIN) $ threadWaitWrite dst
if sent >= hlen then do
let newoff = off + sent - hlen
if len == entire then
- return $ Just (newoff, entire)
+ wait >> return (Just (newoff, entire))
+ else if len - sent <= 0 then
+ -- 0 means the entire file, so stop here.
+ return Nothing
else
- return $ Just (newoff, len - sent)
+ wait >> return (Just (newoff, len - sent))
else do
- -- Parallel IO manager use edge-trigger mode.
- -- So, calling threadWaitWrite only when errnor is eAGAIN.
- when (errno == eAGAIN) $ threadWaitWrite dst
let newlen = if len == entire then entire else len - sent
newhdr = remainingChunks (fromIntegral sent) hdr
newhlen = hlen - sent
- sendloopHeader dst src off newlen sentp newhdr newhlen
+ wait
+ sendloopHeader dst src off newlen sentp newhdr newhlen hook
else
- throwErrno "Network.SendFile.MacOS.sendloopHeader"
+ throwErrno "Network.Sendfile.BSD.sendloopHeader"
----------------------------------------------------------------
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/simple-sendfile-0.2.32/Network/Sendfile/Fallback.hs
new/simple-sendfile-0.2.33/Network/Sendfile/Fallback.hs
--- old/simple-sendfile-0.2.32/Network/Sendfile/Fallback.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/simple-sendfile-0.2.33/Network/Sendfile/Fallback.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
module Network.Sendfile.Fallback (
sendfile
, sendfileWithHeader
@@ -7,45 +6,44 @@
import Control.Monad.IO.Class (MonadIO(liftIO))
import Data.ByteString (ByteString)
import Data.Conduit
-import Data.Conduit.Binary as EB
+import qualified Data.Conduit.Binary as EB
import Network.Sendfile.Types
import Network.Socket
-import Network.Socket.ByteString
import qualified Network.Socket.ByteString as SB
+import System.IO (Handle, IOMode(ReadMode), withBinaryFile)
-- |
-- Sendfile emulation using conduit.
--- Used system calls:
--
-- - Used system calls: open(), stat(), read(), send() and close().
sendfile :: Socket -> FilePath -> FileRange -> IO () -> IO ()
-sendfile sock path EntireFile hook =
- runConduitRes $ sourceFile path .| sinkSocket sock hook
-sendfile sock path (PartOfFile off len) hook =
- runConduitRes $ EB.sourceFileRange path (Just off) (Just len) .|
sinkSocket sock hook
-
--- See sinkHandle.
-sinkSocket :: MonadIO m => Socket -> IO () -> ConduitT ByteString Void m ()
-#if MIN_VERSION_conduit(0,5,0)
-sinkSocket s hook = awaitForever $ \bs -> liftIO $ SB.sendAll s bs >> hook
-#else
-sinkSocket s hook = NeedInput push close
- where
- push bs = flip PipeM (return ()) $ do
- liftIO (SB.sendAll s bs)
- liftIO hook
- return (NeedInput push close)
- close = return ()
-#endif
+sendfile sock path range hook = do
+ checkRange range
+ withBinaryFile path ReadMode $ \h -> sendHandle sock h range hook
-- |
-- Sendfile emulation using conduit.
--- Used system calls:
--
-- - Used system calls: open(), stat(), read(), writev(), send() and close().
+--
+-- The file is opened before the header is sent, so nothing is sent
+-- if the file cannot be opened.
sendfileWithHeader :: Socket -> FilePath -> FileRange -> IO () -> [ByteString]
-> IO ()
sendfileWithHeader sock path range hook hdr = do
- sendMany sock hdr
- sendfile sock path range hook
+ checkRange range
+ withBinaryFile path ReadMode $ \h -> do
+ SB.sendMany sock hdr
+ sendHandle sock h range hook
+
+sendHandle :: Socket -> Handle -> FileRange -> IO () -> IO ()
+sendHandle sock h range hook = runConduit $ source .| sinkSocket sock hook
+ where
+ source = case range of
+ EntireFile -> EB.sourceHandle h
+ PartOfFile off len -> EB.sourceHandleRange h (Just off) (Just len)
+
+-- See sinkHandle.
+sinkSocket :: MonadIO m => Socket -> IO () -> ConduitT ByteString Void m ()
+sinkSocket s hook = awaitForever $ \bs -> liftIO $ SB.sendAll s bs >> hook
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/simple-sendfile-0.2.32/Network/Sendfile/IOVec.hsc
new/simple-sendfile-0.2.33/Network/Sendfile/IOVec.hsc
--- old/simple-sendfile-0.2.32/Network/Sendfile/IOVec.hsc 2001-09-09
03:46:40.000000000 +0200
+++ new/simple-sendfile-0.2.33/Network/Sendfile/IOVec.hsc 2001-09-09
03:46:40.000000000 +0200
@@ -8,7 +8,6 @@
, remainingChunks
) where
-import Control.Monad (zipWithM_)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
@@ -18,6 +17,7 @@
import Foreign.Ptr (Ptr, nullPtr, plusPtr)
import Foreign.Storable (Storable(..))
+#include <limits.h>
#include <sys/uio.h>
#include <sys/socket.h>
@@ -29,8 +29,8 @@
}
instance Storable IOVec where
- sizeOf _ = (#const sizeof(struct iovec))
- alignment _ = alignment (undefined :: CInt)
+ sizeOf _ = (#size struct iovec)
+ alignment _ = (#alignment struct iovec)
peek p = do
base <- (#peek struct iovec, iov_base) p
@@ -49,8 +49,8 @@
}
instance Storable SfHdtr where
- sizeOf _ = (#const sizeof(struct sf_hdtr))
- alignment _ = alignment (undefined :: CInt)
+ sizeOf _ = (#size struct sf_hdtr)
+ alignment _ = (#alignment struct sf_hdtr)
peek p = do
hdr <- (#peek struct sf_hdtr, headers) p
@@ -65,23 +65,27 @@
----------------------------------------------------------------
+-- The buffers stay valid while 'f' runs since the calls are nested.
withIOVec :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a
withIOVec cs f =
- allocaArray csLen $ \aPtr -> do
- zipWithM_ pokeIov (ptrs aPtr) cs
- f (aPtr, csLen)
+ allocaArray csLen $ \aPtr -> go aPtr aPtr cs
where
csLen = length cs
- ptrs = iterate (`plusPtr` sizeOf (undefined :: IOVec))
- pokeIov ptr s =
- unsafeUseAsCStringLen s $ \(sPtr, sLen) ->
- poke ptr $ IOVec sPtr (fromIntegral sLen)
+ go aPtr _ [] = f (aPtr, csLen)
+ go aPtr ptr (s:ss) =
+ unsafeUseAsCStringLen s $ \(sPtr, sLen) -> do
+ poke ptr $ IOVec sPtr (fromIntegral sLen)
+ go aPtr (ptr `plusPtr` sizeOf (undefined :: IOVec)) ss
+-- Too many chunks cause EINVAL, so they are concatenated.
withSfHdtr :: [ByteString] -> (Ptr SfHdtr -> IO a) -> IO a
-withSfHdtr cs f = withIOVec cs $ \(iovecp,len) ->
+withSfHdtr cs0 f = withIOVec cs $ \(iovecp,len) ->
alloca $ \sfhdtrp -> do
poke sfhdtrp $ SfHdtr iovecp (fromIntegral len)
f sfhdtrp
+ where
+ cs | length cs0 > (#const IOV_MAX) = [BS.concat cs0]
+ | otherwise = cs0
----------------------------------------------------------------
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/simple-sendfile-0.2.32/Network/Sendfile/Linux.hsc
new/simple-sendfile-0.2.33/Network/Sendfile/Linux.hsc
--- old/simple-sendfile-0.2.32/Network/Sendfile/Linux.hsc 2001-09-09
03:46:40.000000000 +0200
+++ new/simple-sendfile-0.2.33/Network/Sendfile/Linux.hsc 2001-09-09
03:46:40.000000000 +0200
@@ -1,5 +1,6 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CApiFFI #-}
+-- Let sendfile() take a 64-bit off_t also on 32-bit platforms.
+{-# OPTIONS_GHC -optc-D_FILE_OFFSET_BITS=64 #-}
#define _FILE_OFFSET_BITS 64
@@ -14,13 +15,13 @@
import Control.Exception
import Control.Monad
-import Data.ByteString as B
-import Data.ByteString.Internal
-import Foreign.C.Error (eAGAIN, getErrno, throwErrno)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
+import Foreign.C.Error (eAGAIN, eINTR, getErrno, throwErrno)
import Foreign.C.Types
import Foreign.Marshal (alloca)
-import Foreign.Ptr (Ptr, plusPtr, castPtr)
-import Foreign.ForeignPtr
+import Foreign.Ptr (Ptr, plusPtr)
import Foreign.Storable (poke, sizeOf)
import GHC.Conc (threadWaitWrite)
import Network.Sendfile.Types
@@ -93,37 +94,31 @@
-- is sent and before waiting the socket to be ready for writing.
sendfileFd :: Socket -> Fd -> FileRange -> IO () -> IO ()
sendfileFd sock fd range hook = do
-#if MIN_VERSION_network(3,1,0)
withFdSocket sock $ \s -> do
let dst = Fd s
-#elif MIN_VERSION_network(3,0,0)
- dst <- Fd <$> fdSocket sock
-#else
- let dst = Fd $ fdSocket sock
-#endif
sendfileFd' dst fd range hook
sendfileFd' :: Fd -> Fd -> FileRange -> IO () -> IO ()
-sendfileFd' dst src range hook =
- alloca $ \offp -> case range of
+sendfileFd' dst src range hook = do
+ checkRange range
+ alloca $ \offp -> case range of
EntireFile -> do
poke offp 0
-- System call is very slow. Use PartOfFile instead.
len <- fileSize <$> getFdStatus src
- let len' = fromIntegral len
- sendfileloop dst src offp len' hook
+ sendfileloop dst src offp len hook
PartOfFile off len -> do
poke offp (fromIntegral off)
- let len' = fromIntegral len
- sendfileloop dst src offp len' hook
+ sendfileloop dst src offp (fromIntegral len) hook
-sendfileloop :: Fd -> Fd -> Ptr COff -> CSize -> IO () -> IO ()
+-- The remaining length is COff since CSize is 32-bit on 32-bit platforms.
+sendfileloop :: Fd -> Fd -> Ptr COff -> COff -> IO () -> IO ()
sendfileloop dst src offp len hook = do
-- Multicore IO manager use edge-trigger mode.
-- So, calling threadWaitWrite only when errnor is eAGAIN.
let toSend
- | len > safeSize = safeSize
- | otherwise = len
+ | len > fromIntegral safeSize = safeSize
+ | otherwise = fromIntegral len
bytes <- c_sendfile dst src offp toSend
case bytes of
-1 -> do
@@ -131,8 +126,10 @@
if errno == eAGAIN then do
threadWaitWrite dst
sendfileloop dst src offp len hook
+ else if errno == eINTR then
+ sendfileloop dst src offp len hook
else
- throwErrno "Network.SendFile.Linux.sendfileloop"
+ throwErrno "Network.Sendfile.Linux.sendfileloop"
0 -> return () -- the file is truncated
_ -> do
hook
@@ -140,7 +137,7 @@
when (left /= 0) $ sendfileloop dst src offp left hook
-- Dst Src in order. take care
-foreign import ccall unsafe "sendfile"
+foreign import capi unsafe "sys/sendfile.h sendfile"
c_sendfile :: Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
----------------------------------------------------------------
@@ -149,9 +146,9 @@
-- Simple binding for send() and sendfile() of Linux.
-- Used system calls:
--
--- - EntireFile -- send(), open(), stat(), sendfile(), and close()
+-- - EntireFile -- open(), send(), stat(), sendfile(), and close()
--
--- - PartOfFile -- send(), open(), sendfile(), and close()
+-- - PartOfFile -- open(), send(), sendfile(), and close()
--
-- The fifth header is sent with send() + the MSG_MORE flag. If the
-- file is small enough, the header and the file is send in a single
@@ -166,10 +163,11 @@
-- is sent and before waiting the socket to be ready for writing.
sendfileWithHeader :: Socket -> FilePath -> FileRange -> IO () -> [ByteString]
-> IO ()
-sendfileWithHeader sock path range hook hdr = do
- -- Copying is much faster than syscall.
- sendMsgMore sock $ B.concat hdr
- sendfile sock path range hook
+sendfileWithHeader sock path range hook hdr = bracket setup teardown $ \fd ->
+ sendfileFdWithHeader sock fd range hook hdr
+ where
+ setup = openFd path ReadOnly defaultFileFlags{nonBlock=True}
+ teardown = closeFd
-- |
-- Simple binding for send() and sendfile() of Linux.
@@ -193,25 +191,14 @@
sendfileFdWithHeader :: Socket -> Fd -> FileRange -> IO () -> [ByteString] ->
IO ()
sendfileFdWithHeader sock fd range hook hdr = do
+ checkRange range
-- Copying is much faster than syscall.
sendMsgMore sock $ B.concat hdr
sendfileFd sock fd range hook
sendMsgMore :: Socket -> ByteString -> IO ()
-sendMsgMore sock bs = withForeignPtr fptr $ \ptr -> do
-#if MIN_VERSION_network(3,1,0)
- withFdSocket sock $ \fd -> do
- let s = Fd fd
-#elif MIN_VERSION_network(3,0,0)
- s <- Fd <$> fdSocket sock
-#else
- let s = Fd $ fdSocket sock
-#endif
- let buf = castPtr (ptr `plusPtr` off)
- siz = fromIntegral len
- sendloop s buf siz
- where
- PS fptr off len = bs
+sendMsgMore sock bs = unsafeUseAsCStringLen bs $ \(buf, len) ->
+ withFdSocket sock $ \fd -> sendloop (Fd fd) buf (fromIntegral len)
sendloop :: Fd -> Ptr CChar -> CSize -> IO ()
sendloop s buf len = do
@@ -221,8 +208,10 @@
if errno == eAGAIN then do
threadWaitWrite s
sendloop s buf len
+ else if errno == eINTR then
+ sendloop s buf len
else
- throwErrno "Network.SendFile.Linux.sendloop"
+ throwErrno "Network.Sendfile.Linux.sendloop"
else do
let sent = fromIntegral bytes
when (sent /= len) $ do
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/simple-sendfile-0.2.32/Network/Sendfile/Types.hs
new/simple-sendfile-0.2.33/Network/Sendfile/Types.hs
--- old/simple-sendfile-0.2.32/Network/Sendfile/Types.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/simple-sendfile-0.2.33/Network/Sendfile/Types.hs 2001-09-09
03:46:40.000000000 +0200
@@ -2,6 +2,8 @@
module Network.Sendfile.Types where
+import GHC.IO.Exception (IOErrorType(InvalidArgument), IOException(..))
+
#ifdef VERSION_unix
import qualified Data.ByteString as B
@@ -12,6 +14,16 @@
-- |
-- File range for 'sendfile'.
+--
+-- * If the offset or the length of 'PartOfFile' is negative, an
+-- 'IOException' of 'InvalidArgument' is thrown before anything is sent.
+--
+-- * If the length is 0, nothing is sent (only the header for the
+-- @WithHeader@ variants).
+--
+-- * If the file is shorter than the range, or is truncated while
+-- being sent, sending stops at the end of the file without any
+-- error. So, the number of bytes sent may be less than requested.
data FileRange = EntireFile
| PartOfFile {
@@ -19,6 +31,13 @@
, rangeLength :: Integer
}
+-- | Throws 'InvalidArgument' if the offset or the length is negative.
+checkRange :: FileRange -> IO ()
+checkRange (PartOfFile off len)
+ | off < 0 || len < 0 = ioError $ IOError Nothing InvalidArgument
+ "Network.Sendfile" "negative offset or length" Nothing Nothing
+checkRange _ = return ()
+
-- To avoid build error in windows
#ifdef VERSION_unix
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/simple-sendfile-0.2.32/simple-sendfile.cabal
new/simple-sendfile-0.2.33/simple-sendfile.cabal
--- old/simple-sendfile-0.2.32/simple-sendfile.cabal 2001-09-09
03:46:40.000000000 +0200
+++ new/simple-sendfile-0.2.33/simple-sendfile.cabal 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
cabal-version: >=1.10
name: simple-sendfile
-version: 0.2.32
+version: 0.2.33
license: BSD3
license-file: LICENSE
maintainer: Kazu Yamamoto <[email protected]>
@@ -13,7 +13,10 @@
category: Network
build-type: Simple
-extra-source-files: test/inputFile
+tested-with: GHC == 9.2.8 || == 9.4.8 || == 9.6.7 || == 9.8.4 || ==
9.10.3 || == 9.12.4 || == 9.14.1
+extra-source-files:
+ ChangeLog.md
+ test/inputFile
source-repository head
type: git
@@ -32,7 +35,7 @@
default-language: Haskell2010
ghc-options: -Wall
build-depends:
- base >=4.8 && <5,
+ base >=4.16 && <5,
network >=3.1.4,
bytestring
@@ -63,10 +66,8 @@
else
other-modules: Network.Sendfile.Fallback
build-depends:
- conduit >=1.0 && <1.4,
- conduit-extra >=1.0 && <1.4,
- transformers >=0.2.2 && <0.7,
- resourcet
+ conduit >=1.3 && <1.4,
+ conduit-extra >=1.3 && <1.4
test-suite spec
type: exitcode-stdio-1.0
@@ -75,13 +76,14 @@
hs-source-dirs: test
other-modules: SendfileSpec
default-language: Haskell2010
- ghc-options: -Wall
+ -- The non-threaded RTS on Windows sometimes misses EOF on sockets.
+ ghc-options: -Wall -threaded
build-depends:
HUnit,
base,
bytestring,
- conduit,
- conduit-extra,
+ conduit >=1.3,
+ conduit-extra >=1.3,
directory,
easy-file >= 0.2.4,
hspec >=1.3,
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/simple-sendfile-0.2.32/test/SendfileSpec.hs
new/simple-sendfile-0.2.33/test/SendfileSpec.hs
--- old/simple-sendfile-0.2.32/test/SendfileSpec.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/simple-sendfile-0.2.33/test/SendfileSpec.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module SendfileSpec where
@@ -22,6 +22,7 @@
import System.Timeout
import System.EasyFile
import Test.Hspec
+import System.IO.Unsafe (unsafePerformIO)
----------------------------------------------------------------
@@ -32,6 +33,8 @@
sendFile EntireFile `shouldReturn` True
it "sends a part of file" $ do
sendFile (PartOfFile 2000 1000000) `shouldReturn` True
+ it "sends nothing for a zero-length part" $ do
+ sendFile (PartOfFile 2000 0) `shouldReturn` True
it "terminates even if length is over" $ do
shouldTerminate $ sendIllegal (PartOfFile 2000 5000000)
it "terminates even if offset is over" $ do
@@ -41,15 +44,23 @@
-- not a right test.
it "terminates even if the file is truncated" $ do
shouldTerminate truncateFile
+ it "rejects a negative offset" $ do
+ sendRejected (PartOfFile (-1) 1000) `shouldReturn` ""
+ it "rejects a negative length" $ do
+ sendRejected (PartOfFile 2000 (-1)) `shouldReturn` ""
describe "sendfileWithHeader" $ do
it "sends an header and an entire file" $ do
sendFileH EntireFile `shouldReturn` True
it "sends an header and a part of file" $ do
sendFileH (PartOfFile 2000 1000000) `shouldReturn` True
+ it "sends only an header for a zero-length part" $ do
+ sendFileH (PartOfFile 2000 0) `shouldReturn` True
it "sends a large header and an entire file" $ do
sendFileHLarge EntireFile `shouldReturn` True
it "sends a large header and a part of file" $ do
sendFileHLarge (PartOfFile 2000 1000000) `shouldReturn` True
+ it "sends a header with many chunks" $ do
+ sendFileCore EntireFile (Prelude.replicate 5000 "a\n")
`shouldReturn` True
it "terminates even if length is over" $ do
shouldTerminate $ sendIllegalH (PartOfFile 2000 5000000)
it "terminates even if offset is over" $ do
@@ -59,9 +70,18 @@
-- not a right test.
it "terminates even if the file is truncated" $ do
shouldTerminate truncateFileH
+ it "sends nothing for a negative offset" $ do
+ sendRejectedH (PartOfFile (-1) 1000) `shouldReturn` ""
+ it "sends nothing for a negative length" $ do
+ sendRejectedH (PartOfFile 2000 (-1)) `shouldReturn` ""
+ it "sends nothing if the file does not exist" $ do
+ sendMissingH `shouldReturn` ""
where
fiveSecs = 5000000
- shouldTerminate body = timeout fiveSecs body `shouldReturn` Just ()
+ shouldTerminate body = do
+ r <- timeout fiveSecs body
+ when (r == Nothing) $ tr "TIMEOUT" >> dumpTrace
+ r `shouldBe` Just ()
----------------------------------------------------------------
@@ -94,11 +114,9 @@
sendFileCore :: FileRange -> [ByteString] -> IO Bool
sendFileCore range headers = bracket setup teardown $ \(s2,_) -> do
-#if MIN_VERSION_conduit(1,3,0)
+ tr "reader:begin"
runResourceT $ runConduit (sourceSocket s2 .| sinkFile outputFile)
-#else
- runResourceT $ sourceSocket s2 $$ sinkFile outputFile
-#endif
+ tr "reader:eof"
runResourceT $ copyfile range
!f1 <- BL.readFile outputFile
!f2 <- BL.readFile expectedFile
@@ -106,39 +124,35 @@
where
copyfile EntireFile = do
-- of course, we can use <> here
-#if MIN_VERSION_conduit(1,3,0)
runConduit (sourceList headers .| sinkFile expectedFile)
runConduit (sourceFile inputFile .| sinkAppendFile expectedFile)
-#else
- sourceList headers $$ sinkFile expectedFile
- sourceFile inputFile $$ sinkAppendFile expectedFile
-#endif
copyfile (PartOfFile off len) = do
-#if MIN_VERSION_conduit(1,3,0)
runConduit (sourceList headers .| sinkFile expectedFile)
runConduit (sourceFile inputFile
.| CB.isolate (off' + len')
.| (CB.take off' >> sinkAppendFile expectedFile))
-#else
- sourceList headers $$ sinkFile expectedFile
- sourceFile inputFile $= CB.isolate (off' + len')
- $$ (CB.take off' >> sinkAppendFile expectedFile)
-#endif
where
off' = fromIntegral off
len' = fromIntegral len
setup = do
+ tr "setup:begin"
(s1,s2) <- socketPair AF_UNIX Stream 0
- tid <- forkIO (sf s1 `finally` sendEOF s1)
+ tr "setup:pair"
+ tid <- forkIO $
+ (tr "sender:begin" >> sf s1 >> tr "sender:sent")
+ `finally` (tr "sender:close" >> sendEOF s1 >> tr "sender:closed")
return (s2,tid)
where
sf s1
- | headers == [] = sendfile s1 inputFile range (return ())
- | otherwise = sendfileWithHeader s1 inputFile range (return ())
headers
+ | headers == [] = sendfile s1 inputFile range (tr "sender:hook")
+ | otherwise = sendfileWithHeader s1 inputFile range (tr
"sender:hook") headers
sendEOF = close
teardown (s2,tid) = do
+ tr "teardown:begin"
close s2
+ tr "teardown:closed"
killThread tid
+ tr "teardown:killed"
removeFileIfExists outputFile
removeFileIfExists expectedFile
inputFile = "test/inputFile"
@@ -164,31 +178,64 @@
sendIllegalCore :: FileRange -> [ByteString] -> IO ()
sendIllegalCore range headers = bracket setup teardown $ \(s2,_) -> do
-#if MIN_VERSION_conduit(1,3,0)
+ tr "reader:begin"
runResourceT $ runConduit (sourceSocket s2 .| sinkFile outputFile)
-#else
- runResourceT $ sourceSocket s2 $$ sinkFile outputFile
-#endif
+ tr "reader:eof"
return ()
where
setup = do
+ tr "setup:begin"
(s1,s2) <- socketPair AF_UNIX Stream 0
- tid <- forkIO (sf s1 `finally` sendEOF s1)
+ tr "setup:pair"
+ tid <- forkIO $
+ (tr "sender:begin" >> sf s1 >> tr "sender:sent")
+ `finally` (tr "sender:close" >> sendEOF s1 >> tr "sender:closed")
return (s2,tid)
where
sf s1
- | headers == [] = sendfile s1 inputFile range (return ())
- | otherwise = sendfileWithHeader s1 inputFile range (return ())
headers
+ | headers == [] = sendfile s1 inputFile range (tr "sender:hook")
+ | otherwise = sendfileWithHeader s1 inputFile range (tr
"sender:hook") headers
sendEOF = close
teardown (s2,tid) = do
+ tr "teardown:begin"
close s2
+ tr "teardown:closed"
killThread tid
+ tr "teardown:killed"
removeFileIfExists outputFile
inputFile = "test/inputFile"
outputFile = "test/outputFile"
----------------------------------------------------------------
+-- Returns what the peer received after sendfileWithHeader failed.
+sendMissingH :: IO ByteString
+sendMissingH = sendFailing $ \s ->
+ sendfileWithHeader s "test/nonexistent" EntireFile (return ()) ["header"]
+
+sendRejected :: FileRange -> IO ByteString
+sendRejected range = sendFailing $ \s ->
+ sendfile s "test/inputFile" range (return ())
+
+sendRejectedH :: FileRange -> IO ByteString
+sendRejectedH range = sendFailing $ \s ->
+ sendfileWithHeader s "test/inputFile" range (return ()) ["header"]
+
+-- Runs an action expected to throw and returns what the peer received.
+sendFailing :: (Socket -> IO ()) -> IO ByteString
+sendFailing act = bracket setup teardown $ \(s1,s2) -> do
+ r <- try $ act s1
+ case r of
+ Left (_ :: IOException) -> return ()
+ Right () -> expectationFailure "no exception"
+ close s1
+ BS.concat <$> runConduit (sourceSocket s2 .| CL.consume)
+ where
+ setup = socketPair AF_UNIX Stream 0
+ teardown (_,s2) = close s2
+
+----------------------------------------------------------------
+
truncateFile :: IO ()
truncateFile = truncateFileCore []
@@ -206,19 +253,13 @@
truncateFileCore :: [ByteString] -> IO ()
truncateFileCore headers = bracket setup teardown $ \(s2,_) -> do
-#if MIN_VERSION_conduit(1,3,0)
+ tr "reader:begin"
runResourceT $ runConduit (sourceSocket s2 .| sinkFile outputFile)
-#else
- runResourceT $ sourceSocket s2 $$ sinkFile outputFile
-#endif
+ tr "reader:eof"
return ()
where
setup = do
-#if MIN_VERSION_conduit(1,3,0)
runResourceT $ runConduit (sourceFile inputFile .| sinkFile tempFile)
-#else
- runResourceT $ sourceFile inputFile $$ sinkFile tempFile
-#endif
(s1,s2) <- socketPair AF_UNIX Stream 0
ref <- newIORef (1 :: Int)
tid <- forkIO (sf s1 ref `finally` sendEOF s1)
@@ -233,8 +274,11 @@
when (n == 10) $ setFileSize tempFile 900000
writeIORef ref (n+1)
teardown (s2,tid) = do
+ tr "teardown:begin"
close s2
+ tr "teardown:closed"
killThread tid
+ tr "teardown:killed"
removeFileIfExists tempFile
removeFileIfExists outputFile
inputFile = "test/inputFile"
@@ -251,9 +295,25 @@
sinkAppendFile :: MonadResource m
=> FilePath
-#if MIN_VERSION_conduit(1,3,0)
-> ConduitT ByteString Void m ()
-#else
- -> Sink ByteString m ()
-#endif
sinkAppendFile fp = sinkIOHandle (openBinaryFile fp AppendMode)
+
+----------------------------------------------------------------
+
+-- Lightweight trace ring dumped only on timeout, to locate hangs
+-- without perturbing timing (formatting happens in dumpTrace).
+traceBuf :: IORef [(ThreadId, String)]
+traceBuf = unsafePerformIO $ newIORef []
+{-# NOINLINE traceBuf #-}
+
+tr :: String -> IO ()
+tr msg = do
+ tid <- myThreadId
+ atomicModifyIORef' traceBuf (\xs -> (Prelude.take 200 ((tid, msg) : xs),
()))
+
+dumpTrace :: IO ()
+dumpTrace = do
+ xs <- atomicModifyIORef' traceBuf (\xs -> ([], xs))
+ forM_ (Prelude.reverse (Prelude.take 80 xs)) $ \(t, m) ->
+ System.IO.hPutStrLn stderr ("TRACE " ++ show t ++ " " ++ m)
+ hFlush stderr
