[Git][ghc/ghc][master] base: Use strerror_r instead of strerror
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Mar 8 23:27:26 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
2859a637 by Ben Gamari at 2024-03-08T18:26:47-05:00
base: Use strerror_r instead of strerror
As noted by #24344, `strerror` is not necessarily thread-safe.
Thankfully, POSIX.1-2001 has long offered `strerror_r`, which is
safe to use.
Fixes #24344.
CLC discussion: https://github.com/haskell/core-libraries-committee/issues/249
- - - - -
6 changed files:
- libraries/base/changelog.md
- + libraries/ghc-internal/cbits/strerror.c
- libraries/ghc-internal/configure.ac
- libraries/ghc-internal/ghc-internal.cabal
- libraries/ghc-internal/jsbits/errno.js
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs
Changes:
=====================================
libraries/base/changelog.md
=====================================
@@ -28,6 +28,7 @@
and [CLC proposal #258](https://github.com/haskell/core-libraries-committee/issues/258))
* Add `System.Mem.performMajorGC` ([CLC proposal #230](https://github.com/haskell/core-libraries-committee/issues/230))
* Fix exponent overflow/underflow bugs in the `Read` instances for `Float` and `Double` ([CLC proposal #192](https://github.com/haskell/core-libraries-committee/issues/192))
+ * `Foreign.C.Error.errnoToIOError` now uses the reentrant `strerror_r` to render system errors when possible ([CLC proposal #249](https://github.com/haskell/core-libraries-committee/issues/249))
* Implement `many` and `some` methods of `instance Alternative (Compose f g)` explicitly. ([CLC proposal #181](https://github.com/haskell/core-libraries-committee/issues/181))
* Change the types of the `GHC.Stack.StackEntry.closureType` and `GHC.InfoProv.InfoProv.ipDesc` record fields to use `GHC.Exts.Heap.ClosureType` rather than an `Int`.
To recover the old value use `fromEnum`. ([CLC proposal #210](https://github.com/haskell/core-libraries-committee/issues/210))
=====================================
libraries/ghc-internal/cbits/strerror.c
=====================================
@@ -0,0 +1,29 @@
+// glibc will only expose the POSIX strerror_r if this is defined.
+#define _POSIX_C_SOURCE 200112L
+
+#include <string.h>
+#include <errno.h>
+
+// This must be included after <string.h> lest _GNU_SOURCE may be defined.
+#include "HsBaseConfig.h"
+
+// returns zero on success
+int base_strerror_r(int errnum, char *ptr, size_t buflen)
+{
+#if defined(HAVE_STRERROR_R)
+ int ret = strerror_r(errnum, ptr, buflen);
+ if (ret == ERANGE) {
+ // Ellipsize the error
+ ptr[buflen-4] = '.';
+ ptr[buflen-3] = '.';
+ ptr[buflen-2] = '.';
+ ret = 0;
+ }
+ return ret;
+#elif defined(HAVE_STRERROR_S)
+ strerror_s(ptr, buflen, errnum);
+ return 0;
+#else
+#error neither strerror_r nor strerror_s are supported
+#endif
+}
=====================================
libraries/ghc-internal/configure.ac
=====================================
@@ -41,6 +41,12 @@ AC_CHECK_DECLS([CLOCK_PROCESS_CPUTIME_ID], [], [], [[#include <time.h>]])
AC_CHECK_FUNCS([getclock getrusage times])
AC_CHECK_FUNCS([_chsize_s ftruncate])
+AC_CHECK_FUNCS([strerror_r strerror_s])
+
+if test "$ac_cv_func_strerror_r" = no && test "$ac_cv_func_strerror_s" = no; then
+ AC_MSG_ERROR([Either strerror_r or strerror_s must be available])
+fi
+
# event-related fun
# The line below already defines HAVE_KQUEUE and HAVE_POLL, so technically some of the
# subsequent portions that redefine them could be skipped. However, we keep those portions
=====================================
libraries/ghc-internal/ghc-internal.cabal
=====================================
@@ -330,6 +330,7 @@ Library
cbits/primFloat.c
cbits/sysconf.c
cbits/fs.c
+ cbits/strerror.c
cmm-sources:
cbits/StackCloningDecoding.cmm
=====================================
libraries/ghc-internal/jsbits/errno.js
=====================================
@@ -22,7 +22,7 @@ function h$unsupported(status, c) {
return status;
}
-function h$strerror(err) {
+function h$base_strerror(err) {
if(err === 12456) {
RETURN_UBX_TUP2(h$encodeUtf8("operation unsupported on this platform"), 0);
}
=====================================
libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs
=====================================
@@ -91,6 +91,9 @@ module GHC.Internal.Foreign.C.Error (
#include "HsBaseConfig.h"
import GHC.Internal.Foreign.Ptr
+#if !defined(javascript_HOST_ARCH)
+import GHC.Internal.Foreign.Marshal.Alloc
+#endif
import GHC.Internal.Foreign.C.Types
import GHC.Internal.Foreign.C.String
import GHC.Internal.Data.Functor ( void )
@@ -460,6 +463,29 @@ throwErrnoPathIfMinus1_ = throwErrnoPathIf_ (== -1)
-- conversion of an "errno" value into IO error
-- --------------------------------------------
+errnoToString :: Errno -> IO String
+
+#if defined(javascript_HOST_ARCH)
+foreign import ccall unsafe "base_strerror"
+ c_strerror :: Errno -> IO (Ptr CChar)
+
+errnoToString errno = c_strerror errno >>= peekCString
+
+#else
+foreign import ccall "base_strerror_r"
+ c_strerror_r :: Errno -> Ptr CChar -> CSize -> IO CInt
+
+errnoToString errno =
+ allocaBytes len $ \ptr -> do
+ ret <- c_strerror_r errno ptr len
+ if ret /= 0
+ then return "errnoToString failed"
+ else peekCString ptr
+ where
+ len :: Num a => a
+ len = 512
+#endif
+
-- | Construct an 'IOError' based on the given 'Errno' value.
-- The optional information can be used to improve the accuracy of
-- error messages.
@@ -470,7 +496,7 @@ errnoToIOError :: String -- ^ the location where the error occurred
-> Maybe String -- ^ optional filename associated with the error
-> IOError
errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
- str <- strerror errno >>= peekCString
+ str <- errnoToString errno
return (IOError maybeHdl errType loc str (Just errno') maybeName)
where
Errno errno' = errno
@@ -576,5 +602,3 @@ errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
| errno == eXDEV = UnsupportedOperation
| otherwise = OtherError
-foreign import ccall unsafe "string.h" strerror :: Errno -> IO (Ptr CChar)
-
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2859a6379be53c5f6de34f6dd868ef0f0738b08c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2859a6379be53c5f6de34f6dd868ef0f0738b08c
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/20240308/8e5472ac/attachment-0001.html>
More information about the ghc-commits
mailing list