xlog/lib/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 ~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 = Util.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;
  Unix.sendto t.sock_fd dgram 0 (Bytes.length dgram) [] t.dest |> ignore