Commits

Anonymous committed 1b6d56a

Actually set env variables requested by user

Comments (0)

Files changed (1)

 let ( ** ) f g x = f (g x)
 let dprintf fmt = Printf.printf (fmt ^^ "\n%!")
 let exn_to_string exn = Exn.to_string (Monitor.extract_exn exn)
-module Exn = struct end 
+module Exn = struct end
 
 (* -------------------------------------------------------------------------- *)
 (*  Ids                                                                       *)
       ksprintf (fun s -> printf "%s" (log_msg s)) fmt
     | Some writer ->
       ksprintf (fun s -> Writer.writef writer "%s" (log_msg s)) fmt
-  let log_exn ?(msg = "Caught exception") e = 
+  let log_exn ?(msg = "Caught exception") e =
     logf "%s: %s" msg (exn_to_string e)
 end
 
   val set : Id.t -> var -> bool -> unit deferred
   val get : Id.t -> var -> bool deferred
   val set_emacs_env : Writer.t -> Id.t -> unit deferred
+  val setenv_all : Id.t -> unit deferred
 end = struct
   type var =
     X_LIBRARY_INLINING
 
   let get = Sys.getenv
 
-  let set ~key ~data = Unix.putenv ~key ~data
+  let setenv ~key ~data = Unix.putenv ~key ~data
 
   let get_exn key = match get key with
     | None -> failwithf "No env: %s" key ()
 
   let assure_set ~default ~key =
     match get key with
-    | None -> set ~key ~data:default
+    | None -> setenv ~key ~data:default
     | Some _ -> ()
 
   let () = begin
   let set id x b =
     env id >>= fun t ->
     var_to_set x t b;
+    setenv ~key:(var_to_string x) ~data:(string_of_bool b);
     save id t
 
+  let setenv_all id =
+    env id >>| fun t -> (
+      setenv ~key:(var_to_string X_LIBRARY_INLINING) ~data:(string_of_bool t.x_library_inlining);
+      setenv ~key:(var_to_string LINK_EXECUTABLES) ~data:(string_of_bool t.link_executables);
+      setenv ~key:(var_to_string VERSION_UTIL_SUPPORT) ~data:(string_of_bool t.version_util_support);
+      setenv ~key:(var_to_string LIMIT_SUBDIRS_FOR_SPEED) ~data:(string_of_bool t.limit_subdirs_for_speed);
+    )
+
   let set_emacs_env writer id =
     env id >>= fun t ->
     To_emacs.send writer " \
       t.link_executables
       t.version_util_support
       t.limit_subdirs_for_speed
+
 end
 
 (* -------------------------------------------------------------------------- *)
   let logf t fmt =
     ksprintf (fun s -> Writer.write t.log_writer (log_msg s)) fmt
 
-  let handle_dead_omake_process t = 
+  let handle_dead_omake_process t =
     let ids = Id.to_string t.id in
     t.omake_process_status >>> (fun res ->
-      if t.alert_when_omake_dies then begin 
+      if t.alert_when_omake_dies then begin
         Server.logf "Process died for model: %s" ids;
         To_emacs.send_async
           "(Omake.Ocaml.update-model-dead :id \"%s\" :msg \"The omake process is dead: %s.\")"
         })
         in
         match t with
-        | `Ok t -> 
+        | `Ok t ->
           handle_dead_omake_process t;
           return t
         | `Already_closed -> failwithf "Already closed: %s" (Id.to_string id) ()
       Deferred.List.iter kids ~f:(fun k -> Ashell.run "kill" [k]) >>= fun () ->
       Ashell.run "kill" [pid]) >>| function
     | Ok () -> ()
-    | Error exn -> 
+    | Error exn ->
       Server.log_exn ~msg:"Error killing processes" exn
 end
 
     | Q.Create create ->
       let id = create.C.id in
       let ids = Id.to_string id in
-      begin Models.create create >>| function
+      begin
+        Env.setenv_all id >>= fun () ->
+        Models.create create >>| function
       | Ok () -> Server.logf "Model created: %s" ids
       | Error `Already_exists -> model_exists id
       end
   Asys.file_exists file >>= function
   | `No | `Unknown ->
     failwithf "Missing socket file: %s" file ()
-  | `Yes -> 
+  | `Yes ->
     Tcp.connect_unix ~file () >>= fun (reader, writer) ->
     Writer.write writer msg;
     Pipe.iter (Reader.pipe reader) ~f:(fun s ->
   )
   (fun pid -> schedule
     ~f:(fun () ->
-      try_with (fun () -> 
+      try_with (fun () ->
         To_emacs.set_pid pid;
         serve ()) >>| function
       | Ok () -> ()
     )
     (fun msg ->
       schedule
-      ~f:(fun () -> 
+      ~f:(fun () ->
         try_with (fun () -> connect msg) >>| function
-        | Error exn -> 
+        | Error exn ->
           Server.log_exn (Monitor.extract_exn exn);
           To_emacs.send_async "(message \"Omake server error.  Do M-x Omake.show-server-log\")"
         | Ok () -> ())
       schedule
         ~f:(fun () -> try_with (fun () -> connect "(Ping 0)") >>| function
         | Ok () -> shutdown 0
-        | Error _ -> 
+        | Error _ ->
           shutdown 1)
         ())
 
       schedule
         ~f:(fun () -> try_with (fun () -> connect msg) >>| function
         | Ok () -> shutdown 0
-        | Error exn -> 
+        | Error exn ->
           printf "Omake server error: %s\n" (exn_to_string exn);
           shutdown 1)
         ~quit:()