splice (empty) → 0.1

raw patch · 4 files changed

+263/−0 lines, 4 filesdep +basedep +networkdep +unixsetup-changed

Dependencies added: base, network, unix

Files

LICENSE +31/−0
Setup.lhs +6/−0
splice.cabal +53/−0
src/Network/Socket/Splice.hsc +173/−0

+ LICENSE view

@@ -0,0 +1,31 @@+Copyright (c) 2012, Cetin Sert++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * The names of contributors may not be used to endorse or promote+      products derived from this software without specific prior+      written permission. ++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.lhs view

@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell 
+> module Main where
+> import Distribution.Simple
+> main :: IO ()
+> main = defaultMain
+

+ splice.cabal view

@@ -0,0 +1,53 @@+name:          splice+version:       0.1+stability:     stable on Linux, experimental on other operating systems+synopsis:      Socket to Socket Data Splicing+description:   A library that 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.+               .+               This work has been funded by Corsis Research and is used+               in PortFusion: <http://portfusion.sf.net>+license:       BSD3+license-file:  LICENSE+author:        Cetin Sert <fusion@corsis.eu>+maintainer:    Cetin Sert <fusion@corsis.eu>+homepage:      http://fusion.corsis.eu+category:      Network+build-type:    Simple+cabal-version: >=1.2+copyright:     Copyright © 2012 Cetin Sert+tested-with:   GHC >= 7.4.3+++flag portable+    description: explicitly enable portable splice implemented in Haskell+    default    : False+++library++    hs-source-dirs:  src++    exposed-modules: Network.Socket.Splice++    if os(linux) && !flag(portable)+      build-depends: base    >= 4 && <= 6,+                     network >= 2 && <= 4,+                     unix    >= 2 && <= 4+      cpp-options: -DLINUX_SPLICE+      ghc-options: -O2 -O3 -fllvm -optlo-O3+    else+      build-depends: base    >= 4 && <= 6,+                     network >= 2 && <= 4+      cpp-options: -ULINUX_SPLICE+      ghc-options: -O2 -O3

+ src/Network/Socket/Splice.hsc view

@@ -0,0 +1,173 @@+-- |+-- Module      : Network.Socket.Splice+-- Copyright   : (c) Cetin Sert 2012+-- License     : BSD-style+--+-- Maintainer  : fusion@corsis.eu+-- Stability   : stable+-- Portability : GHC-only++#ifdef LINUX_SPLICE+#include <fcntl.h>+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+#endif++module Network.Socket.Splice (+    Length+  , zeroCopy+  , loopSplice+#ifdef LINUX_SPLICE+  , c_splice+#endif+  ) 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++#ifdef LINUX_SPLICE+import Data.Int+import Data.Bits+import Unsafe.Coerce+import Foreign.C.Types+import Foreign.C.Error+import System.Posix.IO+#else+import Foreign.Marshal.Alloc+#endif+++-- | Indicates whether 'loopSplice' uses zero copy system calls+--   or the portable user mode Haskell substitue implementation.+zeroCopy :: Bool -- ^ True: system calls; otherwise: portable.+zeroCopy =+#ifdef LINUX_SPLICE+  True+#else+  False+#endif+++--------------------------------------------------------------------------------+++type Length =+#ifdef LINUX_SPLICE+  (#type size_t)+#else+  Int+#endif++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 ++#ifdef LINUX_SPLICE++  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 :: (#type ssize_t) -> (#type size_t)+  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))++#else++  s <- fdToHandle fdIn+  t <- fdToHandle fdOut+  hSetBuffering s NoBuffering+  hSetBuffering t NoBuffering+  a <- mallocBytes len :: IO (Ptr Word8)++  print "PORTABLE-SPLICE"++  finally+    (forever $ do+       bytes <-   hGetBufSome s a len+       if bytes > 0+         then     hPutBuf     t a bytes+         else     throwRecv0)+    (do free a+        try_ $ hClose s+        try_ $ hClose t)++#endif+++--------------------------------------------------------------------------------+++#ifdef LINUX_SPLICE+-- 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 (#type loff_t)+  -> Fd+  -> Ptr (#type loff_t)+  -> (#type size_t)+  -> Word+  -> IO (#type ssize_t)++sPLICE_F_MOVE :: Word+sPLICE_F_MOVE = (#const "SPLICE_F_MOVE")++sPLICE_F_MORE :: Word+sPLICE_F_MORE = (#const "SPLICE_F_MORE")+#endif