Source file client_context_unix.ml

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

class unix_wallet ~base_dir ~password_filename : Client_context.wallet =
  object (self)
    val lock_mutex = Lwt_mutex.create ()

    method load_passwords =
      match password_filename with
      | None -> None
      | Some filename ->
          if Sys.file_exists filename then Some (Lwt_io.lines_of_file filename)
          else None

    method read_file path =
      let open Lwt_syntax in
      Lwt.catch
        (fun () ->
          let* content = Lwt_io.(with_file ~mode:Input path read) in
          return_ok content)
        (fun exn -> failwith "cannot read file (%s)" (Printexc.to_string exn))

    method private filename alias_name =
      Filename.concat
        base_dir
        (String.map (function ' ' -> '_' | c -> c) alias_name ^ "s")

    method get_base_dir = base_dir

    method with_lock : type a. (unit -> a Lwt.t) -> a Lwt.t =
      fun f ->
        Lwt_mutex.with_lock lock_mutex (fun () ->
            let open Lwt_syntax in
            let unlock fd =
              let fd = Lwt_unix.unix_file_descr fd in
              Unix.lockf fd Unix.F_ULOCK 0 ;
              Unix.close fd
            in
            let lock () =
              let* fd =
                Lwt_unix.openfile
                  (Filename.concat base_dir "wallet_lock")
                  Lwt_unix.[O_CREAT; O_WRONLY]
                  0o644
              in
              let* () = Lwt_unix.lockf fd Unix.F_LOCK 0 in
              let sighandler =
                Lwt_unix.on_signal Sys.sigint (fun _s -> unlock fd)
              in
              Lwt.return (fd, sighandler)
            in
            let* fd, sh = lock () in
            (* catch might be useless if f always uses the error monad *)
            let* res =
              Lwt.finalize f (fun () ->
                  unlock fd ;
                  Lwt.return_unit)
            in
            Lwt_unix.disable_signal_handler sh ;
            Lwt.return res)

    method load : type a.
        string -> default:a -> a Data_encoding.encoding -> a tzresult Lwt.t =
      fun alias_name ~default encoding ->
        let open Lwt_result_syntax in
        let filename = self#filename alias_name in
        if not (Sys.file_exists filename) then return default
        else
          let* json =
            trace_eval
              (fun () ->
                error_of_fmt "could not read the %s alias file" alias_name)
              (Lwt_utils_unix.Json.read_file filename)
          in
          match Data_encoding.Json.destruct encoding json with
          | exception e ->
              failwith
                "did not understand the %s alias file %s : %s"
                alias_name
                filename
                (Printexc.to_string e)
          | data -> return data

    method write : type a.
        string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t =
      fun alias_name list encoding ->
        let open Lwt_result_syntax in
        trace_eval (fun () ->
            error_of_fmt "could not write the %s alias file." alias_name)
        @@ Error_monad.catch_es (fun () ->
               let*! () = Lwt_utils_unix.create_dir base_dir in
               let filename = self#filename alias_name in
               let json = Data_encoding.Json.construct encoding list in
               let content = Data_encoding.Json.to_string ~minify:false json in
               let*! res =
                 Lwt_utils_unix.with_atomic_open_out ~overwrite:true filename
                 @@ fun chan -> Lwt_utils_unix.write_string chan content
               in
               match res with
               | Ok x -> return x
               | Error {unix_code; caller; arg; _} ->
                   tzfail (Exn (Unix.Unix_error (unix_code, caller, arg))))

    method last_modification_time : string -> float option tzresult Lwt.t =
      let open Lwt_result_syntax in
      fun alias_name ->
        let filename = self#filename alias_name in
        let*! exists = Lwt_unix.file_exists filename in
        if exists then
          let* stat = Error_monad.catch_s (fun () -> Lwt_unix.stat filename) in
          return_some stat.st_mtime
        else return_none
  end

