From 970c461dc2fbab8feb1b0bd4741e5e07fc1e2432 Mon Sep 17 00:00:00 2001 From: M Farkas-Dyck Date: Mon, 7 May 2018 20:50:35 -0800 Subject: [PATCH 1/3] Add openDirStreamFd, openFileAt and createFileAt --- System/Posix/Directory/Common.hsc | 16 ++++++++++++- System/Posix/Directory/Fd.hsc | 7 ++++++ System/Posix/IO.hsc | 39 +++++++++++++++++++++++++------ System/Posix/IO/ByteString.hsc | 39 +++++++++++++++++++++++++------ System/Posix/IO/Common.hsc | 27 ++++++++++----------- unix.cabal | 1 + 6 files changed, 101 insertions(+), 28 deletions(-) create mode 100644 System/Posix/Directory/Fd.hsc diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc index 41144a3b..90717510 100644 --- a/System/Posix/Directory/Common.hsc +++ b/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 @@ -38,6 +39,19 @@ newtype DirStream = DirStream (Ptr CDir) data {-# CTYPE "DIR" #-} CDir data {-# CTYPE "struct dirent" #-} CDirent +-- | @unsafeOpenDirStreamFd fd@ calls @fdopendir@ to obtain a directory stream +-- for @fd@. @fd@ must not be otherwise used after this; see +-- . +unsafeOpenDirStreamFd :: Fd -> IO DirStream +unsafeOpenDirStreamFd (Fd fd) = DirStream <$> throwErrnoIfNull "openDirStreamFd" (c_fdopendir fd) + +-- 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 () diff --git a/System/Posix/Directory/Fd.hsc b/System/Posix/Directory/Fd.hsc new file mode 100644 index 00000000..0dc33e3c --- /dev/null +++ b/System/Posix/Directory/Fd.hsc @@ -0,0 +1,7 @@ +#include "HsUnix.h" + +module System.Posix.Directory.Fd ( + unsafeOpenDirStreamFd +) where + +import System.Posix.Directory.Common diff --git a/System/Posix/IO.hsc b/System/Posix/IO.hsc index 305e4df8..40cdda4f 100644 --- a/System/Posix/IO.hsc +++ b/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) } diff --git a/System/Posix/IO/ByteString.hsc b/System/Posix/IO/ByteString.hsc index 9c65bd7a..1d6a904b 100644 --- a/System/Posix/IO/ByteString.hsc +++ b/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) } diff --git a/System/Posix/IO/Common.hsc b/System/Posix/IO/Common.hsc index 25597292..b7bc7f1a 100644 --- a/System/Posix/IO/Common.hsc +++ b/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. diff --git a/unix.cabal b/unix.cabal index 4abe2159..61383ec0 100644 --- a/unix.cabal +++ b/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 From 697b1b19683cb20bd3f5b0125fe98fd70ea57a04 Mon Sep 17 00:00:00 2001 From: Viktor Dukhovni Date: Tue, 16 Feb 2021 02:25:15 -0500 Subject: [PATCH 2/3] On error close fd passed to unsafeOpenDirStreamFd. This way the caller never ends up owning the fd after the call. Otherwise, cleanup of either the DirStream or else the file-descriptor would be difficult to implement correctly. --- System/Posix/Directory/Common.hsc | 31 ++++++++++++++++++++++++++----- 1 file changed, 26 insertions(+), 5 deletions(-) diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc index 90717510..e69e8f62 100644 --- a/System/Posix/Directory/Common.hsc +++ b/System/Posix/Directory/Common.hsc @@ -30,8 +30,10 @@ 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) @@ -39,11 +41,30 @@ newtype DirStream = DirStream (Ptr CDir) data {-# CTYPE "DIR" #-} CDir data {-# CTYPE "struct dirent" #-} CDirent --- | @unsafeOpenDirStreamFd fd@ calls @fdopendir@ to obtain a directory stream --- for @fd@. @fd@ must not be otherwise used after this; see --- . +-- | 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) = DirStream <$> throwErrnoIfNull "openDirStreamFd" (c_fdopendir fd) +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 From 0d8923824e5932aaec3818cb2aab81ecf23c57e7 Mon Sep 17 00:00:00 2001 From: Viktor Dukhovni Date: Tue, 16 Feb 2021 02:43:35 -0500 Subject: [PATCH 3/3] Update changelog --- changelog.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/changelog.md b/changelog.md index 62ba2489..7ecab220 100644 --- a/changelog.md +++ b/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