Various fixes

Interpreter.hs

@@ -1,14 +1,33 @@
 module Main where
 
-import System.Environment
-import IServ.Remote.Message
-import IServ.Remote.Interpreter
+import           IServ.Remote.Interpreter (startInterpreter')
+import           System.Environment (getArgs, getProgName)
+import           System.Exit (die)
 
-verbose :: Bool
-verbose = False
+import Control.Monad (when)
 
 main :: IO ()
-main = do
-    [portStr, storagePath] <- getArgs
-    let port = read portStr
-    startInterpreter' verbose storagePath port
+main = getArgs >>= startSlave
+
+dieWithUsage :: IO a
+dieWithUsage = do
+  prog <- getProgName
+  die $ msg prog
+ where
+  msg name = "usage: " ++ name ++ " /path/to/storage PORT [-v] [--no-load-call]"
+
+startSlave :: [String] -> IO ()
+startSlave args0
+  | "--help" `elem` args0 = dieWithUsage
+  | otherwise = do
+      (path, port, rest) <- case args0 of
+        arg0:arg1:rest -> return (arg0, read arg1, rest)
+        _              -> dieWithUsage
+
+      let verbose = "-v" `elem` rest
+          noLoadCall = "--no-load-call" `elem` rest
+
+      when (any (not . (`elem` ["-v", "--no-load-call"])) rest)
+        dieWithUsage
+
+      startInterpreter' verbose noLoadCall path port

Main.hs

@@ -98,10 +98,11 @@ main = do
             return (wfd1, rfd2, ip, port, rest)
         _ -> dieWithUsage
 
-  verbose <- case rest of
-    ["-v"] -> return True
-    []     -> return False
-    _      -> dieWithUsage
+  let verbose = "-v" `elem` rest
+      noLoadCall = "--no-load-call" `elem` rest
+
+  when (any (not . (`elem` ["-v", "--no-load-call"])) rest)
+    dieWithUsage
 
   when verbose $
     printf "GHC iserv starting (in: %d; out: %d)\n"
@@ -124,7 +125,7 @@ main = do
 
   when verbose $
     trace "Starting proxy"
-  proxy verbose in_pipe out_pipe
+  proxy verbose noLoadCall in_pipe out_pipe
 
 -- | A hook, to transform outgoing (proxy -> interpreter)
 -- messages prior to sending them to the interpreter.
@@ -141,8 +142,16 @@ hook = return
 --
 fwdTHMsg :: (Binary a) => Pipe -> THMessage a -> IO a
 fwdTHMsg local msg = do
-  writePipe local (putTHMessage msg)
-  readPipe local get
+    writePipe local (putTHMessage (fixAddDep msg))
+    readPipe local get
+  where
+    fixAddDep (AddDependentFile fp) = AddDependentFile $ fixZ (map fixSlash fp)
+    fixAddDep m = m
+    fixZ ('Z':':':rest) = rest
+    fixZ ('/':'/':'?':'/':'Z':':':rest) = rest
+    fixZ fp = fp
+    fixSlash '\\' = '/'
+    fixSlash c = c
 
 -- | Fowarard a @Message@ call and handle @THMessages@.
 fwdTHCall :: (Binary a) => Bool -> Pipe -> Pipe -> Message a -> IO a
@@ -199,7 +208,7 @@ fwdLoadCall verbose _ remote msg = do
       writePipe remote (put m)
     loopLoad :: IO ()
     loopLoad = do
-      when verbose $ trace "fwdLoadCall: reading remote pipe"
+      when verbose $ trace "fwdLoadCall: X reading remote pipe"
       SomeProxyMessage msg' <- readPipe remote getProxyMessage
       when verbose $
         trace ("| Sl Msg:        proxy <- interpreter: " ++ show msg')
@@ -219,8 +228,8 @@ fwdLoadCall verbose _ remote msg = do
 
 -- | The actual proxy. Conntect local and remote pipe,
 -- and does some message handling.
-proxy :: Bool -> Pipe -> Pipe -> IO ()
-proxy verbose local remote = loop
+proxy :: Bool -> Bool -> Pipe -> Pipe -> IO ()
+proxy verbose noLoadCall local remote = loop
   where
     fwdCall :: (Binary a, Show a) => Message a -> IO a
     fwdCall msg = do
@@ -275,7 +284,7 @@ proxy verbose local remote = loop
         -- that are referenced in C:\ these are usually system libraries.
         LoadDLL path@('C':':':_) -> do
           fwdCall msg' >>= reply >> loop
-        LoadDLL path | isAbsolute path -> do
+        LoadDLL path | isAbsolute path && not noLoadCall -> do
           resp <- fwdLoadCall verbose local remote msg'
           reply resp
           loop