module System.XAttr
(
setXAttr
, lSetXAttr
, fdSetXAttr
, createXAttr
, lCreateXAttr
, fdCreateXAttr
, replaceXAttr
, lReplaceXAttr
, fdReplaceXAttr
, getXAttr
, lGetXAttr
, fdGetXAttr
, listXAttr
, lListXAttr
, fdListXAttr
, removeXAttr
, lRemoveXAttr
, fdRemoveXAttr )
where
import Foreign.C
import Foreign.Ptr
import Foreign.Marshal.Alloc
import System.Posix.Types
xAttrSet :: a ->
String ->
String ->
(a -> CString -> Ptr () -> CSize -> CInt -> IO CInt) ->
String ->
CInt ->
IO ()
xAttrSet f attr value func name mode = throwErrnoIfMinus1_ name $
withCString attr $
\b -> withCStringLen value $
\(c,d) -> func
f
b
(castPtr c)
(fromIntegral d)
mode
setXAttr :: FilePath
-> String
-> String
-> IO ()
setXAttr path attr value = withCString path $
\x -> xAttrSet x attr value c_setxattr "setxattr" 0
lSetXAttr :: FilePath -> String -> String -> IO ()
lSetXAttr path attr value = withCString path $
\x -> xAttrSet x attr value c_lsetxattr "lsetxattr" 0
fdSetXAttr :: Fd -> String -> String -> IO ()
fdSetXAttr (Fd n) attr value = xAttrSet n attr value c_fsetxattr "fsetxattr" 0
createXAttr :: FilePath -> String -> String -> IO ()
createXAttr path attr value = withCString path $
\x -> xAttrSet x attr value
c_setxattr
"setxattr"
1
lCreateXAttr :: FilePath -> String -> String -> IO ()
lCreateXAttr path attr value = withCString path $
\x -> xAttrSet x attr value
c_lsetxattr
"lsetxattr"
1
fdCreateXAttr :: Fd -> String -> String -> IO ()
fdCreateXAttr (Fd n) attr value = xAttrSet n attr value
c_fsetxattr
"fsetxattr"
1
replaceXAttr :: FilePath -> String -> String -> IO ()
replaceXAttr path attr value = withCString path $
\x -> xAttrSet x attr value
c_setxattr
"setxattr"
2
lReplaceXAttr :: FilePath -> String -> String -> IO ()
lReplaceXAttr path attr value = withCString path $
\x -> xAttrSet x attr value
c_lsetxattr
"lsetxattr"
2
fdReplaceXAttr :: Fd -> String -> String -> IO ()
fdReplaceXAttr (Fd n) attr value = xAttrSet n attr value
c_fsetxattr
"fsetxattr"
2
xAttrGet f attr func name = withCString attr $
\cstr -> (do
size <- throwErrnoIfMinus1 name $
func f cstr nullPtr 0
ptr <- mallocBytes (fromIntegral size)
throwErrnoIfMinus1 name $
func f cstr ptr (fromIntegral size)
str <- peekCStringLen (castPtr (ptr), (fromIntegral size))
free ptr
return str)
getXAttr :: FilePath
-> String
-> IO (String)
getXAttr path attr = withCString path $
\x -> xAttrGet x attr c_getxattr "getxattr"
lGetXAttr :: FilePath -> String -> IO (String)
lGetXAttr path attr = withCString path $
\x -> xAttrGet x attr c_lgetxattr "lgetxattr"
fdGetXAttr :: Fd -> String -> IO (String)
fdGetXAttr (Fd n) attr = xAttrGet n attr c_fgetxattr "fgetxattr"
xAttrList f func name = do
size <- throwErrnoIfMinus1 name (func f nullPtr 0)
ptr <- mallocBytes (fromIntegral size)
throwErrnoIfMinus1 name (func f ptr (fromIntegral size))
str <- peekCStringLen (ptr, (fromIntegral size))
free ptr
return $ split str
where split "" = []
split xs = (fst c):(split $ tail $ snd c)
where c = break (\x -> x == '\NUL') xs
listXAttr :: FilePath
-> IO ([String])
listXAttr path = withCString path $
\a -> xAttrList a c_listxattr "listxattr"
lListXAttr :: FilePath -> IO ([String])
lListXAttr path = withCString path $
\a -> xAttrList a c_llistxattr "llistxattr"
fdListXAttr :: Fd -> IO ([String])
fdListXAttr (Fd n) = xAttrList n c_flistxattr "flistxattr"
xAttrRemove f attr func name = throwErrnoIfMinus1_ name $
withCString attr (func f)
removeXAttr :: FilePath
-> String
-> IO ()
removeXAttr path attr = withCString path $
\cstr -> xAttrRemove cstr attr c_removexattr "removexattr"
lRemoveXAttr :: FilePath -> String -> IO ()
lRemoveXAttr path attr = withCString path $
\cstr -> xAttrRemove cstr attr c_lremovexattr "lremovexattr"
fdRemoveXAttr :: Fd -> String -> IO ()
fdRemoveXAttr (Fd n) attr = xAttrRemove n attr c_fremovexattr "fremovexattr"
foreign import ccall unsafe "setxattr" c_setxattr :: CString -> CString -> Ptr () -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "lsetxattr" c_lsetxattr :: CString -> CString -> Ptr () -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "fsetxattr" c_fsetxattr :: CInt -> CString -> Ptr () -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "getxattr" c_getxattr :: CString -> CString -> Ptr () -> CSize -> IO CSsize
foreign import ccall unsafe "lgetxattr" c_lgetxattr :: CString -> CString -> Ptr () -> CSize -> IO CSsize
foreign import ccall unsafe "fgetxattr" c_fgetxattr :: CInt -> CString -> Ptr () -> CSize -> IO CSsize
foreign import ccall unsafe "listxattr" c_listxattr :: CString -> CString -> CSize -> IO CSsize
foreign import ccall unsafe "llistxattr" c_llistxattr :: CString -> CString -> CSize -> IO CSsize
foreign import ccall unsafe "flistxattr" c_flistxattr :: CInt -> CString -> CSize -> IO CSsize
foreign import ccall unsafe "removexattr" c_removexattr :: CString -> CString -> IO CInt
foreign import ccall unsafe "lremovexattr" c_lremovexattr :: CString -> CString -> IO CInt
foreign import ccall unsafe "fremovexattr" c_fremovexattr :: CInt -> CString -> IO CInt