[Haskell-beginners] FFI. unIO safety considerations

[Folsk Pratima]

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 <folsk0pratima at cock.li> wrote:

> 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.
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners