Client: Use Host in HTTP requests

and add proper error message when the node refuses connection for
unallowed origin (CORS).

src/bin_client/tezos-init-sandboxed-client.sh

@@ -4,6 +4,8 @@ set -e
 
 client_dirs=()
 
+host=localhost
+
 init_sandboxed_client() {
 
     id="$1"
@@ -14,20 +16,20 @@ init_sandboxed_client() {
     client_dirs+=("$client_dir")
     signer="$local_signer -d $client_dir"
     if [ -n "$USE_TLS" ]; then
-        client="$local_client -S -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+        client="$local_client -S -base-dir $client_dir -addr $host -port $rpc"
-        admin_client="$local_admin_client -S -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+        admin_client="$local_admin_client -S -base-dir $client_dir -addr $host -port $rpc"
-        alpha_baker="$local_alpha_baker -S -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+        alpha_baker="$local_alpha_baker -S -base-dir $client_dir -addr $host -port $rpc"
-        alpha_endorser="$local_alpha_endorser -S -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+	alpha_endorser="$local_alpha_endorser -S -base-dir $client_dir -addr $host -port $rpc"
-        alpha_accuser="$local_alpha_accuser -S -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+	alpha_accuser="$local_alpha_accuser -S -base-dir $client_dir -addr $host -port $rpc"
-        signer="$local_signer -S -base-dir $client_dir"
+        signer="$local_signer -S -base-dir $client_dir -addr $host -port $rpc"
         compiler="$local_compiler"
     else
-        client="$local_client -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+        client="$local_client -base-dir $client_dir -addr $host -port $rpc"
-        admin_client="$local_admin_client -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+        admin_client="$local_admin_client -base-dir $client_dir -addr $host -port $rpc"
-        alpha_baker="$local_alpha_baker -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+        alpha_baker="$local_alpha_baker -base-dir $client_dir -addr $host -port $rpc"
-        alpha_endorser="$local_alpha_endorser -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+	alpha_endorser="$local_alpha_endorser -base-dir $client_dir -addr $host -port $rpc"
-        alpha_accuser="$local_alpha_accuser -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+	alpha_accuser="$local_alpha_accuser -base-dir $client_dir -addr $host -port $rpc"
-        signer="$local_signer -base-dir $client_dir"
+        signer="$local_signer -base-dir $client_dir -addr $host -port $rpc"
         compiler="$local_compiler"
     fi
     parameters_file="${parameters_file:-$client_dir/protocol_parameters.json}"

src/lib_rpc_http/RPC_client.ml

@@ -48,6 +48,7 @@ type rpc_error =
                             media_type: string ;
                             error: string }
   | OCaml_exception of string
+  | Unauthorized_host of string option
 
 let rpc_error_encoding =
   let open Data_encoding in
@@ -196,6 +197,11 @@ let pp_rpc_error ppf err =
       Format.fprintf ppf
         "@[<v 2>The server failed with an unexpected exception:@ %s@]"
         msg
+  | Unauthorized_host host ->
+      Format.fprintf ppf
+        "@[<v 2>The server refused connection to host \"%s\", \
+         please check the node settings for CORS allowed origins.@]"
+        (Option.unopt ~default:"" host)
 
 type error +=
   | Request_failed of { meth: RPC_service.meth ;
@@ -269,6 +275,8 @@ let generic_call ?logger ?headers ?accept ?body ?media meth uri : (content, cont
       request_failed meth uri (Connection_failed msg)
   | `OCaml_exception msg ->
       request_failed meth uri (OCaml_exception msg)
+  | `Unauthorized_host host ->
+      request_failed meth uri (Unauthorized_host host)
 
 let handle_error meth uri (body, media, _) f =
   Cohttp_lwt.Body.is_empty body >>= fun empty ->
@@ -389,6 +397,8 @@ let handle accept (meth, uri, ans) =
       request_failed meth uri (Connection_failed msg)
   | `OCaml_exception msg ->
       request_failed meth uri (OCaml_exception msg)
+  | `Unauthorized_host host ->
+      request_failed meth uri (Unauthorized_host host)
 
 let call_streamed_service
     (type p q i o )

src/lib_rpc_http/RPC_client.mli

@@ -68,6 +68,7 @@ type rpc_error =
                             media_type: string ;
                             error: string }
   | OCaml_exception of string
+  | Unauthorized_host of string option
 
 type error +=
   | Request_failed of { meth: RPC_service.meth ;

vendors/ocplib-resto/lib_resto-cohttp/client.ml

@@ -49,7 +49,8 @@ module Make (Encoding : Resto.ENCODING) = struct
     | `Not_acceptable of string
     | `Unexpected_status_code of Cohttp.Code.status_code * content
     | `Connection_failed of string
-    | `OCaml_exception of string ]
+    | `OCaml_exception of string
+    | `Unauthorized_host of string option ]
 
   type ('o, 'e) service_result =
     [ ('o, 'e option) generic_rest_result
@@ -165,6 +166,15 @@ module Make (Encoding : Resto.ENCODING) = struct
       | None -> headers
       | Some ranges ->
           Header.add headers "accept" (Media_type.accept_header ranges) in
+    let host =
+      match Uri.host uri, Uri.port uri with
+      | None, _ -> None
+      | Some host, None -> Some host
+      | Some host, Some port -> Some (host ^ ":" ^ string_of_int port) in
+    let headers =
+      match host with
+      | None -> headers
+      | Some host -> Header.add headers "host" host in
     Lwt.catch begin fun () ->
       let rec call_and_retry_on_502 attempt delay =
         Cohttp_lwt_unix.Client.call
@@ -209,6 +219,8 @@ module Make (Encoding : Resto.ENCODING) = struct
           (* TODO handle redirection ?? *)
           failwith "Resto_cohttp_client.generic_json_call: unimplemented"
       | `Unauthorized -> Lwt.return (`Unauthorized (ansbody, media_name, media))
+      | `Forbidden when Cohttp.Header.mem headers "X-OCaml-Resto-CORS-Error" ->
+          Lwt.return (`Unauthorized_host host)
       | `Forbidden -> Lwt.return (`Forbidden (ansbody, media_name, media))
       | `Not_found -> Lwt.return (`Not_found (ansbody, media_name, media))
       | `Conflict -> Lwt.return (`Conflict (ansbody, media_name, media))
