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
131
132
133
|
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module : System.Posix.DynamicLinker.Prim
-- 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 and friend
-- 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.Prim (
-- * low level API
c_dlopen,
c_dlsym,
c_dlerror,
c_dlclose,
-- dlAddr, -- XXX NYI
haveRtldNext,
haveRtldLocal,
packRTLDFlags,
RTLDFlags(..),
packDL,
DL(..),
)
where
#include "HsUnix.h"
import Data.Bits ( (.|.) )
import Foreign.Ptr ( Ptr, FunPtr, nullPtr )
import Foreign.C.Types
import Foreign.C.String ( CString )
-- |On some hosts (e.g. SuSe and Ubuntu Linux) 'RTLD_NEXT' (and
-- 'RTLD_DEFAULT') are not visible without setting the macro
-- '_GNU_SOURCE'. Since we don't want to define this macro, you can use
-- the function 'haveRtldNext' to check wether the flag `Next` is
-- available. Ideally, this will be optimized by the compiler so that it
-- should be as efficient as an #ifdef.
--
-- If you fail to test the flag and use it although it is undefined,
-- 'packDL' will throw an error.
--
-- The same applies to RTLD_LOCAL which isn't available on
-- cygwin.
haveRtldNext :: Bool
#ifdef HAVE_RTLDNEXT
haveRtldNext = True
foreign import ccall unsafe "__hsunix_rtldNext" rtldNext :: Ptr a
#else /* HAVE_RTLDNEXT */
haveRtldNext = False
#endif /* HAVE_RTLDNEXT */
#ifdef HAVE_RTLDDEFAULT
foreign import ccall unsafe "__hsunix_rtldDefault" rtldDefault :: Ptr a
#endif /* HAVE_RTLDDEFAULT */
haveRtldLocal :: Bool
#ifdef HAVE_RTLDLOCAL
haveRtldLocal = True
#else /* HAVE_RTLDLOCAL */
haveRtldLocal = False
#endif /* HAVE_RTLDLOCAL */
-- |Flags for 'System.Posix.DynamicLinker.dlopen'.
data RTLDFlags
= RTLD_LAZY
| RTLD_NOW
| RTLD_GLOBAL
| RTLD_LOCAL
deriving (Show, Read)
foreign import ccall unsafe "dlopen" c_dlopen :: CString -> CInt -> IO (Ptr ())
foreign import ccall unsafe "dlsym" c_dlsym :: Ptr () -> CString -> IO (FunPtr a)
foreign import ccall unsafe "dlerror" c_dlerror :: IO CString
foreign import ccall unsafe "dlclose" c_dlclose :: (Ptr ()) -> IO CInt
packRTLDFlags :: [RTLDFlags] -> CInt
packRTLDFlags flags = foldl (\ s f -> (packRTLDFlag f) .|. s) 0 flags
packRTLDFlag :: RTLDFlags -> CInt
packRTLDFlag RTLD_LAZY = #const RTLD_LAZY
packRTLDFlag RTLD_NOW = #const RTLD_NOW
packRTLDFlag RTLD_GLOBAL = #const RTLD_GLOBAL
#ifdef HAVE_RTLDLOCAL
packRTLDFlag RTLD_LOCAL = #const RTLD_LOCAL
#else /* HAVE_RTLDLOCAL */
packRTLDFlag RTLD_LOCAL = error "RTLD_LOCAL not available"
#endif /* HAVE_RTLDLOCAL */
-- |Flags for 'System.Posix.DynamicLinker.dlsym'. Notice that 'Next'
-- might not be available on your particular platform! Use
-- `haveRtldNext`.
--
-- If 'RTLD_DEFAULT' is not defined on your platform, `packDL` `Default`
-- reduces to 'nullPtr'.
data DL = Null | Next | Default | DLHandle (Ptr ()) deriving (Show)
packDL :: DL -> Ptr ()
packDL Null = nullPtr
#ifdef HAVE_RTLDNEXT
packDL Next = rtldNext
#else
packDL Next = error "RTLD_NEXT not available"
#endif
#ifdef HAVE_RTLDDEFAULT
packDL Default = rtldDefault
#else
packDL Default = nullPtr
#endif
packDL (DLHandle h) = h
|
