From b564b2860338133b00f386089c63f7ad4e250797 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Sat, 26 May 2018 11:16:51 +0200 Subject: [PATCH] Client: rename `Client_signer_remote_socket` into `Lwt_utils_unix.Socket` --- src/bin_signer/main_signer.ml | 61 +++++-- .../client_signer_remote.ml | 29 ++-- .../client_signer_remote_socket.ml | 157 ------------------ .../client_signer_remote_socket.mli | 27 --- src/lib_stdlib_unix/lwt_utils_unix.ml | 118 +++++++++++++ src/lib_stdlib_unix/lwt_utils_unix.mli | 20 +++ 6 files changed, 195 insertions(+), 217 deletions(-) delete mode 100644 src/lib_client_base_unix/client_signer_remote_socket.ml delete mode 100644 src/lib_client_base_unix/client_signer_remote_socket.mli diff --git a/src/bin_signer/main_signer.ml b/src/bin_signer/main_signer.ml index e666275b4..8866956ff 100644 --- a/src/bin_signer/main_signer.ml +++ b/src/bin_signer/main_signer.ml @@ -9,15 +9,39 @@ open Client_signer_remote_messages +let default_tcp_host = + match Sys.getenv_opt "TEZOS_SIGNER_TCP_HOST" with + | None -> "localhost" + | Some host -> host + +let default_tcp_port = + match Sys.getenv_opt "TEZOS_SIGNER_TCP_PORT" with + | None -> "7732" + | Some port -> port + +let default_unix_path = + match Sys.getenv_opt "TEZOS_SIGNER_UNIX_PATH" with + | None -> Filename.concat (Sys.getenv "HOME") (".tezos-signer.sock") + | Some path -> path + +let default_https_host = + match Sys.getenv_opt "TEZOS_SIGNER_HTTPS_HOST" with + | None -> "localhost" + | Some host -> host + +let default_https_port = + match Sys.getenv_opt "TEZOS_SIGNER_HTTPS_PORT" with + | None -> "443" + | Some port -> port + let log = Logging.Client.Sign.lwt_log_notice let run_socket_daemon (cctxt : #Client_context.io_wallet) path = - let open Client_signer_remote_socket in - Connection.bind path >>=? fun (fd, display_path) -> + Lwt_utils_unix.Socket.bind path >>=? fun fd -> let rec loop () = Lwt_unix.accept fd >>= fun (fd, _) -> Lwt.async (fun () -> - recv fd Request.encoding >>=? function + Lwt_utils_unix.Socket.recv fd Request.encoding >>=? function | Sign req -> log "Request for signing %d bytes of data for key %s, magic byte = %02X" (MBytes.length req.data) req.key (MBytes.get_uint8 req.data 0) >>= fun () -> @@ -26,9 +50,9 @@ let run_socket_daemon (cctxt : #Client_context.io_wallet) path = | Some (_, _, Some skloc) -> log "Signing data for key %s" req.key >>= fun () -> Client_keys.sign cctxt skloc req.data >>=? fun signature -> - send fd encoding (ok { Sign.Response.signature = signature }) + Lwt_utils_unix.Socket.send fd encoding (ok { Sign.Response.signature = signature }) | _ -> - send fd encoding (error (Unkwnon_alias_key req.key)) >>=? fun _ -> + Lwt_utils_unix.Socket.send fd encoding (error (Unkwnon_alias_key req.key)) >>=? fun _ -> log "Cannot get alias for key %s" req.key >>= fun () -> return () end @@ -38,7 +62,7 @@ let run_socket_daemon (cctxt : #Client_context.io_wallet) path = let encoding = result_encoding Public_key.Response.encoding in Client_keys.alias_keys cctxt req.key >>= begin function | Error err -> - send fd encoding (Error err) >>=? fun _ -> + Lwt_utils_unix.Socket.send fd encoding (Error err) >>=? fun _ -> log "Cannot get alias for key %s" req.key >>= fun () -> return () | Ok value -> @@ -48,17 +72,17 @@ let run_socket_daemon (cctxt : #Client_context.io_wallet) path = Signature.Public_key_hash.pp public_key_hash req.key >>= fun () -> Client_keys.get_key cctxt public_key_hash >>= begin function | Error err -> - send fd encoding (Error err) >>=? fun _ -> + Lwt_utils_unix.Socket.send fd encoding (Error err) >>=? fun _ -> log "Cannot get key %s" req.key >>= fun () -> return () | Ok (_, public_key, _) -> log "Send public key %a for key %s" Signature.Public_key.pp public_key req.key >>= fun () -> - send fd encoding (ok { Public_key.Response.public_key = public_key }) >>=? fun _ -> + Lwt_utils_unix.Socket.send fd encoding (ok { Public_key.Response.public_key = public_key }) >>=? fun _ -> return () end | None -> begin - send fd encoding (error (Unkwnon_alias_key req.key)) >>=? fun _ -> + Lwt_utils_unix.Socket.send fd encoding (error (Unkwnon_alias_key req.key)) >>=? fun _ -> log "Cannot find key %s" req.key >>= fun () -> return () end @@ -69,20 +93,19 @@ let run_socket_daemon (cctxt : #Client_context.io_wallet) path = in Lwt_unix.listen fd 10 ; begin match path with - | Tcp _ -> - log "Accepting TCP requests on %s" display_path + | Tcp (host, port) -> + log "Accepting TCP requests on %s:%d" host port | Unix path -> Sys.set_signal Sys.sigint (Signal_handle (fun _ -> Format.printf "Removing the local socket file and quitting.@." ; Unix.unlink path ; exit 0)) ; - log "Accepting UNIX requests on %s" display_path + log "Accepting UNIX requests on %s" path end >>= fun () -> loop () let run_https_daemon (cctxt : #Client_context.io_wallet) host port cert key = let open Client_signer_remote_services in - base (host, port) >>=? fun (host, port) -> log "Accepting HTTPS requests on port %d" port >>= fun () -> let mode : Conduit_lwt_unix.server = `TLS (`Crt_file_path cert, `Key_file_path key, `No_password, `Port port) in @@ -161,17 +184,18 @@ let select_commands _ _ = ~short: 'a' ~long: "address" ~placeholder: "host|address" - ~default: "$TEZOS_SIGNER_TCP_HOST" + ~default: default_tcp_host (parameter (fun _ s -> return s))) (default_arg ~doc: "listening TCP port" ~short: 'p' ~long: "port" ~placeholder: "port number" - ~default: "$TEZOS_SIGNER_TCP_PORT" + ~default: default_tcp_port (parameter (fun _ s -> return s)))) (prefixes [ "launch" ; "socket" ; "signer" ] @@ stop) (fun (host, port) cctxt -> + let port = int_of_string port in run_socket_daemon cctxt (Tcp (host, port))) ; command ~group ~desc: "Launch a signer daemon over a local Unix socket." @@ -181,7 +205,7 @@ let select_commands _ _ = ~short: 's' ~long: "socket" ~placeholder: "path" - ~default: "TEZOS_SIGNER_UNIX_PATH" + ~default: default_unix_path (parameter (fun _ s -> return s)))) (prefixes [ "launch" ; "local" ; "signer" ] @@ stop) (fun path cctxt -> @@ -194,14 +218,14 @@ let select_commands _ _ = ~short: 'a' ~long: "address" ~placeholder: "host|address" - ~default: "$TEZOS_SIGNER_HTTPS_HOST" + ~default: default_https_host (parameter (fun _ s -> return s))) (default_arg ~doc: "listening HTTPS port" ~short: 'p' ~long: "port" ~placeholder: "port number" - ~default: "$TEZOS_SIGNER_HTTPS_PORT" + ~default: default_https_port (parameter (fun _ s -> return s)))) (prefixes [ "launch" ; "https" ; "signer" ] @@ param @@ -213,6 +237,7 @@ let select_commands _ _ = ~desc: "path to th TLS key" (parameter (fun _ s -> return s)) @@ stop) (fun (host, port) cert key cctxt -> + let port = int_of_string port in run_https_daemon cctxt host port cert key) ; ]]) diff --git a/src/lib_client_base_unix/client_signer_remote.ml b/src/lib_client_base_unix/client_signer_remote.ml index ed21831f7..4f30092f7 100644 --- a/src/lib_client_base_unix/client_signer_remote.ml +++ b/src/lib_client_base_unix/client_signer_remote.ml @@ -11,26 +11,24 @@ open Client_keys open Client_signer_remote_messages type path = - | Socket of Client_signer_remote_socket.path + | Socket of Lwt_utils_unix.Socket.addr | Https of Client_signer_remote_services.path let socket_sign path key data = - let open Client_signer_remote_socket in let req = { Sign.Request.key = key ; data } in - Connection.connect path >>=? fun conn -> - send conn Request.encoding (Request.Sign req) >>=? fun () -> + Lwt_utils_unix.Socket.connect path >>=? fun conn -> + Lwt_utils_unix.Socket.send conn Request.encoding (Request.Sign req) >>=? fun () -> let encoding = result_encoding Sign.Response.encoding in - recv conn encoding >>=? function + Lwt_utils_unix.Socket.recv conn encoding >>=? function | Error err -> Lwt.return (Error err) | Ok res -> Lwt_unix.close conn >>= fun () -> return res.signature let socket_request_public_key path key = - let open Client_signer_remote_socket in let req = { Public_key.Request.key = key } in - Connection.connect path >>=? fun conn -> - send conn Request.encoding (Request.Public_key req) >>=? fun () -> + Lwt_utils_unix.Socket.connect path >>=? fun conn -> + Lwt_utils_unix.Socket.send conn Request.encoding (Request.Public_key req) >>=? fun () -> let encoding = result_encoding Public_key.Response.encoding in - recv conn encoding >>=? function + Lwt_utils_unix.Socket.recv conn encoding >>=? function | Error err -> Lwt.return (Error err) | Ok res -> Lwt_unix.close conn >>= fun () -> return res.public_key @@ -84,11 +82,12 @@ module Remote_signer : SIGNER = struct | "unix" :: file :: key :: [] -> return (Socket (Unix file), key) | "tcp" :: host :: port :: key :: [] -> - return (Socket (Tcp (host, port)), key) - | "tcp" :: host :: key :: [] -> - return (Socket (Tcp (host, "$TEZOS_SIGNER_TCP_PORT")), key) - | "tcp" :: key :: [] -> - return (Socket (Tcp ("$TEZOS_SIGNER_TCP_HOST", "$TEZOS_SIGNER_TCP_PORT")), key) + return (Socket (Tcp (host, int_of_string port)), key) + (* Temporary FIXME *) + (* | "tcp" :: host :: key :: [] -> *) + (* return (Socket (Tcp (host, "$TEZOS_SIGNER_TCP_PORT")), key) *) + (* | "tcp" :: key :: [] -> *) + (* return (Socket (Tcp ("$TEZOS_SIGNER_TCP_HOST", "$TEZOS_SIGNER_TCP_PORT")), key) *) | "https" :: host :: port :: key :: [] -> return (Https (host, port), key) | "https" :: host :: key :: [] -> @@ -103,7 +102,7 @@ module Remote_signer : SIGNER = struct let locator_of_path = function | Socket (Unix path), key -> [ "unix" ; path ; key ] - | Socket (Tcp (host, port)), key -> [ "tcp" ; host ; port ; key ] + | Socket (Tcp (host, port)), key -> [ "tcp" ; host ; string_of_int port ; key ] | Https (host, port), key -> [ "https" ; host ; port ; key ] let pk_locator_of_human_input _cctxt path = diff --git a/src/lib_client_base_unix/client_signer_remote_socket.ml b/src/lib_client_base_unix/client_signer_remote_socket.ml deleted file mode 100644 index aca03c000..000000000 --- a/src/lib_client_base_unix/client_signer_remote_socket.ml +++ /dev/null @@ -1,157 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -type error += - | Encoding_error - | Decoding_error - -let () = - register_error_kind `Permanent - ~id: "signer.encoding_error" - ~title: "Encoding_error" - ~description: "Error while encoding a request to the remote signer" - ~pp: (fun ppf () -> - Format.fprintf ppf "Could not encode a request to the remote signer") - Data_encoding.empty - (function Encoding_error -> Some () | _ -> None) - (fun () -> Encoding_error) ; - register_error_kind `Permanent - ~id: "signer.decoding_error" - ~title: "Decoding_error" - ~description: "Error while decoding a request to the remote signer" - ~pp: (fun ppf () -> - Format.fprintf ppf "Could not decode a request to the remote signer") - Data_encoding.empty - (function Decoding_error -> Some () | _ -> None) - (fun () -> Decoding_error) - -type path = - | Unix of string - | Tcp of string * string - -module Connection = struct - - type t = Lwt_unix.file_descr - - let backlog = 10 - - let read_env path = - if path <> "" && String.get path 0 = '$' then - try - return (Sys.getenv (String.sub path 1 (String.length path - 1))) - with - Not_found -> - match path with - | "$TEZOS_SIGNER_TCP_HOST" -> return "localhost" - | "$TEZOS_SIGNER_TCP_PORT" -> return "6732" - | "$TEZOS_SIGNER_UNIX_PATH" -> return (Filename.concat (Sys.getenv "HOME") ".tezos-signer-socket") - | _ -> - failwith "Remote signer location uses environment variable %s which is not bound" path - else return path - - let catch_unix_error msg f = - Lwt.catch f @@ function - | Unix.Unix_error (err, syscall, _) -> - failwith "%s\nUnix error (%s): %s" msg syscall (Unix.error_message err) - | Failure err -> failwith "%s\n%s" msg err - | exn -> Lwt.fail exn - - let bind path = - match path with - | Unix path -> - read_env path >>=? fun path -> - catch_unix_error ("Cannot listen on " ^ path) @@ fun () -> - let addr = Lwt_unix.ADDR_UNIX path in - let sock = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in - Lwt_unix.bind sock addr >>= fun () -> - Lwt_unix.listen sock backlog ; - return (sock, path) - | Tcp (host, port) -> - read_env host >>=? fun host -> - read_env port >>=? fun port -> - let full = host ^ ":" ^ port in - catch_unix_error ("Cannot listen on " ^ full) @@ fun () -> - let port = int_of_string port in - let host = try - (Unix.gethostbyname host).h_addr_list.(0) - with Not_found -> Pervasives.failwith ("Host " ^ host ^ " not found") in - let addr = Lwt_unix.ADDR_INET (host, port) in - let sock = Lwt_unix.socket PF_INET SOCK_STREAM 0 in - Lwt_unix.setsockopt sock SO_REUSEADDR true; - Lwt_unix.bind sock addr >>= fun () -> - Lwt_unix.listen sock backlog ; - return (sock, full) - - let connect path = - match path with - | Unix path -> - read_env path >>=? fun path -> - let addr = Lwt_unix.ADDR_UNIX path in - let sock = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in - catch_unix_error ("Cannot connect to local socket " ^ path) @@ fun () -> - Lwt_unix.connect sock addr >>= fun () -> - return sock - | Tcp (host, port) -> - read_env host >>=? fun host -> - read_env port >>=? fun port -> - catch_unix_error ("Cannot connect to " ^ host ^ ":" ^ port) @@ fun () -> - let port = int_of_string port in - let host = try - (Unix.gethostbyname host).h_addr_list.(0) - with Not_found -> Pervasives.failwith ("Host " ^ host ^ " not found") in - let addr = Lwt_unix.ADDR_INET (host, port) in - let sock = Lwt_unix.socket PF_INET SOCK_STREAM 0 in - Lwt_unix.connect sock addr >>= fun () -> - return sock - - let read ~len fd buf = - catch_unix_error "Cannot receive message" @@ fun () -> - Lwt_utils_unix.read_mbytes ~len fd buf >>= return - - let write fd buf = - catch_unix_error "Cannot send message" @@ fun () -> - Lwt_utils_unix.write_mbytes fd buf >>= return - -end - -let message_len_size = 2 - -let send fd encoding message = - let encoded_message_len = - Data_encoding.Binary.length encoding message in - fail_unless - (encoded_message_len < 1 lsl (message_len_size * 8)) - Encoding_error >>=? fun () -> - (* len is the length of int16 plus the length of the message we want to send *) - let len = message_len_size + encoded_message_len in - let buf = MBytes.create len in - match Data_encoding.Binary.write - encoding message buf message_len_size encoded_message_len with - | None -> - fail Encoding_error - | Some last -> - fail_unless (last = len) Encoding_error >>=? fun () -> - (* we set the beginning of the buf with the length of what is next *) - MBytes.set_int16 buf 0 encoded_message_len ; - Connection.write fd buf - -let recv fd encoding = - let header_buf = MBytes.create message_len_size in - Connection.read ~len:message_len_size fd header_buf >>=? fun () -> - let len = MBytes.get_uint16 header_buf 0 in - let buf = MBytes.create len in - Connection.read ~len fd buf >>=? fun () -> - match Data_encoding.Binary.read encoding buf 0 len with - | None -> - fail Decoding_error - | Some (read_len, message) -> - if read_len <> len then - fail Decoding_error - else - return message diff --git a/src/lib_client_base_unix/client_signer_remote_socket.mli b/src/lib_client_base_unix/client_signer_remote_socket.mli deleted file mode 100644 index 9a3409ed0..000000000 --- a/src/lib_client_base_unix/client_signer_remote_socket.mli +++ /dev/null @@ -1,27 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -type error += - | Encoding_error - | Decoding_error - -type path = - | Unix of string - | Tcp of string * string - -module Connection : sig - type t = Lwt_unix.file_descr - val bind : path -> (t * string) tzresult Lwt.t - val connect : path -> t tzresult Lwt.t - val read : len:int -> t -> MBytes.t -> unit tzresult Lwt.t - val write : t -> MBytes.t -> unit tzresult Lwt.t -end - -val send : Connection.t -> 'a Data_encoding.t -> 'a -> unit tzresult Lwt.t -val recv : Connection.t -> 'a Data_encoding.t -> 'a tzresult Lwt.t diff --git a/src/lib_stdlib_unix/lwt_utils_unix.ml b/src/lib_stdlib_unix/lwt_utils_unix.ml index 4d4112699..85835240d 100644 --- a/src/lib_stdlib_unix/lwt_utils_unix.ml +++ b/src/lib_stdlib_unix/lwt_utils_unix.ml @@ -263,3 +263,121 @@ let with_tempdir name f = Lwt_unix.unlink base_dir >>= fun () -> Lwt_unix.mkdir base_dir 0o700 >>= fun () -> Lwt.finalize (fun () -> f base_dir) (fun () -> remove_dir base_dir) + + +module Socket = struct + + type addr = + | Unix of string + | Tcp of string * int + + let get_addrs host = + try return (Array.to_list (Unix.gethostbyname host).h_addr_list) + with Not_found -> failwith "Host %s not found" host + + let connect path = + match path with + | Unix path -> + let addr = Lwt_unix.ADDR_UNIX path in + let sock = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in + Lwt_unix.connect sock addr >>= fun () -> + return sock + | Tcp (host, port) -> + get_addrs host >>=? fun addrs -> + let rec try_connect = function + | [] -> failwith "..." + | addr :: addrs -> + Lwt.catch + (fun () -> + let addr = Lwt_unix.ADDR_INET (addr, port) in + let sock = Lwt_unix.socket PF_INET SOCK_STREAM 0 in + Lwt_unix.connect sock addr >>= fun () -> + return sock) + (fun _ -> try_connect addrs) in + try_connect addrs + + let bind ?(backlog = 10) path = + match path with + | Unix path -> + let addr = Lwt_unix.ADDR_UNIX path in + let sock = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in + Lwt_unix.bind sock addr >>= fun () -> + Lwt_unix.listen sock backlog ; + return sock + | Tcp (host, port) -> + get_addrs host >>=? fun addrs -> + let rec try_bind = function + | [] -> failwith "..." + | addr :: addrs -> + Lwt.catch + (fun () -> + let addr = Lwt_unix.ADDR_INET (addr, port) in + let sock = Lwt_unix.socket PF_INET SOCK_STREAM 0 in + Lwt_unix.setsockopt sock SO_REUSEADDR true ; + Lwt_unix.bind sock addr >>= fun () -> + Lwt_unix.listen sock backlog ; + return sock) + (fun _ -> try_bind addrs) in + try_bind addrs + + type error += + | Encoding_error + | Decoding_error + + let () = + register_error_kind `Permanent + ~id: "signer.encoding_error" + ~title: "Encoding_error" + ~description: "Error while encoding a request to the remote signer" + ~pp: (fun ppf () -> + Format.fprintf ppf "Could not encode a request to the remote signer") + Data_encoding.empty + (function Encoding_error -> Some () | _ -> None) + (fun () -> Encoding_error) ; + register_error_kind `Permanent + ~id: "signer.decoding_error" + ~title: "Decoding_error" + ~description: "Error while decoding a request to the remote signer" + ~pp: (fun ppf () -> + Format.fprintf ppf "Could not decode a request to the remote signer") + Data_encoding.empty + (function Decoding_error -> Some () | _ -> None) + (fun () -> Decoding_error) + + let message_len_size = 2 + + let send fd encoding message = + let encoded_message_len = Data_encoding.Binary.length encoding message in + fail_unless + (encoded_message_len < 1 lsl (message_len_size * 8)) + Encoding_error >>=? fun () -> + (* len is the length of int16 plus the length of the message we want to send *) + let len = message_len_size + encoded_message_len in + let buf = MBytes.create len in + match Data_encoding.Binary.write + encoding message buf message_len_size encoded_message_len with + | None -> + fail Encoding_error + | Some last -> + fail_unless (last = len) Encoding_error >>=? fun () -> + (* we set the beginning of the buf with the length of what is next *) + MBytes.set_int16 buf 0 encoded_message_len ; + write_mbytes fd buf >>= fun () -> + return () + + let recv fd encoding = + let header_buf = MBytes.create message_len_size in + read_mbytes ~len:message_len_size fd header_buf >>= fun () -> + let len = MBytes.get_uint16 header_buf 0 in + let buf = MBytes.create len in + read_mbytes ~len fd buf >>= fun () -> + match Data_encoding.Binary.read encoding buf 0 len with + | None -> + fail Decoding_error + | Some (read_len, message) -> + if read_len <> len then + fail Decoding_error + else + return message + +end diff --git a/src/lib_stdlib_unix/lwt_utils_unix.mli b/src/lib_stdlib_unix/lwt_utils_unix.mli index 146a601d7..86bce8771 100644 --- a/src/lib_stdlib_unix/lwt_utils_unix.mli +++ b/src/lib_stdlib_unix/lwt_utils_unix.mli @@ -55,3 +55,23 @@ module Protocol : sig val write_dir: string -> ?hash:Protocol_hash.t -> Protocol.t -> unit tzresult Lwt.t end + +module Socket : sig + + type addr = + | Unix of string + | Tcp of string * int + + val connect: addr -> Lwt_unix.file_descr tzresult Lwt.t + val bind: ?backlog:int -> addr -> Lwt_unix.file_descr tzresult Lwt.t + + type error += + | Encoding_error + | Decoding_error + + val send: + Lwt_unix.file_descr -> 'a Data_encoding.t -> 'a -> unit tzresult Lwt.t + val recv: + Lwt_unix.file_descr -> 'a Data_encoding.t -> 'a tzresult Lwt.t + +end