[Git][ghc/ghc][wip/andreask/setNonBlockingMode] Allow unknown fd device types for setNonBlockingMode.
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Fri Aug 30 15:31:28 UTC 2024
Andreas Klebinger pushed to branch wip/andreask/setNonBlockingMode at Glasgow Haskell Compiler / GHC
Commits:
f272d6d9 by Andreas Klebinger at 2024-08-30T17:12:55+02:00
Allow unknown fd device types for setNonBlockingMode.
This allows fds with a unknown device type to have blocking mode
set. This happens for example for fds from the inotify subsystem.
Fixes #25199.
- - - - -
7 changed files:
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
Changes:
=====================================
libraries/base/changelog.md
=====================================
@@ -16,6 +16,7 @@
* Add `firstA` and `secondA` to `Data.Bitraversable`. ([CLC proposal #172](https://github.com/haskell/core-libraries-committee/issues/172))
* Deprecate `GHC.TypeNats.Internal`, `GHC.TypeLits.Internal`, `GHC.ExecutionStack.Internal` ([CLC proposal #217](https://github.com/haskell/core-libraries-committee/issues/217))
* Define `Eq1`, `Ord1`, `Show1` and `Read1` instances for basic `Generic` representation types. ([CLC proposal #273](https://github.com/haskell/core-libraries-committee/issues/273))
+ * `setNonBlockingMode` will no longer throw an exception when called on a FD associated with a unknown device type. ([CLC proposal #282](https://github.com/haskell/core-libraries-committee/issues/282))
* Add exception type metadata to default exception handler output.
([CLC proposal #231](https://github.com/haskell/core-libraries-committee/issues/231)
and [CLC proposal #261](https://github.com/haskell/core-libraries-committee/issues/261))
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
=====================================
@@ -467,8 +467,8 @@ setNonBlockingMode fd set = do
-- utilities inspecting fdIsNonBlocking (such as readRawBufferPtr)
-- should not be tricked to think otherwise.
is_nonblock <- if set then do
- (fd_type, _, _) <- fdStat (fdFD fd)
- pure $ fd_type /= RegularFile && fd_type /= RawDevice
+ (fd_type, _, _) <- fdStat_maybe (fdFD fd)
+ pure $ fd_type /= Just RegularFile && fd_type /= Just RawDevice
else pure False
setNonBlockingFD (fdFD fd) is_nonblock
#if defined(mingw32_HOST_OS)
=====================================
libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
=====================================
@@ -137,6 +137,20 @@ fdStat fd =
ino <- st_ino p_stat
return (ty,dev,ino)
+-- | NOTE: On Win32 platforms, this will only work with file descriptors
+-- referring to file handles. i.e., it'll fail for socket FDs.
+--
+-- @since base-4.21.0.0
+fdStat_maybe :: FD -> IO (Maybe IODeviceType, CDev, CIno)
+fdStat_maybe fd =
+ allocaBytes sizeof_stat $ \ p_stat -> do
+ throwErrnoIfMinus1Retry_ "fdType" $
+ c_fstat fd p_stat
+ ty <- statGetType_maybe p_stat
+ dev <- st_dev p_stat
+ ino <- st_ino p_stat
+ return (ty,dev,ino)
+
fdType :: FD -> IO IODeviceType
fdType fd = do (ty,_,_) <- fdStat fd; return ty
@@ -152,6 +166,22 @@ statGetType p_stat = do
| s_isblk c_mode -> return RawDevice
| otherwise -> ioError ioe_unknownfiletype
+-- | Unlike @statGetType@, @statGetType_maybe@ will not throw an exception
+-- if the CStat refers to a unknown device type.
+--
+-- @since base-4.21.0.0
+statGetType_maybe :: Ptr CStat -> IO (Maybe IODeviceType)
+statGetType_maybe p_stat = do
+ c_mode <- st_mode p_stat :: IO CMode
+ case () of
+ _ | s_isdir c_mode -> return $ Just Directory
+ | s_isfifo c_mode || s_issock c_mode || s_ischr c_mode
+ -> return $ Just Stream
+ | s_isreg c_mode -> return $ Just RegularFile
+ -- Q: map char devices to RawDevice too?
+ | s_isblk c_mode -> return $ Just RawDevice
+ | otherwise -> return Nothing
+
ioe_unknownfiletype :: IOException
ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType"
"unknown file type"
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -10549,6 +10549,7 @@ module System.Posix.Internals where
fdFileSize :: FD -> GHC.Types.IO GHC.Num.Integer.Integer
fdGetMode :: FD -> GHC.Types.IO GHC.Internal.IO.IOMode.IOMode
fdStat :: FD -> GHC.Types.IO (GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
+ fdStat_maybe :: FD -> GHC.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
fdType :: FD -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
fileType :: GHC.Internal.IO.FilePath -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
getEcho :: FD -> GHC.Types.IO GHC.Types.Bool
@@ -10596,6 +10597,7 @@ module System.Posix.Internals where
st_mtime :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO GHC.Internal.Foreign.C.Types.CTime
st_size :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO GHC.Internal.System.Posix.Types.COff
statGetType :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
+ statGetType_maybe :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Device.IODeviceType)
tcSetAttr :: forall a. FD -> (GHC.Internal.Ptr.Ptr CTermios -> GHC.Types.IO a) -> GHC.Types.IO a
throwInternalNulError :: forall a. GHC.Internal.IO.FilePath -> GHC.Types.IO a
withFilePath :: forall a. GHC.Internal.IO.FilePath -> (GHC.Internal.Foreign.C.String.Encoding.CString -> GHC.Types.IO a) -> GHC.Types.IO a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -13590,6 +13590,7 @@ module System.Posix.Internals where
fdFileSize :: FD -> GHC.Types.IO GHC.Num.Integer.Integer
fdGetMode :: FD -> GHC.Types.IO GHC.Internal.IO.IOMode.IOMode
fdStat :: FD -> GHC.Types.IO (GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
+ fdStat_maybe :: FD -> GHC.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
fdType :: FD -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
fileType :: GHC.Internal.IO.FilePath -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
getEcho :: FD -> GHC.Types.IO GHC.Types.Bool
@@ -13637,6 +13638,7 @@ module System.Posix.Internals where
st_mtime :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO GHC.Internal.Foreign.C.Types.CTime
st_size :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO GHC.Internal.Int.Int64
statGetType :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
+ statGetType_maybe :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Device.IODeviceType)
tcSetAttr :: forall a. FD -> (GHC.Internal.Ptr.Ptr CTermios -> GHC.Types.IO a) -> GHC.Types.IO a
throwInternalNulError :: forall a. GHC.Internal.IO.FilePath -> GHC.Types.IO a
withFilePath :: forall a. GHC.Internal.IO.FilePath -> (GHC.Internal.Foreign.C.String.Encoding.CString -> GHC.Types.IO a) -> GHC.Types.IO a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -10821,6 +10821,7 @@ module System.Posix.Internals where
fdFileSize :: FD -> GHC.Types.IO GHC.Num.Integer.Integer
fdGetMode :: FD -> GHC.Types.IO GHC.Internal.IO.IOMode.IOMode
fdStat :: FD -> GHC.Types.IO (GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
+ fdStat_maybe :: FD -> GHC.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
fdType :: FD -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
fileType :: GHC.Internal.IO.FilePath -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
getEcho :: FD -> GHC.Types.IO GHC.Types.Bool
@@ -10865,6 +10866,7 @@ module System.Posix.Internals where
st_mtime :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO GHC.Internal.Foreign.C.Types.CTime
st_size :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO GHC.Internal.Int.Int64
statGetType :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
+ statGetType_maybe :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Device.IODeviceType)
throwInternalNulError :: forall a. GHC.Internal.IO.FilePath -> GHC.Types.IO a
withFilePath :: forall a. GHC.Internal.IO.FilePath -> (GHC.Internal.Foreign.C.String.CWString -> GHC.Types.IO a) -> GHC.Types.IO a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -10549,6 +10549,7 @@ module System.Posix.Internals where
fdFileSize :: FD -> GHC.Types.IO GHC.Num.Integer.Integer
fdGetMode :: FD -> GHC.Types.IO GHC.Internal.IO.IOMode.IOMode
fdStat :: FD -> GHC.Types.IO (GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
+ fdStat_maybe :: FD -> GHC.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
fdType :: FD -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
fileType :: GHC.Internal.IO.FilePath -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
getEcho :: FD -> GHC.Types.IO GHC.Types.Bool
@@ -10596,6 +10597,7 @@ module System.Posix.Internals where
st_mtime :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO GHC.Internal.Foreign.C.Types.CTime
st_size :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO GHC.Internal.System.Posix.Types.COff
statGetType :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
+ statGetType_maybe :: GHC.Internal.Ptr.Ptr CStat -> GHC.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Device.IODeviceType)
tcSetAttr :: forall a. FD -> (GHC.Internal.Ptr.Ptr CTermios -> GHC.Types.IO a) -> GHC.Types.IO a
throwInternalNulError :: forall a. GHC.Internal.IO.FilePath -> GHC.Types.IO a
withFilePath :: forall a. GHC.Internal.IO.FilePath -> (GHC.Internal.Foreign.C.String.Encoding.CString -> GHC.Types.IO a) -> GHC.Types.IO a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f272d6d90435232f39baf08476c3e48514bd5368
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f272d6d90435232f39baf08476c3e48514bd5368
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240830/52adb5f6/attachment-0001.html>
More information about the ghc-commits
mailing list