diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,33 @@ +Copyright (c) 2010, 2011, wren ng thornton. +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. + + * Neither the name of the copyright holders nor the names of + other contributors may 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. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,45 @@ +#!/usr/bin/env runhaskell +-- Cf. + +{-# OPTIONS_GHC -Wall -fwarn-tabs -fno-warn-missing-signatures #-} +module Main (main) where +import Distribution.Simple +import Distribution.Simple.LocalBuildInfo (withPrograms, buildDir) +import Distribution.Simple.Program (userSpecifyArgs) +import System.Directory +import System.FilePath +import Control.Monad (forM_) +---------------------------------------------------------------- + +-- | The list of generated files to remove. /N.B./, watch your file +-- extensions. +-- +-- TODO: this should be discovered dynamically. +generatedFiles :: [FilePath] +generatedFiles = + [ "System/Posix/Types/Iovec.hs" + ] + + +-- | Define __HADDOCK__ when building documentation. +main :: IO () +main = defaultMainWithHooks + $ simpleUserHooks `modify_haddockHook` \oldHH pkg lbi hooks flags -> do + + -- Horrible hack to force re-processing of the @.hsc@ files. + -- Otherwise the __HADDOCK__ macro doesn't end up being defined + -- because Cabal will reuse the processed file from before. + forM_ generatedFiles $ \file -> + removeFile (buildDir lbi file) `catch` \_ -> return () + + -- Call the old haddockHook with a modified LocalBuildInfo + (\lbi' -> oldHH pkg lbi' hooks flags) + $ lbi `modify_withPrograms` \oldWP -> + userSpecifyArgs "hsc2hs" ["-D__HADDOCK__"] oldWP + + +modify_haddockHook hooks f = hooks { haddockHook = f (haddockHook hooks) } +modify_withPrograms lbi f = lbi { withPrograms = f (withPrograms lbi) } + +---------------------------------------------------------------- +----------------------------------------------------------- fin. diff --git a/src/System/Posix/IO/ByteString.hsc b/src/System/Posix/IO/ByteString.hsc new file mode 100644 --- /dev/null +++ b/src/System/Posix/IO/ByteString.hsc @@ -0,0 +1,484 @@ +{- +/N.B./, There's a bug when trying to use Cabal-style MIN_VERSION_foo(1,2,3) +macros in combination with hsc2hs. We don't need full hsc2hs support +in this file, but if we use CPP instead we get a strange error on +OSX 10.5.8 about "architecture not supported" (even though the +headers work fine with hsc2hs). It turns out that we don't /need/ +to combine Cabal-style macros and hsc2hs\/cpp since we can remove +our dependency on the @unix@ package. But this issue is worth making +a note of. +-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# OPTIONS_GHC -Wall -fwarn-tabs #-} +---------------------------------------------------------------- +-- 2011.03.17 +-- | +-- Module : System.Posix.IO.ByteString +-- Copyright : Copyright (c) 2010--2011 wren ng thornton +-- License : BSD +-- Maintainer : wren@community.haskell.org +-- Stability : experimental +-- Portability : non-portable (POSIX.1, XPG4.2; hsc2hs, FFI) +-- +-- Provides a strict-'BS.ByteString' file-descriptor based I\/O +-- API, designed loosely after the @String@ file-descriptor based +-- I\/O API in "System.Posix.IO". The functions here wrap standard +-- C implementations of the functions specified by the ISO\/IEC +-- 9945-1:1990 (``POSIX.1'') and X\/Open Portability Guide Issue +-- 4, Version 2 (``XPG4.2'') specifications. +---------------------------------------------------------------- +module System.Posix.IO.ByteString + ( + -- * I\/O with file descriptors + -- ** Reading + -- *** The POSIX.1 @read(2)@ syscall + fdRead + , fdReadBuf + , fdReads + -- *** The XPG4.2 @readv(2)@ syscall + -- , fdReadv + , fdReadvBuf + -- *** The XPG4.2 @pread(2)@ syscall + , fdPread + , fdPreadBuf + , fdPreads + + -- ** Writing + -- *** The POSIX.1 @write(2)@ syscall + , fdWrite + , fdWriteBuf + , fdWrites + -- *** The XPG4.2 @writev(2)@ syscall + , fdWritev + , fdWritevBuf + -- *** The XPG4.2 @pwrite(2)@ syscall + , fdPwrite + , fdPwriteBuf + ) where + +import Data.Word (Word8) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSI +import qualified Data.ByteString.Unsafe as BSU + +import qualified System.IO.Error as IOE +{- +-- /N.B./, hsc2hs doesn't like this... +#if (MIN_VERSION_unix(2,4,0)) +import System.Posix.IO (fdReadBuf, fdWriteBuf) +#endif +-} +import System.Posix.Types.Iovec +import System.Posix.Types (Fd, ByteCount, FileOffset + , CSsize, COff) +import Foreign.C.Types (CInt, CSize, CChar) +import qualified Foreign.C.Error as FFI (throwErrnoIfMinus1Retry) +import Foreign.Ptr (Ptr) +import qualified Foreign.Ptr as FFI (castPtr, plusPtr) +import qualified Foreign.Marshal.Array as FMA (withArrayLen) + +-- iovec, writev, and readv are in , but we must include +-- and for legacy reasons. +#include +#include +#include + +---------------------------------------------------------------- +-- | Throw an 'IOE.IOError' for EOF. +ioErrorEOF :: String -> IO a +ioErrorEOF fun = + IOE.ioError + (IOE.ioeSetErrorString + (IOE.mkIOError IOE.eofErrorType fun Nothing Nothing) + "EOF") + + +---------------------------------------------------------------- +-- /N.B./, hsc2hs doesn't like this... +-- #if ! (MIN_VERSION_unix(2,4,0)) +-- This version was copied from unix-2.4.2.0 +-- | Read data from an 'Fd' into memory. This is exactly equivalent +-- to the POSIX.1 @read(2)@ system call. +-- +-- TODO: better documentation. +fdReadBuf + :: Fd + -> Ptr Word8 -- ^ Memory in which to put the data. + -> ByteCount -- ^ How many bytes to try to read. + -> IO ByteCount -- ^ How many bytes were actually read (zero for EOF). +fdReadBuf _ _ 0 = return 0 +fdReadBuf fd buf nbytes = + fmap fromIntegral + $ FFI.throwErrnoIfMinus1Retry + "System.Posix.IO.ByteString.fdReadBuf" + $ c_safe_read + (fromIntegral fd) + (FFI.castPtr buf) + (fromIntegral nbytes) + +foreign import ccall safe "read" + -- ssize_t read(int fildes, void *buf, size_t nbyte); + c_safe_read :: CInt -> Ptr CChar -> CSize -> IO CSsize +-- #endif + + +---------------------------------------------------------------- +-- | Read data from an 'Fd' and convert it to a 'BS.ByteString'. +-- Throws an exception if this is an invalid descriptor, or EOF has +-- been reached. +-- +-- This is essentially equivalent to the POSIX.1 @read(2)@ system +-- call; the differences are that we allocate a byte buffer for the +-- @ByteString@ (and then pass its underlying @Ptr Word8@ and +-- @ByteCount@ components to 'fdReadBuf'), and that we detect EOF +-- and throw an 'IOE.IOError'. +fdRead + :: Fd + -> ByteCount -- ^ How many bytes to try to read. + -> IO BS.ByteString -- ^ The bytes read. +fdRead _ 0 = return BS.empty +fdRead fd n = + BSI.createAndTrim (fromIntegral n) $ \buf -> do + rc <- fdReadBuf fd buf n + if 0 == rc + then ioErrorEOF "System.Posix.IO.ByteString.fdRead" + else return (fromIntegral rc) + + +---------------------------------------------------------------- +-- | Read data from an 'Fd' and convert it to a 'BS.ByteString'. +-- Throws an exception if this is an invalid descriptor, or EOF has +-- been reached. +-- +-- This version takes a kind of stateful predicate for whether and +-- how long to keep retrying. Assume the function is called as +-- @fdReads f z0 fd n0@. We will attempt to read @n0@ bytes from +-- @fd@. If we fall short, then we will call @f len z@ where @len@ +-- is the total number of bytes read so far and @z@ is the current +-- state (initially @z0@). If it returns @Nothing@ then we will +-- give up and return the current buffer; otherwise we will retry +-- with the new state, continuing from where we left off. +-- +-- For example, to define a function that tries up to @n@ times, +-- we can use: +-- +-- > fdReadUptoNTimes :: Int -> Fd -> ByteCount -> IO ByteString +-- > fdReadUptoNTimes n0 +-- > | n0 <= 0 = \_ _ -> return empty +-- > | otherwise = fdReads retry n0 +-- > where +-- > retry _ 0 = Nothing +-- > retry _ n = Just $! n-1 +-- +-- The benefit of doing this instead of the naive approach of calling +-- 'fdRead' repeatedly is that we only need to allocate one byte +-- buffer, and trim it once at the end--- whereas the naive approach +-- would allocate a buffer, trim it to the number of bytes read, +-- and then concatenate with the previous one (another allocation, +-- plus copying everything over) for each time around the loop. +fdReads + :: (ByteCount -> a -> Maybe a) -- ^ A stateful predicate for retrying. + -> a -- ^ An initial state for the predicate. + -> Fd + -> ByteCount -- ^ How many bytes to try to read. + -> IO BS.ByteString -- ^ The bytes read. +fdReads _ _ _ 0 = return BS.empty +fdReads f z0 fd n0 = BSI.createAndTrim (fromIntegral n0) (go z0 0 n0) + where + go _ len n buf | len `seq` n `seq` buf `seq` False = undefined + go z len n buf = do + rc <- fdReadBuf fd buf n + let len' = len + rc + case rc of + _ | rc == 0 -> ioErrorEOF "System.Posix.IO.ByteString.fdReads" + | rc == n -> return (fromIntegral len') -- Finished. + | otherwise -> + case f len' z of + Nothing -> return (fromIntegral len') -- Gave up. + Just z' -> + go z' len' (n - rc) (buf `FFI.plusPtr` fromIntegral rc) + + +---------------------------------------------------------------- +-- | Read data from an 'Fd' and scatter it into memory. This is +-- exactly equivalent to the XPG4.2 @readv(2)@ system call. +-- +-- TODO: better documentation. +fdReadvBuf + :: Fd + -> Ptr CIovec -- ^ A C-style array of buffers to fill. + -> Int -- ^ How many buffers there are. + -> IO ByteCount -- ^ How many bytes were actually read (zero for EOF). +fdReadvBuf _ _ 0 = return 0 +fdReadvBuf fd bufs len = + fmap fromIntegral + $ FFI.throwErrnoIfMinus1Retry + "System.Posix.IO.ByteString.fdReadvBuf" + $ c_safe_readv (fromIntegral fd) bufs (fromIntegral len) + +foreign import ccall safe "readv" + -- ssize_t readv(int fildes, const struct iovec *iov, int iovcnt); + c_safe_readv :: CInt -> Ptr CIovec -> CInt -> IO CSsize + + +-- TODO: What's a reasonable wrapper for fdReadvBuf to make it Haskellish? + +---------------------------------------------------------------- +-- | Read data from a specified position in the 'Fd' into memory, +-- without altering the position stored in the @Fd@. This is exactly +-- equivalent to the XPG4.2 @pread(2)@ system call. +-- +-- TODO: better documentation. +fdPreadBuf + :: Fd + -> Ptr Word8 -- ^ Memory in which to put the data. + -> ByteCount -- ^ How many bytes to try to read. + -> FileOffset -- ^ Where to read the data from. + -> IO ByteCount -- ^ How many bytes were actually read (zero for EOF). +fdPreadBuf _ _ 0 _ = return 0 +fdPreadBuf fd buf nbytes offset = + fmap fromIntegral + $ FFI.throwErrnoIfMinus1Retry + "System.Posix.IO.ByteString.fdPreadBuf" + $ c_safe_pread + (fromIntegral fd) + (FFI.castPtr buf) + (fromIntegral nbytes) + (fromIntegral offset) + +foreign import ccall safe "pread" + -- ssize_t pread(int fildes, void *buf, size_t nbyte, off_t offset); + c_safe_pread :: CInt -> Ptr Word8 -> CSize -> COff -> IO CSsize + + +---------------------------------------------------------------- +-- | Read data from a specified position in the 'Fd' and convert +-- it to a 'BS.ByteString', without altering the position stored +-- in the @Fd@. Throws an exception if this is an invalid descriptor, +-- or EOF has been reached. +-- +-- This is essentially equivalent to the XPG4.2 @pread(2)@ system +-- call; the differences are that we allocate a byte buffer for the +-- @ByteString@ (and then pass its underlying @Ptr Word8@ and +-- @ByteCount@ components to 'fdPreadBuf'), and that we detect EOF +-- and throw an 'IOE.IOError'. +fdPread + :: Fd + -> ByteCount -- ^ How many bytes to try to read. + -> FileOffset -- ^ Where to read the data from. + -> IO BS.ByteString -- ^ The bytes read. +fdPread _ 0 _ = return BS.empty +fdPread fd n offset = + BSI.createAndTrim (fromIntegral n) $ \buf -> do + rc <- fdPreadBuf fd buf n offset + if 0 == rc + then ioErrorEOF "System.Posix.IO.ByteString.fdPread" + else return (fromIntegral rc) + +---------------------------------------------------------------- +-- | Read data from a specified position in the 'Fd' and convert +-- it to a 'BS.ByteString', without altering the position stored +-- in the @Fd@. Throws an exception if this is an invalid descriptor, +-- or EOF has been reached. This is a @pread(2)@ based version of +-- 'fdReads'; see that function for more details. +fdPreads + :: (ByteCount -> a -> Maybe a) -- ^ A stateful predicate for retrying. + -> a -- ^ An initial state for the predicate. + -> Fd + -> ByteCount -- ^ How many bytes to try to read. + -> FileOffset -- ^ Where to read the data from. + -> IO BS.ByteString -- ^ The bytes read. +fdPreads _ _ _ 0 _ = return BS.empty +fdPreads f z0 fd n0 offset = BSI.createAndTrim (fromIntegral n0) (go z0 0 n0) + where + go _ len n buf | len `seq` n `seq` buf `seq` False = undefined + go z len n buf = do + rc <- fdPreadBuf fd buf n (offset + fromIntegral len) + let len' = len + rc + case rc of + _ | rc == 0 -> ioErrorEOF "System.Posix.IO.ByteString.fdPreads" + | rc == n -> return (fromIntegral len') -- Finished. + | otherwise -> + case f len' z of + Nothing -> return (fromIntegral len') -- Gave up. + Just z' -> + go z' len' (n - rc) (buf `FFI.plusPtr` fromIntegral rc) + +---------------------------------------------------------------- +---------------------------------------------------------------- +-- /N.B./, hsc2hs doesn't like this... +-- #if ! (MIN_VERSION_unix(2,4,0)) +-- This version was copied from unix-2.4.2.0 +-- | Write data from memory to an 'Fd'. This is exactly equivalent +-- to the POSIX.1 @write(2)@ system call. +-- +-- TODO: better documentation. +fdWriteBuf + :: Fd + -> Ptr Word8 -- ^ Memory containing the data to write. + -> ByteCount -- ^ How many bytes to try to write. + -> IO ByteCount -- ^ How many bytes were actually written. +fdWriteBuf fd buf nbytes = + fmap fromIntegral + $ FFI.throwErrnoIfMinus1Retry + "System.Posix.IO.ByteString.fdWriteBuf" + $ c_safe_write + (fromIntegral fd) + (FFI.castPtr buf) + (fromIntegral nbytes) + +foreign import ccall safe "write" + -- ssize_t write(int fildes, const void *buf, size_t nbyte); + c_safe_write :: CInt -> Ptr CChar -> CSize -> IO CSsize +-- #endif + + +---------------------------------------------------------------- +-- | Write a 'BS.ByteString' to an 'Fd'. The return value is the +-- total number of bytes actually written. This is exactly equivalent +-- to the POSIX.1 @write(2)@ system call; we just convert the +-- @ByteString@ into its underlying @Ptr Word8@ and @ByteCount@ +-- components for passing to 'fdWriteBuf'. +fdWrite + :: Fd + -> BS.ByteString -- ^ The string to write. + -> IO ByteCount -- ^ How many bytes were actually written. +fdWrite fd s = + -- N.B., BSU.unsafeUseAsCStringLen does zero copying. Use + -- BS.useAsCStringLen if there's any chance fdWriteBuf might + -- alter the buffer. + BSU.unsafeUseAsCStringLen s $ \(buf,len) -> do + fdWriteBuf fd (FFI.castPtr buf) (fromIntegral len) + + +---------------------------------------------------------------- +-- | Write a sequence of 'BS.ByteString's to an 'Fd'. The return +-- value is a triple of: the total number of bytes written, the +-- number of bytes written from the first of the remaining strings, +-- and the remaining (unwritten) strings. We return this triple +-- instead of a pair adjusting the head of the remaining strings +-- (i.e., removing the bytes already written) in case there is some +-- semantic significance to the way the input is split into chunks. +-- +-- This version consumes the list lazily and will call the @write(2)@ +-- system call once for each @ByteString@. This laziness allows the +-- early parts of the list to be garbage collected and prevents +-- needing to hold the whole list of @ByteString@s in memory at +-- once. Compare against 'fdWritev'. +fdWrites + :: Fd + -> [BS.ByteString] + -- ^ The strings to write. + -> IO (ByteCount, ByteCount, [BS.ByteString]) + -- ^ The total number of bytes written, the number of bytes + -- written from the first of the remaining strings, the + -- remaining (unwritten) strings. +fdWrites fd = go 0 + where + -- We want to do a left fold in order to avoid stack overflows, + -- but we need to have an early exit for incomplete writes + -- (which normally requires a right fold). Hence this recursion. + go acc [] = return (acc, 0, []) + go acc ccs@(c:cs) = do + rc <- fdWrite fd c + let acc' = acc+rc in acc' `seq` do + if rc == fromIntegral (BS.length c) + then go acc' cs + else return (acc', rc, ccs) + + +---------------------------------------------------------------- +-- | Write data from memory to an 'Fd'. This is exactly equivalent +-- to the XPG4.2 @writev(2)@ system call. +-- +-- TODO: better documentation. +fdWritevBuf + :: Fd + -> Ptr CIovec -- ^ A C-style array of buffers to write. + -> Int -- ^ How many buffers there are. + -> IO ByteCount -- ^ How many bytes were actually written. +fdWritevBuf _ _ 0 = return 0 +fdWritevBuf fd bufs len = + fmap fromIntegral + $ FFI.throwErrnoIfMinus1Retry + "System.Posix.IO.ByteString.fdWritevBuf" + $ c_safe_writev (fromIntegral fd) bufs (fromIntegral len) + +foreign import ccall safe "writev" + -- ssize_t writev(int fildes, const struct iovec *iov, int iovcnt); + c_safe_writev :: CInt -> Ptr CIovec -> CInt -> IO CSsize + + +---------------------------------------------------------------- +-- | Write a sequence of 'BS.ByteString's to an 'Fd'. The return +-- value is the total number of bytes written. Unfortunately the +-- @writev(2)@ system call does not provide enough information to +-- return the triple that 'fdWrites' does. +-- +-- This version will force the spine of the list, convert each +-- @ByteString@ into an @iovec@, and then call the @writev(2)@ +-- system call. This means we only make one system call, which +-- reduces the overhead of performing context switches. But it also +-- means that we must store the whole list of @ByteString@s in +-- memory at once, and that we must perform some allocation and +-- conversion. Compare against 'fdWrites'. +fdWritev + :: Fd + -> [BS.ByteString] -- ^ The strings to write. + -> IO ByteCount -- ^ How many bytes were actually written. +fdWritev fd cs = do + rc <- FMA.withArrayLen (map unsafeByteString2CIovec cs) $ \len iovs -> + fdWritevBuf fd iovs (fromIntegral len) + -- BUG: is this enough to actually hold onto them? + mapM_ touchByteString cs + return rc + + +---------------------------------------------------------------- +-- | Write data from memory to a specified position in the 'Fd', +-- but without altering the position stored in the @Fd@. This is +-- exactly equivalent to the XPG4.2 @pwrite(2)@ system call. +-- +-- TODO: better documentation. +fdPwriteBuf + :: Fd + -> Ptr Word8 -- ^ Memory containing the data to write. + -> ByteCount -- ^ How many bytes to try to write. + -> FileOffset -- ^ Where to write the data to. + -> IO ByteCount -- ^ How many bytes were actually written. +fdPwriteBuf _ _ 0 _ = return 0 +fdPwriteBuf fd buf nbytes offset = + fmap fromIntegral + $ FFI.throwErrnoIfMinus1Retry + "System.Posix.IO.ByteString.fdPwriteBuf" + $ c_safe_pwrite + (fromIntegral fd) + (FFI.castPtr buf) + (fromIntegral nbytes) + (fromIntegral offset) + +foreign import ccall safe "pwrite" + -- ssize_t pwrite(int fildes, const void *buf, size_t nbyte, off_t offset); + c_safe_pwrite :: CInt -> Ptr Word8 -> CSize -> COff -> IO CSsize + + +---------------------------------------------------------------- +-- | Write data from memory to a specified position in the 'Fd', +-- but without altering the position stored in the @Fd@. This is +-- exactly equivalent to the XPG4.2 @pwrite(2)@ system call; we +-- just convert the @ByteString@ into its underlying @Ptr Word8@ +-- and @ByteCount@ components for passing to 'fdPwriteBuf'. +fdPwrite + :: Fd + -> BS.ByteString -- ^ The string to write. + -> FileOffset -- ^ Where to write the data to. + -> IO ByteCount -- ^ How many bytes were actually written. +fdPwrite fd s offset = + -- N.B., BSU.unsafeUseAsCStringLen does zero copying. Use + -- BS.useAsCStringLen if there's any chance fdPwriteBuf might + -- alter the buffer. + BSU.unsafeUseAsCStringLen s $ \(buf,len) -> do + fdPwriteBuf fd (FFI.castPtr buf) (fromIntegral len) offset + +---------------------------------------------------------------- +----------------------------------------------------------- fin. diff --git a/src/System/Posix/IO/ByteString/Lazy.hs b/src/System/Posix/IO/ByteString/Lazy.hs new file mode 100644 --- /dev/null +++ b/src/System/Posix/IO/ByteString/Lazy.hs @@ -0,0 +1,133 @@ +{-# OPTIONS_GHC -Wall -fwarn-tabs #-} +---------------------------------------------------------------- +-- 2011.03.17 +-- | +-- Module : System.Posix.IO.ByteString.Lazy +-- Copyright : Copyright (c) 2010--2011 wren ng thornton +-- License : BSD +-- Maintainer : wren@community.haskell.org +-- Stability : experimental +-- Portability : non-portable (requires POSIX.1, XPG4.2) +-- +-- Provides a lazy-'BL.ByteString' file-descriptor based I\/O +-- API, designed loosely after the @String@ file-descriptor based +-- I\/O API in "System.Posix.IO". The functions here wrap standard +-- C implementations of the functions specified by the ISO\/IEC +-- 9945-1:1990 (``POSIX.1'') and X\/Open Portability Guide Issue +-- 4, Version 2 (``XPG4.2'') specifications. +-- +-- These functions are provided mainly as a convenience to avoid +-- boilerplate code converting between lazy 'BL.ByteString' and +-- strict @['BS.ByteString']@. It may be depricated in the future. +---------------------------------------------------------------- +module System.Posix.IO.ByteString.Lazy + ( + -- * I\/O with file descriptors + -- ** Reading + fdRead + , fdPread + -- ** Writing + , fdWrites + , fdWritev + ) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU +import qualified System.Posix.IO.ByteString as PosixBS +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Internal as BLI +import System.Posix.Types (Fd, ByteCount, FileOffset) + +---------------------------------------------------------------- +-- | Read data from an 'Fd' and convert it to a 'BL.ByteString'. +-- Throws an exception if this is an invalid descriptor, or EOF has +-- been reached. This is a thin wrapper around 'PosixBS.fdRead'. +fdRead + :: Fd + -> ByteCount -- ^ How many bytes to try to read. + -> IO BL.ByteString -- ^ The bytes read. +fdRead _ 0 = return BL.empty +fdRead fd n = do + s <- PosixBS.fdRead fd n + return (BLI.chunk s BL.empty) + +---------------------------------------------------------------- +-- | Read data from a specified position in the 'Fd' and convert +-- it to a 'BS.ByteString', without altering the position stored +-- in the @Fd@. Throws an exception if this is an invalid descriptor, +-- or EOF has been reached. This is a thin wrapper around +-- 'PosixBS.fdPread'. +fdPread + :: Fd + -> ByteCount -- ^ How many bytes to try to read. + -> FileOffset -- ^ Where to read the data from. + -> IO BL.ByteString -- ^ The bytes read. +fdPread _ 0 _ = return BL.empty +fdPread fd n offset = do + s <- PosixBS.fdPread fd n offset + return (BLI.chunk s BL.empty) + + +---------------------------------------------------------------- +-- | Write a 'BL.ByteString' to an 'Fd'. This function makes one +-- @write(2)@ system call per chunk, as per 'PosixBS.fdWrites'. +fdWrites + :: Fd + -> BL.ByteString + -- ^ The string to write. + -> IO (ByteCount, BL.ByteString) + -- ^ How many bytes were actually written, and the remaining + -- (unwritten) string. +fdWrites fd = go 0 + where + -- We want to do a left fold in order to avoid stack overflows, + -- but we need to have an early exit for incomplete writes + -- (which normally requires a right fold). Hence this recursion. + go acc BLI.Empty = return (acc, BL.empty) + go acc (BLI.Chunk c cs) = do + rc <- PosixBS.fdWrite fd c + let acc' = acc+rc in acc' `seq` do + let rcInt = fromIntegral rc in rcInt `seq` do + if rcInt == BS.length c + then go acc' cs + else return (acc', BLI.Chunk (BSU.unsafeDrop rcInt c) cs) +{- +Using 'BSU.unsafeDrop' above is safe, assuming that +'System.Posix.IO.fdWriteBuf' never returns (rc < 0 || rc > BS.length c). +If we are paranoid about that then we should do the following instead: + + go acc ccs = + case ccs of + BLI.Empty -> return (acc, ccs) + BLI.Chunk c cs -> do + rc <- PosixBS.fdWrite fd c + let acc' = acc+rc in acc' `seq` do + let rcInt = fromIntegral rc in rcInt `seq` do + case BS.length c of + len | rcInt == len -> go acc' cs + | rcInt > len -> error _impossibleByteCount + | rcInt < 0 -> error _negtiveByteCount + | rcInt == 0 -> return (acc', ccs) -- trivial optimizing + | otherwise -> return (acc', BLI.Chunk (BSU.unsafeDrop rcInt c) cs) + +_negtiveByteCount = + "System.Posix.IO.fdWriteBuf: returned a negative byte count" +_impossibleByteCount = + "System.Posix.IO.fdWriteBuf: returned a byte count greater than the length it was given" +-} + + +---------------------------------------------------------------- +-- | Write a 'BL.ByteString' to an 'Fd'. This function makes a +-- single @writev(2)@ system call, as per 'PosixBS.fdWritev'. +fdWritev + :: Fd + -> BL.ByteString -- ^ The string to write. + -> IO ByteCount -- ^ How many bytes were actually written. +fdWritev fd s = PosixBS.fdWritev fd (BL.toChunks s) +{-# INLINE fdWritev #-} +-- Hopefully the intermediate list can be fused away... + + +---------------------------------------------------------------- +----------------------------------------------------------- fin. diff --git a/src/System/Posix/Types/Iovec.hsc b/src/System/Posix/Types/Iovec.hsc new file mode 100644 --- /dev/null +++ b/src/System/Posix/Types/Iovec.hsc @@ -0,0 +1,148 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# OPTIONS_GHC -Wall -fwarn-tabs #-} +---------------------------------------------------------------- +-- 2011.03.17 +-- | +-- Module : System.Posix.Types.Iovec +-- Copyright : Copyright (c) 2010--2011 wren ng thornton +-- License : BSD +-- Maintainer : wren@community.haskell.org +-- Stability : experimental +-- Portability : non-portable (POSIX.1, XPG4.2; hsc2hs, FFI) +-- +-- Imports the C @struct iovec@ type and provides conversion between +-- 'CIovec's and strict 'BS.ByteString's. +---------------------------------------------------------------- +module System.Posix.Types.Iovec + ( + -- * The @struct iovec@ type + CIovec(..) + , unsafeByteString2CIovec + , touchByteString + , unsafeUseAsCIovec + , useAsCIovec + ) where + +import Data.Word (Word8) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSI +import Foreign.Ptr (Ptr) +import qualified Foreign.Ptr as FFI (castPtr, plusPtr) +import qualified Foreign.ForeignPtr as FFP +import Foreign.C.Types (CSize) +import Foreign.Storable (Storable(..)) + +-- N.B., we need a Custom cabal build-type in order for this to +-- work. +#ifdef __HADDOCK__ +import Foreign.C.String (CStringLen) +#endif + +-- iovec, writev, and readv are in , but we must include +-- and for legacy reasons. +#include +#include +#include + +---------------------------------------------------------------- + +-- | Haskell type representing the C @struct iovec@ type. This is +-- exactly like @'CStringLen'@ except there's actually struct +-- definition on the C side. +data CIovec = CIovec + { iov_base :: {-# UNPACK #-} !(Ptr Word8) -- char* or void* + , iov_len :: {-# UNPACK #-} !CSize -- size_t + } + +#let alignment t = \ + "%lu", (unsigned long) offsetof(struct {char x__; t (y__); }, y__) + +instance Storable CIovec where + alignment _ = #{alignment struct iovec} + + sizeOf _ = #{size struct iovec} + + peek ptr = do + base <- #{peek struct iovec, iov_base} ptr + len <- #{peek struct iovec, iov_len} ptr + return (CIovec base len) + + poke ptr (CIovec base len) = do + #{poke struct iovec, iov_base} ptr base + #{poke struct iovec, iov_len} ptr len + + +-- | /O(1) construction/ Convert a @ByteString@ into an @CIovec@. +-- +-- This function is /unsafe/ in two ways: +-- +-- * After calling this function the @CIovec@ shares the underlying +-- byte buffer with the original @ByteString@. Thus, modifying the +-- @CIovec@ either in C or using poke will cause the contents of +-- the @ByteString@ to change, breaking referential transparency. +-- Other @ByteStrings@ created by sharing (such as those produced +-- via 'BS.take' or 'BS.drop') will also reflect these changes. +-- +-- * Also, even though the @CIovec@ shares the underlying byte +-- buffer, it does so in a way that will not keep the original +-- @ByteString@ alive with respect to garbage collection. Thus, the +-- byte buffer could be collected out from under the @CIovec@. To +-- prevent this, you must use 'touchByteString' after the last point +-- where the @CIovec@ is needed. +unsafeByteString2CIovec :: BS.ByteString -> CIovec +unsafeByteString2CIovec (BSI.PS fptr offset len) = + CIovec + (FFP.unsafeForeignPtrToPtr fptr `FFI.plusPtr` offset) + (fromIntegral len) +{-# INLINE unsafeByteString2CIovec #-} + + +-- | Keep the @ByteString@ alive. See 'unsafeByteString2CIovec'. +touchByteString :: BS.ByteString -> IO () +touchByteString (BSI.PS fptr _ _) = FFP.touchForeignPtr fptr +{-# INLINE touchByteString #-} + + +-- | /O(1) construction/ Use a @ByteString@ with a function requiring +-- a @CIovec@. +-- +-- This function does zero copying, and merely unwraps a @ByteString@ +-- to appear as an @CIovec@. It is /unsafe/ in the same way as +-- 'unsafeByteString2CIovec'. +unsafeUseAsCIovec :: BS.ByteString -> (CIovec -> IO a) -> IO a +unsafeUseAsCIovec (BSI.PS fptr offset len) io = + FFP.withForeignPtr fptr $ \ptr -> + io (CIovec (ptr `FFI.plusPtr` offset) (fromIntegral len)) +{-# INLINE unsafeUseAsCIovec #-} +-- The above version saves a case match on @s@ vs using +-- 'unsafeByteString2CIovec' and 'touchByteString' + + +-- | /O(n) construction/ Use a @ByteString@ with a function requiring +-- a @CIovec@. +-- +-- As with 'BS.useAsCString' and 'BS.useAsCStringLen', this function +-- makes a copy of the original @ByteString@ via @memcpy(3)@. The +-- copy will be freed automatically. See 'unsafeUseAsCIovec' for a +-- zero-copying version. +useAsCIovec :: BS.ByteString -> (CIovec -> IO a) -> IO a +useAsCIovec s@(BSI.PS _ _ len) io = + BS.useAsCString s $ \cstr -> + io (CIovec (FFI.castPtr cstr) (fromIntegral len)) +{-# INLINE useAsCIovec #-} +{- +This definition is essentially verbatim 'BS.useAsCStringLen'. We +can save two 'FFI.castPtr' and one 'fromIntegral' if we instead do +an essentially verbatim 'BS.useAsCString': + + useAsCIovec s@(BSI.PS fptr offset len) io = do + let lenCSize = fromIntegral len + FMA.allocaBytes (len+1) $ \buf -> + FFP.withForeignPtr fptr $ \ptr -> do + BSI.memcpy buf (ptr `FFI.plusPtr` offset) lenCSize + pokeByteOff buf len (0 :: Word8) -- add null-terminator + io (CIovec buf lenCSize) +-} + +---------------------------------------------------------------- +----------------------------------------------------------- fin. diff --git a/unix-bytestring.cabal b/unix-bytestring.cabal new file mode 100644 --- /dev/null +++ b/unix-bytestring.cabal @@ -0,0 +1,56 @@ +---------------------------------------------------------------- +-- wren ng thornton ~ 2011.03.17 +---------------------------------------------------------------- + +Name: unix-bytestring +Version: 0.3.2 +-- Source-Repository requires version 1.6 +Cabal-Version: >= 1.6 +-- We need a custom build in order to define __HADDOCK__ +Build-Type: Custom +Stability: experimental +Copyright: Copyright (c) 2010--2011 wren ng thornton +License: BSD3 +License-File: LICENSE +Author: wren ng thornton +Maintainer: wren@community.haskell.org +Homepage: http://code.haskell.org/~wren/ +Category: Data +Synopsis: Unix/Posix-specific functions for ByteStrings. +Description: Unix\/Posix-specific functions for ByteStrings. + . + Provides @ByteString@ file-descriptor based I\/O API, designed + loosely after the @String@ file-descriptor based I\/O API in + "System.Posix.IO". The functions here wrap standard C implementations + of the functions specified by the ISO\/IEC 9945-1:1990 (``POSIX.1'') + and X\/Open Portability Guide Issue 4, Version 2 (``XPG4.2'') + specifications. + . + Note that this package doesn't require the @unix@ package as a + dependency. But you'll need it in order to get your hands on + an @Fd@, so we're not offering a complete replacement. + +Tested-With: GHC == 6.12.1, GHC == 6.12.3 +Source-Repository head + Type: darcs + Location: http://community.haskell.org/~wren/unix-bytestring + +---------------------------------------------------------------- +Library + Hs-Source-Dirs: src + Exposed-Modules: System.Posix.IO.ByteString + , System.Posix.IO.ByteString.Lazy + , System.Posix.Types.Iovec + + -- We require base>=4.1 for Foreign.C.Error.throwErrnoIfMinus1Retry. + -- + -- We would require unix>=2.4 for System.Posix.IO.fdReadBuf/fdWriteBuf + -- (and unix-2.4.0.0 requires base>=4.1 too), except we define + -- them on our own for better backwards compatibility. + -- + -- Not sure what the real minbound is on bytestring... + Build-Depends: base >= 4.1 && < 5 + , bytestring >= 0.9.1.5 + +---------------------------------------------------------------- +----------------------------------------------------------- fin.