From 25b0f118c79f8c1f1e78c5c35094aec3e9166376 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sat, 16 Sep 2023 16:19:23 +0800
Subject: [PATCH] Add statx
---
.github/workflows/ci.yml | 6 +-
System/Posix/Files.hsc | 83 ++++
System/Posix/Files/ByteString.hsc | 83 ++++
System/Posix/Files/Common.hsc | 660 ++++++++++++++++++++++++++++-
System/Posix/Files/PosixString.hsc | 86 +++-
changelog.md | 5 +
configure.ac | 5 +
include/HsUnix.h | 7 +
tests/FileExtendedStatus.hs | 166 ++++++++
tests/{Test.hs => Test.hsc} | 9 +
unix.cabal | 17 +-
11 files changed, 1112 insertions(+), 15 deletions(-)
create mode 100644 tests/FileExtendedStatus.hs
rename tests/{Test.hs => Test.hsc} (97%)
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 13b485d..400ba3e 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -16,13 +16,9 @@ jobs:
fail-fast: true
matrix:
os: [ubuntu-22.04, macOS-latest]
- ghc: ['9.6', '9.4', '9.2', '9.0', '8.10', '8.8', '8.6', '8.4', '8.2']
+ ghc: ['9.6', '9.4', '9.2', '9.0', '8.10', '8.8', '8.6']
steps:
- uses: actions/checkout@v3
- - name: Install prerequisites for GHC 8.2 on ubuntu-22.04
- if: runner.os == 'Linux' && matrix.ghc == '8.2'
- run: |
- sudo apt-get install libncurses5 libtinfo5
- name: Setup toolchain
run: |
which ghcup
diff --git a/System/Posix/Files.hsc b/System/Posix/Files.hsc
index 7587718..0810dc7 100644
--- a/System/Posix/Files.hsc
+++ b/System/Posix/Files.hsc
@@ -1,5 +1,6 @@
{-# LANGUAGE Safe #-}
{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE PatternSynonyms #-}
-----------------------------------------------------------------------------
-- |
@@ -62,6 +63,69 @@ module System.Posix.Files (
fileBlockSize,
fileBlocks,
+ -- * Extended file status
+ ExtendedFileStatus(..),
+ CAttributes(..),
+ -- ** Obtaining extended file status
+ getExtendedFileStatus,
+ -- ** Flags
+ StatxFlags(..),
+ defaultStatxFlags,
+ pattern EmptyPath,
+ pattern NoAutoMount,
+ pattern SymlinkNoFollow,
+ pattern SyncAsStat,
+ pattern ForceSync,
+ pattern DontSync,
+ -- ** Mask
+ StatxMask(..),
+ defaultStatxMask,
+ pattern StatxType,
+ pattern StatxMode,
+ pattern StatxNlink,
+ pattern StatxUid,
+ pattern StatxGid,
+ pattern StatxAtime,
+ pattern StatxMtime,
+ pattern StatxCtime,
+ pattern StatxIno,
+ pattern StatxSize,
+ pattern StatxBlocks,
+ pattern StatxBasicStats,
+ pattern StatxBtime,
+ pattern StatxMntId,
+ pattern StatxAll,
+ -- ** Querying extended file status
+ fileBlockSizeX,
+ linkCountX,
+ fileOwnerX,
+ fileGroupX,
+ fileModeX,
+ fileIDX,
+ fileSizeX,
+ fileBlocksX,
+ accessTimeHiResX,
+ creationTimeHiResX,
+ statusChangeTimeHiResX,
+ modificationTimeHiResX,
+ deviceIDX,
+ specialDeviceIDX,
+ mountIDX,
+ fileCompressedX,
+ fileImmutableX,
+ fileAppendX,
+ fileNoDumpX,
+ fileEncryptedX,
+ fileVerityX,
+ fileDaxX,
+ isBlockDeviceX,
+ isCharacterDeviceX,
+ isNamedPipeX,
+ isRegularFileX,
+ isDirectoryX,
+ isSymbolicLinkX,
+ isSocketX,
+
-- * Creation
createNamedPipe,
createDevice,
@@ -189,6 +253,25 @@ getFileStatus path = do
throwErrnoPathIfMinus1Retry_ "getFileStatus" path (c_stat s p)
return (FileStatus fp)
+-- | Gets extended file status information.
+--
+-- The target file to open is identified in one of the following ways:
+--
+-- - If @pathname@ begins with a slash, then it is an absolute pathname that identifies the target file. In this case, @dirfd@ is ignored
+-- - If @pathname@ is a string that begins with a character other than a slash and @dirfd@ is a file descriptor that refers to a
+-- directory, then pathname is a relative pathname that is interpreted relative to the directory referred to by dirfd.
+-- (See @openat(2)@ for an explanation of why this is useful.)
+-- - If @pathname@ is an empty string and the 'EmptyPath' flag is specified in flags (see below), then the target file is
+-- the one referred to by the file descriptor @dirfd@.
+--
+-- Note: calls @statx@.
+getExtendedFileStatus :: Maybe Fd -- ^ Optional directory file descriptor (@dirfd@)
+ -> FilePath -- ^ @pathname@ to open
+ -> StatxFlags -- ^ flags
+ -> StatxMask -- ^ mask
+ -> IO ExtendedFileStatus
+getExtendedFileStatus mfd path flags masks = withFilePath path $ \s -> getExtendedFileStatus_ mfd s flags masks
+
-- | Acts as 'getFileStatus' except when the 'FilePath' refers to a symbolic
-- link. In that case the @FileStatus@ information of the symbolic link itself
-- is returned instead of that of the file it points to.
diff --git a/System/Posix/Files/ByteString.hsc b/System/Posix/Files/ByteString.hsc
index 1c7b5a0..25327cc 100644
--- a/System/Posix/Files/ByteString.hsc
+++ b/System/Posix/Files/ByteString.hsc
@@ -1,5 +1,6 @@
{-# LANGUAGE Safe #-}
{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE PatternSynonyms #-}
-----------------------------------------------------------------------------
-- |
@@ -62,6 +63,69 @@ module System.Posix.Files.ByteString (
fileBlockSize,
fileBlocks,
+ -- * Extended file status
+ ExtendedFileStatus(..),
+ CAttributes(..),
+ -- ** Obtaining extended file status
+ getExtendedFileStatus,
+ -- ** Flags
+ StatxFlags(..),
+ defaultStatxFlags,
+ pattern EmptyPath,
+ pattern NoAutoMount,
+ pattern SymlinkNoFollow,
+ pattern SyncAsStat,
+ pattern ForceSync,
+ pattern DontSync,
+ -- ** Mask
+ StatxMask(..),
+ defaultStatxMask,
+ pattern StatxType,
+ pattern StatxMode,
+ pattern StatxNlink,
+ pattern StatxUid,
+ pattern StatxGid,
+ pattern StatxAtime,
+ pattern StatxMtime,
+ pattern StatxCtime,
+ pattern StatxIno,
+ pattern StatxSize,
+ pattern StatxBlocks,
+ pattern StatxBasicStats,
+ pattern StatxBtime,
+ pattern StatxMntId,
+ pattern StatxAll,
+ -- ** Querying extended file status
+ fileBlockSizeX,
+ linkCountX,
+ fileOwnerX,
+ fileGroupX,
+ fileModeX,
+ fileIDX,
+ fileSizeX,
+ fileBlocksX,
+ accessTimeHiResX,
+ creationTimeHiResX,
+ statusChangeTimeHiResX,
+ modificationTimeHiResX,
+ deviceIDX,
+ specialDeviceIDX,
+ mountIDX,
+ fileCompressedX,
+ fileImmutableX,
+ fileAppendX,
+ fileNoDumpX,
+ fileEncryptedX,
+ fileVerityX,
+ fileDaxX,
+ isBlockDeviceX,
+ isCharacterDeviceX,
+ isNamedPipeX,
+ isRegularFileX,
+ isDirectoryX,
+ isSymbolicLinkX,
+ isSocketX,
+
-- * Creation
createNamedPipe,
createDevice,
@@ -184,6 +248,25 @@ getFileStatus path = do
throwErrnoPathIfMinus1Retry_ "getFileStatus" path (c_stat s p)
return (FileStatus fp)
+-- | Gets extended file status information.
+--
+-- The target file to open is identified in one of the following ways:
+--
+-- - If @pathname@ begins with a slash, then it is an absolute pathname that identifies the target file. In this case, @dirfd@ is ignored
+-- - If @pathname@ is a string that begins with a character other than a slash and @dirfd@ is a file descriptor that refers to a
+-- directory, then pathname is a relative pathname that is interpreted relative to the directory referred to by dirfd.
+-- (See @openat(2)@ for an explanation of why this is useful.)
+-- - If @pathname@ is an empty string and the 'EmptyPath' flag is specified in flags (see below), then the target file is
+-- the one referred to by the file descriptor @dirfd@.
+--
+-- Note: calls @statx@.
+getExtendedFileStatus :: Maybe Fd -- ^ Optional directory file descriptor (@dirfd@)
+ -> RawFilePath -- ^ @pathname@ to open
+ -> StatxFlags -- ^ flags
+ -> StatxMask -- ^ mask
+ -> IO ExtendedFileStatus
+getExtendedFileStatus mfd path flags masks = withFilePath path $ \s -> getExtendedFileStatus_ mfd s flags masks
+
-- | Acts as 'getFileStatus' except when the 'RawFilePath' refers to a symbolic
-- link. In that case the @FileStatus@ information of the symbolic link itself
-- is returned instead of that of the file it points to.
diff --git a/System/Posix/Files/Common.hsc b/System/Posix/Files/Common.hsc
index b03859a..30ac2b2 100644
--- a/System/Posix/Files/Common.hsc
+++ b/System/Posix/Files/Common.hsc
@@ -1,5 +1,9 @@
{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NumDecimals #-}
-----------------------------------------------------------------------------
-- |
@@ -60,6 +64,65 @@ module System.Posix.Files.Common (
fileBlockSize,
fileBlocks,
+ -- * Extended file status
+ StatxFlags(..),
+ pattern EmptyPath,
+ pattern NoAutoMount,
+ pattern SymlinkNoFollow,
+ pattern SyncAsStat,
+ pattern ForceSync,
+ pattern DontSync,
+ defaultStatxFlags,
+ StatxMask(..),
+ pattern StatxType,
+ pattern StatxMode,
+ pattern StatxNlink,
+ pattern StatxUid,
+ pattern StatxGid,
+ pattern StatxAtime,
+ pattern StatxMtime,
+ pattern StatxCtime,
+ pattern StatxBtime,
+ pattern StatxIno,
+ pattern StatxSize,
+ pattern StatxBlocks,
+ pattern StatxMntId,
+ pattern StatxBasicStats,
+ pattern StatxAll,
+ defaultStatxMask,
+ ExtendedFileStatus(..),
+ CAttributes(..),
+ getExtendedFileStatus_,
+ fileBlockSizeX,
+ linkCountX,
+ fileOwnerX,
+ fileGroupX,
+ fileModeX,
+ fileIDX,
+ fileSizeX,
+ fileBlocksX,
+ accessTimeHiResX,
+ creationTimeHiResX,
+ statusChangeTimeHiResX,
+ modificationTimeHiResX,
+ deviceIDX,
+ specialDeviceIDX,
+ mountIDX,
+ fileCompressedX,
+ fileImmutableX,
+ fileAppendX,
+ fileNoDumpX,
+ fileEncryptedX,
+ fileVerityX,
+ fileDaxX,
+ isBlockDeviceX,
+ isCharacterDeviceX,
+ isNamedPipeX,
+ isRegularFileX,
+ isDirectoryX,
+ isSymbolicLinkX,
+ isSocketX,
+
-- * Setting file sizes
setFdSize,
@@ -93,6 +156,11 @@ import System.IO.Unsafe
import Data.Bits
import Data.Int
import Data.Ratio
+import Data.Word
+#ifdef HAVE_STATX
+import Data.Time.Clock (secondsToNominalDiffTime)
+import Data.Fixed (Fixed(..))
+#endif
import Data.Time.Clock.POSIX (POSIXTime)
import System.Posix.Internals
import Foreign.C
@@ -103,7 +171,7 @@ import Foreign.Marshal (withArray)
import Foreign.Ptr
import Foreign.Storable
-#if !defined(HAVE_FCHMOD) || !defined(HAVE_CHOWN)
+#if !defined(HAVE_FCHMOD) || !defined(HAVE_CHOWN) || !defined(HAVE_STATX)
import System.IO.Error ( ioeSetLocation )
import GHC.IO.Exception ( unsupportedOperation )
#endif
@@ -688,3 +756,593 @@ getFdPathVar (Fd fd) v =
foreign import ccall unsafe "fpathconf"
c_fpathconf :: CInt -> CInt -> IO CLong
+
+
+-- -----------------------------------------------------------------------------
+-- statx
+--
+
+newtype {-# CTYPE "__u64" #-} CAttributes = CAttributes Word64
+ deriving (Read, Show, Eq, Ord, Storable, Num, Bits)
+
+-- | Statx flags.
+--
+-- See the pattern synonyms for possible flags. These are combined via `(<>)`.
+-- Flags can be tested via `(.&.)`.
+--
+-- The following flags influence pathname-based lookup:
+--
+-- - 'EmptyPath'
+-- - 'NoAutoMount'
+-- - 'SymlinkNoFollow'
+--
+-- The following flags can be used to control what sort of synchronization the kernel will do when querying a file on a remote filesystem:
+--
+-- - 'SyncAsStat'
+-- - 'ForceSync'
+-- - 'DontSync'
+newtype StatxFlags = StatxFlags CInt deriving (Read, Show, Eq, Ord, Integral, Num, Enum, Bits, Real)
+
+-- | ORs the flags.
+instance Semigroup StatxFlags where
+ a <> b = a .|. b
+
+instance Monoid StatxFlags where
+ mappend = (<>)
+ mempty = 0
+
+-- | If pathname to 'getExtendedFileStatus' is an empty string, operate on the file referred to by
+-- the 'Maybe Fd' argument.
+--
+-- In this case, it can refer to any type of file, not just a directory.
+pattern EmptyPath :: StatxFlags
+#ifdef AT_EMPTY_PATH
+pattern EmptyPath = StatxFlags (#const AT_EMPTY_PATH)
+#else
+pattern EmptyPath = StatxFlags 0
+#endif
+
+-- | Don't automount the terminal ("basename") component of pathname if it is a directory that is an automount point.
+-- This allows the caller to gather attributes of an automount point (rather than the location it would mount).
+-- This flag can be used in tools that scan directories to prevent mass-automounting of a directory of automount points.
+-- This flag has no effect if the mount point has already been mounted over.
+pattern NoAutoMount :: StatxFlags
+#ifdef AT_NO_AUTOMOUNT
+pattern NoAutoMount = StatxFlags (#const AT_NO_AUTOMOUNT)
+#else
+pattern NoAutoMount = StatxFlags 0
+#endif
+
+-- | If pathname is a symbolic link, do not dereference it: instead return information about the link itself, like @lstat(2)@.
+pattern SymlinkNoFollow :: StatxFlags
+#ifdef AT_SYMLINK_NOFOLLOW
+pattern SymlinkNoFollow = StatxFlags (#const AT_SYMLINK_NOFOLLOW)
+#else
+pattern SymlinkNoFollow = StatxFlags 0
+#endif
+
+-- | Do whatever @stat(2)@ does. This is the default and is very much filesystem-specific.
+pattern SyncAsStat :: StatxFlags
+#ifdef AT_STATX_SYNC_AS_STAT
+pattern SyncAsStat = StatxFlags (#const AT_STATX_SYNC_AS_STAT)
+#else
+pattern SyncAsStat = StatxFlags 0
+#endif
+
+-- | Force the attributes to be synchronized with the server.
+-- This may require that a network filesystem perform a data writeback to get the timestamps correct.
+pattern ForceSync :: StatxFlags
+#ifdef AT_STATX_FORCE_SYNC
+pattern ForceSync = StatxFlags (#const AT_STATX_FORCE_SYNC)
+#else
+pattern ForceSync = StatxFlags 0
+#endif
+
+-- | Don't synchronize anything, but rather just take whatever the system has cached if possible.
+-- This may mean that the information returned is approximate, but, on a network filesystem,
+-- it may not involve a round trip to the server - even if no lease is held.
+pattern DontSync :: StatxFlags
+#ifdef AT_STATX_DONT_SYNC
+pattern DontSync = StatxFlags (#const AT_STATX_DONT_SYNC)
+#else
+pattern DontSync = StatxFlags 0
+#endif
+
+defaultStatxFlags :: StatxFlags
+defaultStatxFlags = mempty
+
+-- | Mask argument to 'statx'. It's used to tell the kernel which fields the caller is interested in.
+--
+-- See the pattern synonyms for possible masks. These are combined via @(<>)@.
+-- Masks can be tested via `(.&.)`.
+newtype StatxMask = StatxMask CInt deriving (Read, Show, Eq, Ord, Integral, Num, Enum, Bits, Real)
+
+-- | ORs the masks.
+instance Semigroup StatxMask where
+ a <> b = a .|. b
+
+instance Monoid StatxMask where
+ mappend = (<>)
+ mempty = 0
+
+-- | Want @stx_mode & S_IFMT@.
+pattern StatxType :: StatxMask
+#ifdef STATX_TYPE
+pattern StatxType = StatxMask (#const STATX_TYPE)
+#else
+pattern StatxType = StatxMask 0
+#endif
+
+-- | Want @stx_mode & ~S_IFMT@.
+pattern StatxMode :: StatxMask
+#ifdef STATX_MODE
+pattern StatxMode = StatxMask (#const STATX_MODE)
+#else
+pattern StatxMode = StatxMask 0
+#endif
+
+-- | Want @stx_nlink@.
+pattern StatxNlink :: StatxMask
+#ifdef STATX_NLINK
+pattern StatxNlink = StatxMask (#const STATX_NLINK)
+#else
+pattern StatxNlink = StatxMask 0
+#endif
+
+-- | Want @stx_uid@.
+pattern StatxUid :: StatxMask
+#ifdef STATX_UID
+pattern StatxUid = StatxMask (#const STATX_UID)
+#else
+pattern StatxUid = StatxMask 0
+#endif
+
+-- | Want @stx_gid@.
+pattern StatxGid :: StatxMask
+#ifdef STATX_GID
+pattern StatxGid = StatxMask (#const STATX_GID)
+#else
+pattern StatxGid = StatxMask 0
+#endif
+
+-- | Want @stx_atime@.
+pattern StatxAtime :: StatxMask
+#ifdef STATX_ATIME
+pattern StatxAtime = StatxMask (#const STATX_ATIME)
+#else
+pattern StatxAtime = StatxMask 0
+#endif
+
+-- | Want @stx_mtime@.
+pattern StatxMtime :: StatxMask
+#ifdef STATX_MTIME
+pattern StatxMtime = StatxMask (#const STATX_MTIME)
+#else
+pattern StatxMtime = StatxMask 0
+#endif
+
+-- | Want @stx_ctime@.
+pattern StatxCtime :: StatxMask
+#ifdef STATX_CTIME
+pattern StatxCtime = StatxMask (#const STATX_CTIME)
+#else
+pattern StatxCtime = StatxMask 0
+#endif
+
+-- | Want @stx_btime@.
+pattern StatxBtime :: StatxMask
+#ifdef STATX_BTIME
+pattern StatxBtime = StatxMask (#const STATX_BTIME)
+#else
+pattern StatxBtime = StatxMask 0
+#endif
+
+-- | Want @stx_mnt_id@.
+pattern StatxMntId :: StatxMask
+#ifdef STATX_MNT_ID
+pattern StatxMntId = StatxMask (#const STATX_MNT_ID)
+#else
+pattern StatxMntId = StatxMask 0
+#endif
+
+-- | Want @stx_ino@.
+pattern StatxIno :: StatxMask
+#ifdef STATX_INO
+pattern StatxIno = StatxMask (#const STATX_INO)
+#else
+pattern StatxIno = StatxMask 0
+#endif
+
+-- | Want @stx_size@.
+pattern StatxSize :: StatxMask
+#ifdef STATX_SIZE
+pattern StatxSize = StatxMask (#const STATX_SIZE)
+#else
+pattern StatxSize = StatxMask 0
+#endif
+
+-- | Want @stx_blocks@.
+pattern StatxBlocks :: StatxMask
+#ifdef STATX_BLOCKS
+pattern StatxBlocks = StatxMask (#const STATX_BLOCKS)
+#else
+pattern StatxBlocks = StatxMask 0
+#endif
+
+-- | Want all of the above.
+pattern StatxBasicStats :: StatxMask
+#ifdef STATX_BASIC_STATS
+pattern StatxBasicStats = StatxMask (#const STATX_BASIC_STATS)
+#else
+pattern StatxBasicStats = StatxMask 0
+#endif
+
+-- | Want all currently available fields.
+pattern StatxAll :: StatxMask
+#ifdef STATX_ALL
+pattern StatxAll = StatxMask (#const STATX_ALL)
+#else
+pattern StatxAll = StatxMask 0
+#endif
+
+
+defaultStatxMask :: StatxMask
+defaultStatxMask = mempty
+
+newtype ExtendedFileStatus = ExtendedFileStatus (ForeignPtr CStatx) -- ^ The constructor is considered internal and may change.
+
+-- | The "preferred" block size for efficient filesystem I/O.
+-- (Writing to a file in smaller chunks may cause an inefficient read-modâ€ify-rewrite.)
+fileBlockSizeX :: ExtendedFileStatus -> CBlkSize
+#if HAVE_STATX
+-- | Further status information about the file.
+fileAttributesX :: ExtendedFileStatus -> CAttributes
+#endif
+-- | The number of hard links on a file.
+linkCountX :: ExtendedFileStatus -> CNlink
+-- | Te user ID of the owner of the file.
+fileOwnerX :: ExtendedFileStatus -> UserID
+-- | The ID of the group owner of the file.
+fileGroupX :: ExtendedFileStatus -> GroupID
+-- | The file type and mode. See @inode(7)@ for details.
+fileModeX :: ExtendedFileStatus -> FileMode
+-- | The inode number of the file.
+fileIDX :: ExtendedFileStatus -> FileID
+-- | The size of the file (if it is a regular file or a symbolic link) in bytes.
+-- The size of a symbolic link is the length of the pathname it contains,
+-- without a terminating null byte.
+fileSizeX :: ExtendedFileStatus -> Word64
+-- | The number of blocks allocated to the file on the medium, in 512-byte units.
+-- (This may be smaller than stx_size/512 when the file has holes.)
+fileBlocksX :: ExtendedFileStatus -> Word64
+#if HAVE_STATX
+-- | A mask indicating which bits in 'fileAttributesX' are supported by the VFS and the filesystem.
+fileAttributesMaskX :: ExtendedFileStatus -> CAttributes
+#endif
+-- | The file's last access timestamp.
+accessTimeHiResX :: ExtendedFileStatus -> POSIXTime
+-- | The file's creation timestamp.
+creationTimeHiResX :: ExtendedFileStatus -> POSIXTime
+-- | The file's last status change timestamp.
+statusChangeTimeHiResX :: ExtendedFileStatus -> POSIXTime
+-- | The file's last modification timestamp.
+modificationTimeHiResX :: ExtendedFileStatus -> POSIXTime
+-- | ID of the device on which this file resides.
+deviceIDX :: ExtendedFileStatus -> DeviceID
+-- | Describes the device that this file represents.
+specialDeviceIDX :: ExtendedFileStatus -> DeviceID
+-- | The mount ID of the mount containing the file. This is the same number
+-- reported by name_to_handle_at(2) and corresponds to the number in the
+-- first field in one of the records in /proc/self/mountinfo.
+mountIDX :: ExtendedFileStatus -> Word64
+-- | The file is compressed by the filesystem and may take extra resources to access.
+-- This is an extended attribute.
+fileCompressedX :: ExtendedFileStatus -> Bool
+-- | The file cannot be modified: it cannot be deleted or renamed, no hard links can
+-- be created to this file and no data can be written to it. See @chattr(1)@.
+-- This is an extended attribute.
+fileImmutableX :: ExtendedFileStatus -> Bool
+-- | The file can only be opened in append mode for writing. Random access writing is not permitted. See @chattr(1)@.
+-- This is an extended attribute.
+fileAppendX :: ExtendedFileStatus -> Bool
+-- | File is not a candidate for backup when a backup program such as @dump(8)@ is run. See @chattr(1)@.
+-- This is an extended attribute.
+fileNoDumpX :: ExtendedFileStatus -> Bool
+-- | A key is required for the file to be encrypted by the filesystem.
+-- This is an extended attribute.
+fileEncryptedX :: ExtendedFileStatus -> Bool
+-- | The file has fs-verity enabled. It cannot be written to, and all reads from it
+-- will be verified against a cryptographic hash that covers the entire file (e.g., via a Merkle tree).
+-- This is an extended attribute.
+-- Since Linux 5.5.
+fileVerityX :: ExtendedFileStatus -> Bool
+-- | The file is in the DAX (cpu direct access) state.
+-- This is an extended attribute.
+-- Since Linux 5.8.
+fileDaxX :: ExtendedFileStatus -> Bool
+
+-- | Checks if this file is a block device.
+isBlockDeviceX :: ExtendedFileStatus -> Bool
+-- | Checks if this file is a character device.
+isCharacterDeviceX :: ExtendedFileStatus -> Bool
+-- | Checks if this file is a named pipe device.
+isNamedPipeX :: ExtendedFileStatus -> Bool
+-- | Checks if this file is a regular file device.
+isRegularFileX :: ExtendedFileStatus -> Bool
+-- | Checks if this file is a directory device.
+isDirectoryX :: ExtendedFileStatus -> Bool
+-- | Checks if this file is a symbolic link device.
+isSymbolicLinkX :: ExtendedFileStatus -> Bool
+-- | Checks if this file is a socket device.
+isSocketX :: ExtendedFileStatus -> Bool
+
+isBlockDeviceX statx =
+ (fileModeX statx `intersectFileModes` fileTypeModes) == blockSpecialMode
+isCharacterDeviceX statx =
+ (fileModeX statx `intersectFileModes` fileTypeModes) == characterSpecialMode
+isNamedPipeX statx =
+ (fileModeX statx `intersectFileModes` fileTypeModes) == namedPipeMode
+isRegularFileX statx =
+ (fileModeX statx `intersectFileModes` fileTypeModes) == regularFileMode
+isDirectoryX statx =
+ (fileModeX statx `intersectFileModes` fileTypeModes) == directoryMode
+isSymbolicLinkX statx =
+ (fileModeX statx `intersectFileModes` fileTypeModes) == symbolicLinkMode
+isSocketX statx =
+ (fileModeX statx `intersectFileModes` fileTypeModes) == socketMode
+
+#if HAVE_STATX
+testFlag :: ExtendedFileStatus -> CAttributes -> Bool
+testFlag ex flag =
+ let attributes = fileAttributesX ex
+ attributes_mask = fileAttributesMaskX ex
+ in (attributes .&. attributes_mask .&. flag) /= 0
+
+#ifdef STATX_ATTR_COMPRESSED
+fileCompressedX ex = testFlag ex (#const STATX_ATTR_COMPRESSED)
+#else
+{-# WARNING fileCompressedX "fileCompressedX: not available on this platform, will default to 'False' (CPP guard: @#if STATX_ATTR_COMPRESSED@)" #-}
+fileCompressedX _ = False
+#endif
+#ifdef STATX_ATTR_IMMUTABLE
+fileImmutableX ex = testFlag ex (#const STATX_ATTR_IMMUTABLE)
+#else
+{-# WARNING fileImmutableX "fileImmutableX: not available on this platform, will default to 'False' (CPP guard: @#if STATX_ATTR_IMMUTABLE@)" #-}
+fileImmutableX _ = False
+#endif
+#ifdef STATX_ATTR_APPEND
+fileAppendX ex = testFlag ex (#const STATX_ATTR_APPEND)
+#else
+{-# WARNING fileAppendX "fileAppendX: not available on this platform, will default to 'False' (CPP guard: @#if STATX_ATTR_APPEND@)" #-}
+fileAppendX _ = False
+#endif
+#ifdef STATX_ATTR_NODUMP
+fileNoDumpX ex = testFlag ex (#const STATX_ATTR_NODUMP)
+#else
+{-# WARNING fileNoDumpX "fileNoDumpX: not available on this platform, will default to 'False' (CPP guard: @#if STATX_ATTR_NODUMP@)" #-}
+fileNoDumpX _ = False
+#endif
+#ifdef STATX_ATTR_ENCRYPTED
+fileEncryptedX ex = testFlag ex (#const STATX_ATTR_ENCRYPTED)
+#else
+{-# WARNING fileEncryptedX "fileEncryptedX: not available on this platform, will default to 'False' (CPP guard: @#if STATX_ATTR_ENCRYPTED@)" #-}
+fileEncryptedX _ = False
+#endif
+#ifdef STATX_ATTR_VERITY
+fileVerityX ex = testFlag ex (#const STATX_ATTR_VERITY)
+#else
+{-# WARNING fileVerityX "fileVerityX: not available on this platform, will default to 'False' (CPP guard: @#if STATX_ATTR_VERITY@)" #-}
+fileVerityX _ = False
+#endif
+#ifdef STATX_ATTR_DAX
+fileDaxX ex = testFlag ex (#const STATX_ATTR_DAX)
+#else
+{-# WARNING fileDaxX "fileDaxX: not available on this platform, will default to 'False' (CPP guard: @#if STATX_ATTR_DAX@)" #-}
+fileDaxX _ = False
+#endif
+
+#ifdef HAVE_SYS_SYSMACROS_H
+deviceIDX (ExtendedFileStatus statx) = unsafePerformIO $ do
+ major <- withForeignPtr statx $ (#peek struct statx, stx_dev_major) :: IO CUInt
+ minor <- withForeignPtr statx $ (#peek struct statx, stx_dev_minor) :: IO CUInt
+ c_makedev major minor
+#else
+{-# WARNING deviceIDX "deviceIDX: not available on this platform, will throw error (CPP guard: @#if HAVE_SYS_SYSMACROS_H@)" #-}
+deviceIDX _ = error "deviceIDX not available on this platform"
+#endif
+#ifdef HAVE_SYS_SYSMACROS_H
+specialDeviceIDX (ExtendedFileStatus statx) = unsafePerformIO $ do
+ major <- withForeignPtr statx $ (#peek struct statx, stx_rdev_major) :: IO CUInt
+ minor <- withForeignPtr statx $ (#peek struct statx, stx_rdev_minor) :: IO CUInt
+ c_makedev major minor
+#else
+{-# WARNING specialDeviceIDX "specialDeviceIDX: not available on this platform, will throw error (CPP guard: @#if HAVE_SYS_SYSMACROS_H@)" #-}
+specialDeviceIDX _ = error "specialDeviceIDX not available on this platform"
+#endif
+#ifdef STATX_MNT_ID
+mountIDX (ExtendedFileStatus statx) =
+ unsafePerformIO $ withForeignPtr statx $ (#peek struct statx, stx_mnt_id)
+#else
+{-# WARNING mountIDX "mountIDX: not available on this platform, will throw error (CPP guard: @#if STATX_MNT_ID@)" #-}
+mountIDX _ = error "mountIDX not available on this platform"
+#endif
+fileBlockSizeX (ExtendedFileStatus statx) = unsafePerformIO $ do
+ r <- withForeignPtr statx $ (#peek struct statx, stx_blksize) :: IO Word32
+ return $ CBlkSize (fromIntegral r)
+fileAttributesX (ExtendedFileStatus statx) =
+ unsafePerformIO $ withForeignPtr statx $ (#peek struct statx, stx_attributes)
+#ifdef STATX_NLINK
+linkCountX (ExtendedFileStatus statx) = unsafePerformIO $ do
+ links <- withForeignPtr statx $ (#peek struct statx, stx_nlink) :: IO Word32
+ return $ CNlink (fromIntegral links)
+#else
+{-# WARNING linkCountX "linkCountX: not available on this platform, will throw error (CPP guard: @#if STATX_NLINK@)" #-}
+linkCountX _ = error "linkCountX not available on this platform"
+#endif
+#ifdef STATX_UID
+fileOwnerX (ExtendedFileStatus statx) =
+ unsafePerformIO $ withForeignPtr statx $ (#peek struct statx, stx_uid)
+#else
+{-# WARNING fileOwnerX "fileOwnerX: not available on this platform, will throw error (CPP guard: @#if STATX_UID@)" #-}
+fileOwnerX _ = error "fileOwnerX not available on this platform"
+#endif
+#ifdef STATX_GID
+fileGroupX (ExtendedFileStatus statx) =
+ unsafePerformIO $ withForeignPtr statx $ (#peek struct statx, stx_gid)
+#else
+{-# WARNING fileGroupX "fileGroupX: not available on this platform, will throw error (CPP guard: @#if STATX_GID@)" #-}
+fileGroupX _ = error "fileGroupX not available on this platform"
+#endif
+#ifdef STATX_MODE
+fileModeX (ExtendedFileStatus statx) = unsafePerformIO $ do
+ r <- withForeignPtr statx $ (#peek struct statx, stx_mode) :: IO Word16
+ return $ CMode $ fromIntegral r
+#else
+{-# WARNING fileModeX "fileModeX: not available on this platform, will throw error (CPP guard: @#if STATX_MODE@)" #-}
+fileModeX _ = error "fileModeX not available on this platform"
+#endif
+#ifdef STATX_INO
+fileIDX (ExtendedFileStatus statx) =
+ unsafePerformIO $ withForeignPtr statx $ (#peek struct statx, stx_ino)
+#else
+{-# WARNING fileIDX "fileIDX: not available on this platform, will throw error (CPP guard: @#if STATX_INO@)" #-}
+fileIDX _ = error "fileIDX not available on this platform"
+#endif
+#ifdef STATX_SIZE
+fileSizeX (ExtendedFileStatus statx) =
+ unsafePerformIO $ withForeignPtr statx $ (#peek struct statx, stx_size) :: Word64
+#else
+{-# WARNING fileSizeX "fileSizeX: not available on this platform, will throw error (CPP guard: @#if STATX_SIZE@)" #-}
+fileSizeX _ = error "fileSizeX not available on this platform"
+#endif
+#ifdef STATX_BLOCKS
+fileBlocksX (ExtendedFileStatus statx) =
+ unsafePerformIO $ withForeignPtr statx $ (#peek struct statx, stx_blocks) :: Word64
+#else
+{-# WARNING fileBlocksX "fileBlocksX: not available on this platform, will throw error (CPP guard: @#if STATX_BLOCKS@)" #-}
+fileBlocksX _ = error "fileBlocksX not available on this platform"
+#endif
+fileAttributesMaskX (ExtendedFileStatus statx) =
+ unsafePerformIO $ withForeignPtr statx $ (#peek struct statx, stx_attributes_mask)
+#ifdef STATX_ATIME
+accessTimeHiResX (ExtendedFileStatus statx) =
+ unsafePerformIO $ withForeignPtr statx $ \statx_ptr -> do
+ sec <- (#peek struct statx, stx_atime.tv_sec) statx_ptr :: IO EpochTime
+ nsec <- (#peek struct statx, stx_atime.tv_nsec) statx_ptr :: IO (#type int)
+ return $ timeHiResToNominalDiffTime sec nsec
+#else
+{-# WARNING accessTimeHiResX "accessTimeHiResX: not available on this platform, will throw error (CPP guard: @#if STATX_ATIME@)" #-}
+accessTimeHiResX _ = error "accessTimeHiResX not available on this platform"
+#endif
+#ifdef STATX_BTIME
+creationTimeHiResX (ExtendedFileStatus statx) =
+ unsafePerformIO $ withForeignPtr statx $ \statx_ptr -> do
+ sec <- (#peek struct statx, stx_btime.tv_sec) statx_ptr :: IO EpochTime
+ nsec <- (#peek struct statx, stx_btime.tv_nsec) statx_ptr :: IO (#type int)
+ return $ timeHiResToNominalDiffTime sec nsec
+#else
+{-# WARNING creationTimeHiResX "creationTimeHiResX: not available on this platform, will throw error (CPP guard: @#if STATX_BTIME@)" #-}
+creationTimeHiResX _ = error "creationTimeHiResX not available on this platform"
+#endif
+#ifdef STATX_CTIME
+statusChangeTimeHiResX (ExtendedFileStatus statx) =
+ unsafePerformIO $ withForeignPtr statx $ \statx_ptr -> do
+ sec <- (#peek struct statx, stx_ctime.tv_sec) statx_ptr :: IO EpochTime
+ nsec <- (#peek struct statx, stx_ctime.tv_nsec) statx_ptr :: IO (#type int)
+ return $ timeHiResToNominalDiffTime sec nsec
+#else
+{-# WARNING statusChangeTimeHiResX "statusChangeTimeHiResX: not available on this platform, will throw error (CPP guard: @#if STATX_CTIME@)" #-}
+statusChangeTimeHiResX _ = error "statusChangeTimeHiResX not available on this platform"
+#endif
+#ifdef STATX_MTIME
+modificationTimeHiResX (ExtendedFileStatus statx) =
+ unsafePerformIO $ withForeignPtr statx $ \statx_ptr -> do
+ sec <- (#peek struct statx, stx_mtime.tv_sec) statx_ptr :: IO EpochTime
+ nsec <- (#peek struct statx, stx_mtime.tv_nsec) statx_ptr :: IO (#type int)
+ return $ timeHiResToNominalDiffTime sec nsec
+#else
+{-# WARNING modificationTimeHiResX "modificationTimeHiResX: not available on this platform, will throw error (CPP guard: @#if STATX_MTIME@)" #-}
+modificationTimeHiResX _ = error "modificationTimeHiResX not available on this platform"
+#endif
+
+timeHiResToNominalDiffTime :: EpochTime -> Int32 -> POSIXTime
+timeHiResToNominalDiffTime (CTime sec) nsec = secondsToNominalDiffTime $ MkFixed $ toInteger sec * 1e12 + toInteger nsec * 1e3
+
+#else
+{-# WARNING linkCountX "linkCountX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+linkCountX _ = error "linkCountX not available on this platform"
+{-# WARNING fileBlockSizeX "fileBlockSizeX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+fileBlockSizeX _ = error "fileBlockSizeX not available on this platform"
+{-# WARNING deviceIDX "deviceIDX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+deviceIDX _ = error "deviceIDX not available on this platform"
+{-# WARNING specialDeviceIDX "specialDeviceIDX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+specialDeviceIDX _ = error "specialDeviceIDX not available on this platform"
+{-# WARNING mountIDX "mountIDX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+mountIDX _ = error "mountIDX not available on this platform"
+{-# WARNING fileOwnerX "fileOwnerX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+fileOwnerX _ = error "fileOwnerX not available on this platform"
+{-# WARNING fileGroupX "fileGroupX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+fileGroupX _ = error "fileGroupX not available on this platform"
+{-# WARNING fileModeX "fileModeX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+fileModeX _ = error "fileModeX not available on this platform"
+{-# WARNING fileIDX "fileIDX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+fileIDX _ = error "fileIDX not available on this platform"
+{-# WARNING fileSizeX "fileSizeX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+fileSizeX _ = error "fileSizeX not available on this platform"
+{-# WARNING fileBlocksX "fileBlocksX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+fileBlocksX _ = error "fileBlocksX not available on this platform"
+{-# WARNING accessTimeHiResX "accessTimeHiResX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+accessTimeHiResX _ = error "accessTimeHiResX not available on this platform"
+{-# WARNING creationTimeHiResX "creationTimeHiResX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+creationTimeHiResX _ = error "creationTimeHiResX not available on this platform"
+{-# WARNING statusChangeTimeHiResX "statusChangeTimeHiResX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+statusChangeTimeHiResX _ = error "statusChangeTimeHiResX not available on this platform"
+{-# WARNING modificationTimeHiResX "modificationTimeHiResX: not available on this platform, will throw error (CPP guard: @#if HAVE_STATX@)" #-}
+modificationTimeHiResX _ = error "modificationTimeHiResX not available on this platform"
+{-# WARNING fileCompressedX "fileCompressedX: not available on this platform, will default to 'False' (CPP guard: @#if HAVE_STATX@)" #-}
+fileCompressedX _ = False
+{-# WARNING fileImmutableX "fileImmutableX: not available on this platform, will default to 'False' (CPP guard: @#if HAVE_STATX@)" #-}
+fileImmutableX _ = False
+{-# WARNING fileAppendX "fileAppendX: not available on this platform, will default to 'False' (CPP guard: @#if HAVE_STATX@)" #-}
+fileAppendX _ = False
+{-# WARNING fileNoDumpX "fileNoDumpX: not available on this platform, will default to 'False' (CPP guard: @#if HAVE_STATX@)" #-}
+fileNoDumpX _ = False
+{-# WARNING fileEncryptedX "fileEncryptedX: not available on this platform, will default to 'False' (CPP guard: @#if HAVE_STATX@)" #-}
+fileEncryptedX _ = False
+{-# WARNING fileVerityX "fileVerityX: not available on this platform, will default to 'False' (CPP guard: @#if HAVE_STATX@)" #-}
+fileVerityX _ = False
+{-# WARNING fileDaxX "fileDaxX: not available on this platform, will default to 'False' (CPP guard: @#if HAVE_STATX@)" #-}
+fileDaxX _ = False
+#endif
+
+data {-# CTYPE "struct statx" #-} CStatx
+
+#ifdef HAVE_STATX
+foreign import capi unsafe "sys/stat.h statx"
+ c_statx :: CInt -> CFilePath -> CInt -> CInt -> Ptr CStatx -> IO CInt
+
+#ifdef HAVE_SYS_SYSMACROS_H
+foreign import capi unsafe "sys/sysmacros.h makedev"
+ c_makedev :: CUInt -> CUInt -> IO CDev
+#endif
+#endif
+
+
+getExtendedFileStatus_ :: Maybe Fd -- ^ Optional directory file descriptor
+ -> CString -- ^ Pathname to open
+ -> StatxFlags
+ -> StatxMask
+ -> IO ExtendedFileStatus
+#ifdef HAVE_STATX
+getExtendedFileStatus_ fdMay str (StatxFlags flags) (StatxMask masks) = do
+ fp <- mallocForeignPtrBytes (#const sizeof(struct statx))
+ withForeignPtr fp $ \p ->
+ throwErrnoIfMinus1_ "getExtendedFileStatus_" (c_statx c_fd str flags masks p)
+ return (ExtendedFileStatus fp)
+ where
+ c_fd = maybe (#const AT_FDCWD) (\ (Fd fd) -> fd) fdMay
+#else
+{-# WARNING getExtendedFileStatus_ "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_STATX@)" #-}
+getExtendedFileStatus_ _ _ _ _ = ioError (ioeSetLocation unsupportedOperation "getExtendedFileStatus")
+#endif
+
diff --git a/System/Posix/Files/PosixString.hsc b/System/Posix/Files/PosixString.hsc
index 2873827..1fdc5d8 100644
--- a/System/Posix/Files/PosixString.hsc
+++ b/System/Posix/Files/PosixString.hsc
@@ -1,4 +1,5 @@
{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE PatternSynonyms #-}
-----------------------------------------------------------------------------
-- |
@@ -58,6 +59,69 @@ module System.Posix.Files.PosixString (
isBlockDevice, isCharacterDevice, isNamedPipe, isRegularFile,
isDirectory, isSymbolicLink, isSocket,
+ -- * Extended file status
+ ExtendedFileStatus(..),
+ CAttributes(..),
+ -- ** Obtaining extended file status
+ getExtendedFileStatus,
+ -- ** Flags
+ StatxFlags(..),
+ defaultStatxFlags,
+ pattern EmptyPath,
+ pattern NoAutoMount,
+ pattern SymlinkNoFollow,
+ pattern SyncAsStat,
+ pattern ForceSync,
+ pattern DontSync,
+ -- ** Mask
+ StatxMask(..),
+ defaultStatxMask,
+ pattern StatxType,
+ pattern StatxMode,
+ pattern StatxNlink,
+ pattern StatxUid,
+ pattern StatxGid,
+ pattern StatxAtime,
+ pattern StatxMtime,
+ pattern StatxCtime,
+ pattern StatxIno,
+ pattern StatxSize,
+ pattern StatxBlocks,
+ pattern StatxBasicStats,
+ pattern StatxBtime,
+ pattern StatxMntId,
+ pattern StatxAll,
+ -- ** Querying extended file status
+ fileBlockSizeX,
+ linkCountX,
+ fileOwnerX,
+ fileGroupX,
+ fileModeX,
+ fileIDX,
+ fileSizeX,
+ fileBlocksX,
+ accessTimeHiResX,
+ creationTimeHiResX,
+ statusChangeTimeHiResX,
+ modificationTimeHiResX,
+ deviceIDX,
+ specialDeviceIDX,
+ mountIDX,
+ fileCompressedX,
+ fileImmutableX,
+ fileAppendX,
+ fileNoDumpX,
+ fileEncryptedX,
+ fileVerityX,
+ fileDaxX,
+ isBlockDeviceX,
+ isCharacterDeviceX,
+ isNamedPipeX,
+ isRegularFileX,
+ isDirectoryX,
+ isSymbolicLinkX,
+ isSocketX,
+
-- * Creation
createNamedPipe,
createDevice,
@@ -102,7 +166,8 @@ import Foreign.C hiding (
throwErrnoPathIfMinus1_ )
import System.OsPath.Types
-import System.Posix.Files hiding (getFileStatus, getSymbolicLinkStatus, createNamedPipe, createDevice, createLink, removeLink, createSymbolicLink, readSymbolicLink, rename, setOwnerAndGroup, setSymbolicLinkOwnerAndGroup, setFileTimes, setSymbolicLinkTimesHiRes, touchFile, touchSymbolicLink, setFileSize, getPathVar, setFileMode, fileAccess, fileExist, setFdTimesHiRes, setFileTimesHiRes)
+import System.Posix.Files hiding (getFileStatus, getExtendedFileStatus, getSymbolicLinkStatus, createNamedPipe, createDevice, createLink, removeLink, createSymbolicLink, readSymbolicLink, rename, setOwnerAndGroup, setSymbolicLinkOwnerAndGroup, setFileTimes, setSymbolicLinkTimesHiRes, touchFile, touchSymbolicLink, setFileSize, getPathVar, setFileMode, fileAccess, fileExist, setFdTimesHiRes, setFileTimesHiRes)
+import System.Posix.Files.Common (getExtendedFileStatus_)
import System.Posix.PosixPath.FilePath
import Data.Time.Clock.POSIX (POSIXTime)
@@ -182,6 +247,25 @@ getFileStatus path = do
throwErrnoPathIfMinus1Retry_ "getFileStatus" path (c_stat s p)
return (Common.FileStatus fp)
+-- | Gets extended file status information.
+--
+-- The target file to open is identified in one of the following ways:
+--
+-- - If @pathname@ begins with a slash, then it is an absolute pathname that identifies the target file. In this case, @dirfd@ is ignored
+-- - If @pathname@ is a string that begins with a character other than a slash and @dirfd@ is a file descriptor that refers to a
+-- directory, then pathname is a relative pathname that is interpreted relative to the directory referred to by dirfd.
+-- (See @openat(2)@ for an explanation of why this is useful.)
+-- - If @pathname@ is an empty string and the 'EmptyPath' flag is specified in flags (see below), then the target file is
+-- the one referred to by the file descriptor @dirfd@.
+--
+-- Note: calls @statx@.
+getExtendedFileStatus :: Maybe Fd -- ^ Optional directory file descriptor (@dirfd@)
+ -> PosixPath -- ^ @pathname@ to open
+ -> StatxFlags -- ^ flags
+ -> StatxMask -- ^ mask
+ -> IO ExtendedFileStatus
+getExtendedFileStatus mfd path flags masks = withFilePath path $ \s -> getExtendedFileStatus_ mfd s flags masks
+
-- | Acts as 'getFileStatus' except when the 'PosixPath' refers to a symbolic
-- link. In that case the @FileStatus@ information of the symbolic link itself
-- is returned instead of that of the file it points to.
diff --git a/changelog.md b/changelog.md
index dec5787..d8f2dcb 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,5 +1,10 @@
# Changelog for [`unix` package](http://hackage.haskell.org/package/unix)
+## 2.8.3.0 *??? 2023*
+
+ * add `getExtendedFileStatus` (based on `statx`) style functions
+ * drop support for GHC < 8.6
+
## 2.8.2.1 *Sep 2023*
* Fix UB bug in `withFilePath` that causes it to error out (introduced in 2.8.2.0) wrt [#295](https://github.com/haskell/unix/issues/295)
diff --git a/configure.ac b/configure.ac
index d7d09a5..978b7ad 100644
--- a/configure.ac
+++ b/configure.ac
@@ -23,6 +23,7 @@ AC_SYS_LARGEFILE
AC_CHECK_HEADERS([dirent.h fcntl.h grp.h limits.h pwd.h signal.h string.h])
AC_CHECK_HEADERS([sys/resource.h sys/stat.h sys/times.h sys/time.h])
AC_CHECK_HEADERS([sys/utsname.h sys/wait.h])
+AC_CHECK_HEADERS([sys/sysmacros.h])
AC_CHECK_HEADERS([bsd/libutil.h libutil.h pty.h utmp.h])
AC_CHECK_HEADERS([termios.h time.h unistd.h utime.h])
@@ -46,6 +47,10 @@ AC_CHECK_FUNCS([chown fchdir fchmod])
AC_CHECK_TYPE([struct rlimit],[AC_DEFINE([HAVE_STRUCT_RLIMIT],[1],[HAVE_STRUCT_RLIMIT])],[],[#include <sys/resource.h>])
+# check for statx
+AC_CHECK_FUNC([statx], [AC_DEFINE([HAVE_STATX_FUN],[1],[HAVE_STATX_FUN])],[],[#include <sys/stat.h>])
+AC_CHECK_TYPE([struct statx],[AC_DEFINE([HAVE_STRUCT_STATX],[1],[HAVE_STRUCT_STATX])],[],[#include <sys/stat.h>])
+
AC_MSG_CHECKING(for F_GETLK from fcntl.h)
AC_EGREP_CPP(yes,
[
diff --git a/include/HsUnix.h b/include/HsUnix.h
index 01add31..7639685 100644
--- a/include/HsUnix.h
+++ b/include/HsUnix.h
@@ -90,6 +90,9 @@
#ifdef HAVE_SIGNAL_H
#include <signal.h>
#endif
+#ifdef HAVE_SYS_SYSMACROS_H
+#include <sys/sysmacros.h>
+#endif
/* defined in rts/posix/Signals.c */
extern HsInt nocldstop;
@@ -123,4 +126,8 @@ int __hsunix_push_module(int fd, const char *module);
clock_t __hsunix_clocks_per_second (void);
#endif
+#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STATX_FUN) && defined(HAVE_STRUCT_STATX)
+#define HAVE_STATX 1
+#endif
+
#endif
diff --git a/tests/FileExtendedStatus.hs b/tests/FileExtendedStatus.hs
new file mode 100644
index 0000000..0885593
--- /dev/null
+++ b/tests/FileExtendedStatus.hs
@@ -0,0 +1,166 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+module FileExtendedStatus (main) where
+
+import System.Posix.Files
+import System.Posix.Directory
+import System.Posix.IO
+import System.Posix.Types
+import Control.Exception as E
+import Control.Monad
+import Test.Tasty.HUnit
+
+main = do
+ cleanup
+ fs <- testRegular
+ ds <- testDir
+ testSymlink fs ds
+ testLink
+ cleanup
+
+regular = "regular"
+dir = "dir"
+slink_regular = "link-regular-symlink"
+hlink_regular = "link-regular-hardlink"
+link_dir = "link-dir"
+
+testRegular = do
+ _ <- createFile regular ownerReadMode
+ (fs, _) <- getStatus regular
+ let expected = (False,False,False,True,False,False,False)
+ actual = snd (statusExtendedElements fs)
+ when (actual /= expected) $
+ fail "unexpected file status bits for regular file"
+ return fs
+
+testDir = do
+ createDirectory dir ownerReadMode
+ (ds, _) <- getStatus dir
+ let expected = (False,False,False,False,True,False,False)
+ actual = snd (statusExtendedElements ds)
+ when (actual /= expected) $
+ fail "unexpected file status bits for directory"
+ return ds
+
+testSymlink fs ds = do
+ createSymbolicLink regular slink_regular
+ createSymbolicLink dir link_dir
+ (fs', ls) <- getStatus slink_regular
+ (ds', lds) <- getStatus link_dir
+
+ let expected = (False,False,False,False,False,True,False)
+ actualF = snd (statusExtendedElements ls)
+ actualD = snd (statusExtendedElements lds)
+
+ when (actualF /= expected) $
+ fail "unexpected file status bits for symlink to regular file"
+
+ when (actualD /= expected) $
+ fail "unexpected file status bits for symlink to directory"
+
+ when (statusExtendedElements fs /= statusExtendedElements fs') $
+ fail "status for a file does not match when it's accessed via a symlink"
+
+ when (statusExtendedElements ds /= statusExtendedElements ds') $
+ fail "status for a directory does not match when it's accessed via a symlink"
+
+
+testLink = do
+ createLink regular hlink_regular
+ (fs, _) <- getStatus regular -- we need to retrieve it again as creating the link causes it to change!
+ (fs', ls) <- getStatus hlink_regular
+ snd (statusExtendedElements ls) @?= (
+ False, -- isBlockDevice
+ False, -- isCharacterDevice
+ False, -- isNamedPipe
+ True, -- isRegularFile
+ False, -- isDirectory
+ False, -- isSymbolicLink
+ False) -- isSocket
+ linkCountX fs' @?= 2
+ statusExtendedElements fs @?= statusExtendedElements fs' -- status for a file should match when accessed via a link
+
+
+cleanup = do
+ ignoreIOExceptions $ removeDirectory dir
+ mapM_ (ignoreIOExceptions . removeLink)
+ [regular, hlink_regular, slink_regular, link_dir]
+
+ignoreIOExceptions io = io `E.catch`
+ ((\_ -> return ()) :: IOException -> IO ())
+
+getStatus f = do
+ fs <- getExtendedFileStatus Nothing f defaultStatxFlags defaultStatxMask
+ ls <- getExtendedFileStatus Nothing f SymlinkNoFollow defaultStatxMask
+ fs' <- getFileStatus f
+
+ statusExtendedElementsMinimal fs @?= statusElementsMinimal fs'
+
+ return (fs, ls)
+
+-- Yay for 20-element tuples!
+statusExtendedElements fs = (,)
+ (fileBlockSizeX fs
+ ,linkCountX fs
+ ,fileOwnerX fs
+ ,fileGroupX fs
+ ,fileModeX fs
+ ,fileIDX fs
+ ,fileSizeX fs
+ ,accessTimeHiResX fs
+ ,creationTimeHiResX fs
+ ,statusChangeTimeHiResX fs
+ ,modificationTimeHiResX fs
+ )
+ (isBlockDeviceX fs
+ ,isCharacterDeviceX fs
+ ,isNamedPipeX fs
+ ,isRegularFileX fs
+ ,isDirectoryX fs
+ ,isSymbolicLinkX fs
+ ,isSocketX fs
+ )
+
+statusExtendedElementsMinimal fs = (,)
+ (fileModeX fs
+ ,deviceIDX fs
+ ,specialDeviceIDX fs
+ ,linkCountX fs
+ ,fileOwnerX fs
+ ,fileGroupX fs
+ ,COff (fromIntegral (fileSizeX fs))
+ ,Just $ CBlkCnt (fromIntegral (fileBlocksX fs))
+ ,accessTimeHiResX fs
+ ,statusChangeTimeHiResX fs
+ ,modificationTimeHiResX fs
+ )
+ (isBlockDeviceX fs
+ ,isCharacterDeviceX fs
+ ,isNamedPipeX fs
+ ,isRegularFileX fs
+ ,isDirectoryX fs
+ ,isSymbolicLinkX fs
+ ,isSocketX fs
+ )
+
+statusElementsMinimal fs = (,)
+ (fileMode fs
+ ,deviceID fs
+ ,specialDeviceID fs
+ ,linkCount fs
+ ,fileOwner fs
+ ,fileGroup fs
+ ,fileSize fs
+ ,fileBlocks fs
+ ,accessTimeHiRes fs
+ ,statusChangeTimeHiRes fs
+ ,modificationTimeHiRes fs
+ )
+ (isBlockDevice fs
+ ,isCharacterDevice fs
+ ,isNamedPipe fs
+ ,isRegularFile fs
+ ,isDirectory fs
+ ,isSymbolicLink fs
+ ,isSocket fs
+ )
diff --git a/tests/Test.hs b/tests/Test.hsc
similarity index 97%
rename from tests/Test.hs
rename to tests/Test.hsc
index 5ce28ec..f6771cf 100644
--- a/tests/Test.hs
+++ b/tests/Test.hsc
@@ -4,6 +4,8 @@
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+#include "HsUnix.h"
+
module Main (main) where
import Control.Applicative
@@ -25,6 +27,7 @@ import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import qualified FileStatus
+import qualified FileExtendedStatus
import qualified FileStatusByteString
import qualified Signals001
@@ -37,6 +40,9 @@ main = defaultMain $ testGroup "All"
, testGroup "Native"
[ executeFile001 -- JS: missing "pipe"
, fileStatus -- JS: missing "openat"
+#ifdef HAVE_STATX
+ , fileExtendedStatus -- JS: missing "openat"
+#endif
, fileStatusByteString -- JS: missing "openat"
, getEnvironment01 -- JS: missing "environ"
, testSystemPosixEnvByteString -- JS: missing "environ"
@@ -74,6 +80,9 @@ fileExist01 = testCase "fileExist01" $ do
fileStatus :: TestTree
fileStatus = testCase "fileStatus" FileStatus.main
+fileExtendedStatus :: TestTree
+fileExtendedStatus = testCase "fileExtendedStatus" FileExtendedStatus.main
+
fileStatusByteString :: TestTree
fileStatusByteString = testCase "fileStatusByteString" FileStatusByteString.main
diff --git a/unix.cabal b/unix.cabal
index 94de693..8942c17 100644
--- a/unix.cabal
+++ b/unix.cabal
@@ -1,6 +1,6 @@
cabal-version: 1.12
name: unix
-version: 2.8.2.1
+version: 2.8.3.0
-- NOTE: Don't forget to update ./changelog.md
license: BSD3
@@ -11,13 +11,13 @@ bug-reports: https://github.com/haskell/unix/issues
synopsis: POSIX functionality
category: System
build-type: Configure
-tested-with: GHC==9.2.4,
+tested-with: GHC==9.6.2,
+ GHC==9.4.7,
+ GHC==9.2.8,
GHC==9.0.2,
GHC==8.10.7,
GHC==8.8.4,
- GHC==8.6.5,
- GHC==8.4.4,
- GHC==8.2.2
+ GHC==8.6.5
description:
This package gives you access to the set of operating system
services standardised by
@@ -69,10 +69,10 @@ library
buildable: False
build-depends:
- base >= 4.10 && < 4.20,
- bytestring >= 0.9.2 && < 0.13,
+ base >= 4.12.0.0 && < 4.20,
+ bytestring >= 0.9.2 && < 0.13,
filepath >= 1.4.100.0 && < 1.5,
- time >= 1.2 && < 1.13
+ time >= 1.9.1 && < 1.13
exposed-modules:
System.Posix
@@ -167,6 +167,7 @@ test-suite unix-tests
main-is: Test.hs
other-modules:
FileStatus
+ FileExtendedStatus
FileStatusByteString
Signals001
type: exitcode-stdio-1.0
--
GitLab