Send daemon output to calling process

1 files changed, 49 insertions, 12 deletions

diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 9cc82da0..4e1f8e2c 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -41,6 +41,7 @@ fun oneRun args =
         val css = ref false
 
         val () = (Compiler.debug := false;
+                  Elaborate.verbose := false;
                   Elaborate.dumpTypes := false;
                   Elaborate.unifyMore := false;
                   Compiler.dumpSource := false;
@@ -91,6 +92,7 @@ fun oneRun args =
                  doArgs rest)
               | "-verbose" :: rest =>
                 (Compiler.debug := true;
+                 Elaborate.verbose := true;
                  doArgs rest)
               | "-timing" :: rest =>
                 (timing := true;
@@ -243,19 +245,43 @@ val () = case CommandLine.arguments () of
                                               val rest = Substring.string (Substring.slice (after, 1, NONE))
                                           in
                                               case cmd of
-                                                  "" => send (sock, if OS.Process.isSuccess ((oneRun (rev args))
-                                                                                             handle ex => (print "unhandled exception:\n";
-                                                                                                           print (General.exnMessage ex ^ "\n");
-                                                                                                           OS.Process.failure)) then
-                                                                        "0"
-                                                                    else
-                                                                        "1")
+                                                  "" =>
+                                                  let
+                                                      val success = (oneRun (rev args))
+                                                          handle ex => (print "unhandled exception:\n";
+                                                                        print (General.exnMessage ex ^ "\n");
+                                                                        OS.Process.failure)
+                                                  in
+                                                      TextIO.flushOut TextIO.stdOut;
+                                                      TextIO.flushOut TextIO.stdErr;
+                                                      send (sock, if OS.Process.isSuccess success then
+                                                                      "\001"
+                                                                  else
+                                                                      "\002")
+                                                  end
                                                 | _ => loop' (rest, cmd :: args)
                                           end
                                   end handle OS.SysErr _ => ()
+
+                              fun redirect old =
+                                  Posix.IO.dup2 {old = valOf (Posix.FileSys.iodToFD (Socket.ioDesc sock)),
+                                                 new = old}
+
+                              val oldStdout = Posix.IO.dup Posix.FileSys.stdout
+                              val oldStderr = Posix.IO.dup Posix.FileSys.stderr
                           in
+                              (* Redirect the daemon's output to the socket. *)
+                              redirect Posix.FileSys.stdout;
+                              redirect Posix.FileSys.stderr;
+                              
                               loop' ("", []);
                               Socket.close sock;
+
+                              Posix.IO.dup2 {old = oldStdout, new = Posix.FileSys.stdout};
+                              Posix.IO.dup2 {old = oldStderr, new = Posix.FileSys.stderr};
+                              Posix.IO.close oldStdout;
+                              Posix.IO.close oldStderr;
+
                               MLton.GC.pack ();
                               loop ()
                           end
@@ -272,15 +298,26 @@ val () = case CommandLine.arguments () of
 
                  fun wait () =
                      let
-                         val v = Socket.recvVec (sock, 1)
+                         val v = Socket.recvVec (sock, 1024)
                      in
                          if Vector.length v = 0 then
                              OS.Process.failure
                          else
-                             case chr (Word8.toInt (Vector.sub (v, 0))) of
-                                 #"0" => OS.Process.success
-                               | #"1" => OS.Process.failure
-                               | _ => raise Fail "Weird return code from daemon"
+                             let
+                                 val s = Vector.map (chr o Word8.toInt) v
+                                 val last = Vector.sub (v, Vector.length v - 1)
+                                 val (rc, s) = if last = Word8.fromInt 1 then
+                                                   (SOME OS.Process.success, String.substring (s, 0, size s - 1))
+                                               else if last = Word8.fromInt 2 then
+                                                   (SOME OS.Process.failure, String.substring (s, 0, size s - 1))
+                                               else
+                                                   (NONE, s)
+                             in
+                                 print s;
+                                 case rc of
+                                     NONE => wait ()
+                                   | SOME rc => rc
+                             end
                      end handle OS.SysErr _ => OS.Process.failure
              in
                  if Socket.connectNB (sock, UnixSock.toAddr socket)