Skip to content

Commit

Permalink
Merge branch 'request_auth_test' of git://github.com/rgrinberg/ocaml-…
Browse files Browse the repository at this point in the history 
…cohttp into cohttp-proxy

Conflicts:
	_tags
	setup.ml
  • Loading branch information
@avsm
avsm committed Feb 17, 2015
2 parents bc7438d + c6010fd commit 10d20ee
Show file tree
Hide file tree
Showing 5 changed files with 196 additions and 40 deletions.
14 changes: 14 additions & 0 deletions _oasis
View file
Original file line number Diff line number Diff line change
Expand Up @@ -156,6 +156,15 @@ Executable test_header
Install: false
BuildDepends: cohttp, oUnit (>= 1.0.2)

Executable test_request
Path: lib_test
MainIs: test_request.ml
Build$: flag(tests)
Custom: true
CompiledObject: best
Install: false
BuildDepends: cohttp, oUnit (>= 1.0.2)

Executable test_net_lwt
Path: lib_test
MainIs: test_net_lwt.ml
Expand Down Expand Up @@ -337,6 +346,11 @@ Test test_header
Command: $test_header
WorkingDirectory: lib_test

Test test_request
Run$: flag(tests)
Command: $test_request
WorkingDirectory: lib_test

Test test_parser
Run$: flag(tests) && flag(lwt_unix)
Command: $test_parser
Expand Down
16 changes: 15 additions & 1 deletion _tags
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: d4d8ccd02056705b676325f96196ac6e)
# DO NOT EDIT (digest: 9e5f723b5dc53e4f0b65b65a00c4b409)
# Ignore VCS directories, you can use the same kind of rule outside
# OASIS_START/STOP if you want to exclude directories that contains
# useless stuff for the build process
Expand Down Expand Up @@ -151,6 +151,20 @@ true: annot, bin_annot
<lib_test/test_header.{native,byte}>: pkg_uri.services
<lib_test/test_header.{native,byte}>: use_cohttp
<lib_test/test_header.{native,byte}>: custom
# Executable test_request
<lib_test/test_request.{native,byte}>: pkg_base64
<lib_test/test_request.{native,byte}>: pkg_bytes
<lib_test/test_request.{native,byte}>: pkg_fieldslib
<lib_test/test_request.{native,byte}>: pkg_fieldslib.syntax
<lib_test/test_request.{native,byte}>: pkg_oUnit
<lib_test/test_request.{native,byte}>: pkg_re.emacs
<lib_test/test_request.{native,byte}>: pkg_sexplib
<lib_test/test_request.{native,byte}>: pkg_sexplib.syntax
<lib_test/test_request.{native,byte}>: pkg_stringext
<lib_test/test_request.{native,byte}>: pkg_uri
<lib_test/test_request.{native,byte}>: pkg_uri.services
<lib_test/test_request.{native,byte}>: use_cohttp
<lib_test/test_request.{native,byte}>: custom
# Executable test_net_lwt
<lib_test/test_net_lwt.{native,byte}>: pkg_base64
<lib_test/test_net_lwt.{native,byte}>: pkg_bytes
Expand Down
75 changes: 39 additions & 36 deletions lib/request.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
*)

open Sexplib.Std

