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
baseSize :: CSize
baseSize = 50
ioString = run baseSize
run :: CSize -> IO String
run size
| size > 100000 =
return $
"!!! INTERNAL strError memory leak detected, " ++
"you can not recover !!!"
| otherwise = do
may <- tryIOString size
case may of
Just str -> return str
Nothing -> run (size + baseSize)
tryIOString :: CSize -> IO (Maybe String)
tryIOString size =
allocaBytes (fromIntegral size) $ \ptr -> do
zeroptr <- memSet ptr 0 (fromIntegral size)
st <- c_strerror_r (fromIntegral errnum) ptr size
-- heuristic
case st of
22 -> return . return $ "Unknown error " ++ show errnum
34 -> return Nothing
_ -> peekCAString ptr >>= return . return
main = mapM_ (putStrLn) $ map strError [1 .. 1000]
On Fri, 12 Apr 2024 15:27:57 -0000
Folsk Pratima
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
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. _______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners