Implement sd_listen_fds in OCaml

This commit is contained in:
Reynir Björnsson 2020-11-18 17:36:36 +01:00
parent b2b9ddcdef
commit c67bafa063
5 changed files with 22 additions and 5 deletions

View File

@ -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}

View File

@ -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))

View File

@ -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

View File

@ -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

View File

@ -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