Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | /* dl_dlopen.xs |
2 | * | |
3 | * Platform: SunOS/Solaris, possibly others which use dlopen. | |
0536e0eb | 4 | * Author: Paul Marquess (Paul.Marquess@btinternet.com) |
a0d0e21e LW |
5 | * Created: 10th July 1994 |
6 | * | |
7 | * Modified: | |
abb9e9dc GS |
8 | * 15th July 1994 - Added code to explicitly save any error messages. |
9 | * 3rd August 1994 - Upgraded to v3 spec. | |
10 | * 9th August 1994 - Changed to use IV | |
11 | * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging, | |
12 | * basic FreeBSD support, removed ClearError | |
b7b1e41b | 13 | * 29th February 2000 - Alan Burlison: Added functionality to close dlopen'd |
abb9e9dc | 14 | * files when the interpreter exits |
fd46a708 | 15 | * 2015-03-12 - rurban: Added optional 3rd dl_find_symbol argument |
a0d0e21e LW |
16 | * |
17 | */ | |
18 | ||
19 | /* Porting notes: | |
20 | ||
21 | ||
22 | Definition of Sunos dynamic Linking functions | |
23 | ============================================= | |
24 | In order to make this implementation easier to understand here is a | |
25 | quick definition of the SunOS Dynamic Linking functions which are | |
26 | used here. | |
27 | ||
28 | dlopen | |
29 | ------ | |
30 | void * | |
31 | dlopen(path, mode) | |
32 | char * path; | |
33 | int mode; | |
34 | ||
35 | This function takes the name of a dynamic object file and returns | |
36 | a descriptor which can be used by dlsym later. It returns NULL on | |
37 | error. | |
38 | ||
39 | The mode parameter must be set to 1 for Solaris 1 and to | |
8e07c86e | 40 | RTLD_LAZY (==2) on Solaris 2. |
a0d0e21e LW |
41 | |
42 | ||
abb9e9dc GS |
43 | dlclose |
44 | ------- | |
45 | int | |
46 | dlclose(handle) | |
47 | void * handle; | |
48 | ||
49 | This function takes the handle returned by a previous invocation of | |
50 | dlopen and closes the associated dynamic object file. It returns zero | |
51 | on success, and non-zero on failure. | |
52 | ||
53 | ||
a0d0e21e LW |
54 | dlsym |
55 | ------ | |
56 | void * | |
57 | dlsym(handle, symbol) | |
58 | void * handle; | |
59 | char * symbol; | |
60 | ||
61 | Takes the handle returned from dlopen and the name of a symbol to | |
62 | get the address of. If the symbol was found a pointer is | |
63 | returned. It returns NULL on error. If DL_PREPEND_UNDERSCORE is | |
64 | defined an underscore will be added to the start of symbol. This | |
65 | is required on some platforms (freebsd). | |
66 | ||
67 | dlerror | |
68 | ------ | |
69 | char * dlerror() | |
70 | ||
71 | Returns a null-terminated string which describes the last error | |
72 | that occurred with either dlopen or dlsym. After each call to | |
73 | dlerror the error message will be reset to a null pointer. The | |
abb9e9dc | 74 | SaveError function is used to save the error as soon as it happens. |
a0d0e21e LW |
75 | |
76 | ||
77 | Return Types | |
78 | ============ | |
79 | In this implementation the two functions, dl_load_file & | |
80 | dl_find_symbol, return void *. This is because the underlying SunOS | |
81 | dynamic linker calls also return void *. This is not necessarily | |
82 | the case for all architectures. For example, some implementation | |
83 | will want to return a char * for dl_load_file. | |
84 | ||
85 | If void * is not appropriate for your architecture, you will have to | |
86 | change the void * to whatever you require. If you are not certain of | |
87 | how Perl handles C data types, I suggest you start by consulting | |
88 | Dean Roerich's Perl 5 API document. Also, have a look in the typemap | |
89 | file (in the ext directory) for a fairly comprehensive list of types | |
90 | that are already supported. If you are completely stuck, I suggest you | |
13934ef4 | 91 | post a message to perl5-porters, comp.lang.perl.misc or if you are really |
a0d0e21e LW |
92 | desperate to me. |
93 | ||
94 | Remember when you are making any changes that the return value from | |
95 | dl_load_file is used as a parameter in the dl_find_symbol | |
96 | function. Also the return value from find_symbol is used as a parameter | |
97 | to install_xsub. | |
98 | ||
99 | ||
100 | Dealing with Error Messages | |
101 | ============================ | |
102 | In order to make the handling of dynamic linking errors as generic as | |
103 | possible you should store any error messages associated with your | |
104 | implementation with the StoreError function. | |
105 | ||
106 | In the case of SunOS the function dlerror returns the error message | |
107 | associated with the last dynamic link error. As the SunOS dynamic | |
108 | linker functions dlopen & dlsym both return NULL on error every call | |
109 | to a SunOS dynamic link routine is coded like this | |
110 | ||
111 | RETVAL = dlopen(filename, 1) ; | |
112 | if (RETVAL == NULL) | |
113 | SaveError("%s",dlerror()) ; | |
114 | ||
115 | Note that SaveError() takes a printf format string. Use a "%s" as | |
42eb1a87 | 116 | the first parameter if the error may contain any % characters. |
a0d0e21e LW |
117 | |
118 | */ | |
119 | ||
53ca1a61 | 120 | #define PERL_NO_GET_CONTEXT |
73e43954 | 121 | #define PERL_EXT |
53ca1a61 | 122 | |
a0d0e21e | 123 | #include "EXTERN.h" |
11f610b5 | 124 | #define PERL_IN_DL_DLOPEN_XS |
a0d0e21e LW |
125 | #include "perl.h" |
126 | #include "XSUB.h" | |
127 | ||
128 | #ifdef I_DLFCN | |
129 | #include <dlfcn.h> /* the dynamic linker include file for Sunos/Solaris */ | |
130 | #else | |
131 | #include <nlist.h> | |
132 | #include <link.h> | |
133 | #endif | |
134 | ||
8e07c86e AD |
135 | #ifndef RTLD_LAZY |
136 | # define RTLD_LAZY 1 /* Solaris 1 */ | |
137 | #endif | |
138 | ||
a0d0e21e | 139 | #ifndef HAS_DLERROR |
5d94fbed AD |
140 | # ifdef __NetBSD__ |
141 | # define dlerror() strerror(errno) | |
142 | # else | |
143 | # define dlerror() "Unknown error - dlerror() not implemented" | |
144 | # endif | |
a0d0e21e LW |
145 | #endif |
146 | ||
147 | ||
148 | #include "dlutils.c" /* SaveError() etc */ | |
149 | ||
150 | ||
151 | static void | |
cea2e8a9 | 152 | dl_private_init(pTHX) |
a0d0e21e | 153 | { |
cea2e8a9 | 154 | (void)dl_generic_private_init(aTHX); |
a0d0e21e LW |
155 | } |
156 | ||
157 | MODULE = DynaLoader PACKAGE = DynaLoader | |
158 | ||
159 | BOOT: | |
cea2e8a9 | 160 | (void)dl_private_init(aTHX); |
a0d0e21e LW |
161 | |
162 | ||
c6c619a9 | 163 | void |
ff7f3c60 NIS |
164 | dl_load_file(filename, flags=0) |
165 | char * filename | |
166 | int flags | |
9d4ce9a5 | 167 | PREINIT: |
8e07c86e | 168 | int mode = RTLD_LAZY; |
c6c619a9 | 169 | void *handle; |
9d4ce9a5 GS |
170 | CODE: |
171 | { | |
172 | #if defined(DLOPEN_WONT_DO_RELATIVE_PATHS) | |
173 | char pathbuf[PATH_MAX + 2]; | |
174 | if (*filename != '/' && strchr(filename, '/')) { | |
00ebc5bd NC |
175 | const size_t filename_len = strlen(filename); |
176 | if (getcwd(pathbuf, PATH_MAX - filename_len)) { | |
177 | const size_t path_len = strlen(pathbuf); | |
178 | pathbuf[path_len] = '/'; | |
179 | filename = (char *) memcpy(pathbuf + path_len + 1, filename, filename_len + 1); | |
9d4ce9a5 GS |
180 | } |
181 | } | |
182 | #endif | |
8e07c86e | 183 | #ifdef RTLD_NOW |
cdc73a10 JH |
184 | { |
185 | dMY_CXT; | |
186 | if (dl_nonlazy) | |
187 | mode = RTLD_NOW; | |
188 | } | |
a0d0e21e | 189 | #endif |
ff7f3c60 NIS |
190 | if (flags & 0x01) |
191 | #ifdef RTLD_GLOBAL | |
192 | mode |= RTLD_GLOBAL; | |
193 | #else | |
cea2e8a9 | 194 | Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); |
ff7f3c60 | 195 | #endif |
bf49b057 | 196 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); |
c6c619a9 DM |
197 | handle = dlopen(filename, mode) ; |
198 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) handle)); | |
a0d0e21e | 199 | ST(0) = sv_newmortal() ; |
c6c619a9 | 200 | if (handle == NULL) |
cea2e8a9 | 201 | SaveError(aTHX_ "%s",dlerror()) ; |
a0d0e21e | 202 | else |
c6c619a9 | 203 | sv_setiv( ST(0), PTR2IV(handle)); |
9d4ce9a5 | 204 | } |
a0d0e21e | 205 | |
abb9e9dc GS |
206 | |
207 | int | |
208 | dl_unload_file(libref) | |
209 | void * libref | |
210 | CODE: | |
d2560b70 | 211 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref))); |
fa2bf5b6 | 212 | RETVAL = (dlclose(libref) == 0 ? 1 : 0); |
9c1391b6 | 213 | if (!RETVAL) |
fa2bf5b6 | 214 | SaveError(aTHX_ "%s", dlerror()) ; |
abb9e9dc GS |
215 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL)); |
216 | OUTPUT: | |
217 | RETVAL | |
218 | ||
219 | ||
c6c619a9 | 220 | void |
fd46a708 | 221 | dl_find_symbol(libhandle, symbolname, ign_err=0) |
a0d0e21e LW |
222 | void * libhandle |
223 | char * symbolname | |
fd46a708 | 224 | int ign_err |
c6c619a9 DM |
225 | PREINIT: |
226 | void *sym; | |
a0d0e21e LW |
227 | CODE: |
228 | #ifdef DLSYM_NEEDS_UNDERSCORE | |
7a3f2258 | 229 | symbolname = Perl_form_nocontext("_%s", symbolname); |
a0d0e21e | 230 | #endif |
bf49b057 | 231 | DLDEBUG(2, PerlIO_printf(Perl_debug_log, |
46fc3d4c | 232 | "dl_find_symbol(handle=%lx, symbol=%s)\n", |
233 | (unsigned long) libhandle, symbolname)); | |
c6c619a9 | 234 | sym = dlsym(libhandle, symbolname); |
bf49b057 | 235 | DLDEBUG(2, PerlIO_printf(Perl_debug_log, |
c6c619a9 | 236 | " symbolref = %lx\n", (unsigned long) sym)); |
fd46a708 RU |
237 | ST(0) = sv_newmortal(); |
238 | if (sym == NULL) { | |
239 | if (!ign_err) | |
240 | SaveError(aTHX_ "%s", dlerror()); | |
241 | } else | |
c6c619a9 | 242 | sv_setiv( ST(0), PTR2IV(sym)); |
a0d0e21e LW |
243 | |
244 | ||
245 | void | |
246 | dl_undef_symbols() | |
c6c619a9 | 247 | CODE: |
a0d0e21e LW |
248 | |
249 | ||
250 | ||
251 | # These functions should not need changing on any platform: | |
252 | ||
253 | void | |
254 | dl_install_xsub(perl_name, symref, filename="$Package") | |
255 | char * perl_name | |
256 | void * symref | |
d3f5e399 | 257 | const char * filename |
a0d0e21e | 258 | CODE: |
8141890a JH |
259 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%"UVxf")\n", |
260 | perl_name, PTR2UV(symref))); | |
77004dee NC |
261 | ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, |
262 | DPTR2FPTR(XSUBADDR_t, symref), | |
263 | filename, NULL, | |
264 | XS_DYNAMIC_FILENAME))); | |
a0d0e21e LW |
265 | |
266 | ||
bb6a367a | 267 | SV * |
a0d0e21e LW |
268 | dl_error() |
269 | CODE: | |
cdc73a10 | 270 | dMY_CXT; |
bb6a367a | 271 | RETVAL = newSVsv(MY_CXT.x_dl_last_error); |
a0d0e21e LW |
272 | OUTPUT: |
273 | RETVAL | |
274 | ||
8c472fc1 CB |
275 | #if defined(USE_ITHREADS) |
276 | ||
277 | void | |
278 | CLONE(...) | |
279 | CODE: | |
280 | MY_CXT_CLONE; | |
281 | ||
3bd46979 DM |
282 | PERL_UNUSED_VAR(items); |
283 | ||
8c472fc1 CB |
284 | /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid |
285 | * using Perl variables that belong to another thread, we create our | |
286 | * own for this thread. | |
287 | */ | |
c2b90b61 | 288 | MY_CXT.x_dl_last_error = newSVpvs(""); |
8c472fc1 CB |
289 | |
290 | #endif | |
291 | ||
a0d0e21e | 292 | # end. |