ext/DynaLoader/dlutils.c

   1 /* dlutils.c - handy functions and definitions for dl_*.xs files
   2  *
   3  * Currently this file is simply #included into dl_*.xs/.c files.
   4  * It should really be split into a dlutils.h and dlutils.c
   5  *
   6  * Modified:
   7  * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
   8  *                      files when the interpreter exits
   9  */
  10
  11 #ifndef XS_VERSION
  12 #  define XS_VERSION "0"
  13 #endif
  14 #define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION
  15
  16 typedef struct {
  17     char *      x_dl_last_error;        /* pointer to allocated memory for
  18                                            last error message */
  19     int         x_dl_nonlazy;           /* flag for immediate rather than lazy
  20                                            linking (spots unresolved symbol) */
  21 #ifdef DL_LOADONCEONLY
  22     HV *        x_dl_loaded_files;      /* only needed on a few systems */
  23 #endif
  24 #ifdef DL_CXT_EXTRA
  25     my_cxtx_t   x_dl_cxtx;              /* extra platform-specific data */
  26 #endif
  27 #ifdef DEBUGGING
  28     int         x_dl_debug;     /* value copied from $DynaLoader::dl_debug */
  29 #endif
  30 } my_cxt_t;
  31
  32 START_MY_CXT
  33
  34 #define dl_last_error   (MY_CXT.x_dl_last_error)
  35 #define dl_nonlazy      (MY_CXT.x_dl_nonlazy)
  36 #ifdef DL_LOADONCEONLY
  37 #define dl_loaded_files (MY_CXT.x_dl_loaded_files)
  38 #endif
  39 #ifdef DL_CXT_EXTRA
  40 #define dl_cxtx         (MY_CXT.x_dl_cxtx)
  41 #endif
  42 #ifdef DEBUGGING
  43 #define dl_debug        (MY_CXT.x_dl_debug)
  44 #endif
  45
  46 #ifdef DEBUGGING
  47 #define DLDEBUG(level,code) \
  48     STMT_START {                                        \
  49         dMY_CXT;                                        \
  50         if (dl_debug>=level) { code; }                  \
  51     } STMT_END
  52 #else
  53 #define DLDEBUG(level,code)     NOOP
  54 #endif
  55
  56 #ifdef DL_UNLOAD_ALL_AT_EXIT
  57 /* Close all dlopen'd files */
  58 static void
  59 dl_unload_all_files(pTHX_ void *unused)
  60 {
  61     CV *sub;
  62     AV *dl_librefs;
  63     SV *dl_libref;
  64
  65     if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) {
  66         dl_librefs = get_av("DynaLoader::dl_librefs", FALSE);
  67         while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
  68            dSP;
  69            ENTER;
  70            SAVETMPS;
  71            PUSHMARK(SP);
  72            XPUSHs(sv_2mortal(dl_libref));
  73            PUTBACK;
  74            call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
  75            FREETMPS;
  76            LEAVE;
  77         }
  78     }
  79 }
  80 #endif
  81
  82 static void
  83 dl_generic_private_init(pTHX)   /* called by dl_*.xs dl_private_init() */
  84 {
  85     char *perl_dl_nonlazy;
  86     MY_CXT_INIT;
  87
  88     dl_last_error = NULL;
  89     dl_nonlazy = 0;
  90 #ifdef DL_LOADONCEONLY
  91     dl_loaded_files = Nullhv;
  92 #endif
  93 #ifdef DEBUGGING
  94     {
  95         SV *sv = get_sv("DynaLoader::dl_debug", 0);
  96         dl_debug = sv ? SvIV(sv) : 0;
  97     }
  98 #endif
  99     if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
 100         dl_nonlazy = atoi(perl_dl_nonlazy);
 101     if (dl_nonlazy)
 102         DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
 103 #ifdef DL_LOADONCEONLY
 104     if (!dl_loaded_files)
 105         dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
 106 #endif
 107 #ifdef DL_UNLOAD_ALL_AT_EXIT
 108     call_atexit(&dl_unload_all_files, (void*)0);
 109 #endif
 110 }
 111
 112
 113 /* SaveError() takes printf style args and saves the result in dl_last_error */
 114 static void
 115 SaveError(pTHX_ char* pat, ...)
 116 {
 117     dMY_CXT;
 118     va_list args;
 119     SV *msv;
 120     char *message;
 121     STRLEN len;
 122
 123     /* This code is based on croak/warn, see mess() in util.c */
 124
 125     va_start(args, pat);
 126     msv = vmess(pat, &args);
 127     va_end(args);
 128
 129     message = SvPV(msv,len);
 130     len++;              /* include terminating null char */
 131
 132     /* Allocate some memory for the error message */
 133     if (dl_last_error)
 134         dl_last_error = (char*)saferealloc(dl_last_error, len);
 135     else
 136         dl_last_error = (char*)safemalloc(len);
 137
 138     /* Copy message into dl_last_error (including terminating null char) */
 139     strncpy(dl_last_error, message, len) ;
 140     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
 141 }
 142