[Git][ghc/ghc][wip/T24344] base: Use strerror_r instead of strerror

[Ben Gamari (@bgamari)]

Ben Gamari pushed to branch wip/T24344 at Glasgow Haskell Compiler / GHC


Commits:
0edd3514 by Ben Gamari at 2024-01-31T16:04:09-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.

- - - - -


4 changed files:

- libraries/base/base.cabal
- + libraries/base/cbits/strerror.c
- libraries/base/configure.ac
- libraries/base/src/Foreign/C/Error.hs


Changes:

=====================================
libraries/base/base.cabal
=====================================
@@ -376,6 +376,7 @@ Library
           cbits/primFloat.c
           cbits/sysconf.c
           cbits/fs.c
+          cbits/strerror.c
 
       cmm-sources:
           cbits/CastFloatWord.cmm


=====================================
libraries/base/cbits/strerror.c
=====================================
@@ -0,0 +1,27 @@
+// glibc will only expose the POSIX strerror_r if this is defined.
+#define _POSIX_C_SOURCE 200112L
+
+#include "HsBaseConfig.h"
+#include <string.h>
+#include <errno.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/base/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/base/src/Foreign/C/Error.hs
=====================================
@@ -91,6 +91,7 @@ module Foreign.C.Error (
 #include "HsBaseConfig.h"
 
 import Foreign.Ptr
+import Foreign.Marshal.Alloc
 import Foreign.C.Types
 import Foreign.C.String
 import Data.Functor            ( void )
@@ -460,6 +461,20 @@ throwErrnoPathIfMinus1_  = throwErrnoPathIf_ (== -1)
 -- conversion of an "errno" value into IO error
 -- --------------------------------------------
 
+foreign import ccall "base_strerror_r"
+    c_strerror_r :: Errno -> Ptr CChar -> CSize -> IO CInt
+
+errnoToString :: Errno -> IO String
+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
+
 -- | Construct an 'IOError' based on the given 'Errno' value.
 -- The optional information can be used to improve the accuracy of
 -- error messages.
@@ -470,7 +485,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 +591,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/0edd3514c8018bccabb675e5d7ab38e67ef61ae9

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0edd3514c8018bccabb675e5d7ab38e67ef61ae9
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/20240131/a4ae1659/attachment-0001.html>