Add more request URI tests for URI components

CHANGES

@@ -1,3 +1,13 @@
+0.17.0 (trunk):
+
+Compatibility breaking interface changes:
+* CONNECT and TRACE methods added to Code. Exhaustive matches will need updating.
+
+New features and bug fixes:
+* Fix handling of request URI for query strings and CONNECT proxies
+* Fix precedence of Host header when request-URI is absolute URI
+* Fix request URI path to be non-empty except for * requests (e.g. OPTIONS *)
+
 0.16.1 (2015-04-09):
 New features and bug fixes:
 * Fix handling of request paths starting with multiple slashes (#308)

_tags

@@ -656,3 +656,4 @@ true: annot, bin_annot
 <examples/async/receive_post.{native,byte}>: custom
 # OASIS_STOP
 true: principal, strict_sequence, debug
+true: warn(@5@8@10@11@12@14@23@24@26@29)

lib/code.ml

@@ -1,9 +1,24 @@
 (* Auto-Generated by 'ocaml generate.ml' *)
 
 open Sexplib.Std
-type version = [ `HTTP_1_0 | `HTTP_1_1 | `Other of string ] with sexp
+type version = [
+  | `HTTP_1_0
+  | `HTTP_1_1
+  | `Other of string
+] with sexp
 
-type meth = [ `GET | `POST | `HEAD | `DELETE | `PATCH | `PUT | `OPTIONS | `Other of string ] with sexp
+type meth = [
+  | `GET
+  | `POST
+  | `HEAD
+  | `DELETE
+  | `PATCH
+  | `PUT
+  | `OPTIONS
+  | `TRACE
+  | `CONNECT
+  | `Other of string
+] with sexp
 
 type informational_status =
   [ `Continue
@@ -89,13 +104,13 @@ type server_error_status =
   | `Network_connect_timeout_error
   ] with sexp
 
-type status =
-  [ informational_status
+type status = [
+  | informational_status
   | success_status
   | redirection_status
   | client_error_status
   | server_error_status
-  ] with sexp
+] with sexp
 
 type status_code = [`Code of int | status ] with sexp
 
@@ -121,6 +136,8 @@ let string_of_method: meth -> string = function
   | `PATCH -> "PATCH"
   | `PUT -> "PUT"
   | `OPTIONS -> "OPTIONS"
+  | `TRACE -> "TRACE"
+  | `CONNECT -> "CONNECT"
   | `Other s -> s
 
 let method_of_string: string -> meth = function
@@ -131,6 +148,8 @@ let method_of_string: string -> meth = function
   | "PATCH" -> `PATCH
   | "PUT" -> `PUT
   | "OPTIONS" -> `OPTIONS
+  | "TRACE" -> `TRACE
+  | "CONNECT" -> `CONNECT
   | s -> `Other s
 
 let compare_method a b =

lib/code.mli

@@ -1,9 +1,24 @@
 (* Auto-Generated by 'ocaml generate.ml' *)
 
 open Sexplib.Std
-type version = [ `HTTP_1_0 | `HTTP_1_1 | `Other of string ] with sexp
-
-type meth = [ `GET | `POST | `HEAD | `DELETE | `PATCH | `PUT | `OPTIONS | `Other of string ] with sexp
+type version = [
+  | `HTTP_1_0
+  | `HTTP_1_1
+  | `Other of string
+] with sexp
+
+type meth = [
+  | `GET
+  | `POST
+  | `HEAD
+  | `DELETE
+  | `PATCH
+  | `PUT
+  | `OPTIONS
+  | `TRACE
+  | `CONNECT
+  | `Other of string
+] with sexp
 
 type informational_status =
   [ `Continue (** Client should continue with request *)
@@ -29,10 +44,8 @@ type success_status =
 
 type redirection_status =
   [ `Multiple_choices (** multiple options for the resource delivered *)
-  | `Moved_permanently (** this and all future requests directed to the
-                           URI provided as the "Location" header. *)
-  | `Found (** temporary response to request found via alternative URI
-               provided by the "Location" header. *)
+  | `Moved_permanently (** this and all future requests directed to the given URI *)
+  | `Found (** temporary response to request found via alternative URI *)
   | `See_other (** permanent response to request found via alternative URI *)
   | `Not_modified (** resource has not been modified since last requested *)
   | `Use_proxy (** content located elsewhere, retrieve from there *)
@@ -96,13 +109,13 @@ type server_error_status =
   ] with sexp
 (** Server_error *)
 
-type status =
-  [ informational_status
+type status = [
+  | informational_status
   | success_status
   | redirection_status
   | client_error_status
   | server_error_status
-  ] with sexp
+] with sexp
 
 type status_code = [`Code of int | status ] with sexp
 

lib/request.ml

@@ -102,30 +102,69 @@ module Make(IO : S.IO) = struct
       end
     | None -> return `Eof
 
+  let return_request headers meth uri version =
+    let encoding = Header.get_transfer_encoding headers in
+    return (`Ok { headers; meth; uri; version; encoding })
+
   let read ic =
     parse_request_fst_line ic >>= function
     | `Eof -> return `Eof
     | `Invalid reason as r -> return r
-    | `Ok (meth, path, version) ->
+    | `Ok (meth, "*", version) ->
       Header_IO.parse ic >>= fun headers ->
-      let empty = Uri.of_string "" in
-      let uri =
-        match Header.get headers "host" with
-        | None -> Uri.with_path empty path
+      let uri = match Header.get headers "host" with
+        | None -> Uri.of_string ""
         | Some host ->
           let host_uri = Uri.of_string ("//"^host) in
-          let uri = Uri.with_path empty path in
-          let uri = Uri.with_host uri (Uri.host host_uri) in
-          Uri.with_port uri (Uri.port host_uri)
+          let uri = Uri.(with_host (of_string "") (host host_uri)) in
+          Uri.(with_port uri (port host_uri))
       in
-      let encoding = Header.get_transfer_encoding headers in
-      return (`Ok { headers; meth; uri; version; encoding })
+      return_request headers meth uri version
+    | `Ok (`CONNECT as meth, authority, version) ->
+      Header_IO.parse ic >>= fun headers ->
+      let uri = Uri.of_string ("//"^authority) in
+      return_request headers meth uri version
+    | `Ok (meth, request_uri_s, version) ->
+      Header_IO.parse ic >>= fun headers ->
+      let uri = Uri.of_string request_uri_s in
+      match Uri.scheme uri with
+        | Some _ -> (* we have an absoluteURI *)
+          let uri = Uri.(
+            match path uri with "" -> with_path uri "/" | _ -> uri
+          ) in
+          return_request headers meth uri version
+        | None ->
+          let len = String.length request_uri_s in
+          if len > 0 && String.get request_uri_s 0 <> '/'
+          then return (`Invalid "bad request URI")
+          else
+            let empty = Uri.of_string "" in
+            let empty_base = Uri.of_string "///" in
+            let pqs = match Stringext.split ~max:2 request_uri_s ~on:'?' with
+              | [] -> empty_base
+              | [path] ->
+                Uri.resolve "http" empty_base (Uri.with_path empty path)
+              | path::qs::_ ->
+                let path_base =
+                  Uri.resolve "http" empty_base (Uri.with_path empty path)
+                in
+                Uri.with_query path_base (Uri.query_of_encoded qs)
+            in
+            let uri = match Header.get headers "host" with
+              | None -> Uri.(with_scheme (with_host pqs None) None)
+              | Some host ->
+                let host_uri = Uri.of_string ("//"^host) in
+                let uri = Uri.with_host pqs (Uri.host host_uri) in
+                Uri.with_port uri (Uri.port host_uri)
+            in
+            return_request headers meth uri version
 
   (* Defined for method types in RFC7231 *)
   let has_body req =
     match req.meth with
-    | `GET | `HEAD | `DELETE -> `No
-    | `POST | `PUT | `PATCH | `OPTIONS | `Other _ -> Transfer.has_body req.encoding
+    | `GET | `HEAD | `DELETE | `CONNECT | `TRACE -> `No
+    | `POST | `PUT | `PATCH | `OPTIONS | `Other _ ->
+      Transfer.has_body req.encoding
 
   let make_body_reader req ic = Transfer_IO.make_reader req.encoding ic
   let read_body_chunk = Transfer_IO.read