Guard Windows RTS DLL search path conversion failures

Resolve relative paths once, retain successful namespace conversion, and use the resolved absolute path when conversion fails. Preserve the DLL directory cookie and Win32 errors across cleanup.

Apply only to Linux-built Win64 ghc914-sh v2 target RTS packages. Add a real-module scope check and native caller boundary regression; Windows runtime qualification remains separate.

flake.nix

@@ -40,7 +40,8 @@
       let compilerCache = import ./scripts/nix/compiler-cache-overlay.nix { inherit haskellNix; }; in
       let androidEmulator = import ./scripts/nix/android-emulator-overlay.nix { inherit haskellNix; }; in
       let muslIserv = import ./scripts/nix/musl-iserv-overlay.nix; in
-      let pkgs = (nativePackages system).appendOverlays [android26 compilerCache androidEmulator muslIserv]; in
+      let windowsRts = import ./scripts/nix/windows-rts-overlay.nix; in
+      let pkgs = (nativePackages system).appendOverlays [android26 compilerCache androidEmulator muslIserv windowsRts]; in
       let compilerSelection = import ./scripts/nix/compiler-selection.nix { inherit haskellNix; }; in
       let mobileRuntime = import ./scripts/nix/mobile-runtime.nix { inherit pkgs compilerSelection; }; in
       let drv' = { extra-modules, pkgs', package-flags ? {}, package-ghc-options ? {}, mobile ? false, ... }:

scripts/nix/README.md

@@ -99,6 +99,18 @@ original description override and copies that override into the slice index.
 The source producer applies the existing haskell.nix patch once; its later
 package patch list is empty to prevent a second application.
 
