add native journald logging

lib/logging/dune

@@ -1,4 +1,4 @@
 (library
  (package talircd)
  (name logging)
- (libraries ptime ptime.clock.os))
+ (libraries ptime ptime.clock.os unix))

lib/logging/journald.ml

@@ -0,0 +1,46 @@
+open Core
+
+let default_socket_path = "/run/systemd/journal/socket"
+
+type t = {
+  mutex : Mutex.t;
+  sock_fd : Unix.file_descr;
+  dest : Unix.sockaddr;
+  dgram : Buffer.t;
+}
+
+let make ?(path = default_socket_path) () = {
+  mutex = Mutex.create ();
+  sock_fd = Unix.socket PF_UNIX SOCK_DGRAM 0 ~cloexec:true;
+  dest = ADDR_UNIX path;
+  dgram = Buffer.create 256;
+}
+
+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 *)
+
+let writer t ~ts ~ns ~lvl msg =
+  let dgram =
+    Mutex.protect t.mutex @@ fun () ->
+    ignore ts;
+    add_field t.dgram "MESSAGE" (Printf.sprintf "%s: %s" ns msg);
+    add_field t.dgram "PRIORITY" (syslog_priority lvl);
+    Buffer.to_bytes t.dgram
+  in
+  Unix.sendto t.sock_fd dgram 0 (Bytes.length dgram) [] t.dest |> ignore

lib/logging/logging.ml

@@ -98,3 +98,12 @@ let init_pretty_writer
   Pretty.make out { color; timestamp; namespace; level } |>
   Pretty.writer |>
   add_writer ?min_level
+
+let init_journald_writer
+      ?min_level
+      ?path
+      ()
+  =
+  Journald.make () ?path |>
+  Journald.writer |>
+  add_writer ?min_level

lib/logging/logging.mli

@@ -31,3 +31,8 @@ val init_pretty_writer :
   ?namespace:bool ->
   ?level:bool ->
   out_channel -> unit
+
+val init_journald_writer :
+  ?min_level:level ->
+  ?path:string ->
+  unit -> unit