talircd/lib/logging/journald.ml

open Core

let default_socket_path = "/run/systemd/journal/socket"

type t = {
  mutex : Mutex.t;
  sock_fd : Unix.file_descr;
  dest : Unix.sockaddr;
  buf : Buffer.t;
}

let should_upgrade () =
  let stderr = Unix.fstat Unix.stderr in
  let dev_ino = Printf.sprintf "%d:%d" stderr.st_dev stderr.st_ino in
  Sys.getenv_opt "JOURNAL_STREAM" = Some dev_ino

let make ?(path = default_socket_path) () = {
  mutex = Mutex.create ();
  sock_fd = Unix.socket PF_UNIX SOCK_DGRAM 0 ~cloexec:true;
  dest = ADDR_UNIX path;
  buf = 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 =
  Mutex.lock t.mutex;
  let dgram =
    Buffer.clear t.buf;
    ignore ts;
    add_field t.buf "MESSAGE" (Printf.sprintf "%s: %s" ns msg);
    add_field t.buf "PRIORITY" (syslog_priority lvl);
    Buffer.to_bytes t.buf
  in
  Mutex.unlock t.mutex;
  Unix.sendto t.sock_fd dgram 0 (Bytes.length dgram) [] t.dest |> ignore