0.16.0

.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"

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)

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,19 +108,22 @@ 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))
       +> flag "-p" (optional_with_default 8080 int) ~doc:"port TCP port to listen on"
       +> 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

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 () =

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 = {

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

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

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
 

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

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"