packages feed

unix-simple (empty) → 0.1.0.0

raw patch · 12 files changed

+678/−0 lines, 12 filesdep +basedep +bytestringdep +unix-simple

Dependencies added: base, bytestring, unix-simple, zenhack-prelude

Files

+ .gitignore view
@@ -0,0 +1,23 @@+dist+dist-newstyle+.ghc.environment.*+cabal.project.local++# Profiler outputs and formatted reports:+*.prof+*.hp+*.aux+*.ps++.hspec+.hspec-failures++# backup files+*~++# Code coverage:+.hpc+*.tix++# used by tests:+/test-tmp
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.1.0.0++First release.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2020 Ian Denhardt++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,59 @@+A straightforward wrapping of unix APIs for Haskell.++I wrote this package because state of posix API support in Haskell is+somewhat unsatisfactory in a few ways:++* There are many syscalls not covered by the `unix` package+* The `unix` package needlessly renames syscalls, making them harder to+  find for people familiar with the posix API. For example, `lstat` has+  been renamed to `getSymbolicLinkStatus`+* There are a large number of packages that fill in various holes, but+  you have to scrape them together.++The goal of this package then, is to provide a one-stop-shop for unix+API bindings, with a straightforward mapping to the underlying C API.+At the time of writing there are many syscalls missing, but in theory+most things belong here. Patches welcome; see the section below re:+how to add a syscall.++# General Conventions++* Function names are the same as the underlying system calls, so there+  is no guesswork.+* Wrappers automatically retry on `EINTR` where appropriate (this is+  safe for most system calls, but not all, e.g. `close` on Linux).+* The basic versions of the syscalls return `IO (Either Errno a)`,+  rather than raising an exception.+  * Each system call also has a variant suffixed with `Exn` that throws+    exceptions.+  * We define a type alias `type EIO a = IO (Either Errno a)` for+    convenience.+* For flags, we add newtype wrappers, and they can be combined with+  their `SemiGroup` instances, e.g.+  * `open "hello.txt" (o_CREAT <> o_RDWR) 0o600`+* Flags are named the same as the C constant, but with the first+  character lower-cased.+* For functions that take a buffer, we instead accept a `ByteString`+  when the buffer is read, or return one when it is written, e.g.+  * `read :: Fd -> Int -> EIO BS.ByteString`+  * `write :: Fd -> BS.ByteString -> EIO CSsize`+* We also provide variants suffixed with `Buf`, that take a pointer and+  size:+  * `readBuf :: Fd -> Ptr Word8 -> CSize -> EIO CSsize`+* We provide a `CString` type for functions which accept strings as+  arguments. This type is an instance of `IsString`, so you can use+  string literals if you enable `OverloadedStrings`, or use the+  `fromString` function to convert. The conversion uses utf-8 encoding.+* For some calls we also add obvious convenience helpers, e.g.+  `readFull` and `writeFull`, which wrap `read` and `write` and handle+  short reads and writes for the caller.++# Contributing++## Adding a syscall++To add a new system call:++* Add the appropriate declaration to `Unix.C`, following conventions+  established by the examples in that file.+* Add a wrapper following the general conventions in `Unix`.
+ src/CString.hs view
@@ -0,0 +1,62 @@+module CString+    ( CString+    , CStr(..)+    , useCStr+    , fromBuilder+    , toBuilder+    ) where++import qualified Data.ByteString.Builder  as BB+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Lazy     as LBS+import           Foreign.C.Types+import           Foreign.ForeignPtr+import           Foreign.Ptr+import           Zhp++-- | wrapper around a nul-terminated C style string; the pointer points to the+-- beginning of the string.+--+-- Users of the library will mostly not use this directly, instead using CString.+newtype CStr = CStr (Ptr CChar)++-- | A string for passing to C api functions. The C-compatible form is computed+-- lazily; it will not be forced until the string is passed to a C API function.+-- Internally, this is stored as a 'BB.Builder' with no trailing nul, so+-- performance characteristics are mostly the same, only requiring a copy when+-- first passing the string to an API function.+data CString = CString+    { bytes :: BB.Builder+    , fptr  :: ForeignPtr CChar+    }++instance Semigroup CString where+    x <> y = fromBuilder (toBuilder x <> toBuilder y)++instance Monoid CString where+    mempty = fromBuilder mempty++-- | Convert a 'BB.Builder' to a CString. The builder should not have a nul+-- terminator; it will be added.+fromBuilder :: BB.Builder -> CString+fromBuilder builder = CString+    { bytes = builder+    , fptr =+        let bs = LBS.toStrict $ BB.toLazyByteString (builder <> BB.word8 0)+            (ptr, off, _len) = BS.toForeignPtr bs+        in+        plusForeignPtr ptr off+    }++-- | Extract a bytestring builder for the string. Does not include the nul+-- terminator. O(1).+toBuilder :: CString -> BB.Builder+toBuilder = bytes++-- | Use the raw pointer underlying the 'CString'.+useCStr :: CString -> (CStr -> IO a) -> IO a+useCStr str use =+    withForeignPtr (fptr str) $ \ptr -> use (CStr ptr)++instance IsString CString where+    fromString = fromBuilder . BB.stringUtf8
+ src/Unix.hs view
@@ -0,0 +1,253 @@+{-# OPTIONS_GHC -Wno-missing-signatures #-}+module Unix+    ( fsync, fsyncExn+    , fdatasync, fdatasyncExn+    , ftruncate, ftruncateExn+    , mkdir, mkdirExn+    , preadBuf, preadBufExn+    , pread, preadExn+    , pwriteBuf, pwriteBufExn+    , pwrite, pwriteExn+    , pwriteFull, pwriteFullExn+    , readBuf, readBufExn+    , writeBuf, writeBufExn+    , read, readExn+    , remove, removeExn+    , rmdir, rmdirExn+    , write, writeExn+    , writeFull, writeFullExn++    , OpenFlag(..)+    , open, openExn+    , openat, openatExn+    , o_APPEND+    , o_CLOEXEC+    , o_CREAT+    , o_DIRECTORY+    , o_EXCL+    , o_NOFOLLOW+    , o_NONBLOCK+    , o_NDELAY+    , o_TRUNC+    , o_RDONLY+    , o_WRONLY+    , o_RDWR++    , close, closeExn++    -- * Re-exported for convenience+    , CString+    ) where++import CString+import Foreign.C.Error+import Foreign.ForeignPtr+import Unix.C+import Unix.C.Errors+import Unix.Errors+import Zhp++import qualified Data.ByteString          as BS+import qualified Data.ByteString.Internal as BS++type EIO a = IO (Either Errno a)++fsync :: Fd -> EIO ()+fsync fd = retryEINTR $ orErrno $ void $ c_fsync fd++fsyncExn :: Fd -> IO ()+fsyncExn fd = throwIfErrno $ fsync fd++fdatasync :: Fd -> EIO ()+fdatasync fd = retryEINTR $ orErrno $ void $ c_fdatasync fd++fdatasyncExn :: Fd -> IO ()+fdatasyncExn fd = throwIfErrno $ fdatasync fd++ftruncate :: Fd -> COff -> EIO ()+ftruncate fd off = retryEINTR $ orErrno $ void $ c_ftruncate fd off++ftruncateExn :: Fd -> COff -> IO ()+ftruncateExn fd off =+    throwIfErrno $ ftruncate fd off++preadBuf :: Fd -> Ptr Word8 -> CSize -> COff -> EIO CSsize+preadBuf fd ptr sz off =+    retryEINTR $ orErrno $ c_pread fd ptr sz off++preadBufExn :: Fd -> Ptr Word8 -> CSize -> COff -> IO CSsize+preadBufExn fd ptr sz off =+    throwIfErrno $ preadBuf fd ptr sz off++pread :: Fd -> CSize -> COff -> EIO BS.ByteString+pread fd sz off = do+    fptr <- mallocForeignPtrBytes (fromIntegral sz)+    r <- withForeignPtr fptr $ \ptr -> preadBuf fd ptr sz off+    pure $! case r of+        Left e  -> Left e+        Right v -> Right (BS.fromForeignPtr fptr 0 (fromIntegral v))++preadExn :: Fd -> CSize -> COff -> IO BS.ByteString+preadExn fd sz off = throwIfErrno $ pread fd sz off++pwriteBuf :: Fd -> Ptr Word8 -> CSize -> COff -> EIO CSsize+pwriteBuf fd ptr sz off =+    retryEINTR $ orErrno $ c_pwrite fd ptr sz off++pwriteBufExn :: Fd -> Ptr Word8 -> CSize -> COff -> IO CSsize+pwriteBufExn fd ptr sz off =+    throwIfErrno $ pwriteBuf fd ptr sz off++pwrite :: Fd -> BS.ByteString -> COff -> EIO CSsize+pwrite fd bs off =+    let (fptr, foff, len) = BS.toForeignPtr bs in+    withForeignPtr fptr $ \ptr ->+        pwriteBuf fd (plusPtr ptr foff) (fromIntegral len) off++pwriteExn :: Fd -> BS.ByteString -> COff -> IO CSsize+pwriteExn fd bs off = throwIfErrno $ pwrite fd bs off++pwriteFull :: Fd -> BS.ByteString -> COff -> EIO ()+pwriteFull fd bs off = do+    ret <- pwrite fd bs off+    case ret of+        Left e -> pure $ Left e+        Right v+            | fromIntegral v == BS.length bs ->+                pure $ Right ()+            | otherwise ->+                pwriteFull fd+                    (BS.drop (fromIntegral v) bs)+                    (off + fromIntegral v)++pwriteFullExn :: Fd -> BS.ByteString -> COff -> IO ()+pwriteFullExn fd bs off = throwIfErrno $ pwriteFull fd bs off++readBuf :: Fd -> Ptr Word8 -> CSize -> EIO CSsize+readBuf fd ptr sz =+    retryEINTR $ orErrno $ c_read fd ptr sz++readBufExn :: Fd -> Ptr Word8 -> CSize -> IO CSsize+readBufExn fd ptr sz =+    throwIfErrno $ readBuf fd ptr sz++read :: Fd -> Int -> EIO BS.ByteString+read fd sz = do+    fptr <- mallocForeignPtrBytes sz+    r <- withForeignPtr fptr $ \ptr -> readBuf fd ptr (fromIntegral sz)+    -- TODO(perf): should we trim the buffer to the size actually+    -- read? Maybe if it's below a certain size,+    -- possibly relative to the size of the buffer?+    pure $! case r of+        Left e  -> Left e+        Right v -> Right (BS.fromForeignPtr fptr 0 (fromIntegral v))++readExn :: Fd -> Int -> IO BS.ByteString+readExn fd sz =+    throwIfErrno $ read fd sz++writeBuf :: Fd -> Ptr Word8 -> CSize -> EIO CSsize+writeBuf fd ptr sz =+    retryEINTR $ orErrno $ c_write fd ptr sz++writeBufExn :: Fd -> Ptr Word8 -> CSize -> IO CSsize+writeBufExn fd ptr sz =+    throwIfErrno $ writeBuf fd ptr sz++write :: Fd -> BS.ByteString -> EIO CSsize+write fd bs =+    let (fptr, off, len) = BS.toForeignPtr bs in+    withForeignPtr fptr $ \ptr ->+        writeBuf fd (plusPtr ptr off) (fromIntegral len)++writeExn :: Fd -> BS.ByteString -> IO CSsize+writeExn fd bs =+    throwIfErrno $ write fd bs++-- | Wrapper around write that makes sure the full bytestring is written,+-- handling short writes from the underlying system call.+writeFull :: Fd -> BS.ByteString -> EIO ()+writeFull fd bs = do+    ret <- write fd bs+    case ret of+        Left e -> pure $ Left e+        Right v+            | (fromIntegral v) == BS.length bs -> pure $ Right ()+            | otherwise -> writeFull fd (BS.drop (fromIntegral v) bs)++writeFullExn :: Fd -> BS.ByteString -> IO ()+writeFullExn fd bs =+    throwIfErrno $ writeFull fd bs++remove :: CString -> EIO ()+remove fpath =+    useCStr fpath $ \path ->+        retryEINTR $ orErrno $ () <$ c_remove path++removeExn :: CString -> IO ()+removeExn fpath =+    throwIfErrno $ remove fpath++rmdir :: CString -> EIO ()+rmdir fpath =+    useCStr fpath $ \path ->+        retryEINTR $ orErrno $ () <$ c_rmdir path++rmdirExn :: CString -> IO ()+rmdirExn fpath =+    throwIfErrno $ rmdir fpath++mkdir :: CString -> CMode -> EIO ()+mkdir fpath mode =+    useCStr fpath $ \path ->+        retryEINTR $ orErrno $ () <$ c_mkdir path mode++mkdirExn :: CString -> CMode -> IO ()+mkdirExn fpath mode =+    throwIfErrno $ mkdir fpath mode++newtype OpenFlag = OpenFlag CInt+instance Semigroup OpenFlag where+    (OpenFlag x) <> (OpenFlag y) = OpenFlag (x .|. y)++open :: CString -> OpenFlag -> CMode -> EIO Fd+open fpath (OpenFlag flag) mode =+    useCStr fpath $ \path ->+        retryEINTR $ orErrno $ c_open path flag mode++openExn :: CString -> OpenFlag -> CMode -> IO Fd+openExn path flag mode =+    throwIfErrno $ open path flag mode++openat :: Fd -> CString -> OpenFlag -> CMode -> EIO Fd+openat fd fpath (OpenFlag flag) mode =+    useCStr fpath $ \path ->+        retryEINTR $ orErrno $ c_openat fd path flag mode++openatExn :: Fd -> CString -> OpenFlag -> CMode -> IO Fd+openatExn fd path flag mode =+    throwIfErrno $ openat fd path flag mode++o_APPEND    = OpenFlag c_O_APPEND+o_CLOEXEC   = OpenFlag c_O_CLOEXEC+o_CREAT     = OpenFlag c_O_CREAT+o_DIRECTORY = OpenFlag c_O_DIRECTORY+o_EXCL      = OpenFlag c_O_EXCL+o_NOFOLLOW  = OpenFlag c_O_NOFOLLOW+o_NONBLOCK  = OpenFlag c_O_NONBLOCK+o_NDELAY    = OpenFlag c_O_NDELAY+o_TRUNC     = OpenFlag c_O_TRUNC+o_RDONLY    = OpenFlag c_O_RDONLY+o_WRONLY    = OpenFlag c_O_WRONLY+o_RDWR      = OpenFlag c_O_RDWR++close :: Fd -> EIO ()+close fd =+    orErrno $ void $ c_close fd+    -- We intentionally do not retryEINTR; posix is silent on whether+    -- the file descriptor will be closed after an EINTR return, but on+    -- at least Linux the answer is always yes, so we must not retry+    -- in case the file descriptor has been re-allocated by another thread.++closeExn :: Fd -> IO ()+closeExn fd = throwIfErrno $ close fd
+ src/Unix/C.hsc view
@@ -0,0 +1,91 @@+{-# LANGUAGE InterruptibleFFI #-}+module Unix.C+    ( module X+    , c_close+    , c_fdatasync+    , c_fsync+    , c_ftruncate+    , c_mkdir+    , c_open+    , c_openat+    , c_pread+    , c_pwrite+    , c_read+    , c_remove+    , c_rmdir+    , c_write++    , c_O_APPEND+    , c_O_CLOEXEC+    , c_O_CREAT+    , c_O_DIRECTORY+    , c_O_EXCL+    , c_O_NOFOLLOW+    , c_O_NONBLOCK+    , c_O_NDELAY+    , c_O_TRUNC+    , c_O_RDONLY+    , c_O_WRONLY+    , c_O_RDWR+    ) where++#include <sys/types.h>+#include <sys/stat.h>+#include <fcntl.h>++import Zhp++import CString (CStr(..))+import Foreign.C.Types    as X+import Foreign.Ptr        as X+import System.Posix.Types as X++foreign import ccall interruptible "close" c_close :: Fd -> IO CInt+foreign import ccall interruptible "fdatasync" c_fdatasync :: Fd -> IO CInt+foreign import ccall interruptible "fsync" c_fsync :: Fd -> IO CInt+foreign import ccall interruptible "ftruncate" c_ftruncate :: Fd -> COff -> IO Int+foreign import ccall interruptible "mkdir" c_mkdir :: CStr -> CMode -> IO CInt+foreign import ccall interruptible "openat" c_openat :: Fd -> CStr -> CInt -> CMode -> IO Fd+foreign import ccall interruptible "open" c_open :: CStr -> CInt -> CMode -> IO Fd+foreign import ccall interruptible "pread"  c_pread  :: Fd -> Ptr Word8 -> CSize -> COff -> IO CSsize+foreign import ccall interruptible "pwrite" c_pwrite :: Fd -> Ptr Word8 -> CSize -> COff -> IO CSsize+foreign import ccall interruptible "read"  c_read :: Fd -> Ptr Word8 -> CSize -> IO CSsize+foreign import ccall interruptible "remove"  c_remove :: CStr -> IO CInt+foreign import ccall interruptible "rmdir"  c_rmdir :: CStr -> IO CInt+foreign import ccall interruptible "write" c_write :: Fd -> Ptr Word8 -> CSize -> IO CSsize++c_O_APPEND :: CInt+c_O_APPEND = #const O_APPEND++c_O_CLOEXEC :: CInt+c_O_CLOEXEC = #const O_CLOEXEC++c_O_CREAT :: CInt+c_O_CREAT = #const O_CREAT++c_O_DIRECTORY :: CInt+c_O_DIRECTORY = #const O_DIRECTORY++c_O_EXCL :: CInt+c_O_EXCL = #const O_EXCL++c_O_NOFOLLOW :: CInt+c_O_NOFOLLOW = #const O_NOFOLLOW++c_O_NONBLOCK :: CInt+c_O_NONBLOCK = #const O_NONBLOCK++c_O_NDELAY :: CInt+c_O_NDELAY = #const O_NDELAY++c_O_TRUNC :: CInt+c_O_TRUNC = #const O_TRUNC++c_O_RDONLY :: CInt+c_O_RDONLY = #const O_RDONLY++c_O_WRONLY :: CInt+c_O_WRONLY = #const O_WRONLY++c_O_RDWR :: CInt+c_O_RDWR = #const O_RDWR
+ src/Unix/C/Errors.hs view
@@ -0,0 +1,15 @@+module Unix.C.Errors+    ( orErrno+    ) where++import Foreign.C.Error+import Zhp++orErrno :: IO a -> IO (Either Errno a)+orErrno io = do+    resetErrno+    r <- io+    e <- getErrno+    pure $! if e /= eOK+        then Left e+        else Right r
+ src/Unix/Errors.hs view
@@ -0,0 +1,23 @@+module Unix.Errors+    ( retryEINTR+    , throwIfErrno+    ) where++import Zhp++import Control.Exception (throwIO)+import Foreign.C.Error++throwIfErrno :: IO (Either Errno a) -> IO a+throwIfErrno io = do+    r <- io+    case r of+        Left e  -> throwIO $ errnoToIOError "" e Nothing Nothing+        Right v -> pure v++retryEINTR :: IO (Either Errno a) -> IO (Either Errno a)+retryEINTR io = do+    r <- io+    case r of+        Left e | e == eINTR -> retryEINTR io+        _                   -> pure r
+ src/Unix/IOVec.hsc view
@@ -0,0 +1,46 @@+{-# LANGUAGE NamedFieldPuns #-}+module Unix.IOVec+    ( CIOVec(..)+    , unsafeFromByteString+    ) where++import Foreign.C.Types+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Storable+import System.IO.Unsafe (unsafePerformIO)+import Zhp+import qualified Data.ByteString.Internal as BS++#include <sys/uio.h>++data CIOVec = CIOVec+    { iovBase :: !(Ptr Word8)+    , iovLen :: !CSize+    }++-- | Unsafe O(1) conversion from a bytestring. This is unsafe in two+-- respects:+--+-- 1. Since the underlying storage is shared with the original bytestring,+--    if the CIOVec is mutated, then the bytestring will be as well, violating+--    referential transparency.+-- 2. Holding a reference to the CIOVec does not keep the underlying storage+--    from being garbage collected, so you must use touchForeignPtr on the+--    underlying foreign pointer after the last use of the CIOVec.+unsafeFromByteString :: BS.ByteString -> CIOVec+unsafeFromByteString bs =+    let (fptr, off, len) = BS.toForeignPtr bs in+    unsafePerformIO $ withForeignPtr fptr $ \ptr ->+        pure $ CIOVec { iovBase = plusPtr ptr off, iovLen = fromIntegral len }++instance Storable CIOVec where+    alignment _ = #{alignment struct iovec}+    sizeOf _ = #{size struct iovec}+    peek ptr = do+        iovBase <- #{peek struct iovec, iov_base} ptr+        iovLen <- #{peek struct iovec, iov_len} ptr+        pure CIOVec {iovBase, iovLen}+    poke ptr v = do+        #{poke struct iovec, iov_base} ptr (iovBase v)+        #{poke struct iovec, iov_len} ptr (iovLen v)
+ tests/Main.hs view
@@ -0,0 +1,33 @@+{-# OPTIONS_GHC -Wno-name-shadowing #-}+module Main (main) where++-- NOTE: in the test suite we don't generally bother worry about async exception+-- safety. It is actually useful *not* to clean up temporary files in the event+-- of an exception, because it allows us to examine the state.++import Control.Monad.Fail (fail)+import System.IO+import Unix+import Zhp+++main :: IO ()+main = do+    let tmpDir :: CString+        tmpDir = "test-tmp"+        pathA :: CString+        pathA = tmpDir <> "/a"+        contentsA :: IsString a => a+        contentsA = "File A"++    mkdirExn tmpDir 0o700+    fd <- openExn pathA (o_CREAT <> o_EXCL <> o_WRONLY) 0o600+    writeFullExn fd contentsA+    closeExn fd+    fd <- openExn pathA o_RDONLY 0o700+    contents <- readExn fd (length (contentsA :: String))+    when (contents /= contentsA) $+        fail $ "Unexpected file contents: " <> show contents+    closeExn fd+    removeExn pathA+    rmdirExn tmpDir
+ unix-simple.cabal view
@@ -0,0 +1,50 @@+cabal-version:       2.2+name:                unix-simple+version:             0.1.0.0+synopsis:            Straightforward bindings to the posix API+-- description:+homepage:            https://github.com/zenhack/haskell-unix-simple+license:             MIT+license-file:        LICENSE+author:              Ian Denhardt+maintainer:          ian@zenhack.net+copyright:           2021 Ian Denhardt+category:            System+build-type:          Simple+extra-source-files:+    CHANGELOG.md+  , README.md+  , .gitignore++source-repository head+  type:     git+  branch:   master+  location: https://github.com/zenhack/haskell-unix-simple++common shared-opts+  default-extensions:+      NoImplicitPrelude+    , OverloadedStrings+  build-depends:+      base >=4.12 && <5+    , bytestring >=0.10.12 && <0.12+    , zenhack-prelude ^>=0.1+  default-language:    Haskell2010++library+  import: shared-opts+  hs-source-dirs:      src+  exposed-modules:+      Unix+    , CString+  other-modules:+      Unix.Errors+    , Unix.C+    , Unix.C.Errors+    , Unix.IOVec+test-suite tests+  import: shared-opts+  build-depends: unix-simple+  type: exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is: Main.hs