Raw File
internal_event_unix.ml
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module Configuration = struct
  type t = { activate : Uri.t list }

  let default =
    { activate = [
          Uri.make ~scheme:Internal_event.Lwt_log_sink.uri_scheme ()
        ] }

  let encoding =
    let open Data_encoding in
    conv
      (fun { activate } -> List.map Uri.to_string activate)
      (fun activate -> { activate = List.map Uri.of_string activate })
      (obj1
         (dft "activate"
            ~description: "List of URIs to activate/configure sinks."
            (list string) []))

  let of_file path =
    Lwt_utils_unix.Json.read_file path >>=? fun json ->
    protect (fun () -> return (Data_encoding.Json.destruct encoding json))

  let apply { activate } =
    List.fold_left
      (fun prev uri ->
         prev >>=? fun () ->
         Internal_event.All_sinks.activate uri)
      return_unit
      activate
end

let env_var_name = "TEZOS_EVENTS_CONFIG"

let init ?lwt_log_sink ?(configuration = Configuration.default) () =
  Lwt_log_sink_unix.initialize ?cfg:lwt_log_sink ()
  >>= fun () ->
  begin
    begin match Sys.(getenv_opt env_var_name) with
      | None ->
          return_unit
      | Some s ->
          let uris =
            String.split ' ' s
            |> List.map (String.split '\n') |> List.concat
            |> List.map (String.split '\t') |> List.concat
            |> List.filter ((<>) "")
            |> List.map Uri.of_string in
          List.fold_left
            (fun prev uri ->
               prev >>=? fun () ->
               match Uri.scheme uri with
               | None ->
                   Configuration.of_file (Uri.path uri) >>=? fun cfg ->
                   Configuration.apply cfg
               | Some _ ->
                   Internal_event.All_sinks.activate uri)
            return_unit
            uris >>=? fun () ->
          Internal_event.Debug_event.(
            emit (make "Loaded URIs from environment"
                    ~attach:(`O [ "variable", `String env_var_name ;
                                  "value", `String s ])))
    end >>=? fun () ->
    Configuration.apply configuration
  end
  >>= function
  | Ok () -> Lwt.return_unit
  | Error el ->
      Format.kasprintf Lwt.fail_with
        "ERROR@ Initializing Internal_event_unix:@ %a\n%!"
        Error_monad.pp_print_error el

let close () =
  Internal_event.All_sinks.close ()
  >>= function
  | Ok () -> Lwt.return_unit
  | Error el ->
      Format.kasprintf Lwt.fail_with
        "ERROR@ closing Internal_event_unix:@ %a\n%!"
        Error_monad.pp_print_error el
back to top