Bind fdopendir and openat

System/Posix/Directory/Common.hsc

@@ -1,4 +1,4 @@
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Safe, CApiFFI #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -18,6 +18,7 @@
 
 module System.Posix.Directory.Common (
        DirStream(..), CDir, CDirent, DirStreamOffset(..),
+       unsafeOpenDirStreamFd,
        rewindDirStream,
        closeDirStream,
 #ifdef HAVE_SEEKDIR
@@ -29,15 +30,49 @@ module System.Posix.Directory.Common (
        changeWorkingDirectoryFd,
   ) where
 
+import Control.Exception (mask_)
+import Control.Monad (void, when)
 import System.Posix.Types
-import Foreign
+import Foreign hiding (void)
 import Foreign.C
 
 newtype DirStream = DirStream (Ptr CDir)
 
 data {-# CTYPE "DIR" #-} CDir
 data {-# CTYPE "struct dirent" #-} CDirent
 
+-- | Call @fdopendir@ to obtain a directory stream for @fd@. @fd@ must not be
+-- otherwise used after this.
+--
+-- On success, it is owned by the returned 'DirStream', which should be closed
+-- via 'closeDirStream' when no longer needed.  On error, the file descriptor
+-- is automatically closed and then an exception is thrown.  There is no code
+-- path in which the file descriptor remains open and yet not owned by a
+-- returned 'DirStream'.
+--
+-- The input file descriptor must not have been used with @threadWaitRead@ or
+-- @threadWaitWrite@.
+unsafeOpenDirStreamFd :: Fd -> IO DirStream
+unsafeOpenDirStreamFd (Fd fd) = mask_ $ do
+    ptr <- c_fdopendir fd
+    when (ptr == nullPtr) $ do
+        errno <- getErrno
+        void $ c_close fd
+        ioError (errnoToIOError "openDirStreamFd" errno Nothing Nothing)
+    return $ DirStream ptr
+
+-- We need c_close here, because 'closeFd' throws exceptions on error,
+-- but we want to silently close the (presumably directory) descriptor.
+foreign import ccall unsafe "HsUnix.h close"
+   c_close :: CInt -> IO CInt
+
+-- NOTE: It is /critical/ to use "capi" and "dirent.h" here, because system
+-- headers on e.g. MacOS alias this function, and linking directly to the
+-- "fdopendir" symbol in libc leads to a crash!
+--
+foreign import capi unsafe "dirent.h fdopendir"
+    c_fdopendir :: CInt -> IO (Ptr CDir)
+
 -- | @rewindDirStream dp@ calls @rewinddir@ to reposition
 --   the directory stream @dp@ at the beginning of the directory.
 rewindDirStream :: DirStream -> IO ()

System/Posix/Directory/Fd.hsc

@@ -0,0 +1,7 @@
+#include "HsUnix.h"
+
+module System.Posix.Directory.Fd (
+    unsafeOpenDirStreamFd
+) where
+
+import System.Posix.Directory.Common

System/Posix/IO.hsc

@@ -27,7 +27,7 @@ module System.Posix.IO (
     -- ** Opening and closing files
     OpenMode(..),
     OpenFileFlags(..), defaultFileFlags,
-    openFd, createFile,
+    openFd, openFdAt, createFile, createFileAt,
     closeFd,
 
     -- ** Reading\/writing data
@@ -74,15 +74,40 @@ openFd :: FilePath
        -> OpenMode
        -> OpenFileFlags
        -> IO Fd
-openFd name how flags =
+openFd = openFdAt Nothing
+
+-- | Open a file relative to an optional directory file descriptor.
+--
+-- Directory file descriptors can be used to avoid some race conditions when
+-- navigating changing directory trees, or to retain access to a portion of the
+-- directory tree that would otherwise become inaccessible after dropping
+-- privileges.
+openFdAt :: Maybe Fd -- ^ Optional directory file descriptor
+         -> FilePath -- ^ Pathname to open
+         -> OpenMode -- ^ Read-only, read-write or write-only
+         -> OpenFileFlags -- ^ Append, exclusive, truncate, etc.
+         -> IO Fd
+openFdAt fdMay name how flags =
    withFilePath name $ \str ->
-     throwErrnoPathIfMinus1Retry "openFd" name $
-       open_ str how flags
+     throwErrnoPathIfMinus1Retry "openFdAt" name $
+       openat_ fdMay str how flags
 
 -- |Create and open this file in WriteOnly mode.  A special case of
 -- 'openFd'.  See 'System.Posix.Files' for information on how to use
 -- the 'FileMode' type.
-
 createFile :: FilePath -> FileMode -> IO Fd
-createFile name mode
-  = openFd name WriteOnly defaultFileFlags{ trunc=True, creat=(Just mode) }
+createFile = createFileAt Nothing
+
+-- | Create and open a file for write-only, with default flags,
+-- relative an optional directory file-descriptor.
+--
+-- Directory file descriptors can be used to avoid some race conditions when
+-- navigating changing directory trees, or to retain access to a portion of the
+-- directory tree that would otherwise become inaccessible after dropping
+-- privileges.
+createFileAt :: Maybe Fd -- ^ Optional directory file descriptor
+             -> FilePath -- ^ Pathname to create
+             -> FileMode -- ^ File permission bits (before umask)
+             -> IO Fd
+createFileAt fdMay name mode
+  = openFdAt fdMay name WriteOnly defaultFileFlags{ trunc=True, creat=(Just mode) }

System/Posix/IO/ByteString.hsc

@@ -27,7 +27,7 @@ module System.Posix.IO.ByteString (
     -- ** Opening and closing files
     OpenMode(..),
     OpenFileFlags(..), defaultFileFlags,
-    openFd, createFile,
+    openFd, openFdAt, createFile, createFileAt,
     closeFd,
 
     -- ** Reading\/writing data
@@ -74,15 +74,40 @@ openFd :: RawFilePath
        -> OpenMode
        -> OpenFileFlags
        -> IO Fd
-openFd name how flags =
+openFd = openFdAt Nothing
+
+-- | Open a file relative to an optional directory file descriptor.
+--
+-- Directory file descriptors can be used to avoid some race conditions when
+-- navigating changing directory trees, or to retain access to a portion of the
+-- directory tree that would otherwise become inaccessible after dropping
+-- privileges.
+openFdAt :: Maybe Fd -- ^ Optional directory file descriptor
+         -> RawFilePath -- ^ Pathname to open
+         -> OpenMode -- ^ Read-only, read-write or write-only
+         -> OpenFileFlags -- ^ Append, exclusive, truncate, etc.
+         -> IO Fd
+openFdAt fdMay name how flags =
    withFilePath name $ \str ->
-     throwErrnoPathIfMinus1Retry "openFd" name $
-       open_ str how flags
+     throwErrnoPathIfMinus1Retry "openFdAt" name $
+       openat_ fdMay str how flags
 
 -- |Create and open this file in WriteOnly mode.  A special case of
 -- 'openFd'.  See 'System.Posix.Files' for information on how to use
 -- the 'FileMode' type.
-
 createFile :: RawFilePath -> FileMode -> IO Fd
-createFile name mode
-  = openFd name WriteOnly defaultFileFlags{ trunc=True, creat=(Just mode) }
+createFile = createFileAt Nothing
+
+-- | Create and open a file for write-only, with default flags,
+-- relative an optional directory file-descriptor.
+--
+-- Directory file descriptors can be used to avoid some race conditions when
+-- navigating changing directory trees, or to retain access to a portion of the
+-- directory tree that would otherwise become inaccessible after dropping
+-- privileges.
+createFileAt :: Maybe Fd -- ^ Optional directory file descriptor
+             -> RawFilePath -- ^ Pathname to create
+             -> FileMode -- ^ File permission bits (before umask)
+             -> IO Fd
+createFileAt fdMay name mode
+  = openFdAt fdMay name WriteOnly defaultFileFlags{ trunc=True, creat=(Just mode) }

System/Posix/IO/Common.hsc

@@ -24,7 +24,7 @@ module System.Posix.IO.Common (
     -- ** Opening and closing files
     OpenMode(..),
     OpenFileFlags(..), defaultFileFlags,
-    open_,
+    openat_,
     closeFd,
 
     -- ** Reading\/writing data
@@ -176,19 +176,20 @@ defaultFileFlags =
   }
 
 
--- |Open and optionally create this file.  See 'System.Posix.Files'
--- for information on how to use the 'FileMode' type.
-open_  :: CString
-       -> OpenMode
-       -> OpenFileFlags
-       -> IO Fd
-open_ str how (OpenFileFlags appendFlag exclusiveFlag nocttyFlag
+-- |Open and optionally create a file relative to an optional
+-- directory file descriptor.
+openat_  :: Maybe Fd -- ^ Optional directory file descriptor
+         -> CString -- ^ Pathname to open
+         -> OpenMode -- ^ Read-only, read-write or write-only
+         -> OpenFileFlags -- ^ Append, exclusive, etc.
+         -> IO Fd
+openat_ fdMay str how (OpenFileFlags appendFlag exclusiveFlag nocttyFlag
                                 nonBlockFlag truncateFlag nofollowFlag
                                 creatFlag cloexecFlag directoryFlag
-                                syncFlag) = do
-    fd <- c_open str all_flags mode_w
-    return (Fd fd)
+                                syncFlag) =
+    Fd <$> c_openat c_fd str all_flags mode_w
   where
+    c_fd = maybe (#const AT_FDCWD) (\ (Fd fd) -> fd) fdMay
     all_flags  = creat .|. flags .|. open_mode
 
     flags =
@@ -211,8 +212,8 @@ open_ str how (OpenFileFlags appendFlag exclusiveFlag nocttyFlag
                    WriteOnly -> (#const O_WRONLY)
                    ReadWrite -> (#const O_RDWR)
 
-foreign import capi unsafe "HsUnix.h open"
-   c_open :: CString -> CInt -> CMode -> IO CInt
+foreign import capi unsafe "HsUnix.h openat"
+   c_openat :: CInt -> CString -> CInt -> CMode -> IO CInt
 
 -- |Close this file descriptor.  May throw an exception if this is an
 -- invalid descriptor.

changelog.md

@@ -1,6 +1,9 @@
 # Changelog for [`unix` package](http://hackage.haskell.org/package/unix)
 
 ## 2.8.0.0 *UNRELEASED*
+  * Add openDirStreamFd, openFileAt and createFileAt
+
+  * Add accessors for st_blocks and st_blksize
 
   * Deal with FreeBSD getpwnam_r(3), ... thread safety.  On FreeBSD these
     are not in fact safe for overlapped execution with a sequence of

unix.cabal

@@ -89,6 +89,7 @@ library
         System.Posix.ByteString.FilePath
 
         System.Posix.Directory
+        System.Posix.Directory.Fd
         System.Posix.Directory.ByteString
 
         System.Posix.DynamicLinker.Module