diff --git a/CHANGES b/CHANGES index b0f9198fe1..f9519f43a4 100644 --- a/CHANGES +++ b/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) diff --git a/_tags b/_tags index 32f177d910..664767ca27 100644 --- a/_tags +++ b/_tags @@ -656,3 +656,4 @@ true: annot, bin_annot : custom # OASIS_STOP true: principal, strict_sequence, debug +true: warn(@5@8@10@11@12@14@23@24@26@29) diff --git a/lib/code.ml b/lib/code.ml index ddd105676d..ed36512bc6 100644 --- a/lib/code.ml +++ b/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 = diff --git a/lib/code.mli b/lib/code.mli index 37d532fcde..326276c33c 100644 --- a/lib/code.mli +++ 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 diff --git a/lib/request.ml b/lib/request.ml index 629db8e12b..c9edc633a4 100644 --- a/lib/request.ml +++ b/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 diff --git a/lib_test/test_request.ml b/lib_test/test_request.ml index fd9bfe4476..69fc5f6c59 100644 --- a/lib_test/test_request.ml +++ b/lib_test/test_request.ml @@ -34,49 +34,159 @@ let auth_uri _ = (r |> Request.headers |> Header.get_authorization) (Some (`Basic ("foo", "bar"))) -let parse_request_uri_ r uri name = +let opt_default default = function + | None -> default + | Some v -> v + +let parse_request_uri_ r expected name = String_io.M.( StringRequest.read (String_io.open_in r) - >>= function - | `Ok { Request.uri = ruri } -> - let msg = - Printf.sprintf "expected path %s got %s" - (Uri.path uri) (Uri.path ruri) + >>= fun result -> match result, expected with + | `Ok { Request.uri = ruri }, `Ok uri -> + let msg = Uri.(Printf.sprintf "expected %s %d %s %s\ngot %s %d %s %s" + (opt_default "_" (host uri)) + (opt_default (-1) (port uri)) + (path uri) (encoded_of_query (query uri)) + (opt_default "_" (host ruri)) + (opt_default (-1) (port ruri)) + (path ruri) (encoded_of_query (query ruri)) + ) in - assert_equal ~msg ruri uri - | _ -> assert_failure (name^" parse failed") + assert_equal ~msg uri ruri + | `Invalid rmsg, `Invalid msg -> + assert_equal rmsg msg + | _ -> assert_failure (name^" unexpected request parse result") ) +let bad_request = `Invalid "bad request URI" + let parse_request_uri _ = let r = "GET / HTTP/1.1\r\n\r\n" in - let uri = Uri.of_string "/" in + let uri = `Ok (Uri.of_string "/") in parse_request_uri_ r uri "parse_request_uri" -let parse_request_uri_double_slash _ = - let r = "GET // HTTP/1.1\r\n\r\n" in - let uri = Uri.with_path (Uri.of_string "") "//" in - parse_request_uri_ r uri "parse_request_uri_double_slash" - -let parse_request_uri_triple_slash _ = - let r = "GET /// HTTP/1.1\r\n\r\n" in - let uri = Uri.with_path (Uri.of_string "") "///" in - parse_request_uri_ r uri "parse_request_uri_triple_slash" - let parse_request_uri_host _ = let r = "GET / HTTP/1.1\r\nHost: example.com\r\n\r\n" in - let uri = Uri.of_string "//example.com/" in + let uri = `Ok (Uri.of_string "//example.com/") in parse_request_uri_ r uri "parse_request_uri_host" +let parse_request_uri_host_port _ = + let r = "GET / HTTP/1.1\r\nHost: example.com:8080\r\n\r\n" in + let uri = `Ok (Uri.of_string "//example.com:8080/") in + parse_request_uri_ r uri "parse_request_uri_host_port" + +let parse_request_uri_double_slash _ = + let r = "GET // HTTP/1.1\r\n\r\n" in + let uri = `Ok (Uri.with_path (Uri.of_string "") "//") in + parse_request_uri_ r uri "parse_request_uri_double_slash" + let parse_request_uri_host_double_slash _ = let r = "GET // HTTP/1.1\r\nHost: example.com\r\n\r\n" in - let uri = Uri.of_string "//example.com//" in + let uri = `Ok (Uri.of_string "//example.com//") in parse_request_uri_ r uri "parse_request_uri_host_double_slash" +let parse_request_uri_triple_slash _ = + let r = "GET /// HTTP/1.1\r\n\r\n" in + let uri = `Ok (Uri.with_path (Uri.of_string "") "///") in + parse_request_uri_ r uri "parse_request_uri_triple_slash" + let parse_request_uri_host_triple_slash _ = let r = "GET /// HTTP/1.1\r\nHost: example.com\r\n\r\n" in - let uri = Uri.of_string "//example.com///" in + let uri = `Ok (Uri.of_string "//example.com///") in parse_request_uri_ r uri "parse_request_uri_host_triple_slash" +let parse_request_uri_no_slash _ = + let r = "GET foo HTTP/1.1\r\n\r\n" in + parse_request_uri_ r bad_request "parse_request_uri_no_slash" + +let parse_request_uri_host_no_slash _ = + let r = "GET foo HTTP/1.1\r\nHost: example.com\r\n\r\n" in + parse_request_uri_ r bad_request "parse_request_uri_host_no_slash" + +let parse_request_uri_empty _ = + let r = "GET HTTP/1.1\r\n\r\n" in + let uri = `Ok (Uri.of_string "/") in + parse_request_uri_ r uri "parse_request_uri_empty" + +let parse_request_uri_host_empty _ = + let r = "GET HTTP/1.1\r\nHost: example.com\r\n\r\n" in + let uri = `Ok (Uri.of_string "//example.com/") in + parse_request_uri_ r uri "parse_request_uri_host_empty" + +let parse_request_uri_path_like_scheme _ = + let r = "GET http://example.net HTTP/1.1\r\n\r\n" in + let uri = `Ok (Uri.of_string "http://example.net/") in + parse_request_uri_ r uri "parse_request_uri_path_like_scheme" + +let parse_request_uri_host_path_like_scheme _ = + let r = "GET http://example.net HTTP/1.1\r\nHost: example.com\r\n\r\n" in + let uri = `Ok (Uri.of_string "http://example.net/") in + parse_request_uri_ r uri "parse_request_uri_host_path_like_scheme" + +let parse_request_uri_path_like_host_port _ = + let path = "//example.net:8080" in + let r = "GET "^path^" HTTP/1.1\r\n\r\n" in + let uri = `Ok (Uri.with_path (Uri.of_string "") path) in + parse_request_uri_ r uri "parse_request_uri_path_like_host_port" + +let parse_request_uri_host_path_like_host_port _ = + let path = "//example.net:8080" in + let r = "GET "^path^" HTTP/1.1\r\nHost: example.com\r\n\r\n" in + let uri = `Ok (Uri.with_path (Uri.of_string "//example.com") path) in + parse_request_uri_ r uri "parse_request_uri_host_path_like_host_port" + +let parse_request_uri_query _ = + let pqs = "/?foo" in + let r = "GET "^pqs^" HTTP/1.1\r\n\r\n" in + let uri = `Ok (Uri.of_string pqs) in + parse_request_uri_ r uri "parse_request_uri_query" + +let parse_request_uri_host_query _ = + let pqs = "/?foo" in + let r = "GET "^pqs^" HTTP/1.1\r\nHost: example.com\r\n\r\n" in + let uri = `Ok (Uri.of_string ("//example.com"^pqs)) in + parse_request_uri_ r uri "parse_request_uri_host_query" + +let parse_request_uri_query_no_slash _ = + let r = "GET ?foo HTTP/1.1\r\n\r\n" in + parse_request_uri_ r bad_request "parse_request_uri_query_no_slash" + +let parse_request_uri_host_query_no_slash _ = + let r = "GET ?foo HTTP/1.1\r\nHost: example.com\r\n\r\n" in + parse_request_uri_ r bad_request "parse_request_uri_host_query_no_slash" + +let parse_request_connect _ = + let r = "CONNECT vpn.example.net:443 HTTP/1.1\r\n" in + let uri = `Ok (Uri.of_string "//vpn.example.net:443") in + parse_request_uri_ r uri "parse_request_connect" + +let parse_request_connect_host _ = + let r = + "CONNECT vpn.example.net:443 HTTP/1.1\r\nHost: vpn.example.com:443\r\n\r\n" + in + let uri = `Ok (Uri.of_string "//vpn.example.net:443") in + parse_request_uri_ r uri "parse_request_connect_host" + +let parse_request_options _ = + let r = "OPTIONS * HTTP/1.1\r\n\r\n" in + let uri = `Ok (Uri.of_string "") in + parse_request_uri_ r uri "parse_request_options" + +let parse_request_options_host _ = + let r = "OPTIONS * HTTP/1.1\r\nHost: example.com:443\r\n\r\n" in + let uri = `Ok (Uri.of_string "//example.com:443") in + parse_request_uri_ r uri "parse_request_options_host" + +let parse_request_uri_traversal _ = + let r = "GET /../../../../etc/shadow HTTP/1.1\r\n\r\n" in + let uri = `Ok (Uri.of_string "/etc/shadow") in + parse_request_uri_ r uri "parse_request_uri_traversal" + +let parse_request_uri_host_traversal _ = + let r = "GET /../../../../etc/shadow HTTP/1.1\r\nHost: example.com\r\n\r\n" in + let uri = `Ok (Uri.of_string "//example.com/etc/shadow") in + parse_request_uri_ r uri "parse_request_uri_host_traversal" + let _ = ("Request" >::: [ "Test header has auth" >:: header_has_auth @@ -84,11 +194,36 @@ let _ = ; "Auth from Uri - do not override" >:: auth_uri_no_override ; "Auth from Uri" >:: auth_uri ; "Parse simple request URI" >:: parse_request_uri - ; "Parse request URI double slash" >:: parse_request_uri_double_slash - ; "Parse request URI triple slash" >:: parse_request_uri_triple_slash ; "Parse request URI with host" >:: parse_request_uri_host + ; "Parse request URI with host and port" >:: parse_request_uri_host_port + ; "Parse request URI double slash" >:: parse_request_uri_double_slash ; "Parse request URI double slash with host" >:: parse_request_uri_host_double_slash + ; "Parse request URI triple slash" >:: parse_request_uri_triple_slash ; "Parse request URI triple slash with host" >:: parse_request_uri_host_triple_slash + ; "Parse request URI no slash" >:: parse_request_uri_no_slash + ; "Parse request URI no slash with host" >:: parse_request_uri_host_no_slash + ; "Parse request URI empty" >:: parse_request_uri_empty + ; "Parse request URI empty with host" >:: parse_request_uri_host_empty + ; "Parse request URI path like scheme" >:: parse_request_uri_path_like_scheme + ; "Parse request URI path like scheme with host" + >:: parse_request_uri_host_path_like_scheme + ; "Parse request URI path like host:port" + >:: parse_request_uri_path_like_host_port + ; "Parse request URI path like host:port with host" + >:: parse_request_uri_host_path_like_host_port + ; "Parse request URI with query string" >:: parse_request_uri_query + ; "Parse request URI with query with host" >:: parse_request_uri_host_query + ; "Parse request URI no slash with query string" + >:: parse_request_uri_query_no_slash + ; "Parse request URI no slash with query with host" + >:: parse_request_uri_host_query_no_slash + ; "Parse CONNECT request URI" >:: parse_request_connect + ; "Parse CONNECT request URI with host" >:: parse_request_connect_host + ; "Parse OPTIONS request URI" >:: parse_request_options + ; "Parse OPTIONS request URI with host" >:: parse_request_options_host + ; "Parse request URI parent traversal" >:: parse_request_uri_traversal + ; "Parse request URI parent traversal with host" + >:: parse_request_uri_host_traversal ]) |> run_test_tt_main diff --git a/scripts/generate.ml b/scripts/generate.ml index c8f0d73fd1..ae70b01842 100644 --- a/scripts/generate.ml +++ b/scripts/generate.ml @@ -1656,14 +1656,9 @@ let output_type oc ~mli t = let output_status_types oc ~mli t = List.iter (output_type oc ~mli) t; - append oc "type status ="; - List.iteri (fun i t -> - if i = 0 then - append oc " [ %s_status" t.section - else - append oc " | %s_status" t.section - ) t; - append oc " ] with sexp"; + append oc "type status = ["; + List.iteri (fun i t -> append oc " | %s_status" t.section) t; + append oc "] with sexp"; append oc ""; append oc "type status_code = [`Code of int | status ] with sexp"; append oc "" @@ -1754,8 +1749,10 @@ type gen = { let g constr string = { constr; string } let output_gen_types oc ~mli (name, typ, gens) = - append oc "type %s = [ %s | `Other of string ] with sexp" typ - (String.concat " | " (List.map (fun g -> g.constr) gens)); + append oc "type %s = [" typ; + List.iter (fun { constr } -> append oc " | %s" constr) gens; + append oc " | `Other of string"; + append oc "] with sexp"; append oc "" let output_gen_convert oc ~mli (name, typ, gens) = @@ -1810,6 +1807,8 @@ let known_methods = [ g "`PATCH" "PATCH"; g "`PUT" "PUT"; g "`OPTIONS" "OPTIONS"; + g "`TRACE" "TRACE"; + g "`CONNECT" "CONNECT"; ] let meth = ("method", "meth", known_methods) @@ -1830,8 +1829,8 @@ let gen oc ~mli = output_is_code oc ~mli t let () = - let ml = open_out "../cohttp/code.ml" in - let mli = open_out "../cohttp/code.mli" in + let ml = open_out "../lib/code.ml" in + let mli = open_out "../lib/code.mli" in gen ml ~mli:false; gen mli ~mli:true; close_out ml;