Removing handshake from Spawn. It used marshalling, which is bad for

non-ML applications. Control channel can be also ignored.

2 files changed, 32 insertions, 36 deletions

diff --git a/lib/spawn.ml b/lib/spawn.ml
index f32aa4d62..5d5c137c4 100644
--- a/lib/spawn.ml
+++ b/lib/spawn.ml
@@ -97,8 +97,7 @@ let spawn_sock env prog args =
     raise (Failure "create_process failed")
   end;
   let cs, cin, cout = accept main_sock in
-  let winpid = handshake cin cout in
-  pid, winpid, cin, cout, cs
+  pid, cin, cout, cs
 
 let spawn_pipe env prog args =
   let master2worker_r,master2worker_w = Unix.pipe () in
@@ -122,8 +121,7 @@ let spawn_pipe env prog args =
   let cout = Unix.out_channel_of_descr master2worker_w in
   set_binary_mode_in cin true;
   set_binary_mode_out cout true;
-  let winpid = handshake cin cout in
-  pid, winpid, cin, cout, worker2master_r
+  pid, cin, cout, worker2master_r
 
 let filter_args args =
   let rec aux = function
@@ -137,13 +135,12 @@ let spawn_with_control prefer_sock env prog args =
   let control_sock, control_sock_name = mk_socket_channel () in
   let extra = [| "-control-channel"; control_sock_name |] in
   let args = Array.append extra (filter_args args) in
-  let (pid, winpid, cin, cout, s), is_sock =
+  let (pid, cin, cout, s), is_sock =
     if Sys.os_type <> "Unix" || prefer_sock
     then spawn_sock env prog args, true
     else spawn_pipe env prog args, false in
   let _, oob_resp, oob_req = accept control_sock in
-  let _ = handshake oob_resp oob_req in
-  (pid, winpid), oob_resp, oob_req, cin, cout, s, is_sock
+  pid, oob_resp, oob_req, cin, cout, s, is_sock
 
 let output_death_sentence pid oob_req =
   prerr_endline ("death sentence for " ^ pid);
@@ -159,7 +156,7 @@ type process = {
   oob_resp : in_channel;
   oob_req  : out_channel;
   gchan : ML.async_chan;
-  pid : int * int;
+  pid : int;
   mutable watch : ML.watch_id option;
   mutable alive : bool;
 }
@@ -167,10 +164,10 @@ type process = {
 type callback = ML.condition list -> read_all:(unit -> string) -> bool
 type handle = process
 
-let uid { pid = (_, winpid) } = string_of_int winpid
-let unixpid { pid = (unixpid, _) } = unixpid
+let uid { pid; } = string_of_int pid
+let unixpid { pid; } = pid
 
-let kill ({ pid = (unixpid, _winpid); oob_req; cin; cout; alive; watch } as p) =
+let kill ({ pid = unixpid; oob_req; cin; cout; alive; watch } as p) =
   p.alive <- false;
   if not alive then prerr_endline "This process is already dead"
   else begin try
@@ -222,7 +219,7 @@ let kill_if p ~sec test =
     end else true)
 
 let rec wait p =
-  try snd (Unix.waitpid [] (fst p.pid))
+  try snd (Unix.waitpid [] p.pid)
   with
   | Unix.Unix_error (Unix.EINTR, _, _) -> wait p
   | Unix.Unix_error _ -> Unix.WEXITED 0o400
@@ -236,7 +233,7 @@ type process = {
   cout : out_channel;
   oob_resp : in_channel;
   oob_req  : out_channel;
-  pid : int * int;
+  pid : int;
   mutable alive : bool;
 }
 
@@ -247,10 +244,10 @@ let spawn ?(prefer_sock=prefer_sock) ?(env=Unix.environment ()) prog args =
     spawn_with_control prefer_sock env prog args in
   { cin; cout; pid; oob_resp; oob_req; alive = true }, cin, cout
 
-let uid { pid = (_, winpid) } = string_of_int winpid
-let unixpid { pid = (unixpid, _) } = unixpid
+let uid { pid; } = string_of_int pid
+let unixpid { pid = pid; } = pid
 
-let kill ({ pid = (unixpid, _winpid); oob_req; cin; cout; alive } as p) =
+let kill ({ pid = unixpid; oob_req; cin; cout; alive } as p) =
   p.alive <- false;
   if not alive then prerr_endline "This process is already dead"
   else begin try
@@ -275,7 +272,7 @@ let kill_if p ~sec test =
       false
     end else true)
 
-let wait { pid = (unixpid, _) } =
+let wait { pid = unixpid } =
   try snd (Unix.waitpid [] unixpid)
   with Unix.Unix_error _ -> Unix.WEXITED 0o400
 
diff --git a/lib/spawned.ml b/lib/spawned.ml
index 9c304435b..d02594569 100644
--- a/lib/spawned.ml
+++ b/lib/spawned.ml
@@ -31,7 +31,6 @@ let open_bin_connection h p =
   let cin, cout = open_connection (ADDR_INET (inet_addr_of_string h,p)) in
   set_binary_mode_in cin true;
   set_binary_mode_out cout true;
-  handshake cin cout;
   cin, cout
 
 let controller h p =
@@ -59,24 +58,24 @@ let channels = ref None
 
 let init_channels () =
   if !channels <> None then Errors.anomaly(Pp.str "init_channels called twice");
-  match !main_channel, !control_channel with
-  | None, None -> ()
-  | None, Some _ | Some _, None ->
-      Errors.anomaly (Pp.str "incomplete channels options")
-  | _, Some AnonPipe ->
-      Errors.anomaly (Pp.str "control channel cannot be a pipe")
-  | Some (Socket(mh,mp)), Some (Socket(ch,cp)) ->
-      channels := Some (open_bin_connection mh mp);
-      controller ch cp
-  | Some AnonPipe, Some (Socket (ch,cp)) ->
-      let stdin = Unix.in_channel_of_descr (Unix.dup Unix.stdin) in
-      let stdout = Unix.out_channel_of_descr (Unix.dup Unix.stdout) in
-      Unix.dup2 Unix.stderr Unix.stdout;
-      set_binary_mode_in stdin true;
-      set_binary_mode_out stdout true;
-      channels := Some (stdin, stdout);
-      handshake stdin stdout;
-      controller ch cp
+  let () = match !main_channel with
+  | None -> ()
+  | Some (Socket(mh,mp)) ->
+    channels := Some (open_bin_connection mh mp);
+  | Some AnonPipe ->
+    let stdin = Unix.in_channel_of_descr (Unix.dup Unix.stdin) in
+    let stdout = Unix.out_channel_of_descr (Unix.dup Unix.stdout) in
+    Unix.dup2 Unix.stderr Unix.stdout;
+    set_binary_mode_in stdin true;
+    set_binary_mode_out stdout true;
+    channels := Some (stdin, stdout);
+  in
+  match !control_channel with
+  | None -> ()
+  | Some (Socket (ch, cp)) ->
+    controller ch cp
+  | Some AnonPipe ->
+    Errors.anomaly (Pp.str "control channel cannot be a pipe")
 
 let get_channels () =
   match !channels with