diff --git a/libguile/dynl.c b/libguile/dynl.c index a2ae6e2..149ed26 100644 *** a/libguile/dynl.c --- b/libguile/dynl.c *************** *** 26,31 **** --- 26,33 ---- #endif #include + #include + #include /* "dynl.c" dynamically link&load object files. Author: Aubrey Jaffer *************** *** 37,43 **** solution would probably be a shared libgcc. */ #undef NDEBUG - #include static void maybe_drag_in_eprintf () --- 39,44 ---- *************** *** 75,92 **** */ /* njrev: not threadsafe, protection needed as described above */ static void * sysdep_dynl_link (const char *fname, const char *subr) { lt_dlhandle handle; ! if (fname != NULL) ! handle = lt_dlopenext (fname); else ! /* Return a handle for the program as a whole. */ ! handle = lt_dlopen (NULL); ! if (NULL == handle) { SCM fn; SCM msg; --- 76,165 ---- */ /* njrev: not threadsafe, protection needed as described above */ + + /* 'system_extensions_path' is used by 'sysdep_dynl_link' to search for + dynamic libraries as a last resort, when they cannot be found in the + usual library search paths. */ + static char *system_extensions_path; + static void * sysdep_dynl_link (const char *fname, const char *subr) { lt_dlhandle handle; ! if (fname == NULL) ! { ! /* Return a handle for the program as a whole. */ ! handle = lt_dlopen (NULL); ! } else ! { ! handle = lt_dlopenext (fname); ! ! if (handle == NULL ! #ifdef LT_DIRSEP_CHAR ! && strchr (fname, LT_DIRSEP_CHAR) == NULL ! #endif ! && strchr (fname, '/') == NULL) ! { ! /* 'fname' contains no directory separators and was not in the ! usual library search paths, so now we search for it in the ! directories specified in 'system_extensions_path'. */ ! char *fname_attempt = malloc (strlen (system_extensions_path) ! + strlen (fname) ! + 1 /* for directory separator */ ! + 1); /* for null terminator */ ! char *path; /* remaining path to search */ ! char *end; /* end of current path component */ ! char *s; ! ! if (fname_attempt != NULL) ! { ! scm_dynwind_begin (0); ! scm_dynwind_free (fname_attempt); ! ! /* Iterate over the components of 'system_extensions_path' */ ! for (path = system_extensions_path; ! *path != '\0'; ! path = (*end == '\0') ? end : (end + 1)) ! { ! /* Find end of pathname component */ ! end = strchr (path, LT_PATHSEP_CHAR); ! if (end == NULL) ! end = strchr (path, '\0'); ! ! /* Skip empty path components */ ! if (path == end) ! continue; ! ! /* Construct 'fname_attempt', starting with path component */ ! s = fname_attempt; ! memcpy (s, path, end - path); ! s += end - path; ! ! /* Append directory separator, but avoid duplicates */ ! if (s[-1] != '/' ! #ifdef LT_DIRSEP_CHAR ! && s[-1] != LT_DIRSEP_CHAR ! #endif ! ) ! *s++ = '/'; ! ! /* Finally, append 'fname' with null terminator */ ! strcpy (s, fname); ! ! /* Try to load it, and terminate the search if successful */ ! handle = lt_dlopenext (fname_attempt); ! if (handle != NULL) ! break; ! } ! ! scm_dynwind_end (); ! } ! } ! } ! if (handle == NULL) { SCM fn; SCM msg; *************** *** 120,149 **** return fptr; } - /* Augment environment variable VARIABLE with VALUE, assuming VARIABLE - is a path kind of variable. */ - static void - augment_env (const char *variable, const char *value) - { - const char *env; - - env = getenv (variable); - if (env != NULL) - { - char *new_value; - static const char path_sep[] = { LT_PATHSEP_CHAR, 0 }; - - new_value = alloca (strlen (env) + strlen (value) + 2); - strcpy (new_value, env); - strcat (new_value, path_sep); - strcat (new_value, value); - - setenv (variable, new_value, 1); - } - else - setenv (variable, value, 1); - } - static void sysdep_dynl_init () { --- 193,198 ---- *************** *** 151,176 **** lt_dlinit (); env = getenv ("GUILE_SYSTEM_EXTENSIONS_PATH"); ! if (env && strcmp (env, "") == 0) ! /* special-case interpret system-ltdl-path=="" as meaning no system path, ! which is the case during the build */ ! ; ! else if (env) ! /* FIXME: should this be a colon-separated path? Or is the only point to ! allow the build system to turn off the installed extensions path? */ ! lt_dladdsearchdir (env); else { ! /* Add SCM_LIB_DIR and SCM_EXTENSIONS_DIR to the loader's search ! path. `lt_dladdsearchdir' and $LTDL_LIBRARY_PATH can't be used ! for that because they are searched before the system-dependent ! search path, which is the one `libtool --mode=execute -dlopen' ! fiddles with (info "(libtool) Libltdl Interface"). See ! ! for details. */ ! augment_env (SHARED_LIBRARY_PATH_VARIABLE, SCM_LIB_DIR); ! augment_env (SHARED_LIBRARY_PATH_VARIABLE, SCM_EXTENSIONS_DIR); } } --- 200,232 ---- lt_dlinit (); + /* Initialize 'system_extensions_path' from + $GUILE_SYSTEM_EXTENSIONS_PATH, or if that's not set: + . + + 'lt_dladdsearchdir' can't be used because it is searched before the + system-dependent search path, which is the one 'libtool + --mode=execute -dlopen' fiddles with (info "(libtool) Libltdl + Interface"). See + . + + The environment variables $LTDL_LIBRARY_PATH and $LD_LIBRARY_PATH + can't be used because they would be propagated to subprocesses + which may cause problems for other programs. See + */ + env = getenv ("GUILE_SYSTEM_EXTENSIONS_PATH"); ! if (env) ! system_extensions_path = env; else { ! system_extensions_path = (char *) malloc (strlen (SCM_LIB_DIR) ! + strlen (SCM_EXTENSIONS_DIR) ! + 1 /* for path separator */ ! + 1); /* for null terminator */ ! assert (system_extensions_path != NULL); ! sprintf (system_extensions_path, "%s%c%s", ! SCM_LIB_DIR, LT_PATHSEP_CHAR, SCM_EXTENSIONS_DIR); } }