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 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