Properly transcode absolute LoadDLL paths for WINE (#1974)

* Properly transcode absolute LoadDLL paths for WINE

We have this sub-protocol in the iserv-proxy (which follows the sub-TH
protocol). The design is horrendous, and needs to be rethought.  The
issue we were seeing is that we started the sub-protocol, because a path
looked like it was absolute, however on the receiving end (windows), the
path /foo/bar/baz, is _not_ an absolute windows path. Thus the
corresponding branch dealing with the sub-protocol was not taken and
we were stuck with messages sent for the primary protocol, and not
understood by the sub-protocol.

This change transcodes unix paths to windows paths, _IF_ the
ISERV_TARGET environment var is set to WINE. In this case we know
we can use Z:\\ as / and share the same file system. This is good enough
for haskell.nix, but a massive hack generally.

---------

Co-authored-by: Hamish Mackenzie <[email protected]>

Author: angerman

overlays/ghc-packages.nix

@@ -250,7 +250,10 @@ in rec {
                        + "/${ghc-extra-projects-type proj.ghc}/${ghcName}";
       compiler-nix-name = ghcName;
       configureArgs = "--disable-tests --disable-benchmarks --allow-newer='terminfo:base'"; # avoid failures satisfying bytestring package tests dependencies
-      modules = [{ reinstallableLibGhc = false; }];
+      modules = [{
+        packages.iserv-proxy.patches = [./patches/ghc/ghc-8.10.7-iserv-proxy-load-dlls.patch];
+        reinstallableLibGhc = false;
+      }];
     }))
     ghc-extra-pkgs-cabal-projects;
 

overlays/mingw_w64.nix

@@ -28,6 +28,8 @@ let
       writeScriptBin ("iserv-wrapper" + lib.optionalString enableProfiling "-prof") ''
         #!${stdenv.shell}
         set -euo pipefail
+        ISERV_ARGS=''${ISERV_ARGS:-}
+        PROXY_ARGS=''${PROXY_ARGS:-}
         # unset the configureFlags.
         # configure should have run already
         # without restting it, wine might fail
@@ -36,7 +38,7 @@ let
         PORT=$((5000 + $RANDOM % 5000))
         (>&2 echo "---> Starting ${interpreter.exeName} on port $PORT")
         REMOTE_ISERV=$(mktemp -d)
-        ln -s ${interpreter}/bin/* $REMOTE_ISERV
+        ln -s ${interpreter.override { enableDebugRTS = true; }}/bin/* $REMOTE_ISERV
         # See coment in comp-builder.nix for where this comes from and why it's here
         for p in $pkgsHostTargetAsString; do
           find "$p" -iname '*.dll' -exec ln -sf {} $REMOTE_ISERV \;
@@ -53,10 +55,10 @@ let
         )
         # Not sure why this `unset` helps.  It might avoids some kind of overflow issue.  We see `wine` fail to start when building `cardano-wallet-cli` test `unit`.
         unset pkgsHostTargetAsString
-        WINEDLLOVERRIDES="winemac.drv=d" WINEDEBUG=warn-all,fixme-all,-menubuilder,-mscoree,-ole,-secur32,-winediag WINEPREFIX=$TMP ${wine}/bin/wine64 $REMOTE_ISERV/${interpreter.exeName} tmp $PORT &
+        WINEDLLOVERRIDES="winemac.drv=d" WINEDEBUG=warn-all,fixme-all,-menubuilder,-mscoree,-ole,-secur32,-winediag WINEPREFIX=$TMP ${wine}/bin/wine64 $REMOTE_ISERV/${interpreter.exeName} tmp $PORT $ISERV_ARGS &
         (>&2 echo "---| ${interpreter.exeName} should have started on $PORT")
         RISERV_PID="$!"
-        ${iserv-proxy}/bin/iserv-proxy $@ 127.0.0.1 "$PORT"
+        ISERV_TARGET=WINE ${iserv-proxy}/bin/iserv-proxy $@ 127.0.0.1 "$PORT" $PROXY_ARGS
         (>&2 echo "---> killing ${interpreter.exeName}...")
         kill $RISERV_PID
       '';

overlays/patches/ghc/ghc-8.10.7-iserv-proxy-load-dlls.patch

@@ -0,0 +1,22 @@
+diff --git a/utils/iserv-proxy/src/Main.hs b/utils/iserv-proxy/src/Main.hs
+index 364a2af..68d7307 100644
+--- a/src/Main.hs
++++ b/src/Main.hs
+@@ -283,8 +283,15 @@ proxy verbose local remote = loop
+         LoadDLL path@('C':':':_) -> do
+           fwdCall msg' >>= reply >> loop
+         LoadDLL path | isAbsolute path -> do
+-          resp <- fwdLoadCall verbose local remote msg'
+-          reply resp
++          target <- lookupEnv "ISERV_TARGET"
++          case target of
++            Just "WINE" -> do
++              let path' = 'Z':':':'\\':map (\c -> if c == '/' then '\\' else c) path
++              resp <- fwdCall (LoadDLL path')
++              reply resp
++            Nothing -> do
++              resp <- fwdLoadCall verbose local remote msg'
++              reply resp
+           loop
+         Shutdown{}    -> fwdCall msg' >> return ()
+         _other        -> fwdCall msg' >>= reply >> loop