This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ext/ + -Wall
[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
AD
177#ifdef RTLD_NOW
178 if (dl_nonlazy)
179 mode = RTLD_NOW;
a0d0e21e 180#endif
ff7f3c60
NIS
181 if (flags & 0x01)
182#ifdef RTLD_GLOBAL
183 mode |= RTLD_GLOBAL;
184#else
cea2e8a9 185 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
ff7f3c60 186#endif
bf49b057 187 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
c6c619a9
DM
188 handle = dlopen(filename, mode) ;
189 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) handle));
a0d0e21e 190 ST(0) = sv_newmortal() ;
c6c619a9 191 if (handle == NULL)
cea2e8a9 192 SaveError(aTHX_ "%s",dlerror()) ;
a0d0e21e 193 else
c6c619a9 194 sv_setiv( ST(0), PTR2IV(handle));
9d4ce9a5 195}
a0d0e21e 196
abb9e9dc
GS
197
198int
199dl_unload_file(libref)
200 void * libref
201 CODE:
d2560b70 202 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
fa2bf5b6 203 RETVAL = (dlclose(libref) == 0 ? 1 : 0);
9c1391b6 204 if (!RETVAL)
fa2bf5b6 205 SaveError(aTHX_ "%s", dlerror()) ;
abb9e9dc
GS
206 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
207 OUTPUT:
208 RETVAL
209
210
c6c619a9 211void
a0d0e21e
LW
212dl_find_symbol(libhandle, symbolname)
213 void * libhandle
214 char * symbolname
c6c619a9
DM
215 PREINIT:
216 void *sym;
a0d0e21e
LW
217 CODE:
218#ifdef DLSYM_NEEDS_UNDERSCORE
7a3f2258 219 symbolname = Perl_form_nocontext("_%s", symbolname);
a0d0e21e 220#endif
bf49b057 221 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
46fc3d4c
PP
222 "dl_find_symbol(handle=%lx, symbol=%s)\n",
223 (unsigned long) libhandle, symbolname));
c6c619a9 224 sym = dlsym(libhandle, symbolname);
bf49b057 225 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
c6c619a9 226 " symbolref = %lx\n", (unsigned long) sym));
a0d0e21e 227 ST(0) = sv_newmortal() ;
c6c619a9 228 if (sym == NULL)
cea2e8a9 229 SaveError(aTHX_ "%s",dlerror()) ;
a0d0e21e 230 else
c6c619a9 231 sv_setiv( ST(0), PTR2IV(sym));
a0d0e21e
LW
232
233
234void
235dl_undef_symbols()
c6c619a9 236 CODE:
a0d0e21e
LW
237
238
239
240# These functions should not need changing on any platform:
241
242void
243dl_install_xsub(perl_name, symref, filename="$Package")
244 char * perl_name
245 void * symref
246 char * filename
247 CODE:
bf49b057 248 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
248e2fea 249 perl_name, (unsigned long) symref));
cea2e8a9
GS
250 ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
251 (void(*)(pTHX_ CV *))symref,
252 filename)));
a0d0e21e
LW
253
254
255char *
256dl_error()
257 CODE:
258 RETVAL = LastError ;
259 OUTPUT:
260 RETVAL
261
262# end.