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