Client: rename Client_signer_remote_socket into Lwt_utils_unix.Socket

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
+  Lwt_utils_unix.Socket.bind path >>=? fun fd ->
-  Connection.bind path >>=? fun (fd, display_path) ->
   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 _ ->
+    | Tcp (host, port) ->
-        log "Accepting TCP requests on %s" display_path
+        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) ;
          ]])
 

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 ->
+  Lwt_utils_unix.Socket.connect path >>=? fun conn ->
-  send conn Request.encoding (Request.Sign req) >>=? fun () ->
+  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 ->
+  Lwt_utils_unix.Socket.connect path >>=? fun conn ->
-  send conn Request.encoding (Request.Public_key req) >>=? fun () ->
+  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)
+        return (Socket (Tcp (host, int_of_string port)), key)
-    | "tcp" :: host :: key :: [] ->
+    (* Temporary FIXME *)
-        return (Socket (Tcp (host, "$TEZOS_SIGNER_TCP_PORT")), key)
+    (* | "tcp" :: host :: key :: [] -> *)
-    | "tcp" :: key :: [] ->
+    (* return (Socket (Tcp (host, "$TEZOS_SIGNER_TCP_PORT")), key) *)
-        return (Socket (Tcp ("$TEZOS_SIGNER_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 =

src/lib_client_base_unix/client_signer_remote_socket.ml

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

src/lib_client_base_unix/client_signer_remote_socket.mli

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

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

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