diff --git a/configure b/configure --- a/configure +++ b/configure @@ -1,8 +1,8 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.63 for FULL-PACKAGE-NAME VERSION. +# Generated by GNU Autoconf 2.63 for System.Xattr 0.5.2. # -# Report bugs to . +# Report bugs to . # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. @@ -594,11 +594,11 @@ SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. -PACKAGE_NAME='FULL-PACKAGE-NAME' -PACKAGE_TARNAME='full-package-name' -PACKAGE_VERSION='VERSION' -PACKAGE_STRING='FULL-PACKAGE-NAME VERSION' -PACKAGE_BUGREPORT='BUG-REPORT-ADDRESS' +PACKAGE_NAME='System.Xattr' +PACKAGE_TARNAME='system-xattr' +PACKAGE_VERSION='0.5.2' +PACKAGE_STRING='System.Xattr 0.5.2' +PACKAGE_BUGREPORT='evan@eklitzke.org' # Factoring default headers for most tests. ac_includes_default="\ @@ -1249,7 +1249,7 @@ # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures FULL-PACKAGE-NAME VERSION to adapt to many kinds of systems. +\`configure' configures System.Xattr 0.5.2 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1297,8 +1297,7 @@ --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] - --docdir=DIR documentation root - [DATAROOTDIR/doc/full-package-name] + --docdir=DIR documentation root [DATAROOTDIR/doc/system-xattr] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] @@ -1311,7 +1310,7 @@ if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of FULL-PACKAGE-NAME VERSION:";; + short | recursive ) echo "Configuration of System.Xattr 0.5.2:";; esac cat <<\_ACEOF @@ -1328,7 +1327,7 @@ Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. -Report bugs to . +Report bugs to . _ACEOF ac_status=$? fi @@ -1391,7 +1390,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -FULL-PACKAGE-NAME configure VERSION +System.Xattr configure 0.5.2 generated by GNU Autoconf 2.63 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -1405,7 +1404,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by FULL-PACKAGE-NAME $as_me VERSION, which was +It was created by System.Xattr $as_me 0.5.2, which was generated by GNU Autoconf 2.63. Invocation command line was $ $0 $@ @@ -3498,9 +3497,9 @@ { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 $as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} ( cat <<\_ASBOX -## --------------------------------- ## -## Report this to BUG-REPORT-ADDRESS ## -## --------------------------------- ## +## -------------------------------- ## +## Report this to evan@eklitzke.org ## +## -------------------------------- ## _ASBOX ) | sed "s/^/$as_me: WARNING: /" >&2 ;; @@ -3842,6 +3841,3 @@ fi done - -#AC_CONFIG_FILES([Makefile]) -#AC_OUTPUT diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -2,7 +2,7 @@ # Process this file with autoconf to produce a configure script. AC_PREREQ([2.63]) -AC_INIT([FULL-PACKAGE-NAME], [VERSION], [BUG-REPORT-ADDRESS]) +AC_INIT([System.Xattr], [0.5.2], [evan@eklitzke.org]) # Checks for programs. AC_PROG_AWK @@ -19,6 +19,3 @@ AC_CHECK_FUNCS([getxattr lgetxattr fgetxattr]) AC_CHECK_FUNCS([setxattr lsetxattr fsetxattr]) AC_CHECK_FUNCS([listxattr llistxattr flistxattr]) - -#AC_CONFIG_FILES([Makefile]) -#AC_OUTPUT diff --git a/src/System/Xattr.hs b/src/System/Xattr.hs new file mode 100644 --- /dev/null +++ b/src/System/Xattr.hs @@ -0,0 +1,146 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : System.Xattr +-- Copyright : (c) Evan Klitzke 2009 +-- License : BSD3 +-- Maintainer: Evan Klitzke +-- Stability : experimental +-- Portability : GHC only +-- +-- Relatively low-level interface to work with extended attributes on Unix +-- systems. This is a fairly straightforward port of the API exposed by SGI's +-- libattr. +-- +-------------------------------------------------------------------------------- + +module System.Xattr + ( + -- * Functions + -- ** Set Functions + setxattr + , lsetxattr + , fsetxattr + + -- ** Get Functions + , getxattr + , lgetxattr + , fgetxattr + + -- ** List Functions + , listxattr + , llistxattr + , flistxattr + + -- * Data Types + , AttrName + , XattrMode(RegularMode,CreateMode,ReplaceMode) + ) + where + +import Data.Char +import Foreign.C +import Foreign.Ptr +import Foreign.Marshal.Alloc +import System.Posix.Types +import System.Posix.IO +import System.IO +import System.Xattr.Types + +import Data.ByteString (ByteString, useAsCStringLen, packCStringLen) + +type Void = CChar + +allocBufSize :: Int +allocBufSize = 4096 + +allocCSize :: CSize +allocCSize = fromIntegral allocBufSize + +foreign import ccall unsafe "setxattr" c_setxattr :: CString -> CString -> Ptr Void -> CSize -> CInt -> IO CInt +foreign import ccall unsafe "lsetxattr" c_lsetxattr :: CString -> CString -> Ptr Void -> CSize -> CInt -> IO CInt +foreign import ccall unsafe "fsetxattr" c_fsetxattr :: CInt -> CString -> Ptr Void -> CSize -> CInt -> IO CInt + +foreign import ccall unsafe "getxattr" c_getxattr :: CString -> CString -> Ptr Void -> CSize -> IO CSize +foreign import ccall unsafe "lgetxattr" c_lgetxattr :: CString -> CString -> Ptr Void -> CSize -> IO CSize +foreign import ccall unsafe "fgetxattr" c_fgetxattr :: CInt -> CString -> Ptr Void -> CSize -> IO CSize + +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 + +-- return a high level wrapper for a setxattr variant +mkSetxattr :: String -> a -> (a -> IO b) -> (b -> CString -> Ptr Void -> CSize -> CInt -> IO CInt) -> AttrName -> ByteString -> XattrMode -> IO () +mkSetxattr funcName x iox cFunc attrName attrData mode = do + x' <- iox x + cName <- newCString attrName + val <- useAsCStringLen attrData $ \(binaryData, dataLen) -> + cFunc x' cName binaryData (fromIntegral dataLen) (fromIntegral $ fromEnum mode) + if val /= 0 + then throwErrno funcName + else return () + +handleToIOCInt :: Handle -> IO CInt +handleToIOCInt = fmap fromIntegral . handleToFd + +-- |Set an attribute on a regular file, by path +setxattr :: FilePath -> AttrName -> ByteString -> XattrMode -> IO () +setxattr path = mkSetxattr "setxattr" path newCString c_setxattr + +-- |Like setxattr, but if the path is a symbolic link set the attribute on the link itself (not the file pointed to by the link) +lsetxattr :: FilePath -> AttrName -> ByteString -> XattrMode -> IO () +lsetxattr path = mkSetxattr "lsetxattr" path newCString c_lsetxattr + +-- |Like setxattr, but use the handle specified rather than a file path +fsetxattr :: Handle -> AttrName -> ByteString -> XattrMode -> IO () +fsetxattr handle = mkSetxattr "fsetxattr" handle handleToIOCInt c_fsetxattr + +-- return a high level wrapper for a getxattr variant +mkGetxattr :: String -> a -> (a -> IO b) -> (b -> CString -> Ptr Void -> CSize -> IO CSize) -> AttrName -> IO ByteString +mkGetxattr funcName x iox cFunc attrName = do + x' <- iox x + cName <- newCString attrName + allocaBytes allocBufSize $ \mem -> do + buflen <- cFunc x' cName mem allocCSize + if buflen == -1 + then throwErrno funcName + else packCStringLen (mem, fromIntegral buflen) + +-- |Get an attribute on a regular file, by path +getxattr :: FilePath -> AttrName -> IO ByteString +getxattr path = mkGetxattr "getxattr" path newCString c_getxattr + +-- |Like getxattr, but if the path is a symbolic link get the attribute on the link itself (not the file pointed to by the link) +lgetxattr :: FilePath -> AttrName -> IO ByteString +lgetxattr path = mkGetxattr "lgetxattr" path newCString c_lgetxattr + +-- |Like getxattr, but use the handle specified rather than a file path +fgetxattr :: Handle -> AttrName -> IO ByteString +fgetxattr handle = mkGetxattr "fgetxattr" handle handleToIOCInt c_fgetxattr + +-- split a string on NUL characters +splitNull :: String -> [String] +splitNull [] = [] +splitNull s = case suf of + "" -> [pre] + _ -> pre : (splitNull $ tail suf) + where (pre, suf) = break (\c -> ord c == 0) s + +mkListxattr :: String -> a -> (a -> IO b) -> (b -> CString -> CSize -> IO CSsize) -> IO [AttrName] +mkListxattr funcName x iox cFunc = do + x' <- iox x + allocaBytes allocBufSize $ \mem -> do buflen <- cFunc x' mem allocCSize + if buflen == -1 + then throwErrno funcName + else fmap splitNull $ peekCStringLen (mem, fromIntegral buflen) + +-- |Get a list of all of the attributes set on a path +listxattr :: FilePath -> IO [AttrName] +listxattr path = mkListxattr "listxattr" path newCString c_listxattr + +-- |Like listxattr, but if the path is a symbolic link get the attributes on the link itself (not the file pointed to by the link) +llistxattr :: FilePath -> IO [AttrName] +llistxattr path = mkListxattr "llistxattr" path newCString c_llistxattr + +-- |Like listxattr, but use the handle specified rather than a file path +flistxattr :: Handle -> IO [AttrName] +flistxattr handle = mkListxattr "flistxattr" handle handleToIOCInt c_flistxattr diff --git a/src/System/Xattr.hsc b/src/System/Xattr.hsc deleted file mode 100644 --- a/src/System/Xattr.hsc +++ /dev/null @@ -1,153 +0,0 @@ --------------------------------------------------------------------------------- --- | --- Module : Sound.Xattr --- Copyright : (c) Evan Klitzke 2009 --- License : BSD3 --- Maintainer: Evan Klitzke --- Stability : experimental --- Portability : only tested with GHC --- --- Relatively low-level interface to work with extended attributes on Unix --- systems. This is a fairly straightforward port of the API exposed by SGI's --- libattr. --- --------------------------------------------------------------------------------- - -module System.Xattr - ( - -- * Functions - setxattr - , lsetxattr - , fsetxattr - , getxattr - , lgetxattr - , fgetxattr - , listxattr - , llistxattr - , flistxattr - - -- * Data Types - , XattrMode(RegularMode,CreateMode,ReplaceMode) - ) - where - -#include -#include - -import Data.Char -import Foreign.C -import Foreign.Ptr -import Foreign.Marshal.Alloc -import System.Posix.Types -import System.Posix.IO -import System.IO - -import qualified Data.ByteString as BS - -type Void = CChar - -data XattrMode = RegularMode | CreateMode | ReplaceMode - -instance Enum XattrMode where - fromEnum RegularMode = 0 - fromEnum CreateMode = #{const XATTR_CREATE} - fromEnum ReplaceMode = #{const XATTR_REPLACE} - toEnum 0 = RegularMode - toEnum #{const XATTR_CREATE} = CreateMode - toEnum #{const XATTR_REPLACE} = ReplaceMode - -allocBufSize :: Int -allocBufSize = 1024 - -allocCSize :: CSize -allocCSize = fromIntegral allocBufSize - -foreign import ccall unsafe "setxattr" c_setxattr :: CString -> CString -> Ptr Void -> CSize -> CInt -> IO CInt -foreign import ccall unsafe "lsetxattr" c_lsetxattr :: CString -> CString -> Ptr Void -> CSize -> CInt -> IO CInt -foreign import ccall unsafe "fsetxattr" c_fsetxattr :: CInt -> CString -> Ptr Void -> CSize -> CInt -> IO CInt - -foreign import ccall unsafe "getxattr" c_getxattr :: CString -> CString -> Ptr Void -> CSize -> IO CSize -foreign import ccall unsafe "lgetxattr" c_lgetxattr :: CString -> CString -> Ptr Void -> CSize -> IO CSize -foreign import ccall unsafe "fgetxattr" c_fgetxattr :: CInt -> CString -> Ptr Void -> CSize -> IO CSize - -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 - --- return a high level wrapper for a setxattr variant -mkSetxattr :: String -> a -> (a -> IO b) -> (b -> CString -> Ptr Void -> CSize -> CInt -> IO CInt) -> String -> BS.ByteString -> XattrMode -> IO () -mkSetxattr funcName x iox cFunc attrName attrData mode = do - x' <- iox x - cName <- newCString attrName - val <- BS.useAsCStringLen attrData $ \(binaryData, dataLen) -> - cFunc x' cName binaryData (fromIntegral dataLen) (fromIntegral $ fromEnum mode) - if val /= 0 - then throwErrno funcName - else return () - -handleToIOCInt :: Handle -> IO CInt -handleToIOCInt = fmap fromIntegral . handleToFd - --- |Set an attribute on a regular file, by path -setxattr :: String -> String -> BS.ByteString -> XattrMode -> IO () -setxattr path = mkSetxattr "setxattr" path newCString c_setxattr - --- |Like setxattr, but if the path is a symbolic link set the attribute on the link itself (not the file pointed to by the link) -lsetxattr :: String -> String -> BS.ByteString -> XattrMode -> IO () -lsetxattr path = mkSetxattr "lsetxattr" path newCString c_lsetxattr - --- |Like setxattr, but use the handle specified rather than a file path -fsetxattr :: Handle -> String -> BS.ByteString -> XattrMode -> IO () -fsetxattr handle = mkSetxattr "fsetxattr" handle handleToIOCInt c_fsetxattr - --- return a high level wrapper for a getxattr variant -mkGetxattr :: String -> a -> (a -> IO b) -> (b -> CString -> Ptr Void -> CSize -> IO CSize) -> String -> IO BS.ByteString -mkGetxattr funcName x iox cFunc attrName = do - x' <- iox x - cName <- newCString attrName - allocaBytes allocBufSize $ \mem -> do - buflen <- cFunc x' cName mem allocCSize - if buflen == -1 - then throwErrno funcName - else BS.packCStringLen (mem, fromIntegral buflen) - --- |Get an attribute on a regular file, by path -getxattr :: String -> String -> IO BS.ByteString -getxattr path = mkGetxattr "getxattr" path newCString c_getxattr - --- |Like getxattr, but if the path is a symbolic link get the attribute on the link itself (not the file pointed to by the link) -lgetxattr :: String -> String -> IO BS.ByteString -lgetxattr path = mkGetxattr "lgetxattr" path newCString c_lgetxattr - --- |Like getxattr, but use the handle specified rather than a file path -fgetxattr :: Handle -> String -> IO BS.ByteString -fgetxattr handle = mkGetxattr "fgetxattr" handle handleToIOCInt c_fgetxattr - --- split a string on NUL characters -splitNull :: String -> [String] -splitNull [] = [] -splitNull s = case suf of - "" -> [pre] - _ -> pre : (splitNull $ tail suf) - where (pre, suf) = break (\c -> ord c == 0) s - -mkListxattr :: String -> a -> (a -> IO b) -> (b -> CString -> CSize -> IO CSsize) -> IO [String] -mkListxattr funcName x iox cFunc = do - x' <- iox x - allocaBytes allocBufSize $ \mem -> do buflen <- cFunc x' mem allocCSize - if buflen == -1 - then throwErrno funcName - else do s <- peekCStringLen (mem, fromIntegral buflen) - return $ splitNull s - --- |Get a list of all of the attributes set on a path -listxattr :: String -> IO [String] -listxattr path = mkListxattr "listxattr" path newCString c_listxattr - --- |Like listxattr, but if the path is a symbolic link get the attributes on the link itsel (not the file pointed to by the link) -llistxattr :: String -> IO [String] -llistxattr path = mkListxattr "llistxattr" path newCString c_llistxattr - --- |Like listxattr, but use the handle specified rather than a file path -flistxattr :: Handle -> IO [String] -flistxattr handle = mkListxattr "flistxattr" handle handleToIOCInt c_flistxattr diff --git a/src/System/Xattr/Types.hsc b/src/System/Xattr/Types.hsc new file mode 100644 --- /dev/null +++ b/src/System/Xattr/Types.hsc @@ -0,0 +1,30 @@ +module System.Xattr.Types + ( + -- * Data Types + AttrName + , XattrMode(RegularMode,CreateMode,ReplaceMode) + ) + where + +#include +#include + +-- |Represents the mode for an update (i.e. set) operation +data XattrMode + = RegularMode -- ^ The attribute will be created if it does not yet exist, and replace the existing named attribute otherwise. + | CreateMode -- ^ Specifies a pure create, which fails if the named attribute exists already. + | ReplaceMode -- ^ Specifies a pure replace operation, which fails if the named attribute does not already exist. + deriving (Eq, Show) + +instance Enum XattrMode where + fromEnum RegularMode = 0 + fromEnum CreateMode = #{const XATTR_CREATE} + fromEnum ReplaceMode = #{const XATTR_REPLACE} + toEnum 0 = RegularMode + toEnum #{const XATTR_CREATE} = CreateMode + toEnum #{const XATTR_REPLACE} = ReplaceMode + +-- |The name of an attribute. Some filesystems support arbitrarily long names, +-- but for portability you're recommended to limit this to 255 bytes. +type AttrName = String + diff --git a/xattr.cabal b/xattr.cabal --- a/xattr.cabal +++ b/xattr.cabal @@ -1,7 +1,7 @@ Author: Evan Klitzke Maintainer: Evan Klitzke Name: xattr -Version: 0.5.1 +Version: 0.5.2 Cabal-Version: >= 1.2 License: BSD3 License-File: LICENSE @@ -17,13 +17,11 @@ Extra-Source-Files: README.md LICENSE - configure.guess - configure.sub configure.ac configure Library - Exposed-Modules: System.Xattr + Exposed-Modules: System.Xattr System.Xattr.Types Build-Depends: base, bytestring, unix Extensions: ForeignFunctionInterface, CPP Hs-Source-Dirs: src