{-# LINE 1 "src/Network/Socket/Splice/Internal.hsc" #-} -- | Implementation. {-# LINE 2 "src/Network/Socket/Splice/Internal.hsc" #-} -- -- Module : Network.Socket.Splice.Internal -- Copyright : (c) Cetin Sert 2012 -- License : BSD3 -- Maintainer : fusion@corsis.eu -- Stability : stable -- Portability : GHC-only, works on all operating systems {-# LINE 12 "src/Network/Socket/Splice/Internal.hsc" #-} {-# LINE 13 "src/Network/Socket/Splice/Internal.hsc" #-} {-# LINE 14 "src/Network/Socket/Splice/Internal.hsc" #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} module Network.Socket.Splice.Internal ( -- * 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. 'splice' and its implementation primitives 'hSplice' and 'fdSplice' are /infinite/ loops that are intended to be used with exception handlers and 'Control.Concurrent.forkIO'. [Initiate bi-directional continuous data transfer between two sockets:] > void . forkIO . try_ $ splice 1024 (sourceSocket, _) (targetSocket, _) > void . forkIO . try_ $ splice 1024 (targetSocket, _) (sourceSocket, _) -} splice , ChunkSize , zeroCopy -- * Combinators for Exception Handling , try_ -- * Implementation Primitives {- | Infinite loops used in the cross-platform implementation of 'splice'. -} , hSplice {-# LINE 47 "src/Network/Socket/Splice/Internal.hsc" #-} , fdSplice {-# LINE 49 "src/Network/Socket/Splice/Internal.hsc" #-} ) where import Data.Word import Foreign.Ptr import System.IO import Network.Socket import Control.Monad import Control.Exception import Foreign.Marshal.Alloc {-# LINE 63 "src/Network/Socket/Splice/Internal.hsc" #-} import Data.Int import Data.Bits import System.Posix.IO import Unsafe.Coerce import Foreign.C.Error import System.Posix.Types import System.Posix.Internals import qualified System.IO.Splice.Linux as L {-# LINE 74 "src/Network/Socket/Splice/Internal.hsc" #-} -------------------------------------------------------------------------------- -- | Indicates whether 'splice' uses zero-copy system calls or the portable user -- space Haskell implementation. zeroCopy :: Bool -- ^ @True@ if 'splice' uses zero-copy system calls; -- otherwise, false. zeroCopy = {-# LINE 85 "src/Network/Socket/Splice/Internal.hsc" #-} True {-# LINE 89 "src/Network/Socket/Splice/Internal.hsc" #-} -- | The numeric type to recommend chunk sizes for moving data between sockets -- used by both zero-copy and portable implementations of 'splice'. type ChunkSize = {-# LINE 95 "src/Network/Socket/Splice/Internal.hsc" #-} L.ChunkSize {-# LINE 99 "src/Network/Socket/Splice/Internal.hsc" #-} throwRecv0 :: a throwRecv0 = error "Network.Socket.Splice.splice ended" -- | Pipes data from one socket to another in an /infinite loop/. -- -- 'splice' currently has two implementations: -- -- [on GNU\/Linux using 'fdSplice' ≅] -- -- > splice len (sIn, _ ) (sOut, _ ) = ... fdSplice ... -- -- [on all other operating systems using 'hSplice' ≅] -- -- > splice len (_ , Just hIn) (_ , Just hOut) = ... hSplice ... -- -- [Notes] -- -- * 'fdSplice' and 'fdSplice' implementation of 'splice' are only available -- on GNU\/Linux. -- -- * 'hSplice' is always available and the 'hSplice' implementation of -- 'splice' can be forced on GNU\/Linux by defining the @portable@ flag at -- compile time. -- splice :: ChunkSize -- ^ chunk size. -> (Socket, Maybe Handle) -- ^ source socket and possibly its opened handle. -> (Socket, Maybe Handle) -- ^ target socket and possibly its opened handle. -> IO () -- ^ infinite loop. {-# LINE 131 "src/Network/Socket/Splice/Internal.hsc" #-} splice len (sIn, _ ) (sOut, _ ) = do {-# LINE 135 "src/Network/Socket/Splice/Internal.hsc" #-} {-# LINE 136 "src/Network/Socket/Splice/Internal.hsc" #-} let s = Fd $ fdSocket sIn let t = Fd $ fdSocket sOut fdSplice len s t {-# LINE 144 "src/Network/Socket/Splice/Internal.hsc" #-} {-# LINE 148 "src/Network/Socket/Splice/Internal.hsc" #-} {- | GNU\/Linux @splice()@ system call loop. 1. creates a pipe in kernel address space 2. uses it until the loop terminates by exception 3. closes the pipe and returns -} fdSplice :: ChunkSize -> Fd -> Fd -> IO () fdSplice len s@(Fd fdIn) t@(Fd fdOut) = do (r,w) <- createPipe let n = nullPtr let u = unsafeCoerce :: (Int32) -> (Word32) {-# LINE 163 "src/Network/Socket/Splice/Internal.hsc" #-} let check = throwErrnoIfMinus1 "Network.Socket.Splice.splice" let flags = L.sPLICE_F_MOVE .|. L.sPLICE_F_MORE let setNonBlockingMode v = do setNonBlockingFD fdIn v setNonBlockingFD fdOut v setNonBlockingMode False finally (forever $ do bytes <- check $ L.c_splice s n w n len flags if bytes > 0 then L.c_splice r n t n (u bytes) flags else throwRecv0) (do closeFd r closeFd w try_ $ setNonBlockingMode True) {-# LINE 180 "src/Network/Socket/Splice/Internal.hsc" #-} {- | The portable Haskell loop. 1. allocates a /single/ memory buffer in user address space 2. uses it until the loop terminates by exception 3. frees the buffer and returns -} hSplice :: Int -> Handle -> Handle -> IO () hSplice len s t = do sb <- hGetBuffering s; hSetBuffering s NoBuffering tb <- hGetBuffering s; hSetBuffering t NoBuffering a <- mallocBytes len :: IO (Ptr Word8) finally (forever $ do bytes <- hGetBufSome s a len if bytes > 0 then hPutBuf t a bytes else throwRecv0) (do free a try_ $ hSetBuffering s sb try_ $ hSetBuffering s tb) -- | Similar to 'Control.Exception.Base.try' but used when an obvious exception -- is expected which can be safely ignored. try_ :: IO () -- ^ action to run which can throw /any/ exception. -> IO () -- ^ new action where exceptions are silenced. try_ a = (try a :: IO (Either SomeException ())) >> return ()