Merge pull request #986 from mseri/master

Cohttp: ensure "host" is the first header in requests and other fixes

.github/workflows/nix.yml

@@ -5,6 +5,8 @@ on:
 jobs:
   tests:
     runs-on: ubuntu-latest
+    env:
+      NIXPKGS_ALLOW_INSECURE: 1
     steps:
     - name: Checkout code
       uses: actions/checkout@v2

.ocamlformat

@@ -1,4 +1,4 @@
-version = 0.24.1
+version = 0.25.1
 profile=conventional
 break-infix=fit-or-vertical
 parse-docstrings=true

CHANGES.md

@@ -1,5 +1,7 @@
-## v6.0.0~alpha2 (2023-06-20)
-
+## v6.0.0~alpha2 (2023-07-1)
+- http.header: introduce "iter_ord" to guarantee iteration following the order of the entries in the headers (mseri #986)
+- http.header: fix "move_to_fist" and "first" ro follow Header's semantics (mseri #986)
+- cohttp: ensure "host" is the first header (mseri #986)
 - do not omit mandatory null Content-Length headers (mefyl #985)
 - cohttp-async, cohttp-curl-async: compatibility with core/async v0.16.0 (mseri, dkalinichenko-js #976)
 - cohttp-lwt server: call conn_closed before drainig the body of response on error (pirbo #982)

cohttp-async/examples/s3_cp.ml

@@ -43,6 +43,8 @@ open Base
 open Core
 open Async
 
+module Time = Time_float
+
 (* open Cohttp *)
 module Client = Cohttp_async.Client
 module Body = Cohttp_async.Body

cohttp-async/test/test_async_integration.ml

@@ -113,7 +113,8 @@ let ts =
             ("Pipe with empty strings", Pipe.of_list [ ""; ""; "" ], true);
           ]
         in
-        Deferred.List.iter ~how:`Sequential tests ~f:(fun (msg, pipe, expected) ->
+        Deferred.List.iter ~how:`Sequential tests
+          ~f:(fun (msg, pipe, expected) ->
             is_empty (`Pipe pipe) >>| fun real ->
             assert_equal ~msg expected real)
         >>= fun () ->

cohttp-eio/src/rwer.ml

@@ -53,7 +53,7 @@ let http_headers r =
 
 let write_headers writer headers =
   let headers = Http.Header.clean_dup headers in
-  Http.Header.iter
+  Http.Header.iter_ord
     (fun k v ->
       Buf_write.string writer k;
       Buf_write.string writer ": ";

cohttp-eio/tests/client.md

@@ -45,10 +45,10 @@ GET method request:
       |> print_string);;
 +socket: wrote "GET / HTTP/1.1\r\n"
 +              "Host: localhost\r\n"
-+              "Connection: TE\r\n"
-+              "TE: trailers\r\n"
-+              "User-Agent: cohttp-eio\r\n"
 +              "Accept: application/json\r\n"
++              "User-Agent: cohttp-eio\r\n"
++              "TE: trailers\r\n"
++              "Connection: TE\r\n"
 +              "\r\n"
 +socket: read "HTTP/1.1 200 OK\r\n"
 +socket: read "content-length: 4\r\n"
@@ -83,11 +83,11 @@ POST request:
       |> print_string);;
 +socket: wrote "POST /post HTTP/1.1\r\n"
 +              "Host: localhost\r\n"
-+              "Connection: TE\r\n"
-+              "TE: trailers\r\n"
-+              "User-Agent: cohttp-eio\r\n"
-+              "Content-Length: 12\r\n"
 +              "Accept: application/json\r\n"
++              "Content-Length: 12\r\n"
++              "User-Agent: cohttp-eio\r\n"
++              "TE: trailers\r\n"
++              "Connection: TE\r\n"
 +              "\r\n"
 +              "hello world!"
 +socket: read "HTTP/1.1 200 OK\r\n"
@@ -159,12 +159,12 @@ Chunk request:
       |> print_string);;
 +socket: wrote "POST /handle_chunk HTTP/1.1\r\n"
 +              "Host: localhost\r\n"
-+              "Connection: TE\r\n"
-+              "TE: trailers\r\n"
-+              "User-Agent: cohttp-eio\r\n"
-+              "Trailer: Expires, Header1\r\n"
-+              "Content-Type: text/plain\r\n"
 +              "Transfer-Encoding: chunked\r\n"
++              "Content-Type: text/plain\r\n"
++              "Trailer: Expires, Header1\r\n"
++              "User-Agent: cohttp-eio\r\n"
++              "TE: trailers\r\n"
++              "Connection: TE\r\n"
 +              "\r\n"
 +              "7;ext1=ext1_v;ext2=ext2_v;ext3\r\n"
 +              "Mozilla\r\n"
@@ -173,9 +173,9 @@ Chunk request:
 +              "7\r\n"
 +              "Network\r\n"
 +              "0\r\n"
-+              "Header2: Header2 value text\r\n"
-+              "Header1: Header1 value text\r\n"
 +              "Expires: Wed, 21 Oct 2015 07:28:00 GMT\r\n"
++              "Header1: Header1 value text\r\n"
++              "Header2: Header2 value text\r\n"
 +              "\r\n"
 +socket: read "HTTP/1.1 200 OK\r\n"
 +socket: read "content-length:0\r\n"
@@ -209,9 +209,9 @@ Chunk request:
     );;
 +socket: wrote "GET /get_chunk HTTP/1.1\r\n"
 +              "Host: localhost\r\n"
-+              "Connection: TE\r\n"
-+              "TE: trailers\r\n"
 +              "User-Agent: cohttp-eio\r\n"
++              "TE: trailers\r\n"
++              "Connection: TE\r\n"
 +              "\r\n"
 +socket: read "HTTP/1.1 200 OK\r\n"
 +socket: read "Trailer: Expires, Header1\r\n"

cohttp-eio/tests/server.md

@@ -137,9 +137,9 @@ Asking for the root:
 +socket: read "GET / HTTP/1.1\r\n"
 +             "\r\n"
 +socket: wrote "HTTP/1.1 200 OK\r\n"
-+              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
-+              "content-length: 4\r\n"
 +              "content-type: text/plain; charset=UTF-8\r\n"
++              "content-length: 4\r\n"
++              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
 +              "\r\n"
 +              "root"
 - : unit = ()
@@ -156,8 +156,8 @@ A missing page:
 +socket: read "GET /missing HTTP/1.1\r\n"
 +             "\r\n"
 +socket: wrote "HTTP/1.1 404 Not Found\r\n"
-+              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
 +              "Content-Length: 0\r\n"
++              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
 +              "\r\n"
 - : unit = ()
 ```
@@ -173,8 +173,8 @@ Streaming a response:
 +socket: read "GET /stream HTTP/1.1\r\n"
 +             "\r\n"
 +socket: wrote "HTTP/1.1 200 OK\r\n"
-+              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
 +              "transfer-encoding: chunked\r\n"
++              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
 +              "\r\n"
 +              "5\r\n"
 +              "Hello\r\n"
@@ -201,9 +201,9 @@ Handle POST request:
 +             "\r\n"
 +socket: read "hello world!"
 +socket: wrote "HTTP/1.1 200 OK\r\n"
-+              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
-+              "content-length: 100\r\n"
 +              "content-type: text/plain; charset=UTF-8\r\n"
++              "content-length: 100\r\n"
++              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
 +              "\r\n"
 +              "meth: POST\n"
 +              "resource: /post\n"
@@ -227,10 +227,10 @@ HTTP chunk-stream response with chunk extensions and trailers:
 +socket: read "TE:trailers\r\n"
 +             "\r\n"
 +socket: wrote "HTTP/1.1 200 OK\r\n"
-+              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
-+              "Trailer: Expires, Header1\r\n"
-+              "Content-Type: text/plain\r\n"
 +              "Transfer-Encoding: chunked\r\n"
++              "Content-Type: text/plain\r\n"
++              "Trailer: Expires, Header1\r\n"
++              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
 +              "\r\n"
 +              "7;ext1=ext1_v;ext2=ext2_v;ext3\r\n"
 +              "Mozilla\r\n"
@@ -239,9 +239,9 @@ HTTP chunk-stream response with chunk extensions and trailers:
 +              "7\r\n"
 +              "Network\r\n"
 +              "0\r\n"
-+              "Header2: Header2 value text\r\n"
-+              "Header1: Header1 value text\r\n"
 +              "Expires: Wed, 21 Oct 2015 07:28:00 GMT\r\n"
++              "Header1: Header1 value text\r\n"
++              "Header2: Header2 value text\r\n"
 +              "\r\n"
 - : unit = ()
 ```
@@ -259,10 +259,10 @@ a HTTP client agent has support for HTTP chunk trailer headers:
 +socket: read "GET /get_chunks HTTP/1.1\r\n"
 +             "\r\n"
 +socket: wrote "HTTP/1.1 200 OK\r\n"
-+              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
-+              "Trailer: Expires, Header1\r\n"
-+              "Content-Type: text/plain\r\n"
 +              "Transfer-Encoding: chunked\r\n"
++              "Content-Type: text/plain\r\n"
++              "Trailer: Expires, Header1\r\n"
++              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
 +              "\r\n"
 +              "7;ext1=ext1_v;ext2=ext2_v;ext3\r\n"
 +              "Mozilla\r\n"
@@ -313,9 +313,9 @@ Server should handle chunk requests from clients:
 +socket: read "Header2: Header2 value text\r\n"
 +             "\r\n"
 +socket: wrote "HTTP/1.1 200 OK\r\n"
-+              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
-+              "content-length: 354\r\n"
 +              "content-type: text/plain; charset=UTF-8\r\n"
++              "content-length: 354\r\n"
++              "Date: Mon, 24 Oct 2022 16:12:15 GMT\r\n"
 +              "\r\n"
 +              "meth: POST\n"
 +              "resource: /handle_chunk\n"

cohttp-lwt-unix/src/debug.ml

@@ -67,10 +67,10 @@ let default_reporter = reporter Lwt_unix.stderr Fmt.stderr
 let set_logger =
   lazy
     (if
-     (* If no reporter has been set by the application, set default one
-        that prints to stderr *)
-     Logs.reporter () == Logs.nop_reporter
-    then Logs.set_reporter default_reporter)
+       (* If no reporter has been set by the application, set default one
+          that prints to stderr *)
+       Logs.reporter () == Logs.nop_reporter
+     then Logs.set_reporter default_reporter)
 
 let activate_debug () =
   if not !_debug_active then (

cohttp-lwt-unix/test/test_parser.ml

@@ -270,7 +270,7 @@ let make_simple_req () =
   let open Cohttp in
   let open Cohttp_lwt_unix in
   let expected =
-    "POST /foo/bar HTTP/1.1\r\nFoo: bar\r\nhost: localhost\r\nuser-agent: "
+    "POST /foo/bar HTTP/1.1\r\nhost: localhost\r\nFoo: bar\r\nuser-agent: "
     ^ user_agent
     ^ "\r\ntransfer-encoding: chunked\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n"
   in
@@ -285,7 +285,7 @@ let mutate_simple_req () =
   let open Cohttp in
   let open Cohttp_lwt_unix in
   let expected =
-    "POST /foo/bar HTTP/1.1\r\nfoo: bar\r\nhost: localhost\r\nuser-agent: "
+    "POST /foo/bar HTTP/1.1\r\nhost: localhost\r\nfoo: bar\r\nuser-agent: "
     ^ user_agent
     ^ "\r\ntransfer-encoding: chunked\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n"
   in

cohttp-lwt/src/connection.ml

@@ -117,34 +117,34 @@ module Make (Net : S.Net) : S.Connection with module Net = Net = struct
             (* A response header to a HEAD request is indistinguishable from a
              * response header to a GET request. Therefore look at the method. *)
             (if
-             match Response.has_body res with
-             | _ when meth = `HEAD -> false
-             | `No -> false
-             | `Yes | `Unknown -> true
-            then (
-             let stream =
-               Body.create_stream Response.read_body_chunk
-                 (Response.make_body_reader res ic)
-             in
-             (* finalise could run in a thread different from the lwt main thread.
-              * You may therefore not call into Lwt from a finaliser. *)
-             let closed = ref false in
-             Gc.finalise_last
-               (fun () ->
-                 if not !closed then
-                   Log.warn (fun m ->
-                       m
-                         "Body not consumed, leaking stream! Refer to \
-                          https://github.com/mirage/ocaml-cohttp/issues/730 \
-                          for additional details"))
-               stream;
-             Lwt.wakeup_later res_r (res, Body.of_stream stream);
-             Lwt_stream.closed stream >>= fun () ->
-             closed := true;
-             Lwt.return_unit)
-            else (
-              Lwt.wakeup_later res_r (res, `Empty);
-              Lwt.return_unit))
+               match Response.has_body res with
+               | _ when meth = `HEAD -> false
+               | `No -> false
+               | `Yes | `Unknown -> true
+             then (
+               let stream =
+                 Body.create_stream Response.read_body_chunk
+                   (Response.make_body_reader res ic)
+               in
+               (* finalise could run in a thread different from the lwt main thread.
+                * You may therefore not call into Lwt from a finaliser. *)
+               let closed = ref false in
+               Gc.finalise_last
+                 (fun () ->
+                   if not !closed then
+                     Log.warn (fun m ->
+                         m
+                           "Body not consumed, leaking stream! Refer to \
+                            https://github.com/mirage/ocaml-cohttp/issues/730 \
+                            for additional details"))
+                 stream;
+               Lwt.wakeup_later res_r (res, Body.of_stream stream);
+               Lwt_stream.closed stream >>= fun () ->
+               closed := true;
+               Lwt.return_unit)
+             else (
+               Lwt.wakeup_later res_r (res, `Empty);
+               Lwt.return_unit))
             >>= fun () ->
             Queue.take connection.in_flight |> ignore;
             Lwt_condition.broadcast connection.condition ();

cohttp/src/header.mli

@@ -187,9 +187,9 @@ val clean_dup : t -> t
     host: anhost.com, anotherhost.com
     v}
 
-    Finally, following {{:https://tools.ietf.org/html/rfc7230#section-3.2.2}
-    RFC7230§3.2.2}, the header [Set-cookie] is treated as an exception and
-    ignored by [clean_dup]. *)
+    Finally, following
+    {{:https://tools.ietf.org/html/rfc7230#section-3.2.2} RFC7230§3.2.2}, the
+    header [Set-cookie] is treated as an exception and ignored by [clean_dup]. *)
 
 val get_content_range : t -> Int64.t option
 val get_media_type : t -> string option

cohttp/src/request.ml

@@ -61,6 +61,7 @@ let make ?(meth = `GET) ?(version = `HTTP_1_1) ?(encoding = Transfer.Unknown)
           ^
           match Uri.port uri with Some p -> ":" ^ string_of_int p | None -> ""))
   in
+  let headers = Header.Private.move_to_front headers "host" in
   let headers =
     Header.add_unless_exists headers "user-agent" Header.user_agent
   in
@@ -203,6 +204,7 @@ module Make (IO : S.IO) = struct
         Header.add_transfer_encoding headers req.encoding
       else headers
     in
+    let headers = Header.Private.move_to_front headers "host" in
     IO.write oc fst_line >>= fun _ -> Header_IO.write headers oc
 
   let make_body_writer ?flush req oc =

cohttp/src/transfer_io.ml

@@ -43,8 +43,8 @@ module Make (IO : S.IO) = struct
         read_chunk ic !remaining >>= fun chunk ->
         remaining := remaining_length chunk !remaining;
         (if !remaining = 0L (* End_of_chunk *) then read_line ic
-         (* Junk the CRLF at end of chunk *)
-        else return None)
+           (* Junk the CRLF at end of chunk *)
+         else return None)
         >>= fun _ -> return chunk
       in
       if !remaining = 0L then

cohttp/test/test_request.ml

@@ -308,8 +308,12 @@ module Request = Request.Private.Make (Test_io)
 let null_content_length_header () =
   let output = Buffer.create 1024 in
   let () =
+    (* The user-agent in releases contentsontains the version, we need to strip
+       it for the test *)
+    let headers = Cohttp.Header.of_list [ ("user-agent", "ocaml-cohttp") ] in
     let r =
-      Cohttp.Request.make_for_client ~chunked:false ~body_length:0L `PUT
+      Cohttp.Request.make_for_client ~headers ~chunked:false ~body_length:0L
+        `PUT
         (Uri.of_string "http://someuri.com")
     in
     Request.write_header r output
@@ -318,7 +322,7 @@ let null_content_length_header () =
     "null content-length header are sent"
     "PUT / HTTP/1.1\r\n\
      host: someuri.com\r\n\
-     user-agent: ocaml-cohttp/\r\n\
+     user-agent: ocaml-cohttp\r\n\
      content-length: 0\r\n\
      \r\n"
     (Buffer.to_string output)