module System.Posix.SharedBuffer (
openSBuffer
, closeSharedBuffer
, removeSharedBuffer
, unlinkSharedBuffer
, SharedBuffer (..)
, Flags (..)
, Protection (..)
, getProtection
, writeProtection
, ShmOpenFlags(..)
, openReadWriteFlags
, openReadFlags
) where
import Control.Exception (try)
import Control.Monad
import Data.Bits
import Data.List (foldl')
import Foreign.Ptr
import Foreign.C.Error
import Foreign.C.Types
import System.Posix.SharedMem
import System.Posix (FileMode, Fd (..), closeFd)
foreign import ccall "mmap" c_mmap :: Ptr () -> CInt -> CInt -> CInt -> Fd -> CInt -> IO (Ptr ())
foreign import ccall "munmap" c_munmap :: Ptr () -> CInt -> IO CInt
foreign import ccall "ftruncate" c_ftruncate :: Fd -> CInt -> IO CInt
data SharedBuffer = SharedBuffer
{ sbPtr :: !(Ptr ())
, sbLen :: !CInt
, sbName :: String
}
deriving (Show)
closeSharedBuffer :: SharedBuffer -> IO ()
closeSharedBuffer SharedBuffer{sbPtr,sbLen} = do
throwErrnoIfMinus1_ "munmap" $ c_munmap sbPtr (fromIntegral sbLen)
removeSharedBuffer :: SharedBuffer -> IO ()
removeSharedBuffer sb@SharedBuffer{sbName} = do
closeSharedBuffer sb
void (try (shmUnlink sbName) :: IO (Either IOError ()))
unlinkSharedBuffer :: SharedBuffer -> IO ()
unlinkSharedBuffer SharedBuffer{sbName} = do
void (try (shmUnlink sbName) :: IO (Either IOError ()))
data Protection =
ProtNone
| ProtRead
| ProtWrite
| ProtExec
deriving (Eq, Show, Ord, Bounded)
instance Enum Protection where
toEnum 0 = ProtNone
toEnum 1 = ProtRead
toEnum 2 = ProtWrite
toEnum 4 = ProtExec
toEnum _ = error "toEnum: invalid Protection level (bit-twiddle it?)"
fromEnum ProtNone = 0
fromEnum ProtRead = 1
fromEnum ProtWrite = 2
fromEnum ProtExec = 4
getProtection :: [Protection] -> CInt
getProtection = fromIntegral . foldl' ((. fromEnum) . (.|.)) 0
writeProtection :: [Protection]
writeProtection = [ProtWrite, ProtRead]
data Flags =
MapShared
| MapPrivate
deriving (Eq, Ord, Show)
instance Enum Flags where
toEnum 1 = MapShared
toEnum 2 = MapPrivate
toEnum x = error $ "invalid mmap flag: " ++ show x
fromEnum MapShared = 1
fromEnum MapPrivate = 2
openReadWriteFlags :: ShmOpenFlags
openReadWriteFlags = ShmOpenFlags
{ shmCreate = True
, shmReadWrite = True
, shmExclusive = True
, shmTrunc = False
}
openReadFlags :: ShmOpenFlags
openReadFlags = ShmOpenFlags
{ shmCreate = False
, shmReadWrite = False
, shmExclusive = False
, shmTrunc = False
}
openSBuffer :: String
-> CInt
-> ShmOpenFlags
-> [Protection]
-> FileMode
-> IO SharedBuffer
openSBuffer sbName sbLen openFlags sbProtection sbpmode = do
resetErrno
fd <- shmOpen sbName openFlags sbpmode
when (shmReadWrite openFlags) $
throwErrnoIfMinus1_ "ftruncate" $ c_ftruncate fd sbLen
sbPtr <- c_mmap nullPtr sbLen (getProtection sbProtection)
(fromIntegral $ fromEnum MapShared) fd 0
errno <- getErrno
closeFd fd
if errno == eOK
then return (SharedBuffer { sbPtr, sbLen, sbName })
else throwErrno "openSBuffer: mmap"