Implement sd_listen_fds in OCaml

albatross.opam

@@ -32,7 +32,6 @@ depends: [
   "metrics" {>= "0.2.0"}
   "metrics-lwt" {>= "0.2.0"}
   "metrics-influx" {>= "0.2.0"}
-  "ocaml-systemd"
 ]
 build: [
   ["dune" "subst"] {pinned}

src/dune

@@ -3,5 +3,4 @@
   (public_name albatross)
   (wrapped false)
   (libraries rresult logs ipaddr bos hex ptime astring duration cstruct jsonm
-             decompress lwt lwt.unix ptime.clock.os asn1-combinators metrics
-	     systemd))
+             decompress lwt lwt.unix ptime.clock.os asn1-combinators metrics))

src/vmm_lwt.ml

@@ -14,8 +14,8 @@ let safe_close fd =
 
 let server_socket systemd sock =
   if systemd
-  then match Daemon.listen_fds () with
-    | [fd] -> Lwt.return (Lwt_unix.of_unix_file_descr fd)
+  then match Vmm_unix.sd_listen_fds () with
+    | Some [fd] -> Lwt.return (Lwt_unix.of_unix_file_descr fd)
     | _ -> failwith "Systemd socket activation error" (* FIXME *)
   else
     let name = Vmm_core.socket_path sock in

src/vmm_unix.ml

@@ -26,6 +26,23 @@ let check_solo5_cmd name =
   | Ok cmd, _ | _, Ok cmd -> Ok cmd
   | _ -> R.error_msgf "%s does not exist" name
 
+(* Pure OCaml implementation of SystemD's sd_listen_fds.
+ * Note: this implementation does not unset environment variables. *)
+let sd_listen_fds () =
+  let fd_of_int (fd : int) : Unix.file_descr = Obj.magic fd in
+  let sd_listen_fds_start = 3 in
+  match Sys.getenv_opt "LISTEN_PID", Sys.getenv_opt "LISTEN_FDS" with
+  | None, _ | _, None -> None
+  | Some listen_pid, Some listen_fds ->
+    match int_of_string_opt listen_pid, int_of_string_opt listen_fds with
+    | None, _ | _, None -> None
+    | Some listen_pid, Some listen_fds ->
+      if listen_pid = Unix.getpid ()
+      then Some (List.init listen_fds
+                   (fun i -> fd_of_int (sd_listen_fds_start + i)))
+      else None
+
+
 (* here we check that the binaries we use in this file are actually present *)
 let check_commands () =
   let uname_cmd = Bos.Cmd.v "uname" in

src/vmm_unix.mli

@@ -8,6 +8,8 @@ type supported = FreeBSD | Linux
 
 val uname : supported Lazy.t
 
+val sd_listen_fds : unit -> Unix.file_descr list option
+
 val set_dbdir : Fpath.t -> unit
 
 val check_commands : unit -> (unit, [> R.msg ]) result