balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Signer: add HTTPS variant

Browse Source
This commit is contained in:
Benjamin Canou 2018-05-24 02:26:10 +02:00 committed by Grégoire Henry
parent fe435ce114
commit 0a6f65263f
9 changed files with 441 additions and 224 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
src/bin_client/main_signer.ml
View File

@ -11,7 +11,8 @@ open Client_signer_remote_messages
let log = Logging.Client.Sign.lwt_log_notice
let run_daemon (cctxt : #Client_context_unix.unix_full) path =
let run_socket_daemon (cctxt : #Client_context_unix.unix_full) path =
let open Client_signer_remote_socket in
Connection.bind path >>=? fun (fd, display_path) ->
let rec loop () =
Lwt_unix.accept fd >>= fun (fd, _) ->
@ -20,22 +21,24 @@ let run_daemon (cctxt : #Client_context_unix.unix_full) path =
| 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 () ->
let encoding = result_encoding Sign.Response.encoding in
Client_keys.alias_keys cctxt req.key >>=? begin function
| Some (_, _, Some skloc) ->
log "Signing data for key %s" req.key >>= fun () ->
Client_keys.sign cctxt skloc req.data >>=? fun signature ->
send fd Sign.Response.encoding (ok { Sign.Response.signature = signature })
send fd encoding (ok { Sign.Response.signature = signature })
| _ ->
send fd Public_key.Response.encoding (error (Unkwnon_alias_key req.key)) >>=? fun _ ->
send fd encoding (error (Unkwnon_alias_key req.key)) >>=? fun _ ->
log "Cannot get alias for key %s" req.key >>= fun () ->
return ()
end
| Public_key req ->
log "Request for public key %s" req.key >>= fun () ->
let encoding = result_encoding Public_key.Response.encoding in
Client_keys.alias_keys cctxt req.key >>= begin function
| Error err ->
send fd Public_key.Response.encoding (Error err) >>=? fun _ ->
send fd encoding (Error err) >>=? fun _ ->
log "Cannot get alias for key %s" req.key >>= fun () ->
return ()
| Ok value ->
@ -45,18 +48,17 @@ let run_daemon (cctxt : #Client_context_unix.unix_full) 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 Public_key.Response.encoding (Error err) >>=? fun _ ->
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 Public_key.Response.encoding
(ok { Public_key.Response.public_key = public_key }) >>=? fun _ ->
send fd encoding (ok { Public_key.Response.public_key = public_key }) >>=? fun _ ->
return ()
end
| None -> begin
send fd Public_key.Response.encoding (error (Unkwnon_alias_key req.key)) >>=? fun _ ->
send fd encoding (error (Unkwnon_alias_key req.key)) >>=? fun _ ->
log "Cannot find key %s" req.key >>= fun () ->
return ()
end
@ -66,17 +68,78 @@ let run_daemon (cctxt : #Client_context_unix.unix_full) path =
loop ()
in
Lwt_unix.listen fd 10 ;
log "Accepting requests on %s" display_path >>= fun () ->
begin match path with
| Tcp _ -> ()
| Tcp _ ->
log "Accepting TCP requests on %s" display_path
| Unix path ->
Sys.set_signal Sys.sigint (Signal_handle (fun _ ->
Format.printf "Removing the local socket file and quitting.@." ;
Unix.unlink path ;
exit 0)) ;
end ;
log "Accepting UNIX requests on %s" display_path
end >>= fun () ->
loop ()
let run_https_daemon (cctxt : #Client_context_unix.unix_full) 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
let dir = RPC_directory.empty in
let dir =
RPC_directory.register0 dir
sign (fun () 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 () ->
Client_keys.alias_keys cctxt req.key >>=? function
| Some (_, _, Some skloc) ->
log "Signing data for key %s" req.key >>= fun () ->
Client_keys.sign cctxt skloc req.data >>=? fun signature ->
return { Sign.Response.signature = signature }
| _ ->
fail (Unkwnon_alias_key req.key)) in
let dir =
RPC_directory.register0 dir
public_key (fun () req ->
log "Request for public key %s" req.key >>= fun () ->
Client_keys.alias_keys cctxt req.key >>= begin function
| Error err ->
log "Cannot get alias for key %s" req.key >>= fun () ->
Lwt.return (Error err)
| Ok value ->
begin match value with
| Some (public_key_hash, _, _) ->
log "Found public key hash %a for key %s"
Signature.Public_key_hash.pp public_key_hash req.key >>= fun () ->
Client_keys.get_key cctxt public_key_hash >>= begin function
| Error err ->
log "Cannot get key %s" req.key >>= fun () ->
Lwt.return (Error err)
| Ok (_, public_key, _) ->
log "Send public key %a for key %s"
Signature.Public_key.pp public_key req.key >>= fun () ->
return { Public_key.Response.public_key = public_key }
end
| None -> begin
log "Cannot find key %s" req.key >>= fun () ->
fail (Unkwnon_alias_key req.key)
end
end
end) in
Lwt.catch
(fun () ->
RPC_server.launch ~host mode dir
~media_types:Media_type.all_media_types
~cors: { allowed_origins = [ "*" ] ;
allowed_headers = [ "Content-Type" ] }
>>= fun _server ->
fst (Lwt.wait ()))
(function
| Unix.Unix_error(Unix.EADDRINUSE, "bind","") ->
failwith "Port already in use."
| exn -> Lwt.return (error_exn exn))
open Clic
let group =
@ -106,7 +169,7 @@ let select_commands _ _ =
(parameter (fun _ s -> return s))))
(prefixes [ "launch" ; "socket" ; "signer" ] @@ stop)
(fun (host, port) cctxt ->
run_daemon cctxt (Tcp (host, port))) ;
run_socket_daemon cctxt (Tcp (host, port))) ;
command ~group
~desc: "Launch a signer daemon over a local Unix socket."
(args1
@ -119,7 +182,35 @@ let select_commands _ _ =
(parameter (fun _ s -> return s))))
(prefixes [ "launch" ; "local" ; "signer" ] @@ stop)
(fun path cctxt ->
run_daemon cctxt (Unix path))
run_socket_daemon cctxt (Unix path)) ;
command ~group
~desc: "Launch a signer daemon over HTTPS."
(args2
(default_arg
~doc: "listening address or host name"
~short: 'a'
~long: "address"
~placeholder: "host|address"
~default: "$TEZOS_SIGNER_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"
(parameter (fun _ s -> return s))))
(prefixes [ "launch" ; "https" ; "signer" ] @@
param
~name:"cert"
~desc: "path to th TLS certificate"
(parameter (fun _ s -> return s)) @@
param
~name:"key"
~desc: "path to th TLS key"
(parameter (fun _ s -> return s)) @@ stop)
(fun (host, port) cert key cctxt ->
run_https_daemon cctxt host port cert key) ;
]])
let () = Client_main_run.run select_commands

