linux-xattr-0.1.1.0: System/Linux/XAttr.hsc
--------------------------------------------------------------------------------
-- |
-- Module : $Header$
-- Copyright : © 2013-2014 Nicola Squartini
-- License : BSD3
--
-- Maintainer : Nicola Squartini <tensor5@gmail.com>
-- Stability : experimental
-- Portability : portable
--
-- @linux-xattr@ provides bindings to the Linux syscalls for reading and
-- manipulating
-- <http://en.wikipedia.org/wiki/Extended_file_attributes extended attributes>
-- (@<http://man7.org/linux/man-pages/man2/setxattr.2.html setxattr>@,
-- @<http://man7.org/linux/man-pages/man2/getxattr.2.html getxattr>@,
-- @<http://man7.org/linux/man-pages/man2/listxattr.2.html listxattr>@ and
-- @<http://man7.org/linux/man-pages/man2/removexattr.2.html removexattr>@).
--
-- Each function in this module has two variants: one with the name prefixed by
-- @__l__@ and one prefixed by @__fd__@. Both of these are identical to the
-- original version except that the @__l__@-variant does not follow symbolic
-- link but acts on the link itself, and the @__fd__@-variant take a file
-- descriptor as argument rather than a @'FilePath'@.
--
-- Moreover, every function has an @/xxx/__UserXAttr__@ variant for working
-- transparently in the @__user__@ namespace of extended attributes, without
-- worrying about the @"user."@ prefix: these functions automatically prepends
-- the string @"user."@ to the @'Name'@ of the attribute when @'Name'@ is an
-- input value, or strip the prefix @"user."@ from it when @'Name'@ is a
-- returned value. See the documentation of each individual function for
-- details.
--
--------------------------------------------------------------------------------
module System.Linux.XAttr
( -- * Set extended attributes
-- | Functions in this section call the
-- @<http://man7.org/linux/man-pages/man2/setxattr.2.html setxattr>@
-- syscall.
setXAttr
, lSetXAttr
, fdSetXAttr
-- ** Set extended @user@ attributes
, setUserXAttr
, lSetUserXAttr
, fdSetUserXAttr
-- * Create extended attributes
-- | Functions in this section call the
-- @<http://man7.org/linux/man-pages/man2/setxattr.2.html setxattr>@
-- syscall with the flag @XATTR_CREATE@.
, createXAttr
, lCreateXAttr
, fdCreateXAttr
-- ** Create extended @user@ attributes
, createUserXAttr
, lCreateUserXAttr
, fdCreateUserXAttr
-- * Replace extended attributes
-- | Functions in this section call the
-- @<http://man7.org/linux/man-pages/man2/setxattr.2.html setxattr>@
-- syscall with the flag @XATTR_REPLACE@.
, replaceXAttr
, lReplaceXAttr
, fdReplaceXAttr
-- ** Replace extended @user@ attributes
, replaceUserXAttr
, lReplaceUserXAttr
, fdReplaceUserXAttr
-- * Retrieve extended attributes
-- | Functions in this section call the
-- @<http://man7.org/linux/man-pages/man2/getxattr.2.html getxattr>@
-- syscall.
, getXAttr
, lGetXAttr
, fdGetXAttr
-- ** Retrieve extended @user@ attributes
, getUserXAttr
, lGetUserXAttr
, fdGetUserXAttr
-- * List extended attributes
-- | Functions in this section call the
-- @<http://man7.org/linux/man-pages/man2/listxattr.2.html listxattr>@
-- syscall.
, listXAttr
, lListXAttr
, fdListXAttr
-- ** List extended @user@ attributes
-- | These functions only list those extended attributes with @'Name'@
-- beginning with @"user."@. The @"user."@ prefix is removed from each
-- @'Name'@ in the output list.
, listUserXAttr
, lListUserXAttr
, fdListUserXAttr
-- * Remove extended attributes
-- | Functions in this section call the
-- @<http://man7.org/linux/man-pages/man2/removexattr.2.html removexattr>@
-- syscall.
, removeXAttr
, lRemoveXAttr
, fdRemoveXAttr
-- ** Remove extended @user@ attributes
, removeUserXAttr
, lRemoveUserXAttr
, fdRemoveUserXAttr
-- * Types for extended attributes
, Name
, Value
) where
#include <sys/xattr.h>
import Control.Monad (liftM)
import Data.ByteString (ByteString, packCStringLen,
useAsCStringLen)
import Foreign.C (CInt (..), CSize (..), CString,
peekCStringLen, throwErrnoIfMinus1,
throwErrnoIfMinus1_, withCString)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (Ptr, nullPtr)
import System.Posix.Types (CSsize (..), Fd (..))
-- | Name of extended attribute.
type Name = String
-- | Value of extended attribute.
type Value = ByteString
xAttrSet :: Name
-> Value
-> (a -> CString -> CString -> CSize -> CInt -> IO CInt)
-> String
-> CInt
-> a
-> IO ()
xAttrSet attr value func name mode f =
throwErrnoIfMinus1_ name $ withCString attr $ \b ->
useAsCStringLen value $ \(c,d) ->
func f b c (fromIntegral d) mode
-- | Set the @'Value'@ of the extended attribute identified by @'Name'@ and
-- associated with the given @'FilePath'@ in the filesystem.
setXAttr :: FilePath -> Name -> Value -> IO ()
setXAttr path attr value =
withCString path $ xAttrSet attr value setxattr "setxattr" 0
-- | @'setUserXAttr' "\/some\/path" "foo" "bar" = 'setXAttr' "\/some\/path" "user.foo" "bar"@
setUserXAttr :: FilePath -> Name -> Value -> IO ()
setUserXAttr = userXAttr setXAttr
-- | Set the @'Value'@ of the extended attribute identified by @'Name'@ and
-- associated with the given @'FilePath'@ in the filesystem (do not follow
-- symbolic links).
lSetXAttr :: FilePath -> Name -> Value -> IO ()
lSetXAttr path attr value =
withCString path $ xAttrSet attr value lsetxattr "lsetxattr" 0
-- | @'lSetUserXAttr' "\/some\/link" "foo" "bar" = 'lSetXAttr' "\/some\/link" "user.foo" "bar"@
lSetUserXAttr :: FilePath -> Name -> Value -> IO ()
lSetUserXAttr = userXAttr lSetXAttr
-- | Set the @'Value'@ of the extended attribute identified by @'Name'@ and
-- associated with the given file descriptor in the filesystem.
fdSetXAttr :: Fd -> Name -> Value -> IO ()
fdSetXAttr (Fd n) attr value =
xAttrSet attr value fsetxattr "fsetxattr" 0 n
-- | @'fdSetUserXAttr' ('Fd' n) "foo" "bar" = 'fdSetXAttr' ('Fd' n) "user.foo" "bar"@
fdSetUserXAttr :: Fd -> Name -> Value -> IO ()
fdSetUserXAttr = userXAttr fdSetXAttr
-- | Identical to @'setXAttr'@, but if the attribute already exists fail with
-- @`System.IO.Error.isAlreadyExistsError`@.
createXAttr :: FilePath -> Name -> Value -> IO ()
createXAttr path attr value =
withCString path $
xAttrSet attr value setxattr "setxattr" #{const XATTR_CREATE}
-- | @'createUserXAttr' "\/some\/path" "foo" "bar" = 'createXAttr' "\/some\/path" "user.foo" "bar"@
createUserXAttr :: FilePath -> Name -> Value -> IO ()
createUserXAttr = userXAttr createXAttr
-- | Identical to @'lSetXAttr'@, but if the attribute already exists fail with
-- @`System.IO.Error.isAlreadyExistsError`@.
lCreateXAttr :: FilePath -> Name -> Value -> IO ()
lCreateXAttr path attr value =
withCString path $
xAttrSet attr value lsetxattr "lsetxattr" #{const XATTR_CREATE}
-- | @'lCreateUserXAttr' "\/some\/link" "foo" "bar" = 'lCreateXAttr' "\/some\/link" "user.foo" "bar"@
lCreateUserXAttr :: FilePath -> Name -> Value -> IO ()
lCreateUserXAttr = userXAttr lCreateXAttr
-- | Identical to @'fdSetXAttr'@, but if the attribute already exists fail with
-- @`System.IO.Error.isAlreadyExistsError`@.
fdCreateXAttr :: Fd -> Name -> Value -> IO ()
fdCreateXAttr (Fd n) attr value =
xAttrSet attr value fsetxattr "fsetxattr" #{const XATTR_CREATE} n
-- | @'fdCreateUserXAttr' ('Fd' n) "foo" "bar" = 'fdCreateXAttr' ('Fd' n) "user.foo" "bar"@
fdCreateUserXAttr :: Fd -> Name -> Value -> IO ()
fdCreateUserXAttr = userXAttr fdCreateXAttr
-- | Identical to @'setXAttr'@, but if the attribute does not exist fail with
-- @`System.IO.Error.isDoesNotExistError`@.
replaceXAttr :: FilePath -> Name -> Value -> IO ()
replaceXAttr path attr value =
withCString path $
xAttrSet attr value setxattr "setxattr" #{const XATTR_REPLACE}
-- | @'replaceUserXAttr' "\/some\/path" "foo" "bar" = 'replaceXAttr' "\/some\/path" "user.foo" "bar"@
replaceUserXAttr :: FilePath -> Name -> Value -> IO ()
replaceUserXAttr = userXAttr replaceXAttr
-- | Identical to @'lSetXAttr'@, but if the attribute does not exist fail with
-- @`System.IO.Error.isDoesNotExistError`@.
lReplaceXAttr :: FilePath -> Name -> Value -> IO ()
lReplaceXAttr path attr value =
withCString path $
xAttrSet attr value lsetxattr "lsetxattr" #{const XATTR_REPLACE}
-- | @'lReplaceUserXAttr' "\/some\/link" "foo" "bar" = 'lReplaceXAttr' "\/some\/link" "user.foo" "bar"@
lReplaceUserXAttr :: FilePath -> Name -> Value -> IO ()
lReplaceUserXAttr = userXAttr lReplaceXAttr
-- | Identical to @'fdSetXAttr'@, but if the attribute does not exist fail with
-- @`System.IO.Error.isDoesNotExistError`@.
fdReplaceXAttr :: Fd -> Name -> Value -> IO ()
fdReplaceXAttr (Fd n) attr value =
xAttrSet attr value fsetxattr "fsetxattr" #{const XATTR_REPLACE} n
-- | @'fdReplaceUserXAttr' ('Fd' n) "foo" "bar" = 'fdReplaceXAttr' ('Fd' n) "user.foo" "bar"@
fdReplaceUserXAttr :: Fd -> Name -> Value -> IO ()
fdReplaceUserXAttr = userXAttr fdReplaceXAttr
xAttrGet :: Name
-> (a -> CString -> CString -> CSize -> IO CSsize)
-> String
-> a
-> IO Value
xAttrGet attr func name f =
withCString attr $ \cstr ->
do size <- throwErrnoIfMinus1 name (func f cstr nullPtr 0)
allocaBytes (fromIntegral size) $ \p ->
do throwErrnoIfMinus1_ name $ func f cstr p (fromIntegral size)
packCStringLen (p, fromIntegral size)
-- | Retrieve the @'Value'@ of the extended attribute identified by @'Name'@ and
-- associated with the given @'FilePath'@ in the filesystem, or fail with
-- @`System.IO.Error.isDoesNotExistError`@ if the attribute does not exist.
getXAttr :: FilePath -> Name -> IO Value
getXAttr path attr =
withCString path $ xAttrGet attr getxattr "getxattr"
-- | @'getUserXAttr' "\/some\/path" "foo" = 'getXAttr' "\/some\/path" "user.foo"@
getUserXAttr :: FilePath -> Name -> IO Value
getUserXAttr = userXAttr getXAttr
-- | Retrieve the @'Value'@ of the extended attribute identified by @'Name'@ and
-- associated with the given @'FilePath'@ in the filesystem, or fail with
-- @`System.IO.Error.isDoesNotExistError`@ if the attribute does not exist (do
-- not follow symbolic links).
lGetXAttr :: FilePath -> Name -> IO Value
lGetXAttr path attr =
withCString path $ xAttrGet attr lgetxattr "lgetxattr"
-- | @'lGetUserXAttr' "\/some\/link" "foo" = 'lGetXAttr' "\/some\/link" "user.foo"@
lGetUserXAttr :: FilePath -> Name -> IO Value
lGetUserXAttr = userXAttr lGetXAttr
-- | Retrieve the @'Value'@ of the extended attribute identified by @'Name'@ and
-- associated with the given file descriptor in the filesystem, or fail with
-- @`System.IO.Error.isDoesNotExistError`@ if the attribute does not exist.
fdGetXAttr :: Fd -> Name -> IO Value
fdGetXAttr (Fd n) attr =
xAttrGet attr fgetxattr "fgetxattr" n
-- | @'fdGetUserXAttr' ('Fd' n) "foo" = 'fdGetXAttr' ('Fd' n) "user.foo"@
fdGetUserXAttr :: Fd -> Name -> IO Value
fdGetUserXAttr = userXAttr fdGetXAttr
xAttrList :: (a -> CString -> CSize -> IO CSsize)
-> String
-> a
-> IO [Name]
xAttrList func name f =
do size <- throwErrnoIfMinus1 name (func f nullPtr 0)
allocaBytes (fromIntegral size) $ \p ->
do throwErrnoIfMinus1_ name (func f p (fromIntegral size))
str <- peekCStringLen (p, fromIntegral size)
return $ split str
where split "" = []
split xs = fst c : split (tail $ snd c)
where c = break (== '\NUL') xs
-- | Get the list of extended attribute @'Name'@s associated with the given
-- @'FilePath'@ in the filesystem.
listXAttr :: FilePath -> IO [Name]
listXAttr path = withCString path $ xAttrList listxattr "listxattr"
-- |
-- @
-- >>> 'listXAttr' "\/some\/path"
-- ["user.foo","user.bar"]
-- >>> 'listUserXAttr' "\/some\/path"
-- ["foo","bar"]
-- @
listUserXAttr :: FilePath -> IO [Name]
listUserXAttr = userXAttrList listXAttr
-- | Get the list of extended attribute @'Name'@s associated with the given
-- @'FilePath'@ in the filesystem (do not follow symbolic links).
lListXAttr :: FilePath -> IO [Name]
lListXAttr path =
withCString path $ xAttrList llistxattr "llistxattr"
-- |
-- @
-- >>> 'lListXAttr' "\/some\/link"
-- ["user.foo","user.bar"]
-- >>> 'lListUserXAttr' "\/some\/link"
-- ["foo","bar"]
-- @
lListUserXAttr :: FilePath -> IO [Name]
lListUserXAttr = userXAttrList lListXAttr
-- | Get the list of extended attribute @'Name'@s associated with the given file
-- descriptor in the filesystem.
fdListXAttr :: Fd -> IO [Name]
fdListXAttr (Fd n) =
xAttrList flistxattr "flistxattr" n
-- |
-- @
-- >>> 'fdListXAttr' ('Fd' n)
-- ["user.foo","user.bar"]
-- >>> 'fdListUserXAttr' ('Fd' n)
-- ["foo","bar"]
-- @
fdListUserXAttr :: Fd -> IO [Name]
fdListUserXAttr = userXAttrList fdListXAttr
xAttrRemove :: Name -> (a -> CString -> IO CInt) -> String -> a -> IO ()
xAttrRemove attr func name f =
throwErrnoIfMinus1_ name $ withCString attr (func f)
-- | Remove the extended attribute identified by @'Name'@ and associated with
-- the given @'FilePath'@ in the filesystem, or fail with
-- @`System.IO.Error.isDoesNotExistError`@ if the attribute does not exist.
removeXAttr :: FilePath -> Name -> IO ()
removeXAttr path attr =
withCString path $ xAttrRemove attr removexattr "removexattr"
-- | @'removeUserXAttr' "\/some\/path" "foo" = 'removeXAttr' "\/some\/path" "user.foo"@
removeUserXAttr :: FilePath -> Name -> IO ()
removeUserXAttr = userXAttr removeXAttr
-- | Remove the extended attribute identified by @'Name'@ and associated with
-- the given @'FilePath'@ in the filesystem, or fail with
-- @`System.IO.Error.isDoesNotExistError`@ if the attribute does not exist (do
-- not follow symbolic links).
lRemoveXAttr :: FilePath -> Name -> IO ()
lRemoveXAttr path attr =
withCString path $ xAttrRemove attr lremovexattr "lremovexattr"
-- | @'lRemoveUserXAttr' "\/some\/link" "foo" = 'lRemoveXAttr' "\/some\/link" "user.foo"@
lRemoveUserXAttr :: FilePath -> Name -> IO ()
lRemoveUserXAttr = userXAttr lRemoveXAttr
-- | Remove the extended attribute identified by @'Name'@ and associated with
-- the given file descriptor in the filesystem, or fail with
-- @`System.IO.Error.isDoesNotExistError`@ if the attribute does not exist.
fdRemoveXAttr :: Fd -> Name -> IO ()
fdRemoveXAttr (Fd n) attr =
xAttrRemove attr fremovexattr "fremovexattr" n
-- | @'fdRemoveUserXAttr' ('Fd' n) "foo" = 'fdRemoveXAttr' ('Fd' n) "user.foo"@
fdRemoveUserXAttr :: Fd -> Name -> IO ()
fdRemoveUserXAttr = userXAttr fdRemoveXAttr
userXAttr :: (a -> Name -> b) -> a -> Name -> b
userXAttr func f name = func f ("user." ++ name)
userXAttrList :: (a -> IO [Name]) -> a -> IO [Name]
userXAttrList func f = liftM unUser $ func f
where unUser [] = []
unUser (x:xs) = case splitAt 5 x of
("user.",attr) -> attr : unUser xs
_ -> unUser xs
foreign import ccall unsafe setxattr :: CString
-> CString
-> Ptr a
-> CSize
-> CInt
-> IO CInt
foreign import ccall unsafe lsetxattr :: CString
-> CString
-> Ptr a
-> CSize
-> CInt
-> IO CInt
foreign import ccall unsafe fsetxattr :: CInt
-> CString
-> Ptr a
-> CSize
-> CInt
-> IO CInt
foreign import ccall unsafe getxattr :: CString
-> CString
-> Ptr a
-> CSize
-> IO CSsize
foreign import ccall unsafe lgetxattr :: CString
-> CString
-> Ptr a
-> CSize
-> IO CSsize
foreign import ccall unsafe fgetxattr :: CInt
-> CString
-> Ptr a
-> CSize
-> IO CSsize
foreign import ccall unsafe listxattr :: CString
-> CString
-> CSize
-> IO CSsize
foreign import ccall unsafe llistxattr :: CString
-> CString
-> CSize
-> IO CSsize
foreign import ccall unsafe flistxattr :: CInt
-> CString
-> CSize
-> IO CSsize
foreign import ccall unsafe removexattr :: CString
-> CString
-> IO CInt
foreign import ccall unsafe lremovexattr :: CString
-> CString
-> IO CInt
foreign import ccall unsafe fremovexattr :: CInt
-> CString
-> IO CInt