diff --git a/ocaml/libs/http-lib/http.ml b/ocaml/libs/http-lib/http.ml index 6b92a014512..be2d4c2c0c5 100644 --- a/ocaml/libs/http-lib/http.ml +++ b/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) diff --git a/ocaml/libs/http-lib/http.mli b/ocaml/libs/http-lib/http.mli index 0f561391de7..84326e38012 100644 --- a/ocaml/libs/http-lib/http.mli +++ b/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 diff --git a/ocaml/libs/http-lib/http_svr.ml b/ocaml/libs/http-lib/http_svr.ml index 2950bb3f79b..c824277e5be 100644 --- a/ocaml/libs/http-lib/http_svr.ml +++ b/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