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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
{-# LANGUAGE ForeignFunctionInterface #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module : System.Posix.DynamicLinker.Module
-- 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)
--
-- DLOpen support, old API
-- Derived from GModule.chs by M.Weber & M.Chakravarty which is part of c2hs
-- I left the API more or less the same, mostly the flags are different.
--
-----------------------------------------------------------------------------
module System.Posix.DynamicLinker.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
--
-- withModule (Just ".") ("libfoo.so") [RTLD_NOW] $ \ mod -> do
-- funptr <- moduleSymbol mod "mogrify"
-- let fun = fun__ funptr
-- withCString "test" $ \ str -> do
-- strptr <- fun str 1
-- strstr <- peekCString strptr
-- ...
Module
, moduleOpen -- :: String -> ModuleFlags -> IO Module
, moduleSymbol -- :: Source -> String -> IO (FunPtr a)
, moduleClose -- :: Module -> IO Bool
, moduleError -- :: IO String
, withModule -- :: Maybe String
-- -> String
-- -> [ModuleFlags ]
-- -> (Module -> IO a)
-- -> IO a
, withModule_ -- :: Maybe String
-- -> String
-- -> [ModuleFlags]
-- -> (Module -> IO a)
-- -> IO ()
)
where
#include "HsUnix.h"
import System.Posix.DynamicLinker
import Foreign.Ptr ( Ptr, nullPtr, FunPtr )
#if __GLASGOW_HASKELL__ > 611
import System.Posix.Internals ( withFilePath )
#else
import Foreign.C.String ( withCString )
withFilePath :: FilePath -> (CString -> IO a) -> IO a
withFilePath = withCString
#endif
-- abstract handle for dynamically loaded module (EXPORTED)
--
newtype Module = Module (Ptr ())
unModule :: Module -> (Ptr ())
unModule (Module adr) = adr
-- Opens a module (EXPORTED)
--
moduleOpen :: String -> [RTLDFlags] -> IO Module
moduleOpen file flags = do
modPtr <- withFilePath file $ \ modAddr -> c_dlopen modAddr (packRTLDFlags flags)
if (modPtr == nullPtr)
then moduleError >>= \ err -> ioError (userError ("dlopen: " ++ err))
else return $ Module modPtr
-- Gets a symbol pointer from a module (EXPORTED)
--
moduleSymbol :: Module -> String -> IO (FunPtr a)
moduleSymbol file sym = dlsym (DLHandle (unModule file)) sym
-- Closes a module (EXPORTED)
--
moduleClose :: Module -> IO ()
moduleClose file = dlclose (DLHandle (unModule file))
-- Gets a string describing the last module error (EXPORTED)
--
moduleError :: IO String
moduleError = dlerror
-- Convenience function, cares for module open- & closing
-- additionally returns status of `moduleClose' (EXPORTED)
--
withModule :: Maybe String
-> String
-> [RTLDFlags]
-> (Module -> IO a)
-> IO a
withModule mdir file flags p = do
let modPath = case mdir of
Nothing -> file
Just dir -> dir ++ if ((head (reverse dir)) == '/')
then file
else ('/':file)
modu <- moduleOpen modPath flags
result <- p modu
moduleClose modu
return result
withModule_ :: Maybe String
-> String
-> [RTLDFlags]
-> (Module -> IO a)
-> IO ()
withModule_ dir file flags p = withModule dir file flags p >>= \ _ -> return ()
|
