Source file main.ml

(*********************************************************************************)
(*                OCaml-ActivityPub                                              *)
(*                                                                               *)
(*    Copyright (C) 2023-2024 INRIA All rights reserved.                         *)
(*    Author: Maxence Guesdon, INRIA Saclay                                      *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Lesser General Public License version        *)
(*    3 as published by the Free Software Foundation.                            *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
(*    GNU General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public License          *)
(*    along with this program; if not, write to the Free Software                *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: maxence.guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)


let lwt_reporter () =
  (* beware to set style before defining the lwt_reporter, or style
     will not be taken into account *)
  Fmt_tty.setup_std_outputs ();
  let buf_fmt ~like =
    let b = Buffer.create 512 in
    Fmt.with_buffer ~like b,
    fun () -> let m = Buffer.contents b in Buffer.reset b; m
  in
  let app, app_flush = buf_fmt ~like:Fmt.stdout in
  let dst, dst_flush = buf_fmt ~like:Fmt.stderr in
  (*let pp_header ppf (level, sopt) =
     let s = Option.value ~default:"?" sopt in
     Format.fprintf ppf "%a[%s]" Logs.pp_level level s
  in*)
  let reporter = Logs_fmt.reporter (*~pp_header*) ~app ~dst () in
  let report src level ~over k msgf =
    let k () =
      let write () = match level with
        | Logs.App -> Lwt_io.write Lwt_io.stdout (app_flush ())
        | _ -> Lwt_io.write Lwt_io.stderr (dst_flush ())
      in
      let unblock () = over (); Lwt.return_unit in
      Lwt.finalize write unblock |> Lwt.ignore_result;
      k ()
    in
    reporter.Logs.report src level ~over:(fun () -> ()) k msgf;
  in
  { Logs.report = report }

let install_log_reporter () = Logs.set_reporter (lwt_reporter ())

let conf_file = ref "conf.json"
let init_conf = ref false

let base_options = [
  "-c", Arg.Set_string conf_file, "<file> read configuration from <file>" ;
  "--init-conf", Arg.Set init_conf, " create configuration file if is does not exists" ;
]

module AP = Activitypub

let default_usage = Printf.sprintf
  "Usage: %s [options] <args>\nwhere options are:"
    (Filename.basename Sys.argv.(0))

let run ?(usage=default_usage) ?(options=[]) f =
  install_log_reporter ();
  Logs.(set_level (Some Error));
  Logs.(Src.set_level AP.Log.log_src (Some Error));
  let options = base_options @ options in
  let args = ref [] in
  try
    Arg.parse options (fun s -> args := s :: !args) usage ;
    let conf =
      let o = Ocf.option Conf.t_wrapper Conf.default_t in
      let g = Ocf.as_group o in
      let conf_file_exists = Sys.file_exists !conf_file in
      Ocf.from_file ~fail_if_not_exist:(not !init_conf) g !conf_file ;
      let c = Ocf.get o in
      if !init_conf && not conf_file_exists then
        (
         Ocf.to_file g !conf_file ;
         AP.Log.info (fun m -> m "Configuration file generated to %s" !conf_file);
         exit 0
        )
      else
        c
    in
    let () =
      if not (Lwt_getdents.get_dents_available ()) then
        AP.Log.warn (fun m -> m "server compiled without get_dents64 available, using Lwt_unix.files_of_directory instead")
    in
    Lwt_main.run
      (
       let%lwt http = Http.mk_http conf in
       let module H = (val http) in
       let module O = Object.Make (H) in
       let module A = Actor.Make (O) in
       f conf (module O : Object.T) (module A : Actor.T) (List.rev !args)
      )
  with
  | Failure msg | Sys_error msg ->
      AP.Log.err (fun m -> m "%s" msg);
      exit 1