From c953f2ed1d04b133a235935337ff847c5b4f4aa7 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Wed, 15 Jun 2016 22:50:30 +0900
Subject: [PATCH] Check the module search path to handle relocated shared
 libraries when loading an image.  Fixes issue #345.

---
 eval.c               | 17 ++++++++++++-----
 gc_heap.c            | 39 ++++++++++++++++++++++++++++++---------
 include/chibi/eval.h |  1 +
 3 files changed, 43 insertions(+), 14 deletions(-)

diff --git a/eval.c b/eval.c
index 183b7eec..d97650a8 100644
--- a/eval.c
+++ b/eval.c
@@ -2183,8 +2183,8 @@ sexp sexp_make_primitive_env_op (sexp ctx, sexp self, sexp_sint_t n, sexp versio
   return e;
 }
 
-sexp sexp_find_module_file (sexp ctx, const char *file) {
-  sexp res=SEXP_FALSE, ls;
+char* sexp_find_module_file_raw (sexp ctx, const char *file) {
+  sexp ls;
   char *dir, *path;
   sexp_uint_t slash, dirlen, filelen, len;
 #ifdef PLAN9
@@ -2199,22 +2199,29 @@ sexp sexp_find_module_file (sexp ctx, const char *file) {
   filelen = strlen(file);
 
   ls = sexp_global(ctx, SEXP_G_MODULE_PATH);
-  for ( ; sexp_pairp(ls) && sexp_not(res); ls=sexp_cdr(ls)) {
+  for ( ; sexp_pairp(ls); ls=sexp_cdr(ls)) {
     dir = sexp_string_data(sexp_car(ls));
     dirlen = sexp_string_size(sexp_car(ls));
     slash = dir[dirlen-1] == '/';
     len = dirlen+filelen+2-slash;
     path = (char*) sexp_malloc(len);
-    if (! path) return sexp_global(ctx, SEXP_G_OOM_ERROR);
+    if (! path) return NULL;
     memcpy(path, dir, dirlen);
     if (! slash) path[dirlen] = '/';
     memcpy(path+len-filelen-1, file, filelen);
     path[len-1] = '\0';
     if (sexp_find_static_library(path) || file_exists_p(path, buf))
-      res = sexp_c_string(ctx, path, len-1);
+      return path;
     free(path);
   }
 
+  return NULL;
+}
+
+sexp sexp_find_module_file (sexp ctx, const char *file) {
+  char* path = sexp_find_module_file_raw(ctx, file);
+  sexp res = sexp_c_string(ctx, path, -1);
+  if (path) free(path);
   return res;
 }
 
diff --git a/gc_heap.c b/gc_heap.c
index c943c9f1..469051a3 100644
--- a/gc_heap.c
+++ b/gc_heap.c
@@ -480,19 +480,40 @@ done:
   return res;
 }
 
-static void* load_image_fn(sexp dl, sexp name) {
+static void* load_image_fn(sexp ctx, sexp dl, sexp name) {
+  sexp ls;
+  int len;
   void *fn = NULL;
+  char *file_name, *rel_name=NULL, *new_file_name;
   char *handle_name = "<static>";
   char *symbol_name = sexp_string_data(name);
   if (dl && sexp_dlp(dl)) {
     if (!sexp_dl_handle(dl)) {
-      sexp_dl_handle(dl) = dlopen(sexp_string_data(sexp_dl_file(dl)),
-                                  RTLD_LAZY);
+      /* try exact file, then the search path */
+      file_name = sexp_string_data(sexp_dl_file(dl));
+      len = sexp_string_size(sexp_dl_file(dl));
+      sexp_dl_handle(dl) = dlopen(file_name, RTLD_LAZY);
       if (!sexp_dl_handle(dl)) {
-        handle_name = sexp_string_data(sexp_dl_file(dl));
-        snprintf(gc_heap_err_str, ERR_STR_SIZE, "dlopen failure: %s",
-                 handle_name);
-        return NULL;
+        for (ls = sexp_global(ctx, SEXP_G_MODULE_PATH); sexp_pairp(ls); ls=sexp_cdr(ls)) {
+          if (strnstr(file_name, sexp_string_data(sexp_car(ls)), len+1)) {
+            rel_name = file_name + sexp_string_size(sexp_car(ls));
+            while (*rel_name == '/')
+              ++rel_name;
+            new_file_name = sexp_find_module_file_raw(ctx, rel_name);
+            if (new_file_name) {
+              sexp_dl_handle(dl) = dlopen(new_file_name, RTLD_LAZY);
+              free(new_file_name);
+              if (sexp_dl_handle(dl))
+                break;
+            }
+          }
+        }
+        if (!sexp_dl_handle(dl)) {
+          handle_name = sexp_string_data(sexp_dl_file(dl));
+          snprintf(gc_heap_err_str, ERR_STR_SIZE, "dlopen failure: %s",
+                   handle_name);
+          return NULL;
+        }
       }
     }
     fn = dlsym(sexp_dl_handle(dl), symbol_name);
@@ -523,7 +544,7 @@ static sexp load_image_callback_p2 (sexp ctx, sexp dstp, void *user) {
       return SEXP_FALSE;
     }
     
-    fn = load_image_fn(sexp_opcode_dl(dstp), name);
+    fn = load_image_fn(ctx, sexp_opcode_dl(dstp), name);
     if (!fn) {
       return SEXP_FALSE;
     }
@@ -535,7 +556,7 @@ static sexp load_image_callback_p2 (sexp ctx, sexp dstp, void *user) {
       snprintf(gc_heap_err_str, ERR_STR_SIZE, "type finalize field missing function name");
       return SEXP_FALSE;
     }
-    fn = load_image_fn(sexp_type_dl(dstp), name);
+    fn = load_image_fn(ctx, sexp_type_dl(dstp), name);
     if (!fn) {
       return SEXP_FALSE;
     }
diff --git a/include/chibi/eval.h b/include/chibi/eval.h
index d1ba5f8f..3f6ca257 100644
--- a/include/chibi/eval.h
+++ b/include/chibi/eval.h
@@ -94,6 +94,7 @@ SEXP_API sexp sexp_make_standard_env_op (sexp context, sexp self, sexp_sint_t n,
 SEXP_API void sexp_set_parameter (sexp ctx, sexp env, sexp name, sexp value);
 SEXP_API sexp sexp_load_standard_ports (sexp context, sexp env, FILE* in, FILE* out, FILE* err, int no_close);
 SEXP_API sexp sexp_load_standard_env (sexp context, sexp env, sexp version);
+SEXP_API char* sexp_find_module_file_raw (sexp ctx, const char *file);
 SEXP_API sexp sexp_find_module_file (sexp ctx, const char *file);
 SEXP_API sexp sexp_load_module_file (sexp ctx, const char *file, sexp env);
 SEXP_API sexp sexp_current_module_path_op (sexp ctx, sexp self, sexp_sint_t n, sexp x);