From 3ad64d6ab9645c3df24bb7b11faeac840c917016 Mon Sep 17 00:00:00 2001 From: xenia Date: Tue, 24 Sep 2024 04:23:56 -0400 Subject: [PATCH] initial commit --- .gitignore | 1 + bin/dune | 5 + bin/main.ml | 24 ++++ dune-project | 27 +++++ lib/config/discover.ml | 8 ++ lib/config/dune | 3 + lib/dune | 13 +++ lib/systemd.ml | 233 +++++++++++++++++++++++++++++++++++++++ lib/systemd.mli | 192 ++++++++++++++++++++++++++++++++ lib/systemd_stubs.c | 30 +++++ lib_xlog/dune | 5 + lib_xlog/systemd_xlog.ml | 83 ++++++++++++++ package.nix | 43 ++++++++ shell.nix | 1 + systemd.opam | 38 +++++++ test/dune | 2 + test/test_systemd.ml | 0 17 files changed, 708 insertions(+) create mode 100644 .gitignore create mode 100644 bin/dune create mode 100644 bin/main.ml create mode 100644 dune-project create mode 100644 lib/config/discover.ml create mode 100644 lib/config/dune create mode 100644 lib/dune create mode 100644 lib/systemd.ml create mode 100644 lib/systemd.mli create mode 100644 lib/systemd_stubs.c create mode 100644 lib_xlog/dune create mode 100644 lib_xlog/systemd_xlog.ml create mode 100644 package.nix create mode 100644 shell.nix create mode 100644 systemd.opam create mode 100644 test/dune create mode 100644 test/test_systemd.ml diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..a485625 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +/_build diff --git a/bin/dune b/bin/dune new file mode 100644 index 0000000..d7dfc94 --- /dev/null +++ b/bin/dune @@ -0,0 +1,5 @@ +(executable + (public_name ocaml-systemd) + (name main) + (modes byte exe) + (libraries systemd systemd.xlog eio_main fmt xlog)) diff --git a/bin/main.ml b/bin/main.ml new file mode 100644 index 0000000..2e87c1b --- /dev/null +++ b/bin/main.ml @@ -0,0 +1,24 @@ +include (val Xlog.logs __FUNCTION__) + +open Eio.Std + +let () = Eio_main.run @@ fun env -> + let clock = Eio.Stdenv.clock env in + Switch.run ~name:"main" @@ fun sw -> + if Systemd.is_journald_attached () then + Xlog.add_writer (Systemd_xlog.make_writer ~sw ~env) ~min_level:Xlog.DEBUG + else + Xlog.init_pretty_writer stdout ~min_level:Xlog.DEBUG; + + info (fun m -> m "meow meow meow"); + + let fds = Systemd.Fdstore.listen_fds ~sw in + List.iter (fun (name, fd) -> Stdlib.Format.printf "got fd %a=%a\n%!" (Fmt.option ~none:(Fmt.any "") Fmt.string) name Eio_unix.Fd.pp fd; Eio_linux.Low_level.writev fd [Cstruct.of_string "meow"]) fds; + + let ctx = Systemd.Notify.make ~sw ~env in + info (fun m -> m "notifying!"); + Systemd.Notify.ready ctx; + info (fun m -> m "performing barrier"); + Systemd.Notify.barrier ctx; + info (fun m -> m "done"); + Eio.Time.sleep clock 2.0 diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..2098be2 --- /dev/null +++ b/dune-project @@ -0,0 +1,27 @@ +(lang dune 3.15) + +(name systemd) +(version 0.0.1) + +(generate_opam_files true) + +(package + (name systemd) + (synopsis "libsystemd-like functionality for native ocaml") + (description "utilities for interacting with systemd when running as a service") + (license "unfree") + (homepage "https://git.lain.faith/haskal/ocaml-systemd") + (authors "xenia ") + (source (uri "https://git.lain.faith/haskal/ocaml-systemd.git")) + (tags + (meow)) + + (depends ocaml dune + (cstruct (>= 6.2.0)) + (dune-configurator (>= 3.15.2)) + (eio (>= 1.1)) + (eio_linux (>= 1.1)) + (eio_main (>= 1.1)) + (ppx_unicode (>= 0.0.1)) + (ptime (>= 1.1)) + (xlog (>= 0.1.0)))) diff --git a/lib/config/discover.ml b/lib/config/discover.ml new file mode 100644 index 0000000..865970d --- /dev/null +++ b/lib/config/discover.ml @@ -0,0 +1,8 @@ +module C = Configurator.V1 + +let () = C.main ~name:"ocaml-systemd" (fun c -> + let has_malloc_trim = C.c_test c ~c_flags:["-Werror"] + "#include \nint main(){malloc_trim(0);}" in + let cflags = if has_malloc_trim then [ "-DOCAML_SYSTEMD_USE_MALLOC_TRIM" ] else [] in + C.Flags.write_sexp "c_flags.sexp" cflags +) diff --git a/lib/config/dune b/lib/config/dune new file mode 100644 index 0000000..187bd5e --- /dev/null +++ b/lib/config/dune @@ -0,0 +1,3 @@ +(executable + (name discover) + (libraries dune-configurator)) diff --git a/lib/dune b/lib/dune new file mode 100644 index 0000000..e924e9f --- /dev/null +++ b/lib/dune @@ -0,0 +1,13 @@ +(library + (name systemd) + (public_name systemd) + (preprocess (pps ppx_unicode)) + (libraries cstruct eio eio_linux unix) + (foreign_stubs + (language c) + (names "systemd_stubs") + (flags (:include c_flags.sexp)))) + +(rule + (targets c_flags.sexp) + (action (run ./config/discover.exe))) diff --git a/lib/systemd.ml b/lib/systemd.ml new file mode 100644 index 0000000..9c45100 --- /dev/null +++ b/lib/systemd.ml @@ -0,0 +1,233 @@ +let is_systemd_booted env = + let fs = Eio.Stdenv.fs env in + Eio.Path.( / ) fs "/run/systemd/system/" |> Eio.Path.is_directory + +let is_in_systemd () = + begin match Option.bind (Sys.getenv_opt "SYSTEMD_EXEC_PID") int_of_string_opt with + | None -> false + | Some(pid) -> + pid = Unix.getpid () + end + +let invocation_id () = + Sys.getenv "INVOCATION_ID" + +let is_journald_attached () = + let stderr = Unix.fstat Unix.stderr in + let dev_ino = Format.sprintf "%d:%d" stderr.st_dev stderr.st_ino in + Sys.getenv_opt "JOURNAL_STREAM" = Some dev_ino + +module Dirs = struct + let runtime_dir () = + Sys.getenv "RUNTIME_DIRECTORY" + + let state_dir () = + Sys.getenv "STATE_DIRECTORY" + + let cache_dir () = + Sys.getenv "CACHE_DIRECTORY" + + let logs_dir () = + Sys.getenv "LOGS_DIRECTORY" + + let configuration_dir () = + Sys.getenv "CONFIGURATION_DIRECTORY" + + let credentials_dir () = + Sys.getenv "CREDENTIALS_DIRECTORY" +end + +module Notify = struct + type t = { + sock : Eio_unix.Fd.t; + mono_clock : Eio.Time.Mono.ty Eio.Time.Mono.t; + } + + module Private = struct + external unix_code_of_unix_error : Unix.error -> int = "ocaml_systemd_unix_code_of_unix_error" + end + + let make ~sw ~env = + (* debatable whether we need a whole fd for this - reference code just opens and closes the socket + each time, and this avoids keeping the fds open the whole time. however, this also means that + if we run out of fds, notify will fail. currently, we just keep the fd open forever *) + if (Eio.Stdenv.backend_id env <> "linux") then failwith "Backend must be Eio_linux"; + let orig_addr = Sys.getenv "NOTIFY_SOCKET" in + let addr = Bytes.of_string orig_addr in + begin if Bytes.starts_with ~prefix:("@"[@bytes]) addr then + Bytes.set addr 0 '\x00' + else if not (Bytes.starts_with ~prefix:("/"[@bytes]) addr) then + failwith "Invalid address family" + end; + let sock_unix = Unix.socket ~cloexec:true Unix.PF_UNIX Unix.SOCK_DGRAM 0 in + let sock = Eio_unix.Fd.of_unix ~sw ~seekable:false ~close_unix:true sock_unix in + Eio_linux.Low_level.connect sock (Unix.ADDR_UNIX (String.of_bytes addr)); + { sock = sock; mono_clock = Eio.Stdenv.mono_clock env; } + + let notify t ?(fds=[]) msg = + let buf = [(Cstruct.of_string msg)] in + let sent = Eio_linux.Low_level.send_msg ~fds:fds t.sock buf in + assert (sent = Cstruct.lenv buf) + + let ready ?(status=None) ?(mainpid=(-1)) t = + let buf = Buffer.create 32 in + Buffer.add_string buf "READY=1\n"; + begin match status with + | Some status -> Printf.bprintf buf "STATUS=%s\n" status + | None -> () + end; + if mainpid > -1 then Printf.bprintf buf "MAINPID=%u\n" mainpid; + notify t (Buffer.contents buf) + + let send_status t status = + notify t ("STATUS=" ^ status ^ "\n") + + let send_status_errno t status errno = + let errno = Private.unix_code_of_unix_error errno in + let msg = Format.sprintf "STATUS=%s\nERRNO=%d\n" status errno in + notify t msg + + let reloading t = + (* this happens to use CLOCK_MONOTONIC on Eio_linux *) + let now = Eio.Time.Mono.now t.mono_clock in + let now_ns = Mtime.to_uint64_ns now in + let now = Int64.div now_ns 1000L in + let msg = Format.sprintf "RELOADING=1\nMONOTONIC_USEC=%Lu\n" now in + notify t msg + + let stopping t = + notify t "STOPPING=1\n" + + module NotifyAccess = struct + type t = + | None + | Main + | Exec + | All + + let to_string = function + | None -> "none" + | Main -> "main" + | Exec -> "exec" + | All -> "all" + end + + let update_access t acc = + notify t ("NOTIFYACCESS=" ^ (NotifyAccess.to_string acc) ^ "\n") + + let extend_timeout t span = + let nsec = Mtime.Span.to_uint64_ns span in + let usec = Int64.div nsec 1000L in + let msg = Format.sprintf "EXTEND_TIMEOUT_USEC=%Lu\n" usec in + notify t msg + + let barrier t = + Eio.Switch.run @@ fun sw -> + let (p0, p1) = Unix.pipe ~cloexec:true () in + let p0 = Eio_unix.Fd.of_unix ~sw ~seekable:false ~close_unix:true p0 in + let p1 = Eio_unix.Fd.of_unix ~sw ~seekable:false ~close_unix:true p1 in + notify t ~fds:[p1] "BARRIER=1\n"; + Eio_unix.Fd.close p1; + (* the libsystemd source uses POLLHUP, which isn't exposed via Eio_linux at all, but POLLIN + works to the same end here - it won't return until the pipe is closed (and no one should + be writing anything to it) *) + Eio_linux.Low_level.await_readable p0; + Eio_unix.Fd.close p0 +end + +module Watchdog = struct + let get_interval_opt () = + match Option.bind (Sys.getenv_opt "WATCHDOG_USEC") Int64.of_string_opt with + | None -> None + | Some usec -> + begin match Option.bind (Sys.getenv_opt "WATCHDOG_PID") int_of_string_opt with + | None -> None + | Some pid -> + if pid = Unix.getpid () then + let nsec = Int64.mul usec 1000L in + Some (Mtime.Span.of_uint64_ns nsec) + else + None + end + + let pet t = + Notify.notify t "WATCHDOG=1\n" + + let trigger t = + Notify.notify t "WATCHDOG=trigger\n" + + let set_watchdog_time t span = + let nsec = Mtime.Span.to_uint64_ns span in + let usec = Int64.div nsec 1000L in + let msg = Format.sprintf "WATCHDOG_USEC=%Lu\n" usec in + Notify.notify t msg +end + +module Fdstore = struct + module Private = struct + let sd_listen_fds_start = 3 + external unsafe_make_fd : int -> Unix.file_descr = "%identity" + end + + let is_valid_fdname s = + let rec iter_chars i = begin + if i = String.length s then + true + else + let dec = String.get_utf_8_uchar s i in + let chr = Uchar.utf_decode_uchar dec |> Uchar.to_int in + let len = Uchar.utf_decode_length dec in + if chr >= 32 && chr <= 126 && chr != 58 then + iter_chars (i + len) + else + false + end in + iter_chars 0 + + let get_fd_limit () = + match Sys.getenv_opt "FDSTORE" with + | None -> 0 + | Some limit -> int_of_string limit + + let store t name ?(poll=true) fd = + if not (is_valid_fdname name) then failwith "Invalid fdstore name"; + let msg = Format.sprintf ("FDSTORE=1\nFDNAME=%s\n" ^^ (if poll then "" else "FDPOLL=0\n")) name in + Notify.notify t ~fds:[fd] msg + + let remove t name = + if not (is_valid_fdname name) then failwith "Invalid fdstore name"; + Notify.notify t (Format.sprintf "FDSTOREREMOVE=1\nFDNAME=%s\n" name) + + let listen_fds ~sw = + match Option.bind (Sys.getenv_opt "LISTEN_PID") int_of_string_opt with + | None -> [] + | Some(pid) -> + if pid = Unix.getpid () then begin + let fd_count = Sys.getenv "LISTEN_FDS" |> int_of_string in + let fd_names = match Sys.getenv_opt "LISTEN_FDNAMES" with + | None -> List.init fd_count (fun _ -> None) + | Some names -> String.split_on_char ':' names |> List.map (fun a -> Some a) in + assert (fd_count = List.length fd_names); + Unix.putenv "LISTEN_FDS" ""; + Unix.putenv "LISTEN_FDNAMES" ""; + List.mapi (fun i name -> + let fd_num = Private.sd_listen_fds_start + i in + let fd = Private.unsafe_make_fd fd_num in + Unix.set_close_on_exec fd; + let fd = Eio_unix.Fd.of_unix ~sw ~seekable:false ~close_unix:true fd in + (name, fd) + ) fd_names + end else [] +end + +(* we can't do memory pressure because of a lack of exposed pollpri :( *) + +module MemPressure = struct + module Private = struct + external ext_memory_trim : unit -> unit = "ocaml_systemd_memory_trim" + end + + let memory_trim () = + Gc.compact (); + Private.ext_memory_trim () +end diff --git a/lib/systemd.mli b/lib/systemd.mli new file mode 100644 index 0000000..3c975bd --- /dev/null +++ b/lib/systemd.mli @@ -0,0 +1,192 @@ +(** [Systemd] is a module for interacting with the {{:https://systemd.io/}systemd} service manager. + It provides functions for most common systemd functionality, such as the protocols for + detecting systemd/journald presence, startup/status notifications, the file descriptor store, + and the watchdog. See also {!Systemd_xlog} for integration with {!Xlog} to log via journald *) + +(** [is_systemd_booted env] checks if the current system is running on systemd. [env] is the Eio + environment from [Eio_main.run] *) +val is_systemd_booted : Eio_unix.Stdenv.base -> bool + +(** [is_in_systemd ()] checks if the program was started as a systemd service *) +val is_in_systemd : unit -> bool + +(** [invocation_id ()] returns the systemd invocation ID if the program was started using systemd, + or if it is the child of a systemd service that has not unset the environment variable *) +val invocation_id : unit -> string + +(** [is_journald_attached ()] checks if the program is currently connected to a journald stream. + This can indicate the ability to upgrade to rich log messages, eg with {!Systemd_xlog}. *) +val is_journald_attached : unit -> bool + +(** [Systemd.Dirs] provides convenience functions for various directories passed in by systemd *) +module Dirs : sig + + (** When started with a [RuntimeDirectory=] option, provides the runtime directory given by + systemd *) + val runtime_dir : unit -> string + + (** When started with a [StateDirectory=] option, provides the state directory given by systemd *) + val state_dir : unit -> string + + (** When started with a [CacheDirectory=] option, provides the cache directory given by systemd *) + val cache_dir : unit -> string + + (** When started with a [LogsDirectory=] option, provides the logs directory given by systemd *) + val logs_dir : unit -> string + + (** When started with a [ConfigurationDirectory=] option, provides the configuration directory + given by systemd *) + val configuration_dir : unit -> string + + (** When started with a [LoadCredential=] or [LoadCredentialEncrypted=] option, provides the + directory with the credentials given by systemd *) + val credentials_dir : unit -> string +end + +(** [Systemd.Notify] implements the notification protocol to inform systemd of service readiness + and other state changes *) +module Notify : sig + + (** Holds context for using this module *) + type t + + (** [Notify.make ~sw ~env] creates a new notify context, which must be passed to the other + functions in this module. [sw] is a [Eio.Switch] which will register the resources associated + with the context, and [env] is the Eio environment from [Eio_main.run] *) + val make : + sw:Eio.Switch.t -> + env:Eio_unix.Stdenv.base -> t + + (** [Notify.notify t ~fds msg] sends [msg] and optionally file descriptors in [fds] to systemd. + This is a low-level function and should only be used if the convenience functions in this + module do not provide the functionality you need. In particular, [fds] should only be set + if [msg] corresponds to a command that accepts file descriptors. *) + val notify : + t -> + ?fds:Eio_unix.Fd.t list -> + string -> unit + + (** [Notify.ready t] tells systemd that this program has finished initialization and can be + considered fully operational. An optional [status] can be sent containing a status message. + Status messages should not contain any newlines. + [mainpid] corresponds to the [MAINPID=] field of the underlying notification command and is + typically not needed. *) + val ready : + ?status:string option -> + ?mainpid:int -> + t -> unit + + (** [Notify.send_status t status] updates the status message of this program as reported by + systemd to the given text. Note that status messages should not contain any newlines. *) + val send_status : + t -> + string -> unit + + (** [Notify.send_status_errno t status errno] is like [Notify.send_status t status] but contains + an additional [Unix.error] corresponding to some error condition encountered by the program. *) + val send_status_errno : + t -> + string -> + Unix.error -> unit + + (** [Notify.reloading t] reports that the program is currently reloading its configuration. + If used, [Notify.ready t] must be called at some point to report completion. *) + val reloading : t -> unit + + (** [Notify.stopping t] reports that the program is stopping. The program should exit soon after + calling this function. *) + val stopping : t -> unit + + (** Represents the different values of the systemd [NotifyAccess=] setting. *) + module NotifyAccess : sig + + (** Possible values for systemd [NotifyAccess=] *) + type t = + | None (** ["none"] *) + | Main (** ["main"] *) + | Exec (** ["exec"] *) + | All (** ["all"] *) + + (** [to_string t] returns the systemd-compatible string representation of [t] *) + val to_string : t -> string + end + + (** [Notify.update_access t acc] changes the access setting for the notification socket, + overriding the systemd [NotifyAccess=] setting *) + val update_access : + t -> + NotifyAccess.t -> unit + + (** [Notify.extend_timeout t span] attempts to add a duration [span] to the + current startup, runtime or shutdown service timeout. A further notification message must be + sent within the duration specified by [span]. *) + val extend_timeout : + t -> + Mtime.Span.t -> unit + + (** [Notify.barrier t] performs a barrier protocol to synchronize systemd with the program. Once + this function returns, systemd is guaranteed to have processed all notification messages sent + before this function was called. *) + val barrier : t -> unit +end + +(** [Systemd.Watchdog] implements the systemd watchdog protocol, when the program is used with eg + [WatchdogSec=] *) +module Watchdog : sig + + (** [Watchdog.get_interval_opt ()] returns either the interval on which the program must send + watchdog notifications, or [None] if the watchdog is not enabled *) + val get_interval_opt : unit -> Mtime.Span.t option + + (** [Watchdog.pet t] sends a keep-alive notification to systemd *) + val pet : Notify.t -> unit + + (** [Watchdog.trigger t] tells systemd to trigger the watchdog action, as if a failure has + occurred *) + val trigger : Notify.t -> unit + + (** [Watchdog.set_watchdog_time t span] updates the watchdog interval to [span] *) + val set_watchdog_time : + Notify.t -> + Mtime.Span.t -> unit +end + +(** [Systemd.Fdstore] implements the systemd + {{:https://systemd.io/FILE_DESCRIPTOR_STORE/}file descriptor store} and socket-passing protocol, + when relevent options are enabled *) +module Fdstore : sig + + (** [Fdstore.is_valid_fdname s] checks if [s] is a valid fdstore name according to systemd *) + val is_valid_fdname : string -> bool + + (** [Fdstore.get_fd_limit ()] retrieves the maximum number of file descriptors that can be stored + with systemd. Returns 0 if fdstore is not enabled *) + val get_fd_limit : unit -> int + + (** [Fdstore.store t name fd] registers [fd] with [name] in the systemd fdstore. If + [poll=false] then systemd will not automatically remove the fd when it's closed, so it must + be manually unregistered. *) + val store : + Notify.t -> + string -> + ?poll:bool -> + Eio_unix.Fd.t -> unit + + (** [Fdstore.remove t name] removes any file descriptor previously registered with [name] from + systemd *) + val remove : + Notify.t -> + string -> unit + + (** [Fdstore.listen_fds ~sw] returns a list of file descriptors passed into this process by + systemd. This can be fds previously registered with [Fdstore.store], or fds associatd with + systemd socket activation (or both). The fds get registered with Eio Switch [sw]. Environment + variables corresponding to this fd-passing protocol get unset when this function completes. *) + val listen_fds : + sw:Eio.Switch.t -> + (string option * Eio_unix.Fd.t) list +end + +module MemPressure : sig + val memory_trim : unit -> unit +end diff --git a/lib/systemd_stubs.c b/lib/systemd_stubs.c new file mode 100644 index 0000000..34dafa1 --- /dev/null +++ b/lib/systemd_stubs.c @@ -0,0 +1,30 @@ +#include + +#include +#include +#include +#include +#include + +/** + * Wrapper for caml_unix_code_of_unix_error that returns a real OCaml int value + */ +CAMLprim value ocaml_systemd_unix_code_of_unix_error(value code) { + CAMLparam1(code); + CAMLlocal1(result); + + int raw_code = caml_unix_code_of_unix_error(code); + result = Val_int(raw_code); + + CAMLreturn(result); +} + +CAMLprim value ocaml_systemd_memory_trim(value unit) { + CAMLparam1(unit); + +#ifdef OCAML_SYSTEMD_USE_MALLOC_TRIM + malloc_trim(0); +#endif + + CAMLreturn(Val_unit); +} diff --git a/lib_xlog/dune b/lib_xlog/dune new file mode 100644 index 0000000..f46c612 --- /dev/null +++ b/lib_xlog/dune @@ -0,0 +1,5 @@ +(library + (name systemd_xlog) + (public_name systemd.xlog) + (preprocess (pps ppx_unicode)) + (libraries cstruct eio eio_linux unix xlog ptime)) diff --git a/lib_xlog/systemd_xlog.ml b/lib_xlog/systemd_xlog.ml new file mode 100644 index 0000000..6bb3a01 --- /dev/null +++ b/lib_xlog/systemd_xlog.ml @@ -0,0 +1,83 @@ +open Xlog + +let default_socket_path = "/run/systemd/journal/socket" + +type t = { + mutex : Mutex.t; + sock_fd : Eio_unix.Fd.t; + buf : Buffer.t; +} + +let add_field dgram key value = + if String.contains value '\n' then + begin + Buffer.add_string dgram key; + Buffer.add_char dgram '\n'; + Buffer.add_int64_le dgram (Int64.of_int (String.length value)); + Buffer.add_string dgram value; + Buffer.add_char dgram '\n'; + end + else + Printf.bprintf dgram "%s=%s\n" key value + +let syslog_priority = function + | TRACE + | DEBUG -> "7" (* LOG_DEBUG *) + | INFO -> "6" (* LOG_INFO *) + | WARN -> "4" (* LOG_WARNING *) + | ERROR -> "3" (* LOG_ERR *) + +external unix_code_of_unix_error : Unix.error -> int = "ocaml_systemd_unix_code_of_unix_error" + +let get_errno errno exn = + if errno != 0 then + errno + else + match exn with + | Some ((Unix.Unix_error (err, _, _)), _) -> unix_code_of_unix_error err + | _ -> 0 + +let writer t ~ts ~ns ~filename ~lineno ~func ~errno ~exn ~lvl msg = + Mutex.lock t.mutex; + let dgram = + Buffer.clear t.buf; + ignore ts; + let maybe_exn = match exn with + | Some (exn, bt) -> + Printf.sprintf "\nException: %s\n%s" (Printexc.to_string exn) + (Printexc.raw_backtrace_to_string bt) + | None -> "" + in + add_field t.buf "MESSAGE" (Printf.sprintf "%s: %s%s" ns msg maybe_exn); + add_field t.buf "PRIORITY" (syslog_priority lvl); + begin if not (filename = "") then + add_field t.buf "CODE_FILE" filename; + add_field t.buf "CODE_LINE" (Printf.sprintf "%d" lineno) + end; + begin if not (func = "") then + add_field t.buf "CODE_FUNC" func + end; + let errno = get_errno errno exn in + begin if errno != 0 then + add_field t.buf "ERRNO" (Printf.sprintf "%d" errno) + end; + Buffer.to_bytes t.buf + in + Mutex.unlock t.mutex; + let buf = [(Cstruct.of_bytes dgram)] in + let sent = Eio_linux.Low_level.send_msg t.sock_fd buf in + assert (sent = Cstruct.lenv buf) + +let make_writer ~sw ~env = + if (Eio.Stdenv.backend_id env <> "linux") then failwith "Backend must be Eio_linux"; + let sock = Unix.socket ~cloexec:true Unix.PF_UNIX Unix.SOCK_DGRAM 0 in + let sock = Eio_unix.Fd.of_unix ~sw ~seekable:false ~close_unix:true sock in + (* this path isn't configurable in libsystemd, so i don't see a reason to take an argument for + it here *) + Eio_linux.Low_level.connect sock (Unix.ADDR_UNIX default_socket_path); + writer { + mutex = Mutex.create (); + sock_fd = sock; + buf = Buffer.create 256; + } + diff --git a/package.nix b/package.nix new file mode 100644 index 0000000..260b33d --- /dev/null +++ b/package.nix @@ -0,0 +1,43 @@ +{ + lib, + gitSource, + + buildDunePackage, + cstruct, + dune-configurator, + eio, + eio_linux, + eio_main, + ppx_unicode, + ptime, + xlog, + + ocaml, + dune_3, + odoc, + utop, + + withShell ? false +}: +buildDunePackage rec { + pname = "systemd"; + version = "0.0.1"; + src = gitSource { root = ./.; }; + + minimalOCamlVersion = "5.1"; + dontStrip = true; + + buildInputs = [ + ppx_unicode + xlog + ptime + dune-configurator + cstruct + eio + eio_main + eio_linux + ] ++ lib.optionals withShell [ utop ]; + nativeBuildInputs = [ ppx_unicode dune-configurator ] ++ lib.optionals withShell [ + ocaml dune_3 odoc utop + ]; +} diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..ea81f7d --- /dev/null +++ b/shell.nix @@ -0,0 +1 @@ +(import {}).ocamlPackages.callPackage ./package.nix { withShell = true; } diff --git a/systemd.opam b/systemd.opam new file mode 100644 index 0000000..c7b5bef --- /dev/null +++ b/systemd.opam @@ -0,0 +1,38 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "0.0.1" +synopsis: "libsystemd-like functionality for native ocaml" +description: + "utilities for interacting with systemd when running as a service" +authors: ["xenia "] +license: "unfree" +tags: ["meow"] +homepage: "https://git.lain.faith/haskal/ocaml-systemd" +depends: [ + "ocaml" + "dune" {>= "3.15"} + "cstruct" {>= "6.2.0"} + "dune-configurator" {>= "3.15.2"} + "eio" {>= "1.1"} + "eio_linux" {>= "1.1"} + "eio_main" {>= "1.1"} + "ppx_unicode" {>= "0.0.1"} + "ptime" {>= "1.1"} + "xlog" {>= "0.1.0"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "https://git.lain.faith/haskal/ocaml-systemd.git" diff --git a/test/dune b/test/dune new file mode 100644 index 0000000..47f50e1 --- /dev/null +++ b/test/dune @@ -0,0 +1,2 @@ +(test + (name test_systemd)) diff --git a/test/test_systemd.ml b/test/test_systemd.ml new file mode 100644 index 0000000..e69de29