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
|
{-# OPTIONS -fffi #-}
-----------------------------------------------------------------------------
-- |
-- 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 ( CInt )
import Foreign.C.String ( CString )
-- RTLD_NEXT madness
-- On some host (e.g. SuSe Linux 7.2) RTLD_NEXT is not visible
-- without setting _GNU_SOURCE. Since we don't want to set this
-- flag, here's a different solution: You can use the Haskell
-- function 'haveRtldNext' to check wether the flag is available
-- to you. 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, 'packOneModuleFlag' will bomb.
-- 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 */
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
#ifdef HAVE_RTLDNOW
packRTLDFlag RTLD_NOW = #const RTLD_NOW
#else /* HAVE_RTLDNOW */
packRTLDFlag RTLD_NOW = error "RTLD_NOW not available"
#endif /* HAVE_RTLDNOW */
#ifdef HAVE_RTLDGLOBAL
packRTLDFlag RTLD_GLOBAL = #const RTLD_GLOBAL
#else /* HAVE_RTLDGLOBAL */
packRTLDFlag RTLD_GLOBAL = error "RTLD_GLOBAL not available"
#endif
#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!
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
|
