├── .github └── workflows │ └── main.yml ├── .gitignore ├── Makefile ├── README.md ├── TODO.org ├── dune-project ├── lib ├── daemon.ml ├── daemon.mli ├── daemon_stubs.c ├── dune ├── journald.ml ├── journald.mli └── journald_stubs.c └── systemd.opam /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: Build and test 2 | 3 | on: 4 | pull_request: 5 | push: 6 | 7 | jobs: 8 | build: 9 | strategy: 10 | fail-fast: false 11 | matrix: 12 | os: 13 | - ubuntu-latest 14 | ocaml-compiler: 15 | - 4.06.x 16 | - 4.14.x 17 | 18 | runs-on: ${{ matrix.os }} 19 | 20 | steps: 21 | - name: Checkout code 22 | uses: actions/checkout@v3 23 | 24 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 25 | uses: ocaml/setup-ocaml@v2 26 | with: 27 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 28 | 29 | - run: opam install . --deps-only --with-test 30 | 31 | - run: opam exec -- dune build 32 | 33 | - run: opam exec -- dune runtest 34 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | PROFILE=release 3 | 4 | build: 5 | dune build --profile=$(PROFILE) 6 | 7 | doc: 8 | dune build @doc 9 | 10 | test: 11 | dune runtest 12 | 13 | install: 14 | dune install 15 | 16 | uninstall: setup.data 17 | dune uninstall 18 | 19 | clean: 20 | dune clean 21 | 22 | .PHONY: build doc test all install uninstall reinstall clean distclean configure 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ocaml-systemd [![Build Status](https://api.travis-ci.org/juergenhoetzel/ocaml-systemd.svg)](https://travis-ci.org/juergenhoetzel/ocaml-systemd/) 2 | 3 | OCaml library allowing interaction with systemd and journald 4 | 5 | # Journald Usage 6 | 7 | ```OCaml 8 | open Journald 9 | 10 | let () = journal_send_message Priority.INFO "Hello"; 11 | 12 | (* compile and link its compilation units with option -g to get CODE_FILE and CODE_LINE entries*) 13 | journal_send_message_loc Priority.INFO "Hello with location"; 14 | (* compile and link its compilation units with option -g *) 15 | journal_send ["CUSTOM_FIELD", "CUSTOM_VALUE"]; 16 | journal_send_loc ["CUSTOM_FIELD", "CUSTOM_VALUE with location"]; 17 | ``` 18 | 19 | ## Performance 20 | 21 | To get callstack info (required for the implicit 22 | `CODE_FILE` and `CODE_LINE` entries) you need to build your 23 | compilation units with 24 | debugging information. 25 | 26 | Getting the callstack at runtime also results in an performance overhead, so there a 2 groups of journal functions: 27 | 28 | ### Journal functions with location info 29 | 30 | ```OCaml 31 | val journal_send_message_loc : Priority.t -> string -> unit 32 | val journal_send_loc : (string * string) list -> unit 33 | ``` 34 | 35 | ### Journal functions without location info 36 | 37 | ```OCaml 38 | val journal_send : (string * string) list -> unit 39 | val journal_send_message : Priority.t -> string -> unit 40 | ``` 41 | 42 | # Socket activation 43 | 44 | No need for forking the process, binding/listening the sockets. 45 | 46 | Also support for systemd watchdog functionality. 47 | 48 | ## Complete Example: Lwt echo server using socket activation 49 | 50 | ```Ocaml 51 | open Daemon 52 | open Daemon.State 53 | open Lwt 54 | open Lwt_unix 55 | open Journald 56 | 57 | let echo_server conn_fd = 58 | let in_channel = Lwt_io.of_fd ~mode:Lwt_io.input conn_fd in 59 | let out_channel = Lwt_io.of_fd ~mode:Lwt_io.output conn_fd in 60 | finalize (fun () -> Lwt_stream.iter_s (Lwt_io.write_line out_channel) (Lwt_io.read_lines in_channel)) 61 | (fun () -> close conn_fd) 62 | 63 | let rec accept fd = 64 | Lwt_unix.accept (Lwt_unix.of_unix_file_descr fd) 65 | >>= (fun (conn_fd, _) -> 66 | async (fun _ -> echo_server conn_fd); 67 | accept fd) 68 | 69 | let _ = 70 | (* Notify systemd software watchdog every second *) 71 | Lwt_engine.on_timer 1.0 true (fun _ -> notify Watchdog|>ignore); 72 | notify Ready |> ignore; 73 | match listen_fds () with 74 | | [] -> journal_send_message Priority.CRIT "No file descriptors passed by the system manager" 75 | | fd::_ -> journal_send_message Priority.INFO "socket activation succeded"; 76 | accept fd |> Lwt_main.run 77 | ``` 78 | -------------------------------------------------------------------------------- /TODO.org: -------------------------------------------------------------------------------- 1 | * Daemon 2 | ** TODO Store additional file descriptors in the Systemd (using sd_pid_notify_with_fds) 3 | 4 | * Journald 5 | ** TODO [[http://lists.freedesktop.org/archives/systemd-devel/2012-November/007359.html][Async logging like in libvirt]] 6 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | -------------------------------------------------------------------------------- /lib/daemon.ml: -------------------------------------------------------------------------------- 1 | module State = struct 2 | type t = 3 | | Ready (* Service startup is finished *) 4 | | Reloading (* Service is reloading its configuration. Has to send Ready when finished reloading *) 5 | | Stopping (* Service is beginning to shutdown *) 6 | | Status of string (* Passes a single UTF-8 status string *) 7 | | Error of Unix.error (* Service failed with Unix Erro *) 8 | | Bus_error of string (* Service failed with D-Bus error-style error code *) 9 | | Main_pid of int (* The main process ID *) 10 | | Watchdog (* Update the watchdog timestamp *) 11 | end (* FDSTORE not implemented yet *) 12 | 13 | external caml_code_of_unix_error : Unix.error -> int = "caml_daemon_code_of_unix_error" 14 | external caml_notify : bool -> string -> bool = "caml_daemon_notify" 15 | 16 | let notify ?(unset_environment = false) state = 17 | let open State in 18 | let s = match state with 19 | | Ready -> "READY=1" 20 | | Reloading -> "RELOADING=1" 21 | | Stopping -> "STOPPING=1" 22 | | Status s -> "STATUS=" ^ s 23 | | Error u -> "ERRNO=" ^ (string_of_int (caml_code_of_unix_error u)) 24 | | Bus_error s -> "BUSERROR=" ^ s 25 | | Main_pid i -> "MAINPID=" ^ (string_of_int i) 26 | | Watchdog -> "WATCHDOG=1" 27 | in caml_notify unset_environment s 28 | 29 | external caml_listen_fds : bool -> Unix.file_descr list = "caml_daemon_listen_fds" 30 | 31 | let listen_fds ?(unset_environment = true) () = caml_listen_fds unset_environment; 32 | 33 | external booted : unit -> bool = "caml_daemon_booted" 34 | 35 | -------------------------------------------------------------------------------- /lib/daemon.mli: -------------------------------------------------------------------------------- 1 | (** OCaml interface to the libsystemd-daemon library. *) 2 | 3 | module State : sig 4 | type t = 5 | | Ready (* Service startup is finished *) 6 | | Reloading (* Service is reloading its configuration. Has to send Ready when finished reloading *) 7 | | Stopping (* Service is beginning to shutdown *) 8 | | Status of string (* Passes a single UTF-8 status string *) 9 | | Error of Unix.error (* Service failed with Unix Erro *) 10 | | Bus_error of string (* Service failed with D-Bus error-style error code *) 11 | | Main_pid of int (* The main process ID *) 12 | | Watchdog (* Update the watchdog timestamp *) 13 | end (* FDSTORE not implemented yet *) 14 | 15 | (** [notify ?unset_environment state] sends a message to the init 16 | system about a status change. If the status was sent return true. May 17 | raise [Unix_error] *) 18 | val notify : ?unset_environment : bool -> State.t -> bool 19 | 20 | (** [listen_fds ?unset_environment] returns the number of 21 | descriptors passed to this process by the init system as part of the 22 | socket-based activation logic or raises [Unix_error] *) 23 | val listen_fds : ?unset_environment : bool -> unit -> Unix.file_descr list 24 | 25 | (** [booted] Return true if this system is running under 26 | systemd. or raises [Unix_error] *) 27 | val booted : unit -> bool 28 | -------------------------------------------------------------------------------- /lib/daemon_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | /* to suppress logging information about this file */ 11 | #define SD_JOURNAL_SUPPRESS_LOCATION 12 | 13 | #include 14 | 15 | CAMLprim value caml_daemon_listen_fds(value unset_environment) { 16 | /* booleans are integers 0 1 -> no need to map */ 17 | CAMLparam1(unset_environment); 18 | CAMLlocal2(res, v); 19 | int n = sd_listen_fds(Bool_val(unset_environment)); 20 | if (n < 0) 21 | unix_error(res, "daemon_listen_fds", Nothing); 22 | else if (n == 0) { 23 | res = Val_int(0); /* the empty list */ 24 | } 25 | else { 26 | /* FIXME: more than one fds received */ 27 | res = caml_alloc_small(2,0); 28 | Field(res, 0) = Val_int(SD_LISTEN_FDS_START); 29 | Field(res, 1) = Val_int(0); 30 | } 31 | CAMLreturn(res); 32 | } 33 | 34 | CAMLprim value caml_daemon_booted() { 35 | int ret = sd_booted(); 36 | if (ret < 0) 37 | unix_error(ret, "daemon_booted", Nothing); 38 | return (ret == 0)?Val_false:Val_true; 39 | } 40 | 41 | /* internal */ 42 | CAMLprim value caml_daemon_code_of_unix_error(value unix_error) { 43 | return Val_int(code_of_unix_error(unix_error)); 44 | } 45 | 46 | CAMLprim value caml_daemon_notify(value unset_environment, value state) { 47 | int ret; 48 | caml_enter_blocking_section(); 49 | ret = sd_notify(Bool_val(unset_environment), String_val(state)); 50 | caml_leave_blocking_section(); 51 | if (ret < 0) 52 | unix_error(ret, "daemon_notify", Nothing); 53 | return (ret == 0)?Val_false:Val_true; 54 | } 55 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name systemd) 3 | (public_name systemd) 4 | (wrapped false) 5 | (libraries unix) 6 | (c_library_flags -lsystemd) 7 | (foreign_stubs 8 | (language c) 9 | (names daemon_stubs journald_stubs))) 10 | -------------------------------------------------------------------------------- /lib/journald.ml: -------------------------------------------------------------------------------- 1 | open Printexc 2 | 3 | module Priority = struct 4 | type t = 5 | | EMERG | ALERT | CRIT | ERR | WARNING | NOTICE | INFO | DEBUG 6 | external to_int : t -> int = "caml_journal_level_to_int" 7 | end 8 | 9 | external caml_journal_send : string list -> unit = "caml_journal_send" 10 | 11 | let journal_send l = List.map (function (k,v) -> k ^ "=" ^ v) l |> caml_journal_send 12 | 13 | let default_entries p s = ("PRIORITY", ((Priority.to_int p) |> string_of_int))::("MESSAGE", s)::[] 14 | 15 | let journal_send_message p s = default_entries p s |> journal_send 16 | 17 | (* assuming get_location is called from function in backtrace 3 slots above *) 18 | let get_location () = match (get_callstack 3 |> backtrace_slots) with 19 | | Some s -> Array.get s 2 |> Slot.location 20 | | None -> None 21 | 22 | let journal_send_loc l = match get_location () with 23 | | Some {filename; line_number; _} -> journal_send (("CODE_FILE", filename)::("CODE_LINE", string_of_int line_number)::l) 24 | | None -> journal_send l 25 | 26 | let journal_send_message_loc p s = match get_location () with 27 | | Some {filename; line_number; _} -> journal_send (("CODE_FILE", filename)::("CODE_LINE", string_of_int line_number)::(default_entries p s)) 28 | | None -> journal_send_message p s 29 | -------------------------------------------------------------------------------- /lib/journald.mli: -------------------------------------------------------------------------------- 1 | (** Submit log entries to the system journal. *) 2 | 3 | module Priority : sig 4 | type t = 5 | | EMERG (** System is unusable *) 6 | | ALERT (** Action must be taken immediately *) 7 | | CRIT (** Critical condition *) 8 | | ERR (** Error conditions *) 9 | | WARNING (** Warning conditions *) 10 | | NOTICE (** Normal, but significant, condition *) 11 | | INFO (** Informational message *) 12 | | DEBUG (** Debug-level message *) 13 | val to_int : t -> int 14 | end 15 | 16 | (** [journal_send] submits a list of KV pairs to the journal. The Key 17 | name must be in uppercase and consist only of characters, numbers and 18 | underscores, and may not begin with an underscore. *) 19 | val journal_send : (string * string) list -> unit 20 | 21 | 22 | val journal_send_loc : (string * string) list -> unit 23 | (** [journal_send_loc] acts like [journal_send], but also adds the CODE_LINE and CODE_FILE location keys and values to the journal. 24 | 25 | Compilation units must be compiled and linked with option -g *) 26 | 27 | val journal_send_message : Priority.t -> string -> unit 28 | (** [journal_send_message p s] is used to submit simple, plain text 29 | log entries to the system journal. The first argument is the 30 | [Priority] [p]. This is followed by the message [s] *) 31 | 32 | val journal_send_message_loc : Priority.t -> string -> unit 33 | (** [journal_send_message_loc] acts like [journal_send_message], but also adds the CODE_LINE and CODE_FILE location keys and values to the journal. 34 | 35 | Compilation units must be compiled and linked with option -g *) 36 | -------------------------------------------------------------------------------- /lib/journald_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | /* to suppress logging information about this file */ 10 | #define SD_JOURNAL_SUPPRESS_LOCATION 11 | 12 | #include 13 | 14 | static int priorities[] = { LOG_EMERG, LOG_ALERT, LOG_CRIT, LOG_ERR, LOG_WARNING, 15 | LOG_NOTICE, LOG_INFO, LOG_DEBUG}; 16 | /* helper function */ 17 | static int caml_list_length(value v_slist) { 18 | int n = 0; 19 | while ( v_slist != Val_emptylist ) { 20 | v_slist = Field(v_slist, 1); 21 | n++; 22 | } 23 | return n; 24 | } 25 | 26 | CAMLprim value caml_journal_level_to_int(value v_level) { 27 | return Val_int(priorities[Int_val(v_level)]); 28 | } 29 | 30 | /* send structured log entries to the system journal */ 31 | 32 | CAMLprim value caml_journal_send(value v_slist) { 33 | int count; 34 | int i = 0; 35 | struct iovec *iovecs; 36 | CAMLparam1(v_slist); 37 | CAMLlocal1( head ); 38 | count = caml_list_length(v_slist); 39 | iovecs = caml_stat_alloc(sizeof(struct iovec) * count); 40 | while ( v_slist != Val_emptylist ) { 41 | head = Field(v_slist, 0); 42 | iovecs[i].iov_len = caml_string_length(head); 43 | iovecs[i].iov_base = caml_stat_strdup(String_val(head)); 44 | v_slist = Field(v_slist, 1); 45 | i++; 46 | } 47 | 48 | sd_journal_sendv(iovecs, count); 49 | 50 | for( i = 0; i < count; i++) { 51 | caml_stat_free(iovecs[i].iov_base); 52 | } 53 | caml_stat_free(iovecs); 54 | CAMLreturn(Val_unit); 55 | } 56 | -------------------------------------------------------------------------------- /systemd.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Juergen Hoetzel " 3 | authors: "Juergen Hoetzel " 4 | homepage: "https://github.com/juergenhoetzel/ocaml-systemd/" 5 | bug-reports: "https://github.com/juergenhoetzel/ocaml-systemd/issues" 6 | dev-repo: "git+https://github.com/juergenhoetzel/ocaml-systemd.git" 7 | license: "LGPL-3.0-only WITH OCaml-LGPL-linking-exception" 8 | build: [ 9 | ["dune" "build" "-p" name "-j" jobs] 10 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 11 | ] 12 | depends: [ 13 | "ocaml" {>= "4.06.0"} 14 | "dune" {>= "2.0"} 15 | ] 16 | depexts: [ 17 | ["libsystemd-dev"] {os-family = "debian"} 18 | ["systemd-devel"] {os-distribution = "centos"} 19 | ["systemd-devel"] {os-distribution = "fedora"} 20 | ] 21 | synopsis: "OCaml module for native access to the systemd facilities" 22 | description: """ 23 | * Logging to the Journal 24 | * Socket activation 25 | * Watchdog 26 | * Notifications""" 27 | flags: light-uninstall 28 | --------------------------------------------------------------------------------