fix: promote ghc-internal to RTLD_GLOBAL to prevent duplicate loading

When ghc-iserv loads user code that depends on ghc-internal via dlopen,
the dynamic linker may load a second copy of libHSghc-internal.so if the
original was loaded with RTLD_LOCAL (which is required by Note [RTLD_LOCAL]
in rts/Linker.c for symbol override behavior).

This causes heap corruption because:
1. The first copy's init_ghc_hs_iface() initializes ghc_hs_iface in the RTS
2. User code compiled against the second copy creates closures with info
   tables from the second copy
3. The GC uses ghc_hs_iface (pointing to first copy's info tables) to
   validate closures
4. The mismatch causes "strange closure type" errors during GC

This fix uses dladdr to find the shared library containing init_ghc_hs_iface
(a known symbol from ghc-internal), then uses dlopen with RTLD_NOLOAD |
RTLD_GLOBAL to promote it to global scope before running any Haskell code.

See Note [Promoting ghc-internal to RTLD_GLOBAL] in iservmain.c.

Author: angerman

utils/ghc-iserv/cbits/iservmain.c

@@ -4,10 +4,91 @@
 
 #include <HsFFI.h>
 
+#if !defined(mingw32_HOST_OS)
+#include <dlfcn.h>
+#endif
+
+/*
+ * Note [Promoting ghc-internal to RTLD_GLOBAL]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * When ghc-iserv loads user code that depends on ghc-internal, the dynamic
+ * linker may load a second copy of libHSghc-internal.so if the original copy
+ * was loaded with RTLD_LOCAL (the default).
+ *
+ * This causes heap corruption because:
+ * 1. The first copy's init_ghc_hs_iface() initializes ghc_hs_iface in the RTS
+ * 2. User code compiled against the second copy creates closures with info
+ *    tables from the second copy
+ * 3. The GC uses ghc_hs_iface (pointing to first copy's info tables) to
+ *    validate closures
+ * 4. The mismatch causes "strange closure type" errors during garbage collection
+ *
+ * To fix this, we use dladdr to find the shared library containing a known
+ * symbol from ghc-internal (init_ghc_hs_iface), then use dlopen with
+ * RTLD_NOLOAD | RTLD_GLOBAL to promote it to global scope. This ensures
+ * that when user code's dependencies are resolved, the dynamic linker uses
+ * the already-loaded copy instead of loading a fresh one.
+ *
+ * Note: RTLD_NOLOAD is a GNU extension (and available on macOS since 10.3)
+ * that returns a handle to an already-loaded library without incrementing
+ * its reference count. Combined with RTLD_GLOBAL, it changes the library's
+ * visibility to global.
+ *
+ * See also:
+ * - Note [RTLD_LOCAL] in rts/Linker.c
+ * - Note [RTS/ghc-internal interface] in rts/RtsToHsIface.c
+ * - Note [ghc-iserv and dynamic symbol export] in utils/ghc-iserv/ghc-iserv.cabal.in
+ */
+#if !defined(mingw32_HOST_OS) && defined(RTLD_NOLOAD)
+static void promote_ghc_internal_to_global(void)
+{
+    /*
+     * Find ghc-internal's shared library by looking up init_ghc_hs_iface,
+     * which is a symbol we know exists in ghc-internal. Then use dladdr
+     * to get the library path, and reopen it with RTLD_GLOBAL.
+     */
+
+    /* init_ghc_hs_iface is defined in ghc-internal's cbits/RtsIface.c */
+    extern void init_ghc_hs_iface(void);
+
+    Dl_info info;
+    if (dladdr((void*)&init_ghc_hs_iface, &info) == 0) {
+        /* dladdr failed - symbol might be in the executable itself (static link).
+         * In that case, symbols are already global via -rdynamic. */
+        return;
+    }
+
+    if (info.dli_fname == NULL) {
+        /* No filename available - shouldn't happen but handle gracefully */
+        return;
+    }
+
+    /* Reopen the library with RTLD_GLOBAL to promote its symbols.
+     * RTLD_NOLOAD ensures we don't load a new copy - we just change
+     * the visibility of the already-loaded library. */
+    void *handle = dlopen(info.dli_fname, RTLD_NOW | RTLD_NOLOAD | RTLD_GLOBAL);
+    if (handle != NULL) {
+        /* Successfully promoted to global scope.
+         * Don't dlclose - we want the library to stay loaded and global. */
+#if defined(DEBUG)
+        fprintf(stderr, "ghc-iserv: promoted %s to RTLD_GLOBAL\n", info.dli_fname);
+#endif
+    }
+    /* If dlopen failed, that's OK - might be statically linked or
+     * the -rdynamic/-flat_namespace linker flags should help. */
+}
+#endif /* !mingw32_HOST_OS && RTLD_NOLOAD */
+
 int main (int argc, char *argv[])
 {
     RtsConfig conf = defaultRtsConfig;
 
+#if !defined(mingw32_HOST_OS) && defined(RTLD_NOLOAD)
+    /* Promote ghc-internal to RTLD_GLOBAL before running any Haskell code.
+     * See Note [Promoting ghc-internal to RTLD_GLOBAL] */
+    promote_ghc_internal_to_global();
+#endif
+
     // We never know what symbols GHC will look up in the future, so
     // we must retain CAFs for running interpreted code.
     conf.keep_cafs = 1;