From c53c9d297b8c2342bd1cff5d2344da98d387fe69 Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Mon, 4 Jan 2021 15:57:46 -0500
Subject: rts/linker: Don't assume existence of dlinfo

The native-code codepath uses dlinfo to identify memory regions owned by
a loaded dynamic object, facilitating safe unload. Unfortunately, this
interface is not always available. Add an autoconf check for it and
introduce a safe fallback behavior.

Fixes #19159.
---
 configure.ac          |  2 ++
 rts/Linker.c          |  1 -
 rts/LinkerInternals.h |  3 ---
 rts/linker/Elf.c      | 28 ++++++++++++++++++++--------
 4 files changed, 22 insertions(+), 12 deletions(-)

diff --git a/configure.ac b/configure.ac
index c9cf01e713..d3fbb48b86 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1126,6 +1126,8 @@ AS_IF([test "$UseSystemLibFFI" = "YES"], [
 dnl ** check whether we need -ldl to get dlopen()
 AC_CHECK_LIB([dl], [dlopen])
 AC_CHECK_LIB([dl], [dlopen], [AC_SUBST([CabalHaveLibdl], [True])], [AC_SUBST([CabalHaveLibdl], [False])])
+dnl ** check whether we have dlinfo
+AC_CHECK_FUNCS([dlinfo])
 
 dnl --------------------------------------------------
 dnl * Miscellaneous feature tests
diff --git a/rts/Linker.c b/rts/Linker.c
index 176127da24..6af70b4f91 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -1459,7 +1459,6 @@ mkOc( ObjectType type, pathchar *path, char *image, int imageSize,
    oc->rx_m32 = m32_allocator_new(true);
 #endif
 
-   oc->l_addr = NULL;
    oc->nc_ranges = NULL;
    oc->dlopen_handle = NULL;
 
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index 695f65dbdb..44fe337802 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -322,9 +322,6 @@ struct _ObjectCode {
     /* handle returned from dlopen */
     void *dlopen_handle;
 
-    /* base virtual address of the loaded code */
-    void *l_addr;
-
     /* virtual memory ranges of loaded code */
     NativeCodeRange *nc_ranges;
 };
diff --git a/rts/linker/Elf.c b/rts/linker/Elf.c
index cc8d2c3309..9aaaedc0b2 100644
--- a/rts/linker/Elf.c
+++ b/rts/linker/Elf.c
@@ -1985,9 +1985,15 @@ int ocRunInit_ELF( ObjectCode *oc )
  * Shared object loading
  */
 
+#if defined(HAVE_DLINFO)
+struct piterate_cb_info {
+  ObjectCode *nc;
+  void *l_addr;   /* base virtual address of the loaded code */
+};
+
 static int loadNativeObjCb_(struct dl_phdr_info *info,
     size_t _size GNUC3_ATTRIBUTE(__unused__), void *data) {
-  ObjectCode* nc = (ObjectCode*) data;
+  struct piterate_cb_info *s = (struct piterate_cb_info *) data;
 
   // This logic mimicks _dl_addr_inside_object from glibc
   // For reference:
@@ -2006,22 +2012,23 @@ static int loadNativeObjCb_(struct dl_phdr_info *info,
   //   return 0;
   // }
 
-  if ((void*) info->dlpi_addr == nc->l_addr) {
+  if ((void*) info->dlpi_addr == s->l_addr) {
     int n = info->dlpi_phnum;
     while (--n >= 0) {
       if (info->dlpi_phdr[n].p_type == PT_LOAD) {
         NativeCodeRange* ncr =
           stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_");
-        ncr->start = (void*) ((char*) nc->l_addr + info->dlpi_phdr[n].p_vaddr);
+        ncr->start = (void*) ((char*) s->l_addr + info->dlpi_phdr[n].p_vaddr);
         ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz);
 
-        ncr->next = nc->nc_ranges;
-        nc->nc_ranges = ncr;
+        ncr->next = s->nc->nc_ranges;
+        s->nc->nc_ranges = ncr;
       }
     }
   }
   return 0;
 }
+#endif /* defined(HAVE_DLINFO) */
 
 static void copyErrmsg(char** errmsg_dest, char* errmsg) {
   if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error";
@@ -2064,6 +2071,7 @@ void * loadNativeObj_ELF (pathchar *path, char **errmsg)
 
    foreignExportsLoadingObject(nc);
    hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL);
+   nc->dlopen_handle = hdl;
    foreignExportsFinishedLoadingObject();
    if (hdl == NULL) {
      /* dlopen failed; save the message in errmsg */
@@ -2071,6 +2079,7 @@ void * loadNativeObj_ELF (pathchar *path, char **errmsg)
      goto dlopen_fail;
    }
 
+#if defined(HAVE_DLINFO)
    struct link_map *map;
    if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) {
      /* dlinfo failed; save the message in errmsg */
@@ -2078,15 +2087,18 @@ void * loadNativeObj_ELF (pathchar *path, char **errmsg)
      goto dlinfo_fail;
    }
 
-   nc->l_addr = (void*) map->l_addr;
-   nc->dlopen_handle = hdl;
    hdl = NULL; // pass handle ownership to nc
 
-   dl_iterate_phdr(loadNativeObjCb_, nc);
+   struct piterate_cb_info piterate_info = {
+     .nc = nc,
+     .l_addr = (void *) map->l_addr
+   };
+   dl_iterate_phdr(loadNativeObjCb_, &piterate_info);
    if (!nc->nc_ranges) {
      copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj");
      goto dl_iterate_phdr_fail;
    }
+#endif /* defined (HAVE_DLINFO) */
 
    insertOCSectionIndices(nc);
 
-- 
cgit v1.2.1