Test large headers and a large number of headers

CHANGES

@@ -1,3 +1,19 @@
+0.19.0 (2015-08-05):
+Compatibility breaking interface changes:
+* Remove `read_form` from the `Request/Response/Header` interfaces
+  as this should be done in `Body` handling instead (#401).
+
+New features and bug fixes:
+* Remove `IO.write_line` as it was unused in any interfaces.
+* Do not use the `lwt` camlp4 extension. No observable external difference.
+* Do not return a code stacktrace in the default 500 handler.
+* Add `Cohttp.Header.compare` (#411)
+* Fix typos in CLI documentation (#413 via @moonlightdrive)
+* Use the Lwt 2.5.0 buffer API.
+* `Cohttp_lwt.read_response` now has a non-optional `closefn` parameter (#400).
+* Add a `Cohttp_lwt_s` module that contains all the Lwt module types
+  in one convenient place (#397).
+
 0.18.3 (2015-07-12):
 * Allow `DELETE` requests to have request bodies (#383).
 * Improve the Lwt client `callv` for HTTP/1.1 pipelined

_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.4
 Name:        cohttp
-Version:     0.18.3
+Version:     0.19.0
 Synopsis:    HTTP library for Lwt, Async, JavaScript and Mirage
 Description: CoHTTP is an OCaml library for creating HTTP clients and
   daemons.  It has a portable HTTP parser.  Optional dependencies
@@ -433,7 +433,7 @@ Test test_accept
 
 Test test_header
   Run$:               flag(tests)
-  Command:            $test_header
+  Command:            $test_header -q
   WorkingDirectory:   lib_test
 
 Test test_request

lib/META

@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: 687d1c664f2d59628da7c01da36c93ea)
-version = "0.18.3"
+# DO NOT EDIT (digest: 6aaffff7daf799c9dd465a2aa76b4441)
+version = "0.19.0"
 description = "HTTP library for Lwt, Async, JavaScript and Mirage"
 requires =
 "re.emacs stringext uri uri.services fieldslib sexplib bytes base64"
@@ -10,7 +10,7 @@ archive(native) = "cohttp.cmxa"
 archive(native, plugin) = "cohttp.cmxs"
 exists_if = "cohttp.cma"
 package "top" (
- version = "0.18.3"
+ version = "0.19.0"
  description = "HTTP library for Lwt, Async, JavaScript and Mirage"
  requires = "cohttp"
  archive(byte) = "cohttp_top.cma"
@@ -21,7 +21,7 @@ package "top" (
 )
 
 package "test" (
- version = "0.18.3"
+ version = "0.19.0"
  description = "HTTP library for Lwt, Async, JavaScript and Mirage"
  requires = "cohttp oUnit"
  archive(byte) = "cohttp_test.cma"
@@ -32,7 +32,7 @@ package "test" (
 )
 
 package "lwt-unix-test" (
- version = "0.18.3"
+ version = "0.19.0"
  description = "HTTP library for Lwt, Async, JavaScript and Mirage"
  requires = "cohttp.test cohttp.lwt unix lwt.unix oUnit"
  archive(byte) = "cohttp_lwt_unix_test.cma"
@@ -43,7 +43,7 @@ package "lwt-unix-test" (
 )
 
 package "lwt-core" (
- version = "0.18.3"
+ version = "0.19.0"
  description = "HTTP library for Lwt, Async, JavaScript and Mirage"
  requires = "lwt uri cohttp"
  archive(byte) = "cohttp_lwt.cma"
@@ -54,7 +54,7 @@ package "lwt-core" (
 )
 
 package "lwt" (
- version = "0.18.3"
+ version = "0.19.0"
  description = "HTTP library for Lwt, Async, JavaScript and Mirage"
  requires = "cohttp.lwt-core unix lwt.unix conduit.lwt-unix magic-mime"
  archive(byte) = "cohttp_lwt_unix.cma"
@@ -65,7 +65,7 @@ package "lwt" (
 )
 
 package "js" (
- version = "0.18.3"
+ version = "0.19.0"
  description = "HTTP library for Lwt, Async, JavaScript and Mirage"
  requires = "cohttp.lwt-core js_of_ocaml"
  archive(byte) = "cohttp_lwt_xhr.cma"
@@ -76,7 +76,7 @@ package "js" (
 )
 
 package "async-test" (
- version = "0.18.3"
+ version = "0.19.0"
  description = "HTTP library for Lwt, Async, JavaScript and Mirage"
  requires = "cohttp.test cohttp.async oUnit"
  archive(byte) = "cohttp_async_test.cma"
@@ -87,7 +87,7 @@ package "async-test" (
 )
 
 package "async" (
- version = "0.18.3"
+ version = "0.19.0"
  description = "HTTP library for Lwt, Async, JavaScript and Mirage"
  requires = "uri cohttp threads async conduit.async magic-mime"
  archive(byte) = "cohttp_async.cma"

lib/conf.ml

@@ -15,5 +15,5 @@
  *
  *)
 
-let user_agent = "ocaml-cohttp/0.18.3"
-let version = "0.18.3"
+let user_agent = "ocaml-cohttp/0.19.0"
+let version = "0.19.0"

lib/header.ml

@@ -33,6 +33,8 @@ type t = string list StringMap.t
 
 let user_agent = Conf.user_agent
 
+let compare = StringMap.compare Pervasives.compare
+
 let headers_with_list_values = Array.map LString.of_string [|
   "accept";"accept-charset";"accept-encoding";"accept-language";
   "accept-ranges";"allow";"cache-control";"connection";"content-encoding";

lib/header.mli

@@ -60,6 +60,9 @@ val replace : t -> string -> string -> t
 (** Check if a key exists in the header. *)
 val mem : t -> string -> bool
 
+(** Structural comparison of two [Header] values. *)
+val compare : t -> t -> int
+
 (** Retrieve a key from a header.  If the header is one of the set of
     headers defined to have list values, then all of the values are
     concatenated into a single string separated by commas and returned.

lib_test/test_header.ml

@@ -18,7 +18,7 @@ open OUnit
 open Printf
 
 module StringResponse = Cohttp.Response.Make(Cohttp.String_io.M)
-
+module HIO = Cohttp.Header_io.Make(Cohttp.String_io.M)
 module H = Cohttp.Header
 
 let valid_auth () =
@@ -83,6 +83,41 @@ let list_valued_header () =
       | None -> "None"
       | Some x -> x) (H.get h "accept") (Some "bar,foo")
 
+let large_header () =
+  let sz = 1024 * 1024 * 100 in
+  let h = H.init () in
+  let v1 = String.make sz 'a' in
+  let h = H.add h "x-large" v1 in
+  let h = H.add h v1 "foo" in
+  assert_equal
+    ~printer:(function
+      | None -> "None"
+      | Some x -> x) (H.get h "x-large") (Some v1);
+  let obuf = Buffer.create (sz + 1024) in
+  HIO.write h obuf;
+  let ibuf = Buffer.contents obuf in
+  let sbuf = Cohttp.String_io.open_in ibuf in
+  let header_printer h =
+    Printf.sprintf "[length %d]%s"
+     (List.length (H.to_list h)) 
+     (String.concat "\n" (List.map (fun (k,v) -> Printf.sprintf "%s: %s" k v) (H.to_list h))) in 
+  assert_equal ~cmp:(fun a b -> H.compare a b = 0) ~printer:header_printer (HIO.parse sbuf) h
+
+let many_headers () =
+  let size = 1000000 in
+  let rec add_header num h =
+    match num with 
+    | 0 -> h
+    | n ->
+       let k = sprintf "h%d" n in
+       let v = sprintf "v%d" n in
+       let h = H.add h k v in
+       add_header (num - 1) h
+  in
+  let h = add_header size (H.init ()) in
+  assert_equal ~printer:string_of_int
+    (List.length (H.to_list h)) size
+
 module Content_range = struct
   let h1 = H.of_list [("Content-Length", "123")]
   let h2 = H.of_list [("Content-Range", "bytes 200-300/1000")]
@@ -446,5 +481,7 @@ Alcotest.run "test_header" [
   "Header", [
     "get list valued", `Quick, list_valued_header;
     "trim whitespace", `Quick, trim_ws;
+    "large header", `Slow, large_header;
+    "many headers", `Slow, many_headers;
   ];
 ]

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.5 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: f559a0a4cbda7bfb637ea3d2863a71fa) *)
+(* DO NOT EDIT (digest: 39334bb729c6e2aef06ecf37a0725ce1) *)
 (*
    Regenerated by OASIS v0.4.5
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6817,7 +6817,7 @@ let setup_t =
             CustomPlugin.Test.main
               {
                  CustomPlugin.cmd_main =
-                   [(OASISExpr.EBool true, ("$test_header", []))];
+                   [(OASISExpr.EBool true, ("$test_header", ["-q"]))];
                  cmd_clean = [(OASISExpr.EBool true, None)];
                  cmd_distclean = [(OASISExpr.EBool true, None)]
               });
@@ -6886,7 +6886,7 @@ let setup_t =
             CustomPlugin.Test.clean
               {
                  CustomPlugin.cmd_main =
-                   [(OASISExpr.EBool true, ("$test_header", []))];
+                   [(OASISExpr.EBool true, ("$test_header", ["-q"]))];
                  cmd_clean = [(OASISExpr.EBool true, None)];
                  cmd_distclean = [(OASISExpr.EBool true, None)]
               });
@@ -6953,7 +6953,7 @@ let setup_t =
             CustomPlugin.Test.distclean
               {
                  CustomPlugin.cmd_main =
-                   [(OASISExpr.EBool true, ("$test_header", []))];
+                   [(OASISExpr.EBool true, ("$test_header", ["-q"]))];
                  cmd_clean = [(OASISExpr.EBool true, None)];
                  cmd_distclean = [(OASISExpr.EBool true, None)]
               });
@@ -6999,7 +6999,7 @@ let setup_t =
           alpha_features = [];
           beta_features = [];
           name = "cohttp";
-          version = "0.18.3";
+          version = "0.19.0";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -8730,7 +8730,7 @@ let setup_t =
                    {
                       test_type = (`Test, "custom", Some "0.4");
                       test_command =
-                        [(OASISExpr.EBool true, ("$test_header", []))];
+                        [(OASISExpr.EBool true, ("$test_header", ["-q"]))];
                       test_custom =
                         {
                            pre_command = [(OASISExpr.EBool true, None)];
@@ -8890,7 +8890,7 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.5";
-     oasis_digest = Some "�#zm-\019\1586\012�CE�kB";
+     oasis_digest = Some "fr���\159al�\145M\144Q\017L\018";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false