2
src/lib_client_base/client_keys.ml
View File

@ -183,7 +183,7 @@ let sign ?watermark cctxt ((Sk_locator { scheme }) as skloc) buf =
Signer.neuterize t >>= fun pk ->
Signer.public_key pk >>=? fun pubkey ->
fail_unless
(Signature.check pubkey signature buf)
(Signature.check ?watermark pubkey signature buf)
(Signature_mismatch skloc) >>=? fun () ->
return signature

80
src/lib_client_base_unix/client_signer_remote.ml
View File

@ -10,20 +10,42 @@
open Client_keys
open Client_signer_remote_messages
let sign conn key data =
type path =
| Socket of Client_signer_remote_socket.path
| 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 () ->
recv conn Sign.Response.encoding >>=? function
let encoding = result_encoding Sign.Response.encoding in
recv conn encoding >>=? function
| Error err -> Lwt.return (Error err)
| Ok res -> Lwt_unix.close conn >>= fun () -> return res.signature
let public_key conn key =
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 () ->
recv conn Public_key.Response.encoding >>=? function
let encoding = result_encoding Public_key.Response.encoding in
recv conn encoding >>=? function
| Error err -> Lwt.return (Error err)
| Ok res -> Lwt_unix.close conn >>= fun () -> return res.public_key
let sign path key data = match path with
| Socket path -> socket_sign path key data
| Https path ->
Client_signer_remote_services.(call path sign) { key ; data } >>=? fun res ->
return res.signature
let request_public_key path key = match path with
| Socket path -> socket_request_public_key path key
| Https path ->
Client_signer_remote_services.(call path public_key) { key } >>=? fun res ->
return res.public_key
module Remote_signer : SIGNER = struct
let scheme = "remote"
@ -34,21 +56,22 @@ module Remote_signer : SIGNER = struct
"Valid locators are one of these two forms:\n\
\ - unix [path to local signer socket] <remote key alias>\n\
\ - tcp [host] [port] <remote key alias>\n\
\ - https [host] [port] <remote key alias>\n\
All fields except the key can be of the form '$VAR', \
in which case their value is taken from environment variable \
VAR each time the key is accessed.\n\
Not specifiyng fields sets them to $TEZOS_SIGNER_UNIX_PATH, \
$TEZOS_SIGNER_TCP_HOST and $TEZOS_SIGNER_TCP_PORT, \
$TEZOS_SIGNER_HTTPS_HOST and $TEZOS_SIGNER_HTTPS_PORT, \
that get evaluated to default values '$HOME/.tezos-signer-socket', \
localhost and 6732, and can be set later on."
type path =
Client_signer_remote_messages.path * Client_signer_remote_messages.key
type key_path = path * key
(* secret key is the identifier of the location key identifier *)
type secret_key = path
type secret_key = key_path
(* public key is the identifier of the location key identifier *)
type public_key = path * Signature.Public_key.t
type public_key = key_path * Signature.Public_key.t
let pks : (secret_key, Signature.Public_key.t) Hashtbl.t = Hashtbl.create 53
@ -57,15 +80,21 @@ module Remote_signer : SIGNER = struct
let path_of_human_input = function
| "unix" :: key :: [] ->
return (Unix "$TEZOS_SIGNER_UNIX_PATH", key)
return (Socket (Unix "$TEZOS_SIGNER_UNIX_PATH"), key)
| "unix" :: file :: key :: [] ->
return (Unix file, key)
return (Socket (Unix file), key)
| "tcp" :: host :: port :: key :: [] ->
return (Tcp (host, port), key)
return (Socket (Tcp (host, port)), key)
| "tcp" :: host :: key :: [] ->
return (Tcp (host, "$TEZOS_SIGNER_TCP_PORT"), key)
return (Socket (Tcp (host, "$TEZOS_SIGNER_TCP_PORT")), key)
| "tcp" :: key :: [] ->
return (Tcp ("$TEZOS_SIGNER_TCP_HOST", "$TEZOS_SIGNER_TCP_PORT"), 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 :: [] ->
return (Https (host, "$TEZOS_SIGNER_HTTPS_PORT"), key)
| "https" :: key :: [] ->
return (Https ("$TEZOS_SIGNER_HTTPS_HOST", "$TEZOS_SIGNER_HTTPS_PORT"), key)
| location ->
failwith
"@[<v 2>Remote Schema : wrong locator %s.@,@[<hov 0>%a@]@]"
@ -73,8 +102,9 @@ module Remote_signer : SIGNER = struct
Format.pp_print_text description
let locator_of_path = function
| Unix path, key -> [ "unix" ; path ; key ]
| Tcp (host, port), key -> [ "tcp" ; host ; port ; key ]
| Socket (Unix path), key -> [ "unix" ; path ; key ]
| Socket (Tcp (host, port)), key -> [ "tcp" ; host ; port ; key ]
| Https (host, port), key -> [ "https" ; host ; port ; key ]
let pk_locator_of_human_input _cctxt path =
path_of_human_input path >>=? fun pk ->
@ -87,8 +117,7 @@ module Remote_signer : SIGNER = struct
let sk_locator_of_human_input _cctxt input =
path_of_human_input input >>=? fun (path, key) ->
Connection.connect path >>=? fun conn ->
public_key conn key >>=? fun pk ->
request_public_key path key >>=? fun pk ->
Hashtbl.replace pks (path, key) pk ;
sk_to_locator (path,key) >>= fun locator ->
return locator
@ -98,8 +127,7 @@ module Remote_signer : SIGNER = struct
let pk_of_locator loc =
path_of_human_input (Public_key_locator.location loc) >>=? fun (path, key) ->
Connection.connect path >>=? fun conn ->
public_key conn key >>=? fun pk ->
request_public_key path key >>=? fun pk ->
Hashtbl.replace pks (path, key) pk ;
return ((path, key), pk)
@ -111,8 +139,7 @@ module Remote_signer : SIGNER = struct
match Hashtbl.find_opt pks sk with
| Some pk -> Lwt.return (sk, pk)
| None -> begin
(Connection.connect path >>=? fun conn ->
public_key conn key) >>= function
request_public_key path key >>= function
| Error _ -> Lwt.fail_with "Remote : Cannot obtain public key from remote signer"
| Ok pk -> begin
Hashtbl.replace pks sk pk ;
@ -123,9 +150,14 @@ module Remote_signer : SIGNER = struct
let public_key (_, x) = return x
let public_key_hash (_, x) = return (Signature.Public_key.hash x)
let sign (path, key) msg =
Connection.connect path >>=? fun conn ->
sign conn key msg
let sign ?watermark (path, key) msg =
let msg =
match watermark with
| None -> msg
| Some watermark ->
MBytes.concat "" [ Signature.bytes_of_watermark watermark ; msg ] in
sign path key msg
end
let () =

167
src/lib_client_base_unix/client_signer_remote_messages.ml
View File

@ -7,11 +7,7 @@
(* *)
(**************************************************************************)
type error +=
| Encoding_error
| Decoding_error
| Unkwnon_alias_key of string
| Unkwnon_request_kind
type error += Unkwnon_alias_key of string
let () =
register_error_kind `Permanent
@ -22,165 +18,14 @@ let () =
Format.fprintf ppf "The key %s does not is not known on the remote signer" s)
Data_encoding.(obj1 (req "value" string))
(function Unkwnon_alias_key s -> Some s | _ -> None)
(fun s -> Unkwnon_alias_key s) ;
register_error_kind `Permanent
~id: "signer.unknown_request_kind"
~title: "Unkwnon_request_kind"
~description: "A request is not not understood by the remote signer"
~pp: (fun ppf () ->
Format.fprintf ppf "The request is not not understood by the remote signer" )
Data_encoding.empty
(function Unkwnon_request_kind -> Some () | _ -> None)
(fun () -> Unkwnon_request_kind) ;
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)
(fun s -> Unkwnon_alias_key s)
type path =
| Unix of string
| Tcp of string * string
type key = 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 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
module Sign = struct
module Request = struct
type t = {
key : string ;
key : key ;
data: MBytes.t ;
}
@ -203,7 +48,6 @@ module Sign = struct
let encoding =
let open Data_encoding in
result_encoding @@
conv
(fun { signature } -> (signature))
(fun (signature) -> { signature })
@ -214,7 +58,7 @@ end
module Public_key = struct
module Request = struct
type t = {
key : string
key : key ;
}
let encoding =
@ -227,12 +71,11 @@ module Public_key = struct
module Response = struct
type t = {
public_key : Signature.Public_key.t
public_key : Signature.Public_key.t ;
}
let encoding =
let open Data_encoding in
result_encoding @@
conv
(fun { public_key } -> public_key)
(fun public_key -> { public_key })

