{-# LINE 1 "libraries/unix/System/Posix/DynamicLinker/Common.hsc" #-}
{-# LANGUAGE Safe #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.DynamicLinker.Common
-- Copyright   :  (c) Volker Stolz <vs@foldr.org> 2003
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  vs@foldr.org
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- Dynamic linker support through dlopen()
-----------------------------------------------------------------------------

module System.Posix.DynamicLinker.Common (

    module System.Posix.DynamicLinker.Prim,
    dlsym,
    dlerror,
    dlclose,
    undl,
    throwDLErrorIf,
    Module(..)
    )

--  Usage:
--  ******
--
--  Let's assume you want to open a local shared library \'foo\' (.\/libfoo.so)
--  offering a function
--    @char \* mogrify (char\*,int)@
--  and invoke @str = mogrify("test",1)@:
--
--
--  type Fun = CString -> Int -> IO CString
--  foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun
--
--  withDL "libfoo.so" [RTLD_NOW] \$ \\ mod -> do
--     funptr <- dlsym mod "mogrify"
--     let fun = fun__ funptr
--     withCString "test" \$ \\ str -> do
--       strptr <- fun str 1
--       strstr <- peekCString strptr
--       ...
--

where



import System.Posix.DynamicLinker.Prim
import Foreign
import Foreign.C

dlclose :: DL -> IO ()
dlclose :: DL -> IO ()
dlclose (DLHandle Ptr ()
h) = String -> (CInt -> Bool) -> IO CInt -> IO ()
forall a. String -> (a -> Bool) -> IO a -> IO ()
throwDLErrorIf_ String
"dlclose" (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr () -> IO CInt
c_dlclose Ptr ()
h
dlclose DL
h = String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"dlclose: invalid argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (DL -> String
forall a. Show a => a -> String
show DL
h)

dlerror :: IO String
dlerror :: IO String
dlerror = IO CString
c_dlerror IO CString -> (CString -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

-- |'dlsym' returns the address binding of the symbol described in @symbol@,
-- as it occurs in the shared object identified by @source@.

dlsym :: DL -> String -> IO (FunPtr a)
dlsym :: forall a. DL -> String -> IO (FunPtr a)
dlsym DL
source String
symbol = do
  String -> (CString -> IO (FunPtr a)) -> IO (FunPtr a)
forall a. String -> (CString -> IO a) -> IO a
withCAString String
symbol ((CString -> IO (FunPtr a)) -> IO (FunPtr a))
-> (CString -> IO (FunPtr a)) -> IO (FunPtr a)
forall a b. (a -> b) -> a -> b
$ \ CString
s -> do
    String -> (FunPtr a -> Bool) -> IO (FunPtr a) -> IO (FunPtr a)
forall a. String -> (a -> Bool) -> IO a -> IO a
throwDLErrorIf String
"dlsym" (FunPtr a -> FunPtr a -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr a
forall a. FunPtr a
nullFunPtr) (IO (FunPtr a) -> IO (FunPtr a)) -> IO (FunPtr a) -> IO (FunPtr a)
forall a b. (a -> b) -> a -> b
$ Ptr () -> CString -> IO (FunPtr a)
forall a. Ptr () -> CString -> IO (FunPtr a)
c_dlsym (DL -> Ptr ()
packDL DL
source) CString
s

-- |'undl' obtains the raw handle. You mustn't do something like
-- @withDL mod flags $ liftM undl >>= \ p -> use p@

undl :: DL -> Ptr ()
undl :: DL -> Ptr ()
undl = DL -> Ptr ()
packDL

throwDLErrorIf :: String -> (a -> Bool) -> IO a -> IO a
throwDLErrorIf :: forall a. String -> (a -> Bool) -> IO a -> IO a
throwDLErrorIf String
s a -> Bool
p IO a
f = do
  a
r <- IO a
f
  if (a -> Bool
p a
r)
    then IO String
dlerror IO String -> (String -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ String
err -> IOError -> IO a
forall a. IOError -> IO a
ioError (String -> IOError
userError ( String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err))
    else a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

throwDLErrorIf_ :: String -> (a -> Bool) -> IO a -> IO ()
throwDLErrorIf_ :: forall a. String -> (a -> Bool) -> IO a -> IO ()
throwDLErrorIf_ String
s a -> Bool
p IO a
f = String -> (a -> Bool) -> IO a -> IO a
forall a. String -> (a -> Bool) -> IO a -> IO a
throwDLErrorIf String
s a -> Bool
p IO a
f IO a -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- abstract handle for dynamically loaded module (EXPORTED)
--
newtype Module = Module (Ptr ())