module System.Xattr
(
setxattr
, lsetxattr
, fsetxattr
, getxattr
, lgetxattr
, fgetxattr
, listxattr
, llistxattr
, flistxattr
, AttrName
, AttrValue
, XattrMode(..)
)
where
import Data.Functor ((<$>))
import Foreign.C
import Foreign.Ptr
import Foreign.Marshal.Alloc
import System.Posix.Types
import System.Posix.IO
import System.IO
import Data.ByteString (ByteString
, useAsCStringLen
, packCStringLen
, split)
import Data.ByteString.Char8 (unpack)
data XattrMode =
RegularMode
| CreateMode
| ReplaceMode
deriving (Eq, Show)
instance Enum XattrMode where
fromEnum RegularMode = 0
fromEnum CreateMode = 1
fromEnum ReplaceMode = 2
toEnum 1 = CreateMode
toEnum 2 = ReplaceMode
toEnum _ = RegularMode
type AttrName = String
type AttrValue = ByteString
type Void = CChar
mkSetxattr :: Show cStringOrCInt => String
-> cStringOrCInt
-> (cStringOrCInt -> CString -> Ptr Void -> CSize -> CInt -> IO CInt)
-> AttrName
-> AttrValue
-> XattrMode
-> IO ()
mkSetxattr funcName pathOrHandle cFunc attrName attrData mode =
throwErrnoIfMinus1_ funcName $ withCString attrName $ \cName ->
useAsCStringLen attrData $ \(cVal, cValLen) ->
let l = fromIntegral cValLen
m = fromIntegral . fromEnum $ mode
in cFunc pathOrHandle cName cVal l m
setxattr :: FilePath
-> AttrName
-> AttrValue
-> XattrMode
-> IO ()
setxattr path name val mode = withCString path $ \cName ->
mkSetxattr "setxattr" cName c_setxattr name val mode
foreign import ccall unsafe "setxattr"
c_setxattr :: CString -> CString -> Ptr Void -> CSize -> CInt -> IO CInt
lsetxattr :: FilePath -> AttrName -> AttrValue -> XattrMode -> IO ()
lsetxattr path name val mode = withCString path $ \cName ->
mkSetxattr "lsetxattr" cName c_lsetxattr name val mode
foreign import ccall unsafe "lsetxattr"
c_lsetxattr :: CString -> CString -> Ptr Void -> CSize -> CInt -> IO CInt
fsetxattr :: Handle -> AttrName -> AttrValue -> XattrMode -> IO ()
fsetxattr handle name val mode = handleToFd handle >>= \fd ->
mkSetxattr "fsetxattr" (fromIntegral fd) c_fsetxattr name val mode
foreign import ccall unsafe "fsetxattr"
c_fsetxattr :: CInt -> CString -> Ptr Void -> CSize -> CInt -> IO CInt
mkGetxattr :: String
-> cStringOrCInt
-> (cStringOrCInt -> CString -> Ptr Void -> CSize -> IO CSsize)
-> AttrName
-> IO AttrValue
mkGetxattr funcName pathOrHandle cFunc attrName = do
withCString attrName $ \cName -> do
len <- throwErrnoIfMinus1 funcName $
cFunc pathOrHandle cName (nullPtr) 0
allocaBytes (fromIntegral len) $ \mem -> do
len' <- throwErrnoIfMinus1 funcName $
cFunc pathOrHandle cName mem (fromIntegral len)
packCStringLen (mem, fromIntegral len')
getxattr :: FilePath -> AttrName -> IO AttrValue
getxattr path name = withCString path $ \cName ->
mkGetxattr "getxattr" cName c_getxattr name
foreign import ccall unsafe "getxattr"
c_getxattr :: CString -> CString -> Ptr Void -> CSize -> IO CSsize
lgetxattr :: FilePath -> AttrName -> IO AttrValue
lgetxattr path name = withCString path $ \cName ->
mkGetxattr "lgetxattr" cName c_lgetxattr name
foreign import ccall unsafe "lgetxattr"
c_lgetxattr :: CString -> CString -> Ptr Void -> CSize -> IO CSsize
fgetxattr :: Handle -> AttrName -> IO AttrValue
fgetxattr handle name = handleToFd handle >>= \fd ->
mkGetxattr "fgetxattr" (fromIntegral fd) c_fgetxattr name
foreign import ccall unsafe "fgetxattr"
c_fgetxattr :: CInt -> CString -> Ptr Void -> CSize -> IO CSsize
mkListxattr :: String
-> cStringOrCInt
-> (cStringOrCInt -> CString -> CSize -> IO CSsize)
-> IO [AttrName]
mkListxattr funcName pathOrHandle cFunc = do
len <- throwErrnoIfMinus1 funcName $
cFunc pathOrHandle (nullPtr) 0
allocaBytes (fromIntegral len) $ \mem -> do
len' <- throwErrnoIfMinus1 funcName $
cFunc pathOrHandle mem (fromIntegral len)
splitNull <$> packCStringLen (mem, fromIntegral len')
where splitNull s = filter (/= "") $ map unpack $ split 0x0 s
listxattr :: FilePath -> IO [AttrName]
listxattr path = withCString path $ \cName ->
mkListxattr "listxattr" cName c_listxattr
foreign import ccall unsafe "listxattr"
c_listxattr :: CString -> CString -> CSize -> IO CSsize
llistxattr :: FilePath -> IO [AttrName]
llistxattr path = withCString path $ \cName ->
mkListxattr "llistxattr" cName c_llistxattr
foreign import ccall unsafe "llistxattr"
c_llistxattr :: CString -> CString -> CSize -> IO CSsize
flistxattr :: Handle -> IO [AttrName]
flistxattr handle = handleToFd handle >>= \fd ->
mkListxattr "flistxattr" (fromIntegral fd) c_flistxattr
foreign import ccall unsafe "flistxattr"
c_flistxattr :: CInt -> CString -> CSize -> IO CSsize