1 /* dl_dlopen.xs
2 *
3 * Platform: SunOS/Solaris, possibly others which use dlopen.
4 * Author: Paul Marquess (Paul.Marquess@btinternet.com)
5 * Created: 10th July 1994
6 *
7 * Modified:
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
13 * 29th February 2000 - Alan Burlison: Added functionality to close dlopen'd
14 * files when the interpreter exits
15 * 2015-03-12 - rurban: Added optional 3rd dl_find_symbol argument
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
40 RTLD_LAZY (==2) on Solaris 2.
41
42
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
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
74 SaveError function is used to save the error as soon as it happens.
75
76 Note that the POSIX standard does not require a per-thread buffer for
77 the error message, and so on multi-threaded builds, it can be overwritten
78 by another thread before SaveError accomplishes its task. Some systems do
79 have a per-thread buffer. The man page on your system should tell you.
80 If your code might be run on a system where this function is not thread
81 safe, you should protect your calls with mutexes. See "Dealing with Error
82 Messages" below.
83
84
85 Return Types
86 ============
87 In this implementation the two functions, dl_load_file &
88 dl_find_symbol, return void *. This is because the underlying SunOS
89 dynamic linker calls also return void *. This is not necessarily
90 the case for all architectures. For example, some implementation
91 will want to return a char * for dl_load_file.
92
93 If void * is not appropriate for your architecture, you will have to
94 change the void * to whatever you require. If you are not certain of
95 how Perl handles C data types, I suggest you start by consulting
96 Dean Roerich's Perl 5 API document. Also, have a look in the typemap
97 file (in the ext directory) for a fairly comprehensive list of types
98 that are already supported. If you are completely stuck, I suggest you
99 post a message to perl5-porters.
100
101 Remember when you are making any changes that the return value from
102 dl_load_file is used as a parameter in the dl_find_symbol
103 function. Also the return value from find_symbol is used as a parameter
104 to install_xsub.
105
106
107 Dealing with Error Messages
108 ============================
109 In order to make the handling of dynamic linking errors as generic as
110 possible you should store any error messages associated with your
111 implementation with the SaveError function.
112
113 In the case of SunOS the function dlerror returns the error message
114 associated with the last dynamic link error. As the SunOS dynamic
115 linker functions dlopen & dlsym both return NULL on error every call
116 to a SunOS dynamic link routine is coded like this
117
118 RETVAL = dlopen(filename, 1) ;
119 if (RETVAL == NULL)
120 SaveError("%s",dlerror()) ;
121
122 Note that SaveError() takes a printf format string. Use a "%s" as
123 the first parameter if the error may contain any % characters.
124 dlerror() may not be thread-safe on some systems; if this code is run on
125 any of those, a mutex should be added. khw (who added this comment) has no
126 idea which systems aren't thread-safe, but consider this possibility when
127 debugging.
128
129 */
130
131 #define PERL_NO_GET_CONTEXT
132 #define PERL_EXT
133
134 #include "EXTERN.h"
135 #define PERL_IN_DL_DLOPEN_XS
136 #include "perl.h"
137 #include "XSUB.h"
138
139 #ifdef I_DLFCN
140 #include <dlfcn.h> /* the dynamic linker include file for Sunos/Solaris */
141 #else
142 #include <nlist.h>
143 #include <link.h>
144 #endif
145
146 #ifndef RTLD_LAZY
147 # define RTLD_LAZY 1 /* Solaris 1 */
148 #endif
149
150 #ifndef HAS_DLERROR
151 # ifdef __NetBSD__
152 # define dlerror() strerror(errno)
153 # else
154 # define dlerror() "Unknown error - dlerror() not implemented"
155 # endif
156 #endif
157
158
159 #include "dlutils.c" /* SaveError() etc */
160
161
162 static void
dl_private_init(pTHX)163 dl_private_init(pTHX)
164 {
165 (void)dl_generic_private_init(aTHX);
166 }
167
168 MODULE = DynaLoader PACKAGE = DynaLoader
169
170 BOOT:
171 (void)dl_private_init(aTHX);
172
173
174 void
175 dl_load_file(filename, flags=0)
176 char * filename
177 int flags
178 PREINIT:
179 int mode = RTLD_LAZY;
180 void *handle;
181 CODE:
182 {
183 #if defined(DLOPEN_WONT_DO_RELATIVE_PATHS)
184 char pathbuf[PATH_MAX + 2];
185 if (*filename != '/' && strchr(filename, '/')) {
186 const size_t filename_len = strlen(filename);
187 if (getcwd(pathbuf, PATH_MAX - filename_len)) {
188 const size_t path_len = strlen(pathbuf);
189 pathbuf[path_len] = '/';
190 filename = (char *) memcpy(pathbuf + path_len + 1, filename, filename_len + 1);
191 }
192 }
193 #endif
194 #ifdef RTLD_NOW
195 {
196 dMY_CXT;
197 if (dl_nonlazy)
198 mode = RTLD_NOW;
199 }
200 #endif
201 if (flags & 0x01)
202 #ifdef RTLD_GLOBAL
203 mode |= RTLD_GLOBAL;
204 #else
205 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
206 #endif
207 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
208 handle = dlopen(filename, mode) ;
209 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) handle));
210 ST(0) = newSV_type_mortal(SVt_IV);
211 if (handle == NULL)
212 SaveError(aTHX_ "%s",dlerror()) ;
213 else
214 sv_setiv( ST(0), PTR2IV(handle));
215 }
216
217
218 int
219 dl_unload_file(libref)
220 void * libref
221 CODE:
222 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
223 RETVAL = (dlclose(libref) == 0 ? 1 : 0);
224 if (!RETVAL)
225 SaveError(aTHX_ "%s", dlerror()) ;
226 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
227 OUTPUT:
228 RETVAL
229
230
231 void
232 dl_find_symbol(libhandle, symbolname, ign_err=0)
233 void * libhandle
234 char * symbolname
235 int ign_err
236 PREINIT:
237 void *sym;
238 CODE:
239 #ifdef DLSYM_NEEDS_UNDERSCORE
240 symbolname = Perl_form_nocontext("_%s", symbolname);
241 #endif
242 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
243 "dl_find_symbol(handle=%lx, symbol=%s)\n",
244 (unsigned long) libhandle, symbolname));
245 sym = dlsym(libhandle, symbolname);
246 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
247 " symbolref = %lx\n", (unsigned long) sym));
248 ST(0) = newSV_type_mortal(SVt_IV);
249 if (sym == NULL) {
250 if (!ign_err)
251 SaveError(aTHX_ "%s", dlerror());
252 } else
253 sv_setiv( ST(0), PTR2IV(sym));
254
255
256 void
257 dl_undef_symbols()
258 CODE:
259
260
261
262 # These functions should not need changing on any platform:
263
264 void
265 dl_install_xsub(perl_name, symref, filename="$Package")
266 char * perl_name
267 void * symref
268 const char * filename
269 CODE:
270 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%" UVxf ")\n",
271 perl_name, PTR2UV(symref)));
272 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
273 DPTR2FPTR(XSUBADDR_t, symref),
274 filename, NULL,
275 XS_DYNAMIC_FILENAME)));
276
277
278 SV *
279 dl_error()
280 CODE:
281 dMY_CXT;
282 RETVAL = newSVsv(MY_CXT.x_dl_last_error);
283 OUTPUT:
284 RETVAL
285
286 #if defined(USE_ITHREADS)
287
288 void
289 CLONE(...)
290 CODE:
291 MY_CXT_CLONE;
292
293 PERL_UNUSED_VAR(items);
294
295 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
296 * using Perl variables that belong to another thread, we create our
297 * own for this thread.
298 */
299 MY_CXT.x_dl_last_error = newSVpvs("");
300
301 #endif
302
303 # end.
304