class unix_prompter : Client_context.prompter =
  object
    method prompt : type a. (a, string tzresult) Client_context.lwt_format -> a
        =
      Format.kasprintf (fun msg ->
          print_string msg ;
          let line = read_line () in
          Lwt.return_ok line)

    method prompt_password : type a.
        (a, Bytes.t tzresult) Client_context.lwt_format -> a =
      Format.kasprintf (fun msg ->
          print_string msg ;
          let line =
            if Unix.isatty Unix.stdin then Lwt_utils_unix.getpass ()
            else read_line ()
          in
          Lwt.return_ok (Bytes.of_string line))

    method multiple_password_retries = true
  end

class unix_logger ~base_dir : Client_context.printer =
  let startup = Format.asprintf "%a" Time.System.pp_hum (Time.System.now ()) in
  let log channel msg =
    let open Lwt_syntax in
    match channel with
    | "stdout" ->
        print_endline msg ;
        Lwt.return_unit
    | "stderr" ->
        prerr_endline msg ;
        Lwt.return_unit
    | log ->
        let open Filename.Infix in
        let* () = Lwt_utils_unix.create_dir (base_dir // "logs" // log) in
        Lwt_io.with_file
          ~flags:Unix.[O_APPEND; O_CREAT; O_WRONLY]
          ~mode:Lwt_io.Output
          (base_dir // "logs" // log // startup)
          (fun chan -> Lwt_io.write chan msg)
  in
  object
    inherit Client_context.simple_printer log
  end

class unix_io_wallet ~base_dir ~password_filename : Client_context.io_wallet =
  object
    inherit unix_wallet ~base_dir ~password_filename

    inherit unix_logger ~base_dir

    inherit unix_prompter
  end

class unix_ui : Client_context.ui =
  object
    method sleep f = Lwt_unix.sleep f

    method exit : 'a. int -> 'a = fun i -> Lwt_exit.exit_and_raise i

    method now = Tezos_base.Time.System.now
  end

class unix_full ~base_dir ~chain ~block ~confirmations ~password_filename
  ~rpc_config ~verbose_rpc_error_diagnostics : Client_context.full =
  object
    inherit unix_logger ~base_dir

    inherit unix_prompter

    inherit unix_wallet ~base_dir ~password_filename

    inherit
      Tezos_rpc_http_client_unix.RPC_client_unix.http_ctxt
        rpc_config
        (Media_type.Command_line.of_command_line rpc_config.media_type)

    inherit unix_ui

    method chain = chain

    method block = block

    method confirmations = confirmations

    method verbose_rpc_error_diagnostics = verbose_rpc_error_diagnostics
  end

class unix_mockup ~base_dir ~mem_only ~mockup_env ~chain_id ~rpc_context
  ~protocol_data : Client_context.full =
  object
    inherit unix_logger ~base_dir

    inherit unix_prompter

    inherit unix_wallet ~base_dir ~password_filename:None

    inherit
      Tezos_mockup.RPC_client.mockup_ctxt
        base_dir
        mem_only
        mockup_env
        chain_id
        rpc_context
        protocol_data

    inherit unix_ui

    method chain = `Hash chain_id

    method block = `Head 0

    method confirmations = None

    method verbose_rpc_error_diagnostics = true
  end

class unix_proxy ~base_dir ?protocol ~chain ~block ~confirmations
  ~password_filename ~rpc_config ~mode () : Client_context.full =
  object
    inherit unix_logger ~base_dir

    inherit unix_prompter

    inherit unix_wallet ~base_dir ~password_filename

    inherit
      Tezos_proxy_rpc.RPC_client.http_local_ctxt
        (new unix_logger ~base_dir)
        (new Tezos_rpc_http_client_unix.RPC_client_unix.http_ctxt
           rpc_config
           (Media_type.Command_line.of_command_line rpc_config.media_type))
        mode
        protocol

    inherit unix_ui

    method chain = chain

    method block = block

    method confirmations = confirmations

    method verbose_rpc_error_diagnostics = true
  end