Expand All @@ -34,37 +34,37 @@ let make ?(meth=`GET) ?(version=`HTTP_1_1) ?encoding ?headers uri =
(* Add user:password auth to headers from uri
* if headers don't already have auth *)
match Header.get_authorization headers, Uri.userinfo uri with
| None, Some userinfo -> begin
match Stringext.split ~on:':' userinfo ~max:2 with
| [user; pass] ->
let auth = `Basic (Uri.pct_decode user, Uri.pct_decode pass) in
Header.add_authorization headers auth
| _ -> headers
end
| _, _ -> headers
| None, Some userinfo -> begin
match Stringext.split ~on:':' userinfo ~max:2 with
| [user; pass] ->
let auth = `Basic (Uri.pct_decode user, Uri.pct_decode pass) in
Header.add_authorization headers auth
| _ -> headers
end
| _, _ -> headers
in
let encoding =
match encoding with
| None -> begin
(* Check for a content-length in the supplied headers first *)
match Header.get_content_range headers with
| Some clen -> Transfer.Fixed clen
| None -> Transfer.Fixed Int64.zero
end
(* Check for a content-length in the supplied headers first *)
match Header.get_content_range headers with
| Some clen -> Transfer.Fixed clen
| None -> Transfer.Fixed Int64.zero
end
| Some e -> e
in
{ meth; version; headers; uri; encoding }

let is_keep_alive { version; headers; _ } =
not (version = `HTTP_1_0 ||
(match Header.connection headers with
| Some `Close -> true
| _ -> false))
| Some `Close -> true
| _ -> false))

(* Make a client request, which involves guessing encoding and
adding content headers if appropriate.
@param chunked Forces chunked encoding
*)
*)
let make_for_client ?headers ?(chunked=true) ?(body_length=Int64.zero) meth uri =
let encoding =
match chunked with
Expand All @@ -90,15 +90,15 @@ module Make(IO : S.IO) = struct
let open Code in
read_line ic >>= function
| Some request_line -> begin
match Stringext.split request_line ~on:' ' with
| [ meth_raw; path; http_ver_raw ] -> begin
let m = method_of_string meth_raw in
match version_of_string http_ver_raw with
| `HTTP_1_1 | `HTTP_1_0 as v -> return (`Ok (m, path, v))
| `Other _ -> return (`Invalid ("Malformed request HTTP version: " ^ http_ver_raw))
match Stringext.split request_line ~on:' ' with
| [ meth_raw; path; http_ver_raw ] -> begin
let m = method_of_string meth_raw in
match version_of_string http_ver_raw with
| `HTTP_1_1 | `HTTP_1_0 as v -> return (`Ok (m, path, v))
| `Other _ -> return (`Invalid ("Malformed request HTTP version: " ^ http_ver_raw))
end
| _ -> return (`Invalid ("Malformed request header: " ^ request_line))
end
| _ -> return (`Invalid ("Malformed request header: " ^ request_line))
end
| None -> return `Eof

let read ic =
Expand All @@ -125,14 +125,17 @@ module Make(IO : S.IO) = struct
let read_body_chunk = Transfer_IO.read

let write_header req oc =
let fst_line = Printf.sprintf "%s %s %s\r\n" (Code.string_of_method req.meth)
(Uri.path_and_query req.uri) (Code.string_of_version req.version) in
let fst_line =
Printf.sprintf "%s %s %s\r\n"
(Code.string_of_method req.meth)
(Uri.path_and_query req.uri)
(Code.string_of_version req.version) in
let headers = Header.add_unless_exists req.headers "host"
(Uri.host_with_default ~default:"localhost" req.uri ^
match Uri.port req.uri with
| Some p -> ":" ^ string_of_int p
| None -> ""
) in
(Uri.host_with_default ~default:"localhost" req.uri ^
match Uri.port req.uri with
| Some p -> ":" ^ string_of_int p
| None -> ""
) in
let headers = Header.add_transfer_encoding headers req.encoding in
IO.write oc fst_line >>= fun _ ->
iter (IO.write oc) (Header.to_lines headers) >>= fun _ ->
Expand All @@ -145,10 +148,10 @@ module Make(IO : S.IO) = struct

let write_footer req oc =
match req.encoding with
|Transfer.Chunked ->
(* TODO Trailer header support *)
IO.write oc "0\r\n\r\n"
|Transfer.Fixed _ | Transfer.Unknown -> return ()
| Transfer.Chunked ->
(* TODO Trailer header support *)
IO.write oc "0\r\n\r\n"
| Transfer.Fixed _ | Transfer.Unknown -> return ()

let write ?flush write_body req oc =
write_header req oc >>= fun () ->
Expand Down
41 changes: 41 additions & 0 deletions lib_test/test_request.ml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,41 @@
open OUnit
open Printf
open Cohttp

let uri_userinfo = Uri.of_string "http://foo:bar@ocaml.org"

let header_auth =
let h = Header.init () in
let h = Header.add_authorization h (`Basic ("qux", "qwerty")) in
h

let is_some = function
| None -> false
| Some _ -> true

let header_has_auth _ =
assert_bool "Test header has auth"
(header_auth |> Header.get_authorization |> is_some)

let uri_has_userinfo _ =
assert_bool "Uri has user info" (uri_userinfo |> Uri.userinfo |> is_some)

let auth_uri_no_override _ =
let r = Request.make ~headers:header_auth uri_userinfo in
assert_equal
(r |> Request.headers |> Header.get_authorization )
(Header.get_authorization header_auth)

let auth_uri _ =
let r = Request.make uri_userinfo in
assert_equal
(r |> Request.headers |> Header.get_authorization)
(Some (`Basic ("foo", "bar")))

let _ =
("Request" >:::
[ "Test header has auth" >:: header_has_auth
; "Test uri has user info" >:: uri_has_userinfo
; "Auth from Uri - do not override" >:: auth_uri_no_override
; "Auth from Uri" >:: auth_uri
]) |> run_test_tt_main
90 changes: 87 additions & 3 deletions setup.ml
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
(* setup.ml generated for the first time by OASIS v0.4.5 *)

(* OASIS_START *)
(* DO NOT EDIT (digest: 820854d797d46964f1e6d357a150b302) *)
(* DO NOT EDIT (digest: 69dd07bfb7823d5b65485f2c355c5f75) *)
(*
Regenerated by OASIS v0.4.5
Visit http://oasis.forge.ocamlcore.org for more information and
Expand Down Expand Up @@ -6821,6 +6821,14 @@ let setup_t =
cmd_clean = [(OASISExpr.EBool true, None)];
cmd_distclean = [(OASISExpr.EBool true, None)]
});
("test_request",
CustomPlugin.Test.main
{
CustomPlugin.cmd_main =
[(OASISExpr.EBool true, ("$test_request", []))];
cmd_clean = [(OASISExpr.EBool true, None)];
cmd_distclean = [(OASISExpr.EBool true, None)]
});
("test_parser",
CustomPlugin.Test.main
{
Expand Down Expand Up @@ -6882,6 +6890,14 @@ let setup_t =
cmd_clean = [(OASISExpr.EBool true, None)];
cmd_distclean = [(OASISExpr.EBool true, None)]
});
("test_request",
CustomPlugin.Test.clean
{
CustomPlugin.cmd_main =
[(OASISExpr.EBool true, ("$test_request", []))];
cmd_clean = [(OASISExpr.EBool true, None)];
cmd_distclean = [(OASISExpr.EBool true, None)]
});
("test_parser",
CustomPlugin.Test.clean
{
Expand Down Expand Up @@ -6941,6 +6957,14 @@ let setup_t =
cmd_clean = [(OASISExpr.EBool true, None)];
cmd_distclean = [(OASISExpr.EBool true, None)]
});
("test_request",
CustomPlugin.Test.distclean
{
CustomPlugin.cmd_main =
[(OASISExpr.EBool true, ("$test_request", []))];
cmd_clean = [(OASISExpr.EBool true, None)];
cmd_distclean = [(OASISExpr.EBool true, None)]
});
("test_parser",
CustomPlugin.Test.distclean
{
Expand Down Expand Up @@ -7589,6 +7613,39 @@ let setup_t =
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
{exec_custom = true; exec_main_is = "test_header.ml"});
Executable
({
cs_name = "test_request";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build =
[
(OASISExpr.EBool true, false);
(OASISExpr.EFlag "tests", true)
];
bs_install = [(OASISExpr.EBool true, false)];
bs_path = "lib_test";
bs_compiled_object = Best;
bs_build_depends =
[
InternalLibrary "cohttp";
FindlibPackage
("oUnit",
Some (OASISVersion.VGreaterEqual "1.0.2"))
];
bs_build_tools = [ExternalTool "ocamlbuild"];
bs_c_sources = [];
bs_data_files = [];
bs_ccopt = [(OASISExpr.EBool true, [])];
bs_cclib = [(OASISExpr.EBool true, [])];
bs_dlllib = [(OASISExpr.EBool true, [])];
bs_dllpath = [(OASISExpr.EBool true, [])];
bs_byteopt = [(OASISExpr.EBool true, [])];
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
{exec_custom = true; exec_main_is = "test_request.ml"});
Executable
({
cs_name = "test_net_lwt";
Expand Down Expand Up @@ -8325,6 +8382,33 @@ let setup_t =
];
test_tools = [ExternalTool "ocamlbuild"]
});
Test
({
cs_name = "test_request";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
test_type = (`Test, "custom", Some "0.4");
test_command =
[(OASISExpr.EBool true, ("$test_request", []))];
test_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command = [(OASISExpr.EBool true, None)]
};
test_working_directory = Some "lib_test";
test_run =
[
(OASISExpr.ENot (OASISExpr.EFlag "tests"), false);
(OASISExpr.EFlag "tests", false);
(OASISExpr.EAnd
(OASISExpr.EFlag "tests",
OASISExpr.EFlag "tests"),
true)
];
test_tools = [ExternalTool "ocamlbuild"]
});
Test
({
cs_name = "test_parser";
Expand Down Expand Up @@ -8437,14 +8521,14 @@ let setup_t =
};
oasis_fn = Some "_oasis";
oasis_version = "0.4.5";
oasis_digest = Some "jÇTvT\151À¹ª\029ÓU\130~I%";
oasis_digest = Some "Ò\142:Úú)\127$\153\157Û*Ò\159U4";
oasis_exec = None;
oasis_setup_args = [];
setup_update = false
};;

let setup () = BaseSetup.setup setup_t;;

# 8449 "setup.ml"
# 8533 "setup.ml"
(* OASIS_STOP *)
let () = setup ();;

0 comments on commit 10d20ee

Please sign in to comment.