From c67bafa0633240a0d6ab4c59cc5e8565871af60a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= <reynir@reynir.dk>
Date: Wed, 18 Nov 2020 17:36:36 +0100
Subject: [PATCH] Implement sd_listen_fds in OCaml

---
 albatross.opam   |  1 -
 src/dune         |  3 +--
 src/vmm_lwt.ml   |  4 ++--
 src/vmm_unix.ml  | 17 +++++++++++++++++
 src/vmm_unix.mli |  2 ++
 5 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/albatross.opam b/albatross.opam
index 23dc2cf..9a63a9b 100644
--- a/albatross.opam
+++ b/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}
diff --git a/src/dune b/src/dune
index 2333dfa..0c6bda0 100644
--- a/src/dune
+++ b/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))
diff --git a/src/vmm_lwt.ml b/src/vmm_lwt.ml
index 495ae02..2adc7a1 100644
--- a/src/vmm_lwt.ml
+++ b/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
diff --git a/src/vmm_unix.ml b/src/vmm_unix.ml
index 4491c45..6e55161 100644
--- a/src/vmm_unix.ml
+++ b/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
diff --git a/src/vmm_unix.mli b/src/vmm_unix.mli
index 837c8f5..42fe555 100644
--- a/src/vmm_unix.mli
+++ b/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