Signer: various fixes and cosmetic changes

src/bin_client/main_signer.ml

@@ -9,53 +9,55 @@
 
 open Client_signer_remote_messages
 
-let run_daemon (cctxt : #Client_context.full) _delegates =
+let log = Logging.Client.Sign.lwt_log_notice
-  let uri = Uri.of_string "tezos:/localhost:9000" in
+
-  Connection.bind uri >>= fun fd ->
+let run_daemon (cctxt : #Client_context_unix.unix_full) path =
-  cctxt#message "Accepting request on %s" (Uri.to_string uri) >>= fun () ->
+  Connection.bind path >>=? fun (fd, display_path) ->
   let rec loop () =
     Lwt_unix.accept fd >>= fun (fd, _) ->
     Lwt.async (fun () ->
-        cctxt#message "Receiving" >>= fun () ->
         recv fd Request.encoding >>=? function
         | Sign req ->
-            cctxt#message "Signer: Request for siging data" >>= fun () ->
+            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 >>=? begin function
               | Some (_, _, Some skloc) ->
-                  cctxt#message "Signer: signing data" >>= fun () ->
+                  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 Public_key.Response.encoding (error (Unkwnon_alias_key req.key)) >>=? fun _ ->
-                  cctxt#warning "Singer: Cannot get alias for key %s" req.key >>= fun () ->
+                  log "Cannot get alias for key %s" req.key >>= fun () ->
                   return ()
             end
 
         | Public_key req ->
-            cctxt#message "Singer: Request for public key %s" req.key >>= fun () ->
+            log "Request for public key %s" req.key >>= fun () ->
             Client_keys.alias_keys cctxt req.key >>= begin function
               | Error err ->
                   send fd Public_key.Response.encoding (Error err) >>=? fun _ ->
-                  cctxt#warning "Singer: Cannot get alias for key %s" req.key >>= fun () ->
+                  log "Cannot get alias for key %s" req.key >>= fun () ->
                   return ()
               | Ok value ->
                   begin match value with
                     | Some (public_key_hash, _, _) ->
-                        cctxt#message "Signer: Hash Public Key %a" Signature.Public_key_hash.pp public_key_hash >>= fun () ->
+                        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) ->
+                          | Error err ->
                               send fd Public_key.Response.encoding (Error err) >>=? fun _ ->
-                              cctxt#warning "Singer: cannot get key %s" req.key >>= fun () ->
+                              log "Cannot get key %s" req.key >>= fun () ->
                               return ()
                           | Ok (_, public_key, _) ->
-                              cctxt#message "Signer: Send Public Key %a" Signature.Public_key.pp public_key >>= fun () ->
+                              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 _ ->
                               return ()
                         end
-                    | _ -> begin
+                    | None -> begin
                         send fd Public_key.Response.encoding (error (Unkwnon_alias_key req.key)) >>=? fun _ ->
-                        cctxt#warning "Signer cannot find key %s" req.key >>= fun () ->
+                        log "Cannot find key %s" req.key >>= fun () ->
                         return ()
                       end
                   end
@@ -63,8 +65,16 @@ let run_daemon (cctxt : #Client_context.full) _delegates =
       );
     loop ()
   in
-  Lwt_unix.listen fd 10;
+  Lwt_unix.listen fd 10 ;
-  cctxt#message "Listening" >>= fun () ->
+  log "Accepting requests on %s" display_path >>= fun () ->
+  begin match path with
+    | Tcp _ -> ()
+    | 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 ;
   loop ()
 
 open Clic
@@ -77,12 +87,39 @@ let select_commands _ _ =
   return
     (List.flatten
        [ Client_keys_commands.commands () ;
-         [ command ~group ~desc: "Launch the signer daemon."
+         [ command ~group
-             no_options
+             ~desc: "Launch a signer daemon over a TCP socket."
-             (prefixes [ "signer" ; "daemon" ]
+             (args2
-              @@ seq_of_param Client_keys.Public_key_hash.alias_param)
+                (default_arg
-             (fun () delegates cctxt ->
+                   ~doc: "listening address or host name"
-                run_daemon cctxt delegates) ;
+                   ~short: 'a'
+                   ~long: "address"
+                   ~placeholder: "host|address"
+                   ~default: "$TEZOS_SIGNER_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"
+                   (parameter (fun _ s -> return s))))
+             (prefixes [ "launch" ; "socket" ; "signer" ] @@ stop)
+             (fun (host, port) cctxt ->
+                run_daemon cctxt (Tcp (host, port))) ;
+           command ~group
+             ~desc: "Launch a signer daemon over a local Unix socket."
+             (args1
+                (default_arg
+                   ~doc: "path to the local socket file"
+                   ~short: 's'
+                   ~long: "socket"
+                   ~placeholder: "path"
+                   ~default: "TEZOS_SIGNER_UNIX_PATH"
+                   (parameter (fun _ s -> return s))))
+             (prefixes [ "launch" ; "local" ; "signer" ] @@ stop)
+             (fun path cctxt ->
+                run_daemon cctxt (Unix path))
          ]])
 
 let () = Client_main_run.run select_commands

src/lib_client_base_unix/client_signer_remote.ml

@@ -15,112 +15,116 @@ let sign conn key data =
   send conn Request.encoding (Request.Sign req) >>=? fun () ->
   recv conn Sign.Response.encoding >>=? function
   | Error err -> Lwt.return (Error err)
-  | Ok res -> return res.signature
+  | Ok res -> Lwt_unix.close conn >>= fun () -> return res.signature
 
 let public_key conn key =
   let req = { Public_key.Request.key = key } in
   send conn Request.encoding (Request.Public_key req) >>=? fun () ->
   recv conn Public_key.Response.encoding >>=? function
   | Error err -> Lwt.return (Error err)
-  | Ok res -> return res.public_key
+  | Ok res -> Lwt_unix.close conn >>= fun () -> return res.public_key
-
 
 module Remote_signer : SIGNER = struct
   let scheme = "remote"
 
   let title =
-    "Built-in signer using remote wallet."
+    "Built-in tezos-signer using remote wallet."
 
-  let description = ""
+  let description =
+    "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\
+     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, \
+     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
 
   (* secret key is the identifier of the location key identifier *)
-  type secret_key = Uri.t * string
+  type secret_key = path
-  (* public key is the key itself *)
+  (* public key is the identifier of the location key identifier *)
-  type public_key = Signature.Public_key.t
+  type public_key = path * Signature.Public_key.t
 
-  let pks : (secret_key,public_key) Hashtbl.t = Hashtbl.create 53
+  let pks : (secret_key, Signature.Public_key.t) Hashtbl.t = Hashtbl.create 53
-
-  (* XXX : I want to reuse the connection, but this doesn't work
-     let conn_table = Hashtbl.create 53
-     let connect uri =
-     match Hashtbl.find_opt conn_table uri with
-     | None ->
-        Connection.connect uri >>= fun conn ->
-        Hashtbl.add conn_table uri conn;
-        Lwt.return conn
-     | Some conn -> Lwt.return conn
-  *)
 
   (* load and init the remote wallet. initialize the connection *)
   let init _cctxt = return ()
 
-  let pk_locator_of_human_input _cctxt = function
+  let path_of_human_input = function
-    | [] -> failwith "Remote Schema : Missing public key argument"
+    | "unix" :: key :: [] ->
-    | uri :: key :: _ ->
+        return (Unix "$TEZOS_SIGNER_UNIX_PATH", key)
-        return (
+    | "unix" :: file :: key :: [] ->
-          Public_key_locator.create
+        return (Unix file, key)
-            ~scheme ~location:[String.trim uri; String.trim key]
+    | "tcp" :: host :: port :: key :: [] ->
-        )
+        return (Tcp (host, port), key)
-    | l -> failwith
+    | "tcp" :: host :: key :: [] ->
-             "Remote Schema : Wrong location type %a"
+        return (Tcp (host, "$TEZOS_SIGNER_TCP_PORT"), key)
-             Format.(pp_print_list ~pp_sep:pp_print_cut pp_print_string) l
+    | "tcp" :: key :: [] ->
+        return (Tcp ("$TEZOS_SIGNER_TCP_HOST", "$TEZOS_SIGNER_TCP_PORT"), key)
+    | location ->
+        failwith
+          "@[<v 2>Remote Schema : wrong locator %s.@,@[<hov 0>%a@]@]"
+          (Secret_key_locator.to_string (Secret_key_locator.create ~scheme ~location))
+          Format.pp_print_text description
 
-  let sk_to_locator (uri,key) =
+  let locator_of_path = function
-    Lwt.return (
+    | Unix path, key -> [ "unix" ; path ; key ]
-      Secret_key_locator.create
+    | Tcp (host, port), key -> [ "tcp" ; host ; port ; key ]
-        ~scheme ~location:[Uri.to_string uri; String.trim key]
-    )
 
-  let sk_locator_of_human_input _cctxt = function
+  let pk_locator_of_human_input _cctxt path =
-    | [] -> failwith "Remote Schema : Missing secret key argument"
+    path_of_human_input path >>=? fun pk ->
-    | uri_string :: key :: _ ->
+    let location = locator_of_path pk in
-        let uri = Uri.of_string uri_string in
+    return (Public_key_locator.create ~scheme ~location)
-        Connection.connect uri >>= fun conn ->
-        public_key conn key >>=? fun pk ->
-        Hashtbl.replace pks (uri,key) pk ;
-        sk_to_locator (uri,key) >>= fun locator ->
-        return locator
-    | l -> failwith
-             "Remote Schema : Missing secret key argument %a"
-             Format.(pp_print_list ~pp_sep:pp_print_cut pp_print_string) l
 
-  let sk_of_locator = function
+  let sk_to_locator sk =
-    | (Sk_locator { location  = (uri :: key :: _) }) ->
+    let location = locator_of_path sk in
-        return (Uri.of_string uri, key)
+    Lwt.return (Secret_key_locator.create ~scheme ~location)
-    | skloc ->
-        failwith "Remote Schema : sk_of_locator Wrong locator type: %s"
-          (Secret_key_locator.to_string skloc)
 
-  let pk_of_locator = function
+  let sk_locator_of_human_input _cctxt input =
-    | (Pk_locator { location = ( location :: _ ) }) ->
+    path_of_human_input input >>=? fun (path, key) ->
-        Lwt.return (Signature.Public_key.of_b58check location)
+    Connection.connect path >>=? fun conn ->
-    | pkloc ->
+    public_key conn key >>=? fun pk ->
-        failwith "Remote Schema : pk_of_locator Wrong locator type: %s"
+    Hashtbl.replace pks (path, key) pk ;
-          (Public_key_locator.to_string pkloc)
+    sk_to_locator (path,key) >>= fun locator ->
+    return locator
 
-  let pk_to_locator pk =
+  let sk_of_locator loc =
-    Public_key_locator.create
+    path_of_human_input (Secret_key_locator.location loc)
-      ~scheme ~location:[Signature.Public_key.to_b58check pk] |>
-    Lwt.return
 
-  let neuterize ((uri, key) as sk) =
+  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 ->
+    Hashtbl.replace pks (path, key) pk ;
+    return ((path, key), pk)
+
+  let pk_to_locator (path, _) =
+    let location = locator_of_path path in
+    Lwt.return (Public_key_locator.create ~scheme ~location)
+
+  let neuterize ((path, key) as sk) =
     match Hashtbl.find_opt pks sk with
-    | Some pk -> Lwt.return pk
+    | Some pk -> Lwt.return (sk, pk)
     | None -> begin
-        Connection.connect uri >>= fun conn ->
+        (Connection.connect path >>=? fun conn ->
-        public_key conn key >>= function
+         public_key conn key) >>= function
         | Error _ -> Lwt.fail_with "Remote : Cannot obtain public key from remote signer"
         | Ok pk -> begin
             Hashtbl.replace pks sk pk ;
-            Lwt.return pk
+            Lwt.return (sk, pk)
           end
       end
 
-  let public_key x = return x
+  let public_key (_, x) = return x
-  let public_key_hash x = return (Signature.Public_key.hash x)
+  let public_key_hash (_, x) = return (Signature.Public_key.hash x)
 
-  let sign (uri, key) msg =
+  let sign (path, key) msg =
-    Connection.connect uri >>= fun conn ->
+    Connection.connect path >>=? fun conn ->
     sign conn key msg
 end
 

src/lib_client_base_unix/client_signer_remote_messages.ml

@@ -51,6 +51,9 @@ let () =
     (function Decoding_error -> Some () | _ -> None)
     (fun () -> Decoding_error)
 
+type path =
+  | Unix of string
+  | Tcp of string * string
 type key = string
 
 module Connection = struct
@@ -58,53 +61,82 @@ module Connection = struct
   type t = Lwt_unix.file_descr
 
   let backlog = 10
-  let default_port = 9000
-  let localhost = Ipaddr.V4 (Ipaddr.V4.localhost)
 
-  let getaddr uri =
+  let read_env path =
-    match Uri.scheme uri with
+    if path <> "" && String.get path 0 = '$' then
-    | Some "file" ->
+      try
-        let path = Uri.path uri in
+        return (Sys.getenv (String.sub path 1 (String.length path - 1)))
-        Lwt.catch
+      with
-          (fun () -> Lwt_unix.unlink path)
+        Not_found ->
-          (fun _ -> Lwt.return ())
+          match path with
-        >>= fun () ->
+          | "$TEZOS_SIGNER_TCP_HOST" -> return "localhost"
-        Lwt.return (Lwt_unix.ADDR_UNIX path)
+          | "$TEZOS_SIGNER_TCP_PORT" -> return "6732"
-    | Some "tezos" -> begin
+          | "$TEZOS_SIGNER_UNIX_PATH" -> return (Filename.concat (Sys.getenv "HOME") ".tezos-signer-socket")
-        match Uri.host uri, Uri.port uri with
+          | _ ->
-        | Some host, port_opt ->
+              failwith "Remote signer location uses environment variable %s which is not bound" path
-            begin match Ipaddr.of_string host with
+    else return path
-              |Some host ->
-                  let h = Ipaddr_unix.to_inet_addr host in
-                  let p = Option.unopt ~default:default_port port_opt in
-                  Lwt.return (Lwt_unix.ADDR_INET(h,p))
-              | None ->
-                  Lwt.fail_with ("Cannot parse host " ^ (Uri.to_string uri))
-            end
-        | None, _ ->
-            let h = Ipaddr_unix.to_inet_addr localhost in
-            Lwt.return (Lwt_unix.ADDR_INET(h, default_port))
-      end
-    | _ -> Lwt.fail_with ("Cannot parse URI " ^ (Uri.to_string uri))
 
-  let bind remote =
+  let catch_unix_error msg f =
-    getaddr remote >>= fun addr ->
+    Lwt.catch f @@ function
-    let sock = Lwt_unix.socket PF_INET SOCK_STREAM 0 in
+    | Unix.Unix_error (err, syscall, _) ->
-    Lwt_unix.setsockopt sock SO_REUSEADDR true;
+        failwith "%s\nUnix error (%s): %s" msg syscall (Unix.error_message err)
-    Lwt_unix.bind sock @@ addr >|= fun () ->
+    | Failure err -> failwith "%s\n%s" msg err
-    Lwt_unix.listen sock backlog;
+    | exn -> Lwt.fail exn
-    sock
 
-  let connect remote =
+  let bind path =
-    getaddr remote >>= fun addr ->
+    match path with
-    let sock = Lwt_unix.socket PF_INET SOCK_STREAM 0 in
+    | Unix path ->
-    Lwt_unix.connect sock @@ addr >|= fun () ->
+        read_env path >>=? fun path ->
-    sock
+        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

src/lib_client_base_unix/client_signer_remote_messages.mli

@@ -13,12 +13,15 @@ type error +=
   | Unkwnon_alias_key of string
   | Unkwnon_request_kind
 
+type path =
+  | Unix of string
+  | Tcp of string * string
 type key = string
 
 module Connection : sig
   type t = Lwt_unix.file_descr
-  val bind : Uri.t -> t Lwt.t
+  val bind : path -> (t * string) tzresult Lwt.t
-  val connect : Uri.t -> t 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