From 5c9561ba81ba3d3883cf4959541f5e2675516f88 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 17 Oct 2023 16:49:39 -0700 Subject: [PATCH] fix: don't send invalid HTTP/2 headers (#197) also: - refactor: don't send redundant arguments --- lib/client.ml | 43 +++++++++++++++++++---------------------- lib/connection.ml | 1 + lib/headers.ml | 22 +++++++++++++++------ lib/http1.ml | 9 ++++++++- lib/http2.ml | 1 + lib/http_impl.ml | 22 +++++++++++++-------- lib/http_server_impl.ml | 11 +++++++++-- lib/server_config.ml | 5 ++++- 8 files changed, 73 insertions(+), 41 deletions(-) diff --git a/lib/client.ml b/lib/client.ml index 69ff8f20..e3f2e003 100644 --- a/lib/client.ml +++ b/lib/client.ml @@ -35,7 +35,6 @@ module Connection_info = Connection.Info type t = { mutable conn : Connection.t - ; config : Config.t ; env : Eio_unix.Stdenv.base ; sw : Switch.t } @@ -160,11 +159,9 @@ let shutdown_conn (Connection.Conn { impl; connection; info; fd; _ }) = Http_impl.shutdown (module (val impl)) ~fd connection let change_connection t (conn_info : Connection_info.t) = - let { sw; conn; env; _ } = t in + let { sw; conn = Connection.Conn { config; _ } as conn; env; _ } = t in Fiber.fork ~sw (fun () -> shutdown_conn conn); - let+! conn' = - open_connection ~sw ~config:t.config ~uri:conn_info.uri env conn_info - in + let+! conn' = open_connection ~sw ~config ~uri:conn_info.uri env conn_info in t.conn <- conn' let shutdown t = shutdown_conn t.conn @@ -172,8 +169,8 @@ let shutdown t = shutdown_conn t.conn (* returns true if it succeeding in reusing the connection, false otherwise. *) let reuse_or_set_up_new_connection ({ conn = - Connection.Conn ({ impl = (module Http); connection; info; _ } as conn) - ; config + Connection.Conn + ({ impl = (module Http); connection; config; info; _ } as conn) ; env ; _ } as t) @@ -247,7 +244,7 @@ type request_info = } let rec return_response - ({ conn; config; sw; _ } as t) + ({ conn; sw; _ } as t) ({ request; _ } as request_info) ({ Response.status; headers; version; body } as response) = @@ -257,6 +254,7 @@ let rec return_response ; info = { Connection_info.scheme; _ } as conn_info ; uri ; fd + ; config ; _ }) = @@ -313,7 +311,7 @@ let is_h2c_upgrade ~config ~version ~scheme = | _ -> false let make_request_info - { conn = Connection.Conn { version; info; _ }; config; _ } + { conn = Connection.Conn { version; info; config; _ }; _ } ?(remaining_redirects = config.max_redirects) ~meth ~headers @@ -355,12 +353,11 @@ let make_request_info let rec send_request_and_handle_response t - ~body ({ remaining_redirects; request; headers; meth; _ } as request_info) = - let { conn = Conn ({ info; uri; _ } as conn); config; _ } = t in + let { conn = Conn ({ info; uri; config; _ } as conn); _ } = t in - match Http_impl.send_request ~sw:t.sw t.conn ~config ~body request with + match Http_impl.send_request ~sw:t.sw t.conn request with | Error (#Error.client as err) -> Error err | Ok response -> if conn.persistent @@ -427,10 +424,10 @@ let rec send_request_and_handle_response ~remaining_redirects:(remaining_redirects - 1) ~meth:meth' ~headers - ~body + ~body:request.body target in - send_request_and_handle_response t ~body request_info') + send_request_and_handle_response t request_info') (* Either not a redirect, or we shouldn't follow redirects. *) | false, _, _, _ | _, false, _, _ | true, true, _, None -> return_response t request_info response) @@ -438,16 +435,18 @@ let rec send_request_and_handle_response let create ?(config = Config.default) ~sw env uri = let*! conn_info = Connection_info.of_uri env ~config uri in match open_connection ~config ~sw ~uri:conn_info.uri env conn_info with - | Ok conn -> Ok { conn; config; env; sw } + | Ok conn -> Ok { conn; env; sw } | Error (#Error.client as err) -> Error err let call t ~meth ?(headers = []) ?(body = Body.empty) target = (* Need to try to reconnect to the base host on every call, if redirects are * enabled, because the connection manager could have tried to follow a * temporary redirect. We remember permanent redirects. *) - let (Connection.Conn { impl = (module Http); connection; uri; _ }) = t.conn in + let (Connection.Conn { impl = (module Http); connection; config; uri; _ }) = + t.conn + in let reused = - if t.config.follow_redirects || Http_impl.is_closed (module Http) connection + if config.follow_redirects || Http_impl.is_closed (module Http) connection then reuse_or_set_up_new_connection t uri else Ok true in @@ -455,12 +454,12 @@ let call t ~meth ?(headers = []) ?(body = Body.empty) target = | Error #Error.client as err -> err | Ok _ -> let request_info = - let headers = t.config.default_headers @ headers in + let headers = config.default_headers @ headers in make_request_info t ~meth ~headers ~body target in let (Connection.Conn conn) = t.conn in conn.persistent <- Request.persistent_connection request_info.request; - send_request_and_handle_response t ~body request_info + send_request_and_handle_response t request_info let request t ?headers ?body ~meth target = call t ?headers ?body ~meth target @@ -523,12 +522,10 @@ module Oneshot = struct create ~config ~sw env uri in let target = Uri.path_and_query conn.uri in - let headers = t.config.default_headers @ headers in + let headers = conn.config.default_headers @ headers in let request_info = make_request_info t ~meth ~headers ~body target in conn.persistent <- Request.persistent_connection request_info.request; - let response_result = - send_request_and_handle_response t ~body request_info - in + let response_result = send_request_and_handle_response t request_info in Fiber.fork ~sw (fun () -> (match response_result with | Ok { Response.body; _ } -> diff --git a/lib/connection.ml b/lib/connection.ml index d6589fe5..f280628d 100644 --- a/lib/connection.ml +++ b/lib/connection.ml @@ -209,6 +209,7 @@ type t = | Conn : { impl : (module Http_intf.HTTPCommon with type Client.t = 'a) ; connection : 'a + ; config : Config.t ; fd : Eio_unix.Net.stream_socket_ty Eio.Net.stream_socket ; mutable info : Info.t ; mutable uri : Uri.t diff --git a/lib/headers.ml b/lib/headers.ml index 828e860d..7186f7b0 100644 --- a/lib/headers.ml +++ b/lib/headers.ml @@ -54,7 +54,7 @@ module Well_known = struct end end -let add_length_related_headers ~body_length headers = +let add_length_related_headers ~version ~body_length headers = (* TODO: check `Httpaf.Response.body_length` because we may have to issue a * 0-length response body. *) (* Don't step over an explicit `content-length` header. *) @@ -62,10 +62,20 @@ let add_length_related_headers ~body_length headers = | `Fixed n -> add_unless_exists headers Well_known.content_length (Int64.to_string n) | `Chunked -> - add_unless_exists - headers - Well_known.transfer_encoding - Well_known.Values.chunked + (* From RFC9113ยง8.2.2: + * An endpoint MUST NOT generate an HTTP/2 message containing + * connection-specific header fields. This includes the Connection header + * field and those listed as having connection-specific semantics in + * Section 7.6.1 of [HTTP] (that is, Proxy-Connection, Keep-Alive, + * Transfer-Encoding, and Upgrade). + *) + (match version with + | Versions.HTTP.HTTP_2 -> headers + | HTTP_1_0 | HTTP_1_1 -> + add_unless_exists + headers + Well_known.transfer_encoding + Well_known.Values.chunked) | `Close_delimited -> add_unless_exists headers Well_known.connection Well_known.Values.close | `Error _ | `Unknown -> headers @@ -83,7 +93,7 @@ let canonicalize_headers ~body_length ~host ~version headers = | HTTP_1_0 | HTTP_1_1 -> add_unless_exists (of_list headers) Well_known.HTTP1.host host in - add_length_related_headers ~body_length headers + add_length_related_headers ~version ~body_length headers let host t ~version = match version with diff --git a/lib/http1.ml b/lib/http1.ml index bd79a5fb..f9266927 100644 --- a/lib/http1.ml +++ b/lib/http1.ml @@ -165,6 +165,13 @@ module MakeHTTP1 (Runtime_scheme : Scheme.Runtime.SCHEME) : (module HttpServer) ~fd ~scheme:Runtime_scheme.scheme + ~version: + (Option.value + ~default:HTTP_1_1 + (Option.map + (fun (request : Httpaf.Request.t) -> + Versions.HTTP.Raw.to_version_exn request.version) + request)) ~error_handler ~start_response client_addr @@ -194,7 +201,7 @@ module MakeHTTP1 (Runtime_scheme : Scheme.Runtime.SCHEME) : { Server_intf.Handler.ctx = { Request_info.client_address = client_addr ; scheme = Runtime_scheme.scheme - ; version = HTTP_1_1 + ; version = Versions.HTTP.Raw.to_version_exn request.version ; sw } ; request = request_of_http1 ~body:request_body request diff --git a/lib/http2.ml b/lib/http2.ml index 77bffcf1..d377934c 100644 --- a/lib/http2.ml +++ b/lib/http2.ml @@ -171,6 +171,7 @@ end = struct ?request:(Option.map Request.of_h2 request) (module HttpServer) ~scheme:Runtime_scheme.scheme + ~version:HTTP_2 ~fd ~error_handler ~start_response diff --git a/lib/http_impl.ml b/lib/http_impl.ml index 8505b38b..aec7f24d 100644 --- a/lib/http_impl.ml +++ b/lib/http_impl.ml @@ -65,6 +65,7 @@ let create_connection in Connection.Conn { impl = (module Http_impl) + ; config ; connection ; fd ; info = conn_info @@ -112,8 +113,8 @@ let handle_response : Fiber.fork ~sw (fun () -> match Fiber.any - [ (fun () -> Error (Promise.await response_error_p :> Error.t)) - ; (fun () -> Error (Promise.await connection_error_p :> Error.t)) + [ (ptoerr response_error_p :> unit -> (_, Error.t) result) + ; (ptoerr connection_error_p :> unit -> (_, Error.t) result) ; (fun () -> Body.closed response.body) ] with @@ -128,14 +129,18 @@ let handle_response : let send_request : sw:Switch.t -> Connection.t - -> config:Config.t - -> body:Body.t -> Request.t -> (Response.t, Error.client) result = - fun ~sw conn ~config ~body request -> + fun ~sw conn request -> let (Connection.Conn - { impl = (module Http); connection; fd; connection_error_received; _ }) + { impl = (module Http) + ; connection + ; config + ; fd + ; connection_error_received + ; _ + }) = conn in @@ -152,7 +157,7 @@ let send_request : Promise.resolve notify_response response in let flush_headers_immediately = - match body.contents with + match request.body.contents with | `Sendfile _ -> true | _ -> config.flush_headers_immediately in @@ -163,7 +168,7 @@ let send_request : ~response_handler request in - match body.contents with + match request.body.contents with | `Empty _ -> Bodyw.close request_body | `String s -> Bodyw.write_string request_body s; @@ -287,6 +292,7 @@ let create_h2c_connection let connection = Connection.Conn { impl = (module Http2) + ; config ; fd ; connection ; info = conn_info diff --git a/lib/http_server_impl.ml b/lib/http_server_impl.ml index 23ce0aac..4e2a0b49 100644 --- a/lib/http_server_impl.ml +++ b/lib/http_server_impl.ml @@ -97,7 +97,9 @@ let handle_request : = fun (module Http) ~config ?upgrade ~fd ~handler ~arg reqd -> let report_exn = report_exn (module Http) reqd in - let { Server_intf.Handler.ctx = { Request_info.sw; scheme; _ }; _ } = arg in + let { Server_intf.Handler.ctx = { Request_info.sw; scheme; version; _ }; _ } = + arg + in Fiber.fork ~sw (fun () -> try let ({ Response.headers; body; _ } as response) = handler arg in @@ -118,8 +120,10 @@ let handle_request : | None -> let response = { response with - headers = + version + ; headers = Headers.add_length_related_headers + ~version ~body_length:(Piaf_body.length body) headers } @@ -182,6 +186,7 @@ let handle_error : -> start_response:(Headers.t -> writer) -> error_handler:Server_intf.error_handler -> scheme:Scheme.t + -> version:Versions.HTTP.t -> fd:Eio_unix.Net.stream_socket_ty Eio.Net.stream_socket -> Eio.Net.Sockaddr.stream -> Error.server @@ -192,6 +197,7 @@ let handle_error : ~start_response ~error_handler ~scheme + ~version ~fd client_address error -> @@ -200,6 +206,7 @@ let handle_error : let respond ~headers body = let headers = Headers.add_length_related_headers + ~version ~body_length:(Piaf_body.length body) headers in diff --git a/lib/server_config.ml b/lib/server_config.ml index 9d0239f3..fe09b2f8 100644 --- a/lib/server_config.ml +++ b/lib/server_config.ml @@ -44,7 +44,10 @@ type t = - the highest HTTP version that ALPN will negotiate with the remote peer - the version to listen on the insecure server: - max_http_version == HTTP/2 && h2c_upgrade => HTTP/1.1 + H2c upgrade - - max_http_version == HTTP/2 => HTTP/2 server *) + - max_http_version == HTTP/2 => HTTP/2 server. + + TODO(anmonteiro): doesn't make it possible to create a http/https server + where https is listening on http/2 and http on http1.1 *) ; https : HTTPS.t option ; h2c_upgrade : bool (** Send an upgrade to `h2c` (HTTP/2 over TCP) request to the server.