+Linux-built Win64 `ghc914-sh` v2 projects patch only the RTS DLL search-path
+caller, including normal and profiling interpreters. It resolves relative paths
+once, retains successful namespace conversion for long paths, and uses the
+resolved absolute path if conversion returns NULL. Invalid paths fail without
+passing NULL to `AddDllDirectory`; its opaque cookie and Win32 errors survive
+cleanup. Other filesystem helpers and native compilers keep their sources.
+The native caller regression uses scripted APIs, not Wine or a target ABI test:
+`python3 scripts/nix/test-windows-dll-search-path.py --rts-source /path/to/configured-ghc/rts`.
+`scripts/nix/check-windows-rts-scope.nix` checks the real module fixed point using
+the same pinned-lib invocation as the musl scope check above. Production Win64
+RTS compilation and the canonical Wine TH gate remain runtime qualification.
+
 Run these commands from the repository root:
 
 ```sh

scripts/nix/check-windows-rts-scope.nix

@@ -0,0 +1,57 @@
+# Exercise the real module fixed point without target tools or project IFD.
+{ lib, projectModule ? import ./windows-rts-project.nix }:
+let
+  apply = { windows ? true, x86_64 ? true, linux ? true,
+    compiler ? "ghc914-sh", builderVersion ? 2,
+    name ? "simplex-chat", profiling ? false }:
+    let
+      project = lib.evalModules {
+        modules = [ projectModule {
+          options = {
+            name = lib.mkOption { type = lib.types.str; };
+            profiling = lib.mkOption { type = lib.types.bool; };
+            compiler-nix-name = lib.mkOption { type = lib.types.str; };
+            builderVersion = lib.mkOption { type = lib.types.int; };
+            modules = lib.mkOption { type = lib.types.listOf lib.types.anything; default = []; };
+          };
+          config = {
+            inherit name profiling builderVersion;
+            compiler-nix-name = compiler;
+            _module.args.pkgs.stdenv = {
+              hostPlatform = { isWindows = windows; isx86_64 = x86_64; };
+              buildPlatform.isLinux = linux;
+            };
+          };
+        } ];
+      };
+      package = lib.evalModules {
+        modules = [ {
+          options.packages = lib.mkOption {
+            type = lib.types.attrsOf (lib.types.submodule {
+              options.patches = lib.mkOption { type = lib.types.listOf lib.types.path; default = []; };
+            });
+            default = {};
+          };
+          config.packages.rts.patches = [ ./ghc914-rts-elf-section-alignment.patch ];
+        } ] ++ project.config.modules;
+      };
+    in package.config.packages.rts.patches;
+  unchanged = [ ./ghc914-rts-elf-section-alignment.patch ];
+  selected = unchanged ++ [ ./ghc914-rts-windows-dll-search-path.patch ];
+in
+assert apply {} == selected;
+assert apply { name = "iserv-proxy"; } == selected;
+assert apply { name = "iserv-proxy"; profiling = true; } == selected;
+assert apply { windows = false; } == unchanged;
+assert apply { x86_64 = false; } == unchanged;
+assert apply { linux = false; } == unchanged;
+assert apply { compiler = "ghc963"; } == unchanged;
+assert apply { compiler = "ghc914-sh-stage1"; } == unchanged;
+assert apply { builderVersion = 1; } == unchanged;
+{
+  moduleArgumentFixedPointEvaluated = true;
+  windows64ApplicationAndInterpreterCovered = true;
+  profilingCovered = true;
+  existingPatchOrderPreserved = true;
+  otherPlatformsCompilersAndBuildersUnchanged = true;
+}

scripts/nix/ghc914-rts-windows-dll-search-path.patch

@@ -0,0 +1,65 @@
+--- a/linker/PEi386.c
++++ b/linker/PEi386.c
+@@ -1028,22 +1028,50 @@
+     return result;
+ }
+-
++
+ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path)
+ {
+-    // Make sure the path is an absolute path in UNC-style to ensure that we
+-    // aren't subject to the MAX_PATH restriction. See #21059.
+-    wchar_t *abs_path = __rts_create_device_name(dll_path);
+-
+-    HsPtr result = AddDllDirectory(abs_path);
++    const DWORD capacity = 32768;
++
++    if (dll_path == NULL || dll_path[0] == L'\0') {
++        sysErrorBelch("addLibrarySearchPath: empty DLL search path (Win32 error %lu)",
++                      (unsigned long)ERROR_INVALID_PARAMETER);
++        SetLastError(ERROR_INVALID_PARAMETER);
++        return NULL;
++    }
++
++    // AddDllDirectory accepts an absolute DOS or UNC path. Resolve it once:
++    // querying and filling separately could observe different current dirs.
++    // Allocate for an extended-length Windows path, including NUL.
++    wchar_t *abs_path = stgMallocBytes(sizeof(wchar_t) * capacity,
++                                     "addLibrarySearchPath_PEi386");
++    DWORD length = GetFullPathNameW(dll_path, capacity, abs_path, NULL);
++    if (length == 0 || length >= capacity) {
++        DWORD error = length == 0 ? GetLastError() : ERROR_INSUFFICIENT_BUFFER;
++        sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)",
++                      dll_path, error);
++        stgFree(abs_path);
++        SetLastError(error);
++        return NULL;
++    }
++
++    // Preserve the established namespace conversion when it succeeds (#21059).
++    // Its failure must never pass NULL into AddDllDirectory: the resolved
++    // absolute path is already suitable for that API.
++    wchar_t *device_path = __rts_create_device_name(abs_path);
++    const wchar_t *search_path = device_path != NULL ? device_path : abs_path;
++    HsPtr result = AddDllDirectory(search_path);
++    DWORD error = GetLastError();
+     if (!result) {
+-        sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError());
+-        stgFree(abs_path);
+-        return NULL;
+-    }
+-
++        sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)",
++                      search_path, error);
++    }
++    if (device_path != NULL) {
++        stgFree(device_path);
++    }
+     stgFree(abs_path);
++    SetLastError(error);
+     return result;
+ }
+-
++
+ bool removeLibrarySearchPath_PEi386(HsPtr dll_path_index)
+ {

scripts/nix/test-windows-dll-search-path.py

@@ -0,0 +1,55 @@
+#!/usr/bin/env python3
+"""Check the real patched RTS caller with scripted API boundary controls.
+
+This native unit does not run Wine or qualify Windows API/ABI behavior.
+"""
+
+import argparse
+from pathlib import Path
+import shutil
+import subprocess
+import tempfile
+
+
+def main():
+    parser = argparse.ArgumentParser(description=__doc__)
+    parser.add_argument("--rts-source", type=Path, required=True,
+                        help="configured GHC rts directory, containing linker/PEi386.c")
+    parser.add_argument("--cc", default="cc", help="native C11 compiler executable")
+    args = parser.parse_args()
+    scripts = Path(__file__).resolve().parent
+    source = args.rts_source / "linker/PEi386.c"
+    if not source.is_file():
+        parser.error(f"missing RTS source: {source}")
+
+    with tempfile.TemporaryDirectory(prefix="windows-dll-search-path-") as directory:
+        root = Path(directory)
+        (root / "linker").mkdir()
+        target = root / "linker/PEi386.c"
+        shutil.copyfile(source, target)
+        subprocess.run(
+            ["patch", "-p1", "-F0", "-i",
+             str(scripts / "ghc914-rts-windows-dll-search-path.patch")],
+            cwd=root, check=True, timeout=30,
+        )
+        text = target.read_text()
+        start = "HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path)\n"
+        end = "\nbool removeLibrarySearchPath_PEi386"
+        if text.count(start) != 1 or text.count(end) != 1:
+            raise RuntimeError("expected one exact RTS caller boundary")
+        begin = text.index(start)
+        finish = text.index(end, begin)
+        (root / "candidate-body.inc").write_text(text[begin:finish])
+        shutil.copyfile(scripts / "windows-dll-search-path/CallerBoundary.c",
+                        root / "CallerBoundary.c")
+        executable = root / "caller-boundary"
+        subprocess.run(
+            [args.cc, "-std=c11", "-Werror=vla", "-pedantic", "-Wall", "-Wextra",
+             "-O1", str(root / "CallerBoundary.c"), "-o", str(executable)],
+            check=True, timeout=30,
+        )
+        subprocess.run([str(executable)], check=True, timeout=10)
+
+
+if __name__ == "__main__":
+    main()

scripts/nix/windows-dll-search-path/CallerBoundary.c

@@ -0,0 +1,186 @@
+#include <stdbool.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <wchar.h>
+
+/* Caller-contract unit only. These deliberately scripted Win32/RTS APIs do
+ * not qualify OS path handling, Wine, the target ABI, or the full RTS. */
+typedef unsigned long DWORD;
+typedef void *HsPtr;
+typedef wchar_t pathchar;
+#define PATH_FMT "ls"
+#define ERROR_INVALID_PARAMETER 87UL
+#define ERROR_INSUFFICIENT_BUFFER 122UL
+#define ERROR_PATH_NOT_FOUND 3UL
+#define ERROR_ACCESS_DENIED 5UL
+
+static const DWORD capacity = 32768;
+static const wchar_t short_path[] = L"C:\\fixture";
+static char cookie;
+static struct {
+    const wchar_t *input;
+    const wchar_t *resolved;
+    bool converted;
+    bool add_fails;
+    DWORD resolve_result;
+    DWORD last_error;
+    unsigned resolve_calls;
+    unsigned convert_calls;
+    unsigned add_calls;
+    unsigned diagnostics;
+    unsigned allocations;
+    unsigned releases;
+    void *absolute_allocation;
+    void *converted_allocation;
+} state;
+
+#define CHECK(condition) do { \
+    if (!(condition)) { \
+        fprintf(stderr, "FAIL line %d: %s\n", __LINE__, #condition); \
+        exit(1); \
+    } \
+} while (0)
+
+static void SetLastError(DWORD error) { state.last_error = error; }
+static DWORD GetLastError(void) { return state.last_error; }
+
+static void *stgMallocBytes(size_t size, char *message) {
+    (void)message;
+    CHECK(state.absolute_allocation == NULL);
+    void *result = malloc(size);
+    CHECK(result != NULL);
+    state.absolute_allocation = result;
+    state.allocations++;
+    return result;
+}
+
+static void stgFree(void *pointer) {
+    CHECK(pointer != NULL);
+    CHECK(pointer == state.absolute_allocation
+          || pointer == state.converted_allocation);
+    if (pointer == state.absolute_allocation) {
+        state.absolute_allocation = NULL;
+    } else {
+        state.converted_allocation = NULL;
+    }
+    state.releases++;
+    free(pointer);
+    SetLastError(0xdeadUL); /* Cleanup must not overwrite the API error. */
+}
+
+static void sysErrorBelch(const char *format, ...) {
+    (void)format;
+    state.diagnostics++;
+    SetLastError(0xbeefUL); /* Nor may a diagnostic overwrite it. */
+}
+
+static DWORD GetFullPathNameW(const wchar_t *input, DWORD size,
+                              wchar_t *output, wchar_t **part) {
+    state.resolve_calls++;
+    CHECK(state.resolve_calls == 1);
+    CHECK(input == state.input && size == capacity && part == NULL);
+    CHECK(output == state.absolute_allocation);
+    if (state.resolve_result == 0) {
+        SetLastError(ERROR_PATH_NOT_FOUND);
+    } else if (state.resolve_result < size) {
+        CHECK(wcslen(state.resolved) == state.resolve_result);
+        wmemcpy(output, state.resolved, state.resolve_result + 1);
+    }
+    return state.resolve_result;
+}
+
+static wchar_t *__rts_create_device_name(const wchar_t *input) {
+    state.convert_calls++;
+    CHECK(input == state.absolute_allocation);
+    CHECK(wcscmp(input, state.resolved) == 0);
+    if (!state.converted) {
+        SetLastError(0x1234UL);
+        return NULL;
+    }
+    const wchar_t converted[] = L"\\\\?\\C:\\fixture";
+    wchar_t *result = malloc(sizeof(converted));
+    CHECK(result != NULL);
+    wmemcpy(result, converted, sizeof(converted) / sizeof(converted[0]));
+    state.converted_allocation = result;
+    state.allocations++;
+    return result;
+}
+
+static HsPtr AddDllDirectory(const wchar_t *path) {
+    state.add_calls++;
+    CHECK(path != NULL);
+    CHECK(path == (state.converted ? state.converted_allocation
+                                  : state.absolute_allocation));
+    SetLastError(state.add_fails ? ERROR_ACCESS_DENIED : 0x55UL);
+    return state.add_fails ? NULL : &cookie;
+}
+
+/* Generated byte-for-byte from the candidate's one changed RTS function. */
+#include "candidate-body.inc"
+
+static void reset(const wchar_t *input, const wchar_t *resolved,
+                  DWORD result, bool converted, bool add_fails) {
+    CHECK(state.absolute_allocation == NULL);
+    CHECK(state.converted_allocation == NULL);
+    memset(&state, 0, sizeof(state));
+    state.input = input;
+    state.resolved = resolved;
+    state.resolve_result = result;
+    state.converted = converted;
+    state.add_fails = add_fails;
+}
+
+static void invalid_input(const wchar_t *input) {
+    reset(input, NULL, 0, false, false);
+    CHECK(addLibrarySearchPath_PEi386((pathchar *)input) == NULL);
+    CHECK(GetLastError() == ERROR_INVALID_PARAMETER);
+    CHECK(state.resolve_calls == 0 && state.convert_calls == 0
+          && state.add_calls == 0 && state.allocations == 0);
+}
+
+static void resolution_failure(DWORD result, DWORD error) {
+    reset(L"relative", NULL, result, false, false);
+    CHECK(addLibrarySearchPath_PEi386((pathchar *)state.input) == NULL);
+    CHECK(GetLastError() == error);
+    CHECK(state.resolve_calls == 1 && state.convert_calls == 0
+          && state.add_calls == 0 && state.allocations == state.releases);
+}
+
+static void resolved_path(const wchar_t *input, const wchar_t *resolved,
+                          bool converted, bool add_fails) {
+    reset(input, resolved, (DWORD)wcslen(resolved), converted, add_fails);
+    HsPtr result = addLibrarySearchPath_PEi386((pathchar *)input);
+    CHECK(result == (add_fails ? NULL : &cookie));
+    CHECK(GetLastError() == (add_fails ? ERROR_ACCESS_DENIED : 0x55UL));
+    CHECK(state.resolve_calls == 1 && state.convert_calls == 1
+          && state.add_calls == 1);
+    CHECK(state.allocations == state.releases);
+    CHECK(state.absolute_allocation == NULL && state.converted_allocation == NULL);
+}
+
+int main(void) {
+    invalid_input(NULL);
+    invalid_input(L"");
+    resolution_failure(0, ERROR_PATH_NOT_FOUND);
+    resolution_failure(capacity, ERROR_INSUFFICIENT_BUFFER);
+    resolution_failure(capacity + 1, ERROR_INSUFFICIENT_BUFFER);
+    resolved_path(L"relative", short_path, false, false);
+    resolved_path(L"relative", short_path, true, false);
+    resolved_path(L"relative", short_path, false, true);
+    resolved_path(L"relative", short_path, true, true);
+    resolved_path(L"\\\\?\\C:\\fixture", L"\\\\?\\C:\\fixture", false, false);
+    resolved_path(L"\\\\server\\share", L"\\\\server\\share", false, false);
+    wchar_t *long_path = malloc(capacity * sizeof(wchar_t));
+    CHECK(long_path != NULL);
+    wmemset(long_path, L'a', capacity - 1);
+    long_path[0] = L'C';
+    long_path[1] = L':';
+    long_path[2] = L'\\';
+    long_path[capacity - 1] = L'\0';
+    resolved_path(L"relative", long_path, false, false);
+    free(long_path);
+    puts("PASS 12 mocked caller boundary controls; no Windows/Wine runtime claim");
+    return 0;
+}

scripts/nix/windows-rts-overlay.nix

@@ -0,0 +1,13 @@
+final: prev:
+prev.lib.optionalAttrs (
+  prev.stdenv.hostPlatform.isWindows
+  && prev.stdenv.hostPlatform.isx86_64
+  && prev.stdenv.buildPlatform.isLinux
+) {
+  haskell-nix = prev.haskell-nix // {
+    cabalProject' = projectModule: prev.haskell-nix.cabalProject' (
+      [ ./windows-rts-project.nix ]
+      ++ (if builtins.isList projectModule then projectModule else [ projectModule ])
+    );
+  };
+}

scripts/nix/windows-rts-project.nix

@@ -0,0 +1,16 @@
+{ config, lib, pkgs, ... }:
+lib.mkIf (
+  pkgs.stdenv.hostPlatform.isWindows
+  && pkgs.stdenv.hostPlatform.isx86_64
+  && pkgs.stdenv.buildPlatform.isLinux
+  && config.compiler-nix-name == "ghc914-sh"
+  && config.builderVersion == 2
+) {
+  # Cross projects build target boot libraries here, including both iserv
+  # flavours. Keep their Haskell ways and the native compiler unchanged.
+  modules = [
+    ({ lib, ... }: {
+      packages.rts.patches = lib.mkAfter [ ./ghc914-rts-windows-dll-search-path.patch ];
+    })
+  ];
+}