diff --git a/.travis.yml b/.travis.yml index 59a3b99e14..247f7ec309 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,3 +4,4 @@ script: bash -ex .travis-opam.sh env: - PACKAGE="cohttp" OCAML_VERSION=4.01 DEPOPTS="async lwt js_of_ocaml" POST_INSTALL_HOOK="opam install github cowabloga" - PACKAGE="cohttp" OCAML_VERSION=latest DEPOPTS="async lwt js_of_ocaml" POST_INSTALL_HOOK="opam install github cowabloga" + - PACKAGE="cohttp" OCAML_VERSION=latest DEPOPTS="async_ssl" POST_INSTALL_HOOK="opam install github cowabloga" diff --git a/CHANGES b/CHANGES index bcbdbf0a38..204d78a8dc 100644 --- a/CHANGES +++ b/CHANGES @@ -1,10 +1,15 @@ -0.16.0 (trunk): +0.16.0 (2015-03-23): Compatibility breaking interface changes: * [lwt] Fix types in `post_form` to be a `string * string list` instead of a `Header.t` (#257) +* Simplify the `Net` signature which needs to be provided for Lwt servers + to not be required. Only the Lwt client needs a `Net` functor argument + to make outgoing connections. (#274) New features and bug fixes: +* Add a `cohttp-lwt-proxy` to act as an HTTP proxy. (#248) +* Extend `cohttp-server-async` file server to work with HTTPS (#277). * Copy basic auth from `Uri.userinfo` into the Authorization header for HTTP requests. (#255) * Install binaries via an OPAM `.install` file to ensure that they are @@ -23,6 +28,13 @@ New features and bug fixes: specify the `content-length` or `transfer-encoding` headers (#268). * `cohttp_server_lwt` and `cohttp_server_async` now include sizes in directory listing titles +* Add `Header.add_multi` to initialise a header structure with multiple + fields more efficiently (#272). +* Expose `IO.ic` and `IO.oc` types for `Cohttp_async` (#271). +* Skip empty body chunks in `Transfer_io.write` (#270). +* With the Lwt backend, `read` hangs if trying to fetch more than + `Sys.max_string_length` (which can be triggered on 32-bit platforms). + Read only a maximum that fits into a string (#282). 0.15.2 (2015-02-15): * When transfer encoding is unknown, read until EOF when body size is unknown. (#241) diff --git a/bin/cohttp_server_async.ml b/bin/cohttp_server_async.ml index 59c71f9888..1a477031dd 100644 --- a/bin/cohttp_server_async.ml +++ b/bin/cohttp_server_async.ml @@ -87,9 +87,17 @@ let rec handler ~info ~docroot ~verbose ~index ~body sock req = end ) +let determine_mode cert_file_path key_file_path = + (* Determines if the server runs in http or https *) + match (cert_file_path, key_file_path) with + | Some c, Some k -> `OpenSSL (`Crt_file_path c, `Key_file_path k) + | None, None -> `TCP + | _ -> failwith "Error: must specify both certificate and key for HTTPS" -let start_server docroot port host index verbose () = - printf "Listening for HTTP requests on: %s %d\n%!" host port; +let start_server docroot port host index verbose cert_file key_file () = + let mode = determine_mode cert_file key_file in + let mode_str = (match mode with `OpenSSL _ -> "HTTPS" | `TCP -> "HTTP") in + printf "Listening for %s requests on: %s %d\n%!" mode_str host port; let info = sprintf "Served by Cohttp/Async listening on %s:%d" host port in Unix.Inet_addr.of_string_or_getbyname host >>= fun host -> @@ -100,13 +108,14 @@ let start_server docroot port host index verbose () = in Server.create ~on_handler_error:`Ignore + ~mode:(determine_mode cert_file key_file) listen_on (handler ~info ~docroot ~index ~verbose) >>= fun _ -> never () let _ = Command.async_basic - ~summary:"Serve the local directory contents via HTTP" + ~summary:"Serve the local directory contents via HTTP or HTTPS" Command.Spec.( empty +> anon (maybe_with_default "." ("docroot" %: string)) @@ -114,5 +123,7 @@ let _ = +> flag "-s" (optional_with_default "0.0.0.0" string) ~doc:"address IP address to listen on" +> flag "-i" (optional_with_default "index.html" string) ~doc:"file Name of index file in directory" +> flag "-v" (optional_with_default false bool) ~doc:" Verbose logging output to console" + +> flag "-cert-file" (optional file) ~doc:"File of cert for https" + +> flag "-key-file" (optional file) ~doc:"File of private key for https" ) start_server |> Command.run diff --git a/lib_test/test_parser.ml b/lib_test/test_parser.ml index e4bf35f3bc..0eb4075bfe 100644 --- a/lib_test/test_parser.ml +++ b/lib_test/test_parser.ml @@ -101,6 +101,14 @@ let oc_of_buffer buf = Lwt_io.of_bytes ~mode:Lwt_io.output buf open Lwt +let pp_diff fmt (a,b) = + Format.pp_print_string fmt "Expected:"; + Format.pp_print_newline fmt (); + Format.pp_print_string fmt a; + Format.pp_print_string fmt "Result:"; + Format.pp_print_newline fmt (); + Format.pp_print_string fmt b + let p_sexp f x = x |> f |> Sexplib.Sexp.to_string let basic_req_parse () = @@ -112,7 +120,7 @@ let basic_req_parse () = assert_equal (Cohttp.Request.version req) `HTTP_1_1; assert_equal (CU.Request.meth req) `GET; assert_equal ~printer:(fun x -> x) - "http://www.example.com/index.html" + "//www.example.com/index.html" (Uri.to_string (CU.Request.uri req)); return () | _ -> assert false @@ -225,7 +233,7 @@ let res_chunked_parse () = (* Extract the substring of the byte buffer that has been written to *) let get_substring oc buf = let len = Int64.to_int (Lwt_io.position oc) in - let b = String.create len in + let b = Bytes.create len in Lwt_bytes.blit_to_bytes buf 0 b 0 len; b @@ -239,7 +247,7 @@ let write_req expected req = Request.write (fun writer -> Cohttp_lwt_body.write_body (Request.write_body writer) body ) req oc >>= fun () -> - assert_equal expected (get_substring oc buf); + assert_equal ~pp_diff expected (get_substring oc buf); (* Use the high-level write API. This also tests that req is immutable * by re-using it *) let buf = Lwt_bytes.create 4096 in @@ -251,8 +259,8 @@ let write_req expected req = let make_simple_req () = let open Cohttp in let open Cohttp_lwt_unix in - let expected = "GET /foo/bar HTTP/1.1\r\nfoo: bar\r\nhost: localhost\r\ntransfer-encoding: chunked\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n" in - let req = Request.make ~encoding:Transfer.Chunked ~headers:(Header.init_with "Foo" "bar") (Uri.of_string "/foo/bar") in + let expected = "POST /foo/bar HTTP/1.1\r\nfoo: bar\r\nhost: localhost\r\ntransfer-encoding: chunked\r\n\r\n6\r\nfoobar\r\n0\r\n\r\n" in + let req = Request.make ~encoding:Transfer.Chunked ~meth:`POST ~headers:(Header.init_with "Foo" "bar") (Uri.of_string "/foo/bar") in write_req expected req let mutate_simple_req () = diff --git a/lwt/cohttp_lwt.ml b/lwt/cohttp_lwt.ml index fa1b02d25d..15c9cf2797 100644 --- a/lwt/cohttp_lwt.ml +++ b/lwt/cohttp_lwt.ml @@ -219,9 +219,6 @@ module type Server = sig module Request : Request module Response : Response - type ctx with sexp_of - val default_ctx : ctx - type conn = IO.conn * Cohttp.Connection.t type t @@ -268,14 +265,11 @@ end module Make_server(IO:IO) (Request:Request with module IO=IO) (Response:Response with module IO=IO) - (Net:Net with module IO=IO) = struct += struct module IO = IO module Request = Request module Response = Response - type ctx = Net.ctx with sexp_of - let default_ctx = Net.default_ctx - type conn = IO.conn * Cohttp.Connection.t type t = { diff --git a/lwt/cohttp_lwt.mli b/lwt/cohttp_lwt.mli index 8809508a38..64d980b0bf 100644 --- a/lwt/cohttp_lwt.mli +++ b/lwt/cohttp_lwt.mli @@ -163,9 +163,6 @@ module type Server = sig module Request : Request module Response : Response - type ctx with sexp_of - val default_ctx : ctx - type conn = IO.conn * Cohttp.Connection.t type t @@ -225,8 +222,6 @@ module Make_server (IO:IO) (Request:Request with module IO=IO) (Response:Response with module IO=IO) - (Net:Net with module IO = IO) : - Server with module IO = IO + : Server with module IO = IO and module Request = Request and module Response = Response - and type ctx = Net.ctx diff --git a/lwt/cohttp_lwt_unix.ml b/lwt/cohttp_lwt_unix.ml index 268bb1b682..8a6982e35b 100644 --- a/lwt/cohttp_lwt_unix.ml +++ b/lwt/cohttp_lwt_unix.ml @@ -37,8 +37,8 @@ module Client = struct let custom_ctx = Cohttp_lwt_unix_net.custom_ctx end -module Server_core = Cohttp_lwt.Make_server - (Cohttp_lwt_unix_io)(Request)(Response)(Cohttp_lwt_unix_net) +module Server_core = + Cohttp_lwt.Make_server (Cohttp_lwt_unix_io)(Request)(Response) module Server = struct include Server_core @@ -86,7 +86,7 @@ module Server = struct let body = Printexc.to_string exn in respond_error ~status:`Internal_server_error ~body () - let create ?timeout ?stop ?(ctx=default_ctx) ?(mode=`TCP (`Port 8080)) spec = + let create ?timeout ?stop ?(ctx=Cohttp_lwt_unix_net.default_ctx) ?(mode=`TCP (`Port 8080)) spec = Conduit_lwt_unix.serve ?timeout ?stop ~ctx:ctx.Cohttp_lwt_unix_net.ctx ~mode (fun conn ic oc -> (callback spec) conn ic oc) end @@ -96,7 +96,6 @@ module type S = sig include Cohttp_lwt.Server with module IO = Cohttp_lwt_unix_io and module Request = Request and module Response = Response - and type ctx = Cohttp_lwt_unix_net.ctx val resolve_file : docroot:string -> uri:Uri.t -> string diff --git a/lwt/cohttp_lwt_unix.mli b/lwt/cohttp_lwt_unix.mli index 99e368ecc8..4d393175a6 100644 --- a/lwt/cohttp_lwt_unix.mli +++ b/lwt/cohttp_lwt_unix.mli @@ -63,7 +63,6 @@ module type S = sig include Cohttp_lwt.Server with module IO = Cohttp_lwt_unix_io and module Request = Request and module Response = Response - and type ctx = Cohttp_lwt_unix_net.ctx val resolve_file : docroot:string -> uri:Uri.t -> string diff --git a/lwt/cohttp_lwt_unix_io.ml b/lwt/cohttp_lwt_unix_io.ml index 4a57b07b86..711ec40624 100644 --- a/lwt/cohttp_lwt_unix_io.ml +++ b/lwt/cohttp_lwt_unix_io.ml @@ -37,6 +37,7 @@ let read_line ic = Lwt_io.read_line_opt ic let read ic count = + let count = min count Sys.max_string_length in if !CD.debug_active then (lwt buf = try_lwt Lwt_io.read ~count ic diff --git a/opam b/opam index 1cd4beef16..9b82349d0f 100644 --- a/opam +++ b/opam @@ -30,6 +30,7 @@ install: [make "PREFIX=%{prefix}%" "install"] remove: [["ocamlfind" "remove" "cohttp"]] depends: [ + "base-bytes" "ocamlfind" {build} "cmdliner" {build & >= "0.9.4"} "re"