/* Note: VMS filenames also contain version numbers. The caller will have
* to deal with that.
*
* The extension includes the '.'. If no extension is present, "" is returned.
*/
char *SLpath_extname (SLFUTURE_CONST char *file)
{
char *b;
if (NULL == (file = SLpath_basename (file)))
return NULL;
b = (char *) file + strlen (file);
while (b != file)
{
b--;
if (*b == '.')
return b;
}
if (*b == '.')
return b;
/* Do not return a literal "" */
return (char *) file + strlen (file);
}
static void path_basename (char *path)
{
(void) SLang_push_string (SLpath_basename (path));
}
static Handle_Type *dynamic_link_module (SLFUTURE_CONST char *module)
{
Handle_Type *h;
VOID_STAR handle;
SLFUTURE_CONST char *err;
char filebuf[1024];
char *save_file;
char *save_err;
int api_version;
int *api_version_ptr;
#define MAX_MODULE_NAME_SIZE 256
char module_so[MAX_MODULE_NAME_SIZE + 32];
char *module_name;
char *file, *pathfile;
if (strlen (module) >= MAX_MODULE_NAME_SIZE)
{
_pSLang_verror (SL_LimitExceeded_Error, "module name too long");
return NULL;
}
SLsnprintf (module_so, sizeof(module_so), "%s-module.%s", module, SO_SUFFIX);
if (Module_Path != NULL)
pathfile = SLpath_find_file_in_path (Module_Path, module_so);
else pathfile = NULL;
if ((pathfile == NULL)
&& (NULL != (pathfile = _pSLsecure_getenv (MODULE_PATH_ENV_NAME))))
pathfile = SLpath_find_file_in_path (pathfile, module_so);
if (pathfile == NULL)
pathfile = SLpath_find_file_in_path (MODULE_INSTALL_DIR, module_so);
if (pathfile != NULL)
file = pathfile;
else
file = module_so;
save_err = NULL;
save_file = file;
while (1)
{
#ifndef RTLD_GLOBAL
# define RTLD_GLOBAL 0
#endif
#ifdef RTLD_NOW
handle = (VOID_STAR) dlopen (file, RTLD_NOW | RTLD_GLOBAL);
#else
handle = (VOID_STAR) dlopen (file, RTLD_LAZY | RTLD_GLOBAL);
#endif
if (handle != NULL)
{
if (_pSLang_Load_File_Verbose & SLANG_LOAD_MODULE_VERBOSE)
SLang_vmessage ("Importing %s", file);
if (save_err != NULL)
SLfree (save_err);
break;
}
/* Purify reports that dlerror returns a pointer that generates UMR
* errors. There is nothing that I can do about that....
*/
if ((NULL == strchr (file, '/'))
&& (strlen(file) < sizeof(filebuf)))
{
err = (char *) dlerror ();
if (err != NULL)
save_err = SLmake_string (err);
SLsnprintf (filebuf, sizeof (filebuf), "./%s", file);
file = filebuf;
continue;
}
if ((NULL == (err = save_err))
&& (NULL == (err = (char *) dlerror ())))
err = "UNKNOWN";
_pSLang_verror (SL_Import_Error,
"Error linking to %s: %s", save_file, err);
if (save_err != NULL)
SLfree (save_err);
if (pathfile != NULL)
SLfree (pathfile);
return NULL;
}
/* Using SLpath_basename allows, e.g., import ("/path/to/module"); */
module_name = SLpath_basename (module);
api_version_ptr = (int *) do_dlsym (handle, file, 0, "SLmodule_%s_api_version", module_name);
if (api_version_ptr == NULL)
api_version_ptr = (int *) do_dlsym (handle, file, 0, "_SLmodule_%s_api_version", module_name);
if (api_version_ptr == NULL)
api_version = 0;
else
api_version = *api_version_ptr;
if ((-1 == check_api_version (file, api_version))
|| (NULL == (h = allocate_handle_type (module, handle))))
{
SLfree (pathfile); /* NULL ok */
dlclose (handle);
return NULL;
}
if (NULL == (h->ns_init_fun = (int (*)(SLCONST char *)) do_dlsym (handle, file, 1, "init_%s_module_ns", module_name)))
{
SLfree (pathfile);
free_handle_type (h);
dlclose (handle);
return NULL;
}
h->deinit_fun = (void (*)(void)) do_dlsym (handle, file, 0, "deinit_%s_module", module_name);
SLfree (pathfile); /* NULL ok */
h->next = Handle_List;
Handle_List = h;
return h;
}
/* If path looks like: A/B/C/D/whatever, it returns A/B/C/D as a malloced
* string.
*/
char *SLpath_dirname (SLFUTURE_CONST char *drivefile)
{
SLCONST char *b;
const char *file;
char *dir, *drivedir;
size_t len;
if (drivefile == NULL) return NULL;
file = skip_drive (drivefile);
b = file + strlen (file);
while (b != file)
{
b--;
if (0 == IS_PATH_SEP(*b))
continue;
#ifdef VMS
b++; /* make sure final ] is included */
#else
/* collapse multiple slashes */
while ((b != file) && IS_PATH_SEP(*(b-1)))
b--;
if (b == file) b++;
#endif
break;
}
/* now b should point to the character after the slash:
* file="zzz/xxxx"
* b------^
*/
if (b == file)
{
/* pathological cases -- what is the parent? For simplicity
* simply return the current directory.
*/
len = file - drivefile;
if (NULL == (dir = SLmalloc (len + 1 + strlen(THIS_DIR_STRING))))
return NULL;
strncpy (dir, drivefile, len);
strcpy (dir + len, THIS_DIR_STRING);
return dir;
}
if (NULL == (drivedir = SLmake_nstring (drivefile, b - drivefile)))
return NULL;
dir = drivedir + (file - drivefile);
len = b - file; /* len is from start of file on drive */
#ifndef VMS
/* handle special cases
* /foo/. --> /foo
* /. --> /
* /foo/.. --> /
* C:/.
*/
while ((len > 1) && (dir[len-1] == '.'))
{
if (IS_PATH_SEP(dir[len-2]))
{
len--; /* lose "." */
while ((len > 1) && IS_PATH_SEP(dir[len-1]))
len--; /* lose "/" */
dir[len] = 0;
continue;
}
if ((len > 2) && (dir[len-2] == '.') && IS_PATH_SEP(dir[len-3]))
{
len -= 2; /* lose ".." */
if (len > 1)
{
len--; /* lose "/" */
dir[len] = 0;
b = SLpath_basename (dir); /* will not fail: zzz/xxx --> zzz/x */
len = b - dir;
while ((len > 1) && IS_PATH_SEP(dir[len-1]))
len--;
}
dir[len] = 0;
continue;
}
break;
}
#endif /* not VMS */
return drivedir;
}