Signer/TCP: more flexible spec

src/bin_signer/main_signer.ml

@@ -97,19 +97,19 @@ let commands base_dir require_auth =
             ~default: default_tcp_host
             (parameter (fun _ s -> return s)))
          (default_arg
-            ~doc: "listening TCP port"
+            ~doc: "listening TCP port or service name"
             ~short: 'p'
             ~long: "port"
             ~placeholder: "port number"
             ~default: default_tcp_port
-            (parameter
-               (fun _ x ->
-                  try return (int_of_string x)
-                  with Failure _ -> failwith "Invalid port %s" x))))
+            (parameter (fun _ s -> return s))))
       (prefixes [ "launch" ; "socket" ; "signer" ] @@ stop)
       (fun (magic_bytes, host, port) cctxt ->
          Tezos_signer_backends.Encrypted.decrypt_all cctxt >>=? fun () ->
-         Socket_daemon.run cctxt (Tcp (host, port)) ?magic_bytes ~require_auth) ;
+         Socket_daemon.run
+           cctxt (Tcp (host, port, [AI_SOCKTYPE SOCK_STREAM]))
+           ?magic_bytes ~require_auth >>=? fun _ ->
+         return_unit) ;
     command ~group
       ~desc: "Launch a signer daemon over a local Unix socket."
       (args2
@@ -124,7 +124,9 @@ let commands base_dir require_auth =
       (prefixes [ "launch" ; "local" ; "signer" ] @@ stop)
       (fun (magic_bytes, path) cctxt ->
          Tezos_signer_backends.Encrypted.decrypt_all cctxt >>=? fun () ->
-         Socket_daemon.run cctxt (Unix path) ?magic_bytes ~require_auth) ;
+         Socket_daemon.run
+           cctxt (Unix path) ?magic_bytes ~require_auth >>=? fun _ ->
+         return_unit) ;
     command ~group
       ~desc: "Launch a signer daemon over HTTP."
       (args3

src/bin_signer/signer_logging.ml

@@ -26,7 +26,8 @@
 include Tezos_stdlib.Logging.Make_semantic(struct let name = "client.signer" end)
 
 let host_name = Tag.def ~doc:"Host name" "host" Format.pp_print_text
+let service_name = Tag.def ~doc:"Service name" "service" Format.pp_print_text
+let port_number = Tag.def ~doc:"Port number" "port" Format.pp_print_int
 let magic_byte = Tag.def ~doc:"Magic byte" "magic_byte" Format.pp_print_int
 let num_bytes = Tag.def ~doc:"Number of bytes" "num_bytes" Format.pp_print_int
-let port_number = Tag.def ~doc:"Port number" "port" Format.pp_print_int
 let unix_socket_path = Tag.def ~doc:"UNIX socket file path" "unix_socket" Format.pp_print_text

src/bin_signer/signer_logging.mli

@@ -26,7 +26,8 @@
 include Tezos_stdlib.Logging.SEMLOG
 
 val host_name: string Tag.def
+val service_name: string Tag.def
+val port_number: int Tag.def
 val magic_byte: int Tag.def
 val num_bytes: int Tag.def
-val port_number: int Tag.def
 val unix_socket_path: string Tag.def

src/bin_signer/socket_daemon.ml

@@ -28,46 +28,42 @@ open Signer_messages
 
 let log = lwt_log_notice
 
+let handle_client ?magic_bytes ~require_auth cctxt fd =
+  Lwt_utils_unix.Socket.recv fd Request.encoding >>=? function
+  | Sign req ->
+      let encoding = result_encoding Sign.Response.encoding in
+      Handler.sign cctxt req ?magic_bytes ~require_auth >>= fun res ->
+      Lwt_utils_unix.Socket.send fd encoding res >>= fun _ ->
+      Lwt_unix.close fd >>= fun () ->
+      return_unit
+  | Public_key pkh ->
+      let encoding = result_encoding Public_key.Response.encoding in
+      Handler.public_key cctxt pkh >>= fun res ->
+      Lwt_utils_unix.Socket.send fd encoding res >>= fun _ ->
+      Lwt_unix.close fd >>= fun () ->
+      return_unit
+  | Authorized_keys ->
+      let encoding = result_encoding Authorized_keys.Response.encoding in
+      begin if require_auth then
+          Handler.Authorized_key.load cctxt >>=? fun keys ->
+          return (Authorized_keys.Response.Authorized_keys
+                    (keys |> List.split |> snd |> List.map Signature.Public_key.hash))
+        else return Authorized_keys.Response.No_authentication
+      end >>= fun res ->
+      Lwt_utils_unix.Socket.send fd encoding res >>= fun _ ->
+      Lwt_unix.close fd >>= fun () ->
+      return_unit
+
 let run (cctxt : #Client_context.wallet) path ?magic_bytes ~require_auth =
-  Lwt_utils_unix.Socket.bind path >>=? fun fd ->
-  let rec loop () =
-    Lwt_unix.accept fd >>= fun (fd, _) ->
-    Lwt.async begin fun () ->
-      Lwt_utils_unix.Socket.recv fd Request.encoding >>=? function
-      | Sign req ->
-          let encoding = result_encoding Sign.Response.encoding in
-          Handler.sign cctxt req ?magic_bytes ~require_auth >>= fun res ->
-          Lwt_utils_unix.Socket.send fd encoding res >>= fun _ ->
-          Lwt_unix.close fd >>= fun () ->
-          return_unit
-      | Public_key pkh ->
-          let encoding = result_encoding Public_key.Response.encoding in
-          Handler.public_key cctxt pkh >>= fun res ->
-          Lwt_utils_unix.Socket.send fd encoding res >>= fun _ ->
-          Lwt_unix.close fd >>= fun () ->
-          return_unit
-      | Authorized_keys ->
-          let encoding = result_encoding Authorized_keys.Response.encoding in
-          begin if require_auth then
-              Handler.Authorized_key.load cctxt >>=? fun keys ->
-              return (Authorized_keys.Response.Authorized_keys
-                        (keys |> List.split |> snd |> List.map Signature.Public_key.hash))
-            else return Authorized_keys.Response.No_authentication
-          end >>= fun res ->
-          Lwt_utils_unix.Socket.send fd encoding res >>= fun _ ->
-          Lwt_unix.close fd >>= fun () ->
-          return_unit
-    end ;
-    loop ()
-  in
+  let open Lwt_utils_unix.Socket in
   begin
     match path with
-    | Tcp (host, port) ->
+    | Tcp (host, service, _opts) ->
         log Tag.DSL.(fun f ->
-            f "Accepting TCP requests on port %s:%d"
+            f "Accepting TCP requests on %s:%s"
             -% t event "accepting_tcp_requests"
             -% s host_name host
-            -% s port_number port)
+            -% s service_name service)
     | Unix path ->
         Sys.set_signal Sys.sigint (Signal_handle begin fun _ ->
             Format.printf "Removing the local socket file and quitting.@." ;
@@ -79,4 +75,18 @@ let run (cctxt : #Client_context.wallet) path ?magic_bytes ~require_auth =
             -% t event "accepting_unix_requests"
             -% s unix_socket_path path)
   end >>= fun () ->
-  loop ()
+  bind path >>=? fun fds ->
+  let rec loop fd =
+    Lwt_unix.accept fd >>= fun (cfd, _) ->
+    Lwt.async begin fun () ->
+      protect
+        ~on_error:(function
+            | [Exn End_of_file] -> return_unit
+            | errs -> Lwt.return (Error errs))
+        (fun () ->
+           handle_client ?magic_bytes ~require_auth cctxt cfd)
+    end ;
+    loop fd
+  in
+  Lwt_list.map_p loop fds >>=
+  return

src/bin_signer/socket_daemon.mli

@@ -28,4 +28,4 @@ val run:
   Lwt_utils_unix.Socket.addr ->
   ?magic_bytes: int list ->
   require_auth: bool ->
-  'a tzresult Lwt.t
+  'a list tzresult Lwt.t

src/lib_signer_backends/socket.ml

@@ -136,7 +136,8 @@ module Make(P : sig
             with _ -> "" in
           Lwt.return
             (Signature.Public_key_hash.of_b58check pkh) >>=? fun pkh ->
-          return (Lwt_utils_unix.Socket.Tcp (path, port), pkh)
+          return (Lwt_utils_unix.Socket.Tcp (path, string_of_int port,
+                                             [Lwt_unix.AI_SOCKTYPE SOCK_STREAM]), pkh)
 
     let public_key uri =
       parse (uri : pk_uri :> Uri.t) >>=? fun (path, pkh) ->