@@ -324,7 +336,8 @@ module Make (Encoding : Resto.ENCODING) = struct
       | `Not_acceptable _
       | `Unexpected_status_code _
       | `Connection_failed _
-      | `OCaml_exception _ as err -> Lwt.return err
+      | `OCaml_exception _
+      | `Unauthorized_host _ as err -> Lwt.return err
     end >>= fun ans ->
     Lwt.return (meth, uri, ans)
 
@@ -388,7 +401,8 @@ module Make (Encoding : Resto.ENCODING) = struct
       | `Not_acceptable _
       | `Unexpected_status_code _
       | `Connection_failed _
-      | `OCaml_exception _ as err -> Lwt.return err
+      | `OCaml_exception _
+      | `Unauthorized_host _ as err -> Lwt.return err
     end >>= fun ans ->
     Lwt.return (meth, uri, ans)
 

vendors/ocplib-resto/lib_resto-cohttp/client.mli

@@ -32,7 +32,8 @@ module Make (Encoding : Resto.ENCODING) : sig
     | `Not_acceptable of string
     | `Unexpected_status_code of Cohttp.Code.status_code * content
     | `Connection_failed of string
-    | `OCaml_exception of string ]
+    | `OCaml_exception of string
+    | `Unauthorized_host of string option ]
 
   module type LOGGER = sig
     type request

vendors/ocplib-resto/lib_resto-cohttp/server.ml

@@ -97,8 +97,10 @@ module Make (Encoding : Resto.ENCODING)(Log : LOGGING) = struct
       match Request.meth req with
       | #Resto.meth when server.cors.allowed_origins <> [] &&
                          not (Cors.check_host req_headers server.cors) ->
+          let headers =
+            Cohttp.Header.init_with "X-OCaml-Resto-CORS-Error" "invalid host" in
           Lwt.return_ok
-            (Response.make ~status:`Forbidden (),
+            (Response.make ~headers ~status:`Forbidden (),
              Cohttp_lwt.Body.empty)
       | #Resto.meth as meth -> begin
           Directory.lookup server.root ()
@@ -320,7 +322,7 @@ module Make (Encoding : Resto.ENCODING)(Log : LOGGING) = struct
       mode root =
     let default_media_type =
       match Media_type.first_complete_media media_types with
-      | None -> invalid_arg "RestoCohttp.launch(empty media type list)"
+      | None -> invalid_arg "Resto_directory_cohttp.launch(empty media type list)"
       | Some ((l, r), m) -> l^"/"^r, m in
     let stop, stopper = Lwt.wait () in
     let server = {