Merge pull request #5770 from xapi-project/revert-5726-private/asultanov/uri-improvement

Revert "CP-49953: Remove parse_uri, switch to using Uri module instead'"

Author: robhoes

ocaml/libs/http-lib/http.ml

@@ -208,6 +208,15 @@ let parse_keyvalpairs xs =
       )
     kvpairs
 
+let parse_uri x =
+  match Astring.String.cuts ~sep:"?" x with
+  | [uri] ->
+      (uri, [])
+  | [uri; params] ->
+      (uri, parse_keyvalpairs params)
+  | _ ->
+      raise Http_parse_failure
+
 type authorization = Basic of string * string | UnknownAuth of string
 [@@deriving rpc]
 
@@ -620,6 +629,42 @@ module Request = struct
 
   let get_version x = x.version
 
+  let of_request_line x =
+    match Astring.String.fields ~empty:false x with
+    | [m; uri; version] -> (
+        (* Request-Line   = Method SP Request-URI SP HTTP-Version CRLF *)
+        let uri, query = parse_uri uri in
+        (* strip the "HTTP/" prefix from the version string *)
+        match Astring.String.cut ~sep:"/" version with
+        | Some (_, version) ->
+            {
+              m= method_t_of_string m
+            ; frame= false
+            ; uri
+            ; query
+            ; content_length= None
+            ; transfer_encoding= None
+            ; accept= None
+            ; version
+            ; cookie= []
+            ; auth= None
+            ; task= None
+            ; subtask_of= None
+            ; content_type= None
+            ; host= None
+            ; user_agent= None
+            ; close= false
+            ; additional_headers= []
+            ; body= None
+            ; traceparent= None
+            }
+        | None ->
+            error "Failed to parse: %s" x ;
+            raise Http_parse_failure
+      )
+    | _ ->
+        raise Http_parse_failure
+
   let to_string x =
     let kvpairs x =
       String.concat "; " (List.map (fun (k, v) -> k ^ "=" ^ v) x)

ocaml/libs/http-lib/http.mli

@@ -119,6 +119,10 @@ module Request : sig
   val get_version : t -> string
   (** [get_version t] returns the HTTP protocol version *)
 
+  val of_request_line : string -> t
+  (** [of_request_line l] parses [l] of the form "METHOD HTTP/VERSION" and
+      		returns the corresponding [t] *)
+
   val to_string : t -> string
   (** [to_string t] returns a short string summarising [t] *)
 
@@ -172,6 +176,8 @@ end
 
 val authorization_of_string : string -> authorization
 
+val parse_uri : string -> string * (string * string) list
+
 val http_403_forbidden : ?version:string -> unit -> string list
 
 val http_200_ok : ?version:string -> ?keep_alive:bool -> unit -> string list

ocaml/libs/http-lib/http_svr.ml

@@ -359,12 +359,6 @@ 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
-  in
   let request =
     Astring.String.cuts ~sep:"\n" headers
     |> List.fold_left
@@ -373,10 +367,7 @@ let request_of_bio_exn ~proxy_seen ~read_timeout ~total_timeout ~max_length bio
              match Astring.String.fields ~empty:false header with
              | [meth; uri; version] ->
                  (* Request-Line   = Method SP Request-URI SP HTTP-Version CRLF *)
-                 let uri_t = Uri.of_string uri in
-                 if uri_t = Uri.empty then raise Http_parse_failure ;
-                 let uri = Uri.path uri_t in
-                 let query = Uri.query uri_t |> kvlist_flatten in
+                 let uri, query = Http.parse_uri uri in
                  let m = Http.method_t_of_string meth in
                  let version =
                    let x = String.trim version in