{-# LINE 1 "src/Network/Socket/Splice.hsc" #-} -- | {-# LINE 2 "src/Network/Socket/Splice.hsc" #-} -- Module : Network.Socket.Splice -- Copyright : (c) Cetin Sert 2012 -- License : BSD-style -- -- Maintainer : fusion@corsis.eu -- Stability : stable -- Portability : GHC-only {-# LINE 11 "src/Network/Socket/Splice.hsc" #-} {-# LINE 12 "src/Network/Socket/Splice.hsc" #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LINE 15 "src/Network/Socket/Splice.hsc" #-} module Network.Socket.Splice ( Length , zeroCopy , loopSplice {-# LINE 21 "src/Network/Socket/Splice.hsc" #-} , c_splice {-# LINE 23 "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 37 "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 46 "src/Network/Socket/Splice.hsc" #-} -- | Indicates whether 'loopSplice' uses zero copy system calls -- or the portable user mode Haskell substitue implementation. zeroCopy :: Bool -- ^ True: system calls; otherwise: portable. zeroCopy = {-# LINE 53 "src/Network/Socket/Splice.hsc" #-} True {-# LINE 57 "src/Network/Socket/Splice.hsc" #-} -------------------------------------------------------------------------------- type Length = {-# LINE 64 "src/Network/Socket/Splice.hsc" #-} (Word32) {-# LINE 65 "src/Network/Socket/Splice.hsc" #-} {-# LINE 68 "src/Network/Socket/Splice.hsc" #-} try_ :: IO () -> IO () try_ a = (try a :: IO (Either SomeException ())) >> return () -- | The 'loopSplice' function 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 space. -- On other operating systems, a portable -- implementation utilizes a user space buffer -- and works on handles instead of file descriptors. loopSplice :: Length -- ^ Splice length -> Socket -- ^ Source socket -> Socket -- ^ Target socket -> IO () loopSplice len sIn sOut = do let throwRecv0 = error "Network.Socket.Splice.splice ended" let fdIn = fdSocket sIn let fdOut = fdSocket sOut {-# LINE 93 "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 102 "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 140 "src/Network/Socket/Splice.hsc" #-} -------------------------------------------------------------------------------- {-# LINE 146 "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 -- ); foreign import ccall "splice" c_splice :: Fd -> Ptr (Int64) {-# LINE 162 "src/Network/Socket/Splice.hsc" #-} -> Fd -> Ptr (Int64) {-# LINE 164 "src/Network/Socket/Splice.hsc" #-} -> (Word32) {-# LINE 165 "src/Network/Socket/Splice.hsc" #-} -> Word -> IO (Int32) {-# LINE 167 "src/Network/Socket/Splice.hsc" #-} sPLICE_F_MOVE :: Word sPLICE_F_MOVE = (134520145) {-# LINE 170 "src/Network/Socket/Splice.hsc" #-} sPLICE_F_MORE :: Word sPLICE_F_MORE = (134520205) {-# LINE 173 "src/Network/Socket/Splice.hsc" #-} {-# LINE 174 "src/Network/Socket/Splice.hsc" #-}