ext/DynaLoader/dl_dlopen.xs

   1 /* dl_dlopen.xs
   2  *
   3  * Platform:    SunOS/Solaris, possibly others which use dlopen.
   4  * Author:      Paul Marquess (pmarquess@bfsec.bt.co.uk)
   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  *
  14  */
  15
  16 /* Porting notes:
  17
  18
  19    Definition of Sunos dynamic Linking functions
  20    =============================================
  21    In order to make this implementation easier to understand here is a
  22    quick definition of the SunOS Dynamic Linking functions which are
  23    used here.
  24
  25    dlopen
  26    ------
  27      void *
  28      dlopen(path, mode)
  29      char * path;
  30      int    mode;
  31
  32      This function takes the name of a dynamic object file and returns
  33      a descriptor which can be used by dlsym later. It returns NULL on
  34      error.
  35
  36      The mode parameter must be set to 1 for Solaris 1 and to
  37      RTLD_LAZY (==2) on Solaris 2.
  38
  39
  40    dlsym
  41    ------
  42      void *
  43      dlsym(handle, symbol)
  44      void * handle;
  45      char * symbol;
  46
  47      Takes the handle returned from dlopen and the name of a symbol to
  48      get the address of. If the symbol was found a pointer is
  49      returned.  It returns NULL on error. If DL_PREPEND_UNDERSCORE is
  50      defined an underscore will be added to the start of symbol. This
  51      is required on some platforms (freebsd).
  52
  53    dlerror
  54    ------
  55      char * dlerror()
  56
  57      Returns a null-terminated string which describes the last error
  58      that occurred with either dlopen or dlsym. After each call to
  59      dlerror the error message will be reset to a null pointer. The
  60      SaveError function is used to save the error as soo as it happens.
  61
  62
  63    Return Types
  64    ============
  65    In this implementation the two functions, dl_load_file &
  66    dl_find_symbol, return void *. This is because the underlying SunOS
  67    dynamic linker calls also return void *.  This is not necessarily
  68    the case for all architectures. For example, some implementation
  69    will want to return a char * for dl_load_file.
  70
  71    If void * is not appropriate for your architecture, you will have to
  72    change the void * to whatever you require. If you are not certain of
  73    how Perl handles C data types, I suggest you start by consulting
  74    Dean Roerich's Perl 5 API document. Also, have a look in the typemap
  75    file (in the ext directory) for a fairly comprehensive list of types
  76    that are already supported. If you are completely stuck, I suggest you
  77    post a message to perl5-porters, comp.lang.perl.misc or if you are really
  78    desperate to me.
  79
  80    Remember when you are making any changes that the return value from
  81    dl_load_file is used as a parameter in the dl_find_symbol
  82    function. Also the return value from find_symbol is used as a parameter
  83    to install_xsub.
  84
  85
  86    Dealing with Error Messages
  87    ============================
  88    In order to make the handling of dynamic linking errors as generic as
  89    possible you should store any error messages associated with your
  90    implementation with the StoreError function.
  91
  92    In the case of SunOS the function dlerror returns the error message
  93    associated with the last dynamic link error. As the SunOS dynamic
  94    linker functions dlopen & dlsym both return NULL on error every call
  95    to a SunOS dynamic link routine is coded like this
  96
  97         RETVAL = dlopen(filename, 1) ;
  98         if (RETVAL == NULL)
  99             SaveError("%s",dlerror()) ;
 100
 101    Note that SaveError() takes a printf format string. Use a "%s" as
 102    the first parameter if the error may contain and % characters.
 103
 104 */
 105
 106 #include "EXTERN.h"
 107 #include "perl.h"
 108 #include "XSUB.h"
 109
 110 #ifdef I_DLFCN
 111 #include <dlfcn.h>      /* the dynamic linker include file for Sunos/Solaris */
 112 #else
 113 #include <nlist.h>
 114 #include <link.h>
 115 #endif
 116
 117 #ifndef RTLD_LAZY
 118 # define RTLD_LAZY 1    /* Solaris 1 */
 119 #endif
 120
 121 #ifndef HAS_DLERROR
 122 # ifdef __NetBSD__
 123 #  define dlerror() strerror(errno)
 124 # else
 125 #  define dlerror() "Unknown error - dlerror() not implemented"
 126 # endif
 127 #endif
 128
 129
 130 #include "dlutils.c"    /* SaveError() etc      */
 131
 132
 133 static void
 134 dl_private_init(pTHX)
 135 {
 136     (void)dl_generic_private_init(aTHX);
 137 }
 138
 139 MODULE = DynaLoader     PACKAGE = DynaLoader
 140
 141 BOOT:
 142     (void)dl_private_init(aTHX);
 143
 144
 145 void *
 146 dl_load_file(filename, flags=0)
 147     char *      filename
 148     int         flags
 149     PREINIT:
 150     int mode = RTLD_LAZY;
 151     CODE:
 152 #ifdef RTLD_NOW
 153     if (dl_nonlazy)
 154         mode = RTLD_NOW;
 155 #endif
 156     if (flags & 0x01)
 157 #ifdef RTLD_GLOBAL
 158         mode |= RTLD_GLOBAL;
 159 #else
 160         Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
 161 #endif
 162     DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
 163     RETVAL = dlopen(filename, mode) ;
 164     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL));
 165     ST(0) = sv_newmortal() ;
 166     if (RETVAL == NULL)
 167         SaveError(aTHX_ "%s",dlerror()) ;
 168     else
 169         sv_setiv( ST(0), (IV)RETVAL);
 170
 171
 172 void *
 173 dl_find_symbol(libhandle, symbolname)
 174     void *      libhandle
 175     char *      symbolname
 176     CODE:
 177 #ifdef DLSYM_NEEDS_UNDERSCORE
 178     symbolname = form("_%s", symbolname);
 179 #endif
 180     DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
 181                              "dl_find_symbol(handle=%lx, symbol=%s)\n",
 182                              (unsigned long) libhandle, symbolname));
 183     RETVAL = dlsym(libhandle, symbolname);
 184     DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
 185                              "  symbolref = %lx\n", (unsigned long) RETVAL));
 186     ST(0) = sv_newmortal() ;
 187     if (RETVAL == NULL)
 188         SaveError(aTHX_ "%s",dlerror()) ;
 189     else
 190         sv_setiv( ST(0), (IV)RETVAL);
 191
 192
 193 void
 194 dl_undef_symbols()
 195     PPCODE:
 196
 197
 198
 199 # These functions should not need changing on any platform:
 200
 201 void
 202 dl_install_xsub(perl_name, symref, filename="$Package")
 203     char *              perl_name
 204     void *              symref
 205     char *              filename
 206     CODE:
 207     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
 208                 perl_name, (unsigned long) symref));
 209     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
 210                                         (void(*)(pTHX_ CV *))symref,
 211                                         filename)));
 212
 213
 214 char *
 215 dl_error()
 216     CODE:
 217     RETVAL = LastError ;
 218     OUTPUT:
 219     RETVAL
 220
 221 # end.