Also see
[Haskell-beginners] FFI to POSIX libc; strerror (errnum); unfreed memory
Exactly how unsafe this code is? What do I do about it? It is so very
stupid to have a pure function strerror_r in the IO monad!
StrError.hs
import Control.Exception
import Control.Monad.ST
import Control.Monad.ST.Unsafe
import Data.Word
import Foreign.C.String
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
foreign import ccall unsafe "strerror_r_portalbe.c strerror_r_portable" c_strerror_r
:: CInt -> Ptr CChar -> CSize -> IO CInt
memSet :: Ptr a -> Word8 -> Word32 -> IO (Ptr a)
memSet ptr _ 0 = return ptr
memSet ptr byte size = do
let voidptr = castPtr ptr :: Ptr Word8
acts =
map
(\i -> pokeByteOff voidptr i byte)
[0 .. fromIntegral (size - 1)]
mapM_ id acts
return ptr
strError :: Int -> String
strError errnum = runST $ unsafeIOToST ioString
where
buflen = 512 :: CSize
ioString =
allocaBytes (fromIntegral buflen) $ \ptr -> do
zeroptr <- memSet ptr 0 (fromIntegral buflen)
code <- c_strerror_r (fromIntegral errnum) ptr buflen
-- heuristic!
case code of
22 -> return $ "Unknown error " ++ show errnum
-- this is very dangerous, as far as I understand, and nobody in
-- his right might should not do it if he later intends to
-- unsafely escape IO
34 ->
throwIO $
userError $
"strError: " ++
show code ++
": ERANGE: " ++
"Numerical result out of range: " ++
"this is internal an error, which means not enough space " ++
"was allocated to store the error. You can not recover"
_ -> peekCAString ptr
main = mapM_ (putStrLn) $ map strError [1 .. 1000]
strerror_portable.c
#define _POSIX_C_SOURCE 200112L
#include <string.h>
int
strerror_r_portable (int e, char *c, size_t s)
{
return strerror_r (e, c, s);
}
The C code is needed because GHC uses _GNU_SOURCE, which I personally do not
want to use. Besides, I do not know how to predict whether GHC will define
_GNU_SOURCE or not, so this also feels more reliable.
To compile, do
$ mkdir lib
$ gcc -c -o lib/portable.o strerror_portable.c
$ ar -csr lib/portable.a lib/portable.o
$ ghc StrError.hs lib/portable.a
No leaks, of course.
