{-# LINE 1 "src/Network/Socket/Splice.hsc" #-} {- | {-# LINE 2 "src/Network/Socket/Splice.hsc" #-} This library implements efficient socket to socket data transfer loops for proxy servers. On Linux, it uses the zero-copy splice() system call: <http://kerneltrap.org/node/6505>. On all other operating systems, it currently falls back to a portable Haskell implementation that allocates a constant-sized memory buffer before it enters an inner loop which then uses hGetBufSome and hPutBuf; this avoids lots of tiny allocations as would otherwise be caused by recv and sendAll functions from Network.Socket.ByteString. -} -- -- Module : Network.Socket.Splice -- Copyright : (c) Cetin Sert 2012 -- License : BSD-style -- Maintainer : fusion@corsis.eu -- Stability : stable -- Portability : GHC-only, works on all OSes {-# LINE 24 "src/Network/Socket/Splice.hsc" #-} {-# LINE 25 "src/Network/Socket/Splice.hsc" #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LINE 28 "src/Network/Socket/Splice.hsc" #-} module Network.Socket.Splice ( -- * Cross-platform API for Socket to Socket Data Transfer Loops {- | 'splice' is the cross-platform API for continous, uni-directional data transfer between two network sockets. It is an /infinite loop/ that is intended to be used with 'Control.Concurrent.forkIO': > void . forkIO . try_ $ splice 1024 sourceSocket targetSocket > void . forkIO . try_ $ splice 1024 targetSocket sourceSocket -} splice , ChunkSize , zeroCopy -- * Combinators for Exception Handling , try_ -- * Linux splice() Components {- | These are available only on Linux and will be moved to a different namespace in later releases. Their names will stay the same. -} {-# LINE 58 "src/Network/Socket/Splice.hsc" #-} , c_splice , sPLICE_F_MOVE , sPLICE_F_MORE , sPLICE_F_NONBLOCK {-# LINE 63 "src/Network/Socket/Splice.hsc" #-} ) where import Data.Word import Foreign.Ptr import Network.Socket import Control.Monad import Control.Exception import System.IO import System.Posix.Types import System.Posix.Internals import GHC.IO.Handle.FD {-# LINE 78 "src/Network/Socket/Splice.hsc" #-} import Data.Int import Data.Bits import Unsafe.Coerce import Foreign.C.Types import Foreign.C.Error import System.Posix.IO {-# LINE 87 "src/Network/Socket/Splice.hsc" #-} -- | Indicates whether 'splice' uses zero-copy system calls -- or the portable user mode Haskell substitue implementation. zeroCopy :: Bool -- ^ True: uses zero-copy system calls; otherwise: portable. zeroCopy = {-# LINE 94 "src/Network/Socket/Splice.hsc" #-} True {-# LINE 98 "src/Network/Socket/Splice.hsc" #-} -------------------------------------------------------------------------------- -- | The numeric type used to recommend chunk sizes for moving -- data between sockets used by both the Linux 'splice' and -- the portable implementation of 'splice'. type ChunkSize = {-# LINE 107 "src/Network/Socket/Splice.hsc" #-} (Word32) {-# LINE 108 "src/Network/Socket/Splice.hsc" #-} {-# LINE 111 "src/Network/Socket/Splice.hsc" #-} -- | Pipes data from one socket to another in an -- **infinite loop**. -- -- On Linux this happens in kernel space with -- zero copying between kernel and user spaces. -- -- On other operating systems, a portable -- implementation utilizes a user space buffer -- and works on handles instead of file descriptors. splice :: ChunkSize -- ^ Chunk size. -> Socket -- ^ Source socket. -> Socket -- ^ Target socket. -> IO () -- ^ Infinite loop. splice len sIn sOut = do let throwRecv0 = error "Network.Socket.Splice.splice ended" let fdIn = fdSocket sIn let fdOut = fdSocket sOut {-# LINE 135 "src/Network/Socket/Splice.hsc" #-} print "LINUX-SPLICE" (r,w) <- createPipe -- r: read end of pipe print ('+',r,w) -- w: write end of pipe let s = Fd fdIn -- s: source socket let t = Fd fdOut -- t: target socket let n = nullPtr let u = unsafeCoerce :: (Int32) -> (Word32) {-# LINE 144 "src/Network/Socket/Splice.hsc" #-} let check = throwErrnoIfMinus1 "Network.Socket.Splice.splice" let flags = sPLICE_F_MOVE .|. sPLICE_F_MORE let setNonBlockingMode v = do setNonBlockingFD fdIn v setNonBlockingFD fdOut v setNonBlockingMode False finally (forever $ do bytes <- check $ c_splice s n w n len flags if bytes > 0 then c_splice r n t n (u bytes) flags else throwRecv0) (do closeFd r closeFd w try_ $ setNonBlockingMode True print ('-',r,w)) {-# LINE 182 "src/Network/Socket/Splice.hsc" #-} -- | Similar to 'Control.Exception.Base.try' but used when an -- obvious exception is expected whose type can be safely -- ignored. try_ :: IO () -- ^ The action to run which can throw any exception. -> IO () -- ^ The new action where exceptions are silenced. try_ a = (try a :: IO (Either SomeException ())) >> return () -------------------------------------------------------------------------------- {-# LINE 197 "src/Network/Socket/Splice.hsc" #-} -- SPLICE -- fcntl.h -- ssize_t splice( -- int fd_in, -- loff_t* off_in, -- int fd_out, -- loff_t* off_out, -- size_t len, -- unsigned int flags -- ); -- | Moves data between two file descriptors without -- copying between kernel address space and user -- address space. It transfers up to 'len' bytes of -- data from the file descriptor 'fd_in' to the file -- file descriptor 'fd_out', where one of the -- descriptors must refer to a pipe. -- -- 'c_splice' is NOT a loop and needs to called repeatedly. -- For an example, see the source code of 'splice'. foreign import ccall "splice" c_splice :: Fd -- ^ fd_in -> Ptr (Int64) -- ^ off_in {-# LINE 222 "src/Network/Socket/Splice.hsc" #-} -> Fd -- ^ fd_out -> Ptr (Int64) -- ^ off_out {-# LINE 224 "src/Network/Socket/Splice.hsc" #-} -> (Word32) -- ^ len {-# LINE 225 "src/Network/Socket/Splice.hsc" #-} -> Word -- ^ flags -> IO (Int32) -- ^ number of bytes moved or -1 on error {-# LINE 227 "src/Network/Socket/Splice.hsc" #-} -- | Attempt to move pages instead of copying. This is -- only a hint to the kernel: pages may stil be copied -- if the kernel cannot move the pages from the pipe, -- or if the pipe buffers don't refer to full pages. sPLICE_F_MOVE :: Word sPLICE_F_MOVE = (134522833) {-# LINE 235 "src/Network/Socket/Splice.hsc" #-} -- | More data will be coming in a subsequent splice. -- This is a helpful hint when 'fd_out' refers to a -- socket. sPLICE_F_MORE :: Word sPLICE_F_MORE = (134523015) {-# LINE 242 "src/Network/Socket/Splice.hsc" #-} -- | Do not block on I/O. This makes the splice pipe -- operations nonblocking, but splice() may nevertheless -- block because the file descriptors that are spliced -- to/from may block (unless they have the O_NONBLOCK flag -- set). sPLICE_F_NONBLOCK :: Word sPLICE_F_NONBLOCK = (134523323) {-# LINE 251 "src/Network/Socket/Splice.hsc" #-} {-# LINE 253 "src/Network/Socket/Splice.hsc" #-}