Client: rename Client_signer_remote_socket into Lwt_utils_unix.Socket

This commit is contained in:
Grégoire Henry 2018-05-26 11:16:51 +02:00
parent 272066ab04
commit b564b28603
6 changed files with 195 additions and 217 deletions

View File

@ -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) ;
]])

View File

@ -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 =

View File

@ -1,157 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

View File

@ -1,27 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

View File

@ -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

View File

@ -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