Export setup_control_socket in Release_ipc

dm04806 · Mar 13, 2012 · d31e28b · d31e28b
1 parent c3810e3
commit d31e28b
Show file tree

Hide file tree

Showing 4 changed files with 37 additions and 33 deletions.
diff --git a/lib/release.ml b/lib/release.ml
@@ -1,8 +1,6 @@
 open Lwt
 open Printf
 
-type ipc_handler = (Lwt_unix.file_descr -> unit Lwt.t)
-
 let fork () =
   lwt () = Lwt_io.flush_all () in
   match Lwt_unix.fork () with
@@ -185,28 +183,7 @@ let handle_termination signal _ =
 let handle_sigterm = handle_termination "sigterm"
 let handle_sigint = handle_termination "sigint"
 
-let handle_control_connections (sock_path, handler) =
-  try_lwt
-    let sock = Lwt_unix.socket Lwt_unix.PF_UNIX Lwt_unix.SOCK_STREAM 0 in
-    Lwt_unix.setsockopt sock Lwt_unix.SO_REUSEADDR true;
-    let sock_addr = Lwt_unix.ADDR_UNIX sock_path in
-    Lwt_unix.bind sock sock_addr;
-    Lwt_unix.listen sock 10;
-    let rec accept () =
-      lwt cli_sock, _ = Lwt_unix.accept sock in
-      let timeout_t =
-        lwt () = Lwt_unix.sleep 10.0 in
-        lwt () = Lwt_log.warning_f "timeout on control socket" in
-        Lwt_unix.close cli_sock in
-      let handler_t =
-        lwt () = handler cli_sock in
-        Lwt_unix.close cli_sock in
-      ignore (Lwt.pick [handler_t; timeout_t]);
-      accept () in
-    accept ()
-  with Unix.Unix_error (Unix.EADDRINUSE, _, _) ->
-    lwt () = Lwt_log.error_f "control socket %s already exists" sock_path in
-    exit 1
+let curry f (x, y) = f x y
 
 let master_slaves ?(background = true) ?(syslog = true) ?(privileged = true)
                   ?control ~lock_file ~slaves () =
@@ -226,7 +203,7 @@ let master_slaves ?(background = true) ?(syslog = true) ?(privileged = true)
       return ());
     let idle_t, idle_w = Lwt.wait () in
     let control_t =
-      Option.either return handle_control_connections control in
+      Option.either return (curry Release_ipc.setup_control_socket) control in
     lwt () = Lwt_list.iter_p create_slaves slaves in
     control_t <&> idle_t in
   let main_t =

diff --git a/lib/release.mli b/lib/release.mli
@@ -1,21 +1,19 @@
-type ipc_handler = (Lwt_unix.file_descr -> unit Lwt.t)
-
 val daemon : (unit -> unit Lwt.t) -> unit Lwt.t
 
-val master_slave : slave:(string * ipc_handler)
+val master_slave : slave:(Lwt_io.file_name * Release_ipc.handler)
                 -> ?background:bool
                 -> ?syslog:bool
                 -> ?privileged:bool
-                -> ?control:(string * ipc_handler)
-                -> lock_file:string
+                -> ?control:(Lwt_io.file_name * Release_ipc.handler)
+                -> lock_file:Lwt_io.file_name
                 -> unit -> unit
 
 val master_slaves : ?background:bool
                  -> ?syslog:bool
                  -> ?privileged:bool
-                 -> ?control:(string * ipc_handler)
-                 -> lock_file:string
-                 -> slaves:(string * ipc_handler * int) list
+                 -> ?control:(Lwt_io.file_name * Release_ipc.handler)
+                 -> lock_file:Lwt_io.file_name
+                 -> slaves:(Lwt_io.file_name * Release_ipc.handler * int) list
                  -> unit -> unit
 
 val me : ?syslog:bool

diff --git a/lib/release_ipc.ml b/lib/release_ipc.ml
@@ -1,5 +1,30 @@
 open Lwt
 
+type handler = (Lwt_unix.file_descr -> unit Lwt.t)
+
+let setup_control_socket path handler =
+  try_lwt
+    let sock = Lwt_unix.socket Lwt_unix.PF_UNIX Lwt_unix.SOCK_STREAM 0 in
+    Lwt_unix.setsockopt sock Lwt_unix.SO_REUSEADDR true;
+    let sock_addr = Lwt_unix.ADDR_UNIX path in
+    Lwt_unix.bind sock sock_addr;
+    Lwt_unix.listen sock 10;
+    let rec accept () =
+      lwt cli_sock, _ = Lwt_unix.accept sock in
+      let timeout_t =
+        lwt () = Lwt_unix.sleep 10.0 in
+        lwt () = Lwt_log.warning_f "timeout on control socket" in
+        Lwt_unix.close cli_sock in
+      let handler_t =
+        lwt () = handler cli_sock in
+        Lwt_unix.close cli_sock in
+      ignore (Lwt.pick [handler_t; timeout_t]);
+      accept () in
+    accept ()
+  with Unix.Unix_error (Unix.EADDRINUSE, _, _) ->
+    lwt () = Lwt_log.error_f "control socket `%s' already exists" path in
+    exit 1
+
 module type Ops = sig
   type request
   type response

diff --git a/lib/release_ipc.mli b/lib/release_ipc.mli
@@ -1,3 +1,7 @@
+type handler = (Lwt_unix.file_descr -> unit Lwt.t)
+
+val setup_control_socket : Lwt_io.file_name -> handler -> unit Lwt.t
+
 module type Ops = sig
   type request
   type response