mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Implement ltdl-like directory search for modules

Browse source 
Search LTDL_LIBRARY_PATH and LD_LIBRARY_PATH before
the system extensions path.

* dynl.c (sysdep_dynl_link_search): new procedure
  (sysdep_dynl_link): search library paths
This commit is contained in:
Mike Gran 2020-03-24 14:55:21 -07:00
parent f6373cf69f
commit bcce103393
1 changed files with 72 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

121
libguile/dynl.c
View file

@ -66,6 +66,60 @@ static scm_i_pthread_mutex_t ltdl_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
/* LT_PATH_SEP-separated extension library search path, searched last */
static char *system_extensions_path;
static void *
sysdep_dynl_link_search (const char *fname, const char *subr, char *library_path)
{
GModule *handle = NULL;
if (library_path == NULL || strlen(library_path) == 0)
return NULL;
char *fname_attempt
= scm_gc_malloc_pointerless (strlen (library_path)
+ strlen (fname) + 2,
"dynl fname_attempt");
char *path; /* remaining path to search */
char *end; /* end of current path component */
char *s;
/* Iterate over the components of SYSTEM_EXTENSIONS_PATH */
for (path = library_path;
*path != '\0';
path = (*end == '\0') ? end : (end + 1))
{
/* Find end of path 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 (including null terminator) */
strcpy (s, fname);
/* Try to load it, and terminate the search if successful */
handle = g_module_open (fname_attempt, 0);
if (handle != NULL)
break;
}
return handle;
}
static void *
sysdep_dynl_link (const char *fname, const char *subr)
{
@ -73,8 +127,8 @@ sysdep_dynl_link (const char *fname, const char *subr)
/* Try the literal filename first or, if NULL, the program itself */
handle = g_module_open (fname, 0);
if (handle == NULL
if (handle == NULL && fname != NULL
#ifdef LT_DIRSEP_CHAR
&& strchr (fname, LT_DIRSEP_CHAR) == NULL
#endif
@ -82,49 +136,18 @@ sysdep_dynl_link (const char *fname, const char *subr)
{
/* FNAME contains no directory separators and was not in the
usual library search paths, so now we search for it in
SYSTEM_EXTENSIONS_PATH. */
char *fname_attempt
= scm_gc_malloc_pointerless (strlen (system_extensions_path)
+ strlen (fname) + 2,
"dynl fname_attempt");
char *path; /* remaining path to search */
char *end; /* end of current path component */
char *s;
/* Iterate over the components of SYSTEM_EXTENSIONS_PATH */
for (path = system_extensions_path;
*path != '\0';
path = (*end == '\0') ? end : (end + 1))
LTDL_LIBRARY_PATH, LD_LIBRARY_PATH, and SYSTEM_EXTENSIONS_PATH. */
handle = sysdep_dynl_link_search (fname, subr, getenv("LTDL_LIBRARY_PATH"));
if (!handle)
handle = sysdep_dynl_link_search (fname, subr, getenv("LD_LIBRARY_PATH"));
if (!handle)
handle = sysdep_dynl_link_search (fname, subr, system_extensions_path);
if (!handle)
{
/* Find end of path component */
end = strchr (path, LT_PATHSEP_CHAR);
if (end == NULL)
end = strchr (path, '\0');
/* Skip empty path components */
if (path == end)
continue;
SCM fn;
/* 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 (including null terminator) */
strcpy (s, fname);
/* Try to load it, and terminate the search if successful */
handle = g_module_open (fname_attempt, 0);
if (handle != NULL)
break;
fn = fname != NULL ? scm_from_locale_string (fname) : SCM_BOOL_F;
scm_misc_error (subr, "module ~S not found in search paths", scm_list_1 (fn));
}
}
@ -135,7 +158,7 @@ sysdep_dynl_link (const char *fname, const char *subr)
fn = fname != NULL ? scm_from_locale_string (fname) : SCM_BOOL_F;
msg = scm_from_locale_string (g_module_error ());
scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
scm_misc_error (subr, "module ~S not found, message: ~S", scm_list_2 (fn, msg));
}
return (void *) handle;
@ -149,7 +172,7 @@ sysdep_dynl_unlink (void *handle, const char *subr)
scm_misc_error (subr, (char *) g_module_error (), SCM_EOL);
}
}
static void *
sysdep_dynl_value (const char *symb, void *handle, const char *subr)
{
@ -257,7 +280,7 @@ SCM_DEFINE (scm_dynamic_link, "dynamic-link", 0, 1, 0,
#undef FUNC_NAME
SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0,
SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a dynamic object handle,\n"
"or @code{#f} otherwise.")
@ -268,7 +291,7 @@ SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0,
#undef FUNC_NAME
SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
(SCM dobj),
"Unlink a dynamic object from the application, if possible. The\n"
"object must have been linked by @code{dynamic-link}, with \n"
@ -330,7 +353,7 @@ SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 2, 0, 0,
#undef FUNC_NAME
SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
(SCM name, SCM dobj),
"Return a ``handle'' for the function @var{name} in the\n"
"shared object referred to by @var{dobj}. The handle\n"
@ -347,7 +370,7 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
#undef FUNC_NAME
SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
(SCM func, SCM dobj),
"Call a C function in a dynamic object. Two styles of\n"
"invocation are supported:\n\n"