30
src/lib_client_base_unix/client_signer_remote_messages.mli
View File

@ -7,29 +7,14 @@
(* *)
(**************************************************************************)
type error +=
| Encoding_error
| Decoding_error
| Unkwnon_alias_key of string
| Unkwnon_request_kind
type error += Unkwnon_alias_key of string
type path =
| Unix of string
| Tcp of string * string
type key = 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
module Sign : sig
module Request : sig
type t = {
key : string ;
key : key ;
data: MBytes.t ;
}
val encoding : t Data_encoding.t
@ -38,22 +23,22 @@ module Sign : sig
type t = {
signature : Signature.t ;
}
val encoding : t tzresult Data_encoding.t
val encoding : t Data_encoding.t
end
end
module Public_key : sig
module Request : sig
type t = {
key : string
key : key ;
}
val encoding : t Data_encoding.t
end
module Response : sig
type t = {
public_key : Signature.Public_key.t
public_key : Signature.Public_key.t ;
}
val encoding : t tzresult Data_encoding.t
val encoding : t Data_encoding.t
end
end
@ -63,6 +48,3 @@ module Request : sig
| Public_key of Public_key.Request.t
val encoding : t Data_encoding.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

62
src/lib_client_base_unix/client_signer_remote_services.ml Normal file
View File

