Merge pull request #5832 from last-genius/private/asultanov/query-fix

CA-395626: Fix (server status report generation report)

Author: edwintorok

ocaml/libs/http-lib/http_svr.ml

@@ -359,11 +359,13 @@ let request_of_bio_exn ~proxy_seen ~read_timeout ~total_timeout ~max_length bio
     proxy |> Option.fold ~none:[] ~some:(fun p -> [("STUNNEL_PROXY", p)])
   in
   let open Http.Request in
-  (* Below transformation only keeps one value per key, whereas
-     a fully compliant implementation following Uri's interface
-     would operate on list of values for each key instead *)
   let kvlist_flatten ls =
-    List.map (function k, v :: _ -> (k, v) | k, [] -> (k, "")) ls
+    (* Uri.query splits the value string into several if they are separated
+       with commas. Like this: "?k=v1,v2,v3" -> [("k", ["v1";"v2";"v3"])]
+       This function concatenates these back. It will not concatenate values
+       entered for duplicate keys, as these will be separate tuples:
+       "?k=v1,v2,v3&k=v4" ->  [("k", ["v1"; "v2"; "v3"]); ("k", ["v4"])] *)
+    List.map (fun (k, vs) -> (k, Astring.String.concat ~sep:"," vs)) ls
   in
   let request =
     Astring.String.cuts ~sep:"\n" headers

ocaml/libs/http-lib/test_client.ml

@@ -43,6 +43,25 @@ let one ~use_fastpath ~use_framing keep_alive s =
           failwith "Need a content length"
   )
 
+let query ~use_fastpath ~use_framing keep_alive s =
+  let query_string = "v1,v2,v3,<>`" in
+  Http_client.rpc ~use_fastpath s
+    (Http.Request.make ~frame:use_framing ~version:"1.1" ~keep_alive ~user_agent
+       ~query:[("k1", query_string)]
+       Http.Get "/query"
+    )
+    (fun response s ->
+      match response.Http.Response.content_length with
+      | Some l ->
+          let s = Unixext.really_read_string s (Int64.to_int l) in
+          if s <> query_string then
+            failwith "Incorrectly parsed query string"
+          else
+            ()
+      | None ->
+          failwith "Need a content length"
+    )
+
 module Normal_population = struct
   (** Stats on a normally-distributed population *)
   type t = {sigma_x: float; sigma_xx: float; n: int}
@@ -122,6 +141,16 @@ let _ =
     )
   in
   Printf.printf "%s RPCs/sec\n%!" (Normal_population.to_string nonpersistent) ;
+  Printf.printf "1 thread non-persistent connections (query):        " ;
+  let nonpersistent_query =
+    sample 1 (fun () ->
+        per_nsec 1. (fun () ->
+            transport !ip !port (query ~use_fastpath ~use_framing false)
+        )
+    )
+  in
+  Printf.printf "%s RPCs/sec\n%!"
+    (Normal_population.to_string nonpersistent_query) ;
   Printf.printf "10 threads non-persistent connections: " ;
   let thread_nonpersistent =
     sample 1 (fun () ->

ocaml/libs/http-lib/test_server.ml

@@ -64,6 +64,22 @@ let _ =
          Unixext.really_write_string s r
        )
     ) ;
+  Server.add_handler server Http.Get "/query"
+    (FdIO
+       (fun request s _ ->
+         match request.Http.Request.query with
+         | (_, v) :: _ ->
+             Unixext.really_write_string s
+               (Http.Response.to_wire_string
+                  (Http.Response.make ~body:v "200" "OK")
+               )
+         | _ ->
+             Unixext.really_write_string s
+               (Http.Response.to_wire_string
+                  (Http.Response.make "404" "Query string missing")
+               )
+       )
+    ) ;
   let ip = "0.0.0.0" in
   let inet_addr = Unix.inet_addr_of_string ip in
   let addr = Unix.ADDR_INET (inet_addr, !port) in