1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module : System.Posix.DynamicLinker
-- 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 (
module System.Posix.DynamicLinker.Prim,
dlopen,
dlsym,
dlerror,
dlclose,
withDL, withDL_,
undl,
)
-- 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
#include "HsUnix.h"
import System.Posix.DynamicLinker.Prim
import Control.Exception ( bracket )
import Control.Monad ( liftM )
import Foreign.Ptr ( Ptr, nullPtr, FunPtr, nullFunPtr )
import Foreign.C.String
#if __GLASGOW_HASKELL__ > 611
import System.Posix.Internals ( withFilePath )
#else
withFilePath :: FilePath -> (CString -> IO a) -> IO a
withFilePath = withCString
#endif
dlopen :: FilePath -> [RTLDFlags] -> IO DL
dlopen path flags = do
withFilePath path $ \ p -> do
liftM DLHandle $ throwDLErrorIf "dlopen" (== nullPtr) $ c_dlopen p (packRTLDFlags flags)
dlclose :: DL -> IO ()
dlclose (DLHandle h) = throwDLErrorIf_ "dlclose" (/= 0) $ c_dlclose h
dlclose h = error $ "dlclose: invalid argument" ++ (show h)
dlerror :: IO String
dlerror = c_dlerror >>= 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 source symbol = do
withCAString symbol $ \ s -> do
throwDLErrorIf "dlsym" (== nullFunPtr) $ c_dlsym (packDL source) s
withDL :: String -> [RTLDFlags] -> (DL -> IO a) -> IO a
withDL file flags f = bracket (dlopen file flags) (dlclose) f
withDL_ :: String -> [RTLDFlags] -> (DL -> IO a) -> IO ()
withDL_ file flags f = withDL file flags f >> return ()
-- |'undl' obtains the raw handle. You mustn't do something like
-- @withDL mod flags $ liftM undl >>= \ p -> use p@
undl :: DL -> Ptr ()
undl = packDL
throwDLErrorIf :: String -> (a -> Bool) -> IO a -> IO a
throwDLErrorIf s p f = do
r <- f
if (p r)
then dlerror >>= \ err -> ioError (userError ( s ++ ": " ++ err))
else return r
throwDLErrorIf_ :: String -> (a -> Bool) -> IO a -> IO ()
throwDLErrorIf_ s p f = throwDLErrorIf s p f >> return ()
|