@ -0,0 +1,62 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Client_signer_remote_messages
let sign = RPC_service.post_service
~description: "Sign a piece of data with a given remote key"
~query: RPC_query.empty
~input: Sign.Request.encoding
~output: Sign.Response.encoding
RPC_path.(root / "sign")
let public_key = RPC_service.post_service
~description: "Retrieve the public key of a given remote key"
~query: RPC_query.empty
~input: Public_key.Request.encoding
~output: Public_key.Response.encoding
RPC_path.(root / "public_key")
type path = string * string
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_HTTPS_HOST" -> return "localhost"
| "$TEZOS_SIGNER_HTTPS_PORT" -> return "5732"
| _ ->
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 base (host, port) =
read_env host >>=? fun host ->
read_env port >>=? fun port ->
catch_unix_error "Cannot parse port" @@ fun () ->
return (host, int_of_string port)
let call (host, port) service arg =
read_env host >>=? fun host ->
read_env port >>=? fun port ->
catch_unix_error "Cannot call remote service" @@ fun () ->
let port = int_of_string port in
RPC_client.call_service
Media_type.all_media_types
~base: (Uri.of_string (Format.asprintf "https://%s:%d" host port))
service () () arg

23
src/lib_client_base_unix/client_signer_remote_services.mli Normal file
View File

@ -0,0 +1,23 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Client_signer_remote_messages
val sign :
([ `POST ], unit, unit, unit, Sign.Request.t, Sign.Response.t) RPC_service.t
val public_key :
([ `POST ], unit, unit, unit, Public_key.Request.t, Public_key.Response.t) RPC_service.t
type path = string * string
val base : path -> (string * int) tzresult Lwt.t
val call :
path -> ([ `POST ], unit, unit, unit, 'p, 'r) RPC_service.t -> 'p -> 'r tzresult Lwt.t

157
src/lib_client_base_unix/client_signer_remote_socket.ml Normal file
View File

@ -0,0 +1,157 @@
(**************************************************************************)
(* *)
(* 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

27
src/lib_client_base_unix/client_signer_remote_socket.mli Normal file
View File

@ -0,0 +1,27 @@
(**************************************************************************)
(* *)
(* 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