Merge pull request mirage#11 from avsm/master

release 0.9.15

CHANGES

@@ -1,3 +1,13 @@
+0.9.15 (2014-01-11):
+* Remove `Cohttp_mirage` libraries, which have now moved to `mirage/mirage-http-*` on GitHub.
+* Add an "HTTP only" `Cookie` attribute (#69).
+* Fix parsing of cookies with `=` in the values (#71).
+* Add `Max-age` support for cookies (#70).
+* Make the `Response` record fields mutable to match the `Request` (#67).
+* Fix compilation with Async 109.58.00 (#77).
+* Make Header handling case-insensitive (by forcing lowercase) (#75).
+* Remove the `>>` operator as it was unused and had incorrect precedence (#79).
+
 0.9.14 (2013-12-15):
 * Install a `cohttp-server` binary that serves local directory contents via a web server (#54).
 * Add a `flush` function to the `IO` module type and implement in Lwt/Async/Mirage.

Makefile

@@ -5,7 +5,7 @@ PREFIX ?= /usr/local
 NAME=cohttp
 
 LWT ?= $(shell if ocamlfind query lwt.ssl >/dev/null 2>&1; then echo --enable-lwt; fi)
-ASYNC ?= $(shell if ocamlfind query async_core >/dev/null 2>&1; then echo --enable-async; fi)
+ASYNC ?= $(shell if ocamlfind query async >/dev/null 2>&1; then echo --enable-async; fi)
 MIRAGE_UNIX ?= $(shell if ocamlfind query mirage-tcpip-unix >/dev/null 2>&1; then echo --enable-mirage-unix; fi)
 MIRAGE_XEN ?= $(shell if ocamlfind query mirage-tcpip-xen >/dev/null 2>&1; then echo --enable-mirage-xen; fi)
 ifeq "$(findstring $(MIRAGE_OS),xen kfreebsd)" ""

README.md

@@ -3,11 +3,13 @@ HTTP parser, and implementations using various asynchronous programming
 libraries:
 
 * `Cohttp_lwt_unix` uses the [Lwt](http://ocsigen.org/lwt) library, and
-specifically the UNIX bindings.
+  specifically the UNIX bindings.
 * `Cohttp_async` uses the [Async](https://realworldocaml.org/v1/en/html/concurrent-programming-with-async.html)
-library.
-* `Cohttp_mirage` uses the [Mirage](http://www.openmirage.org) interface
-to generate standalone microkernels.
+  library.
+* `Cohttp_lwt` exposes an OS-independent Lwt interface, which is used
+  by the the [Mirage](http://www.openmirage.org) interface
+  to generate standalone microkernels (see the [xen](https://github.com/mirage/mirage-http-xen)
+  and [unix](https://github.com/mirage/mirage-http-unix) respectively).
 
 You can implement other targets using the parser very easily.  Look at the
 `lib/IO.mli` signature and implement that in the desired backend.

_oasis

@@ -1,8 +1,8 @@
 OASISFormat: 0.3
 Name:        cohttp
-Version:     0.9.14
+Version:     0.9.15
 Synopsis:    HTTP library for Lwt, Async and Mirage
-Authors:     Anil Madhavapeddy, Stefano Zacchiroli, David Sheets, Thomas Gazagnaire, David Scott
+Authors:     Anil Madhavapeddy, Stefano Zacchiroli, David Sheets, Thomas Gazagnaire, David Scott, Rudy Grinberg
 License:     ISC
 Plugins:     META (0.3)
 BuildTools:  ocamlbuild
@@ -53,31 +53,13 @@ Library cohttp_lwt_unix
   BuildDepends: cohttp.lwt-core, unix, lwt.unix, lwt.ssl
   Modules: Cohttp_lwt_unix_io, Cohttp_lwt_unix, Cohttp_lwt_unix_net
 
-Library cohttp_mirage_unix
-  Build$: flag(mirage_unix)
-  Install$: flag(mirage_unix)
-  Path: mirage
-  Findlibname: mirage-unix
-  FindlibParent: cohttp
-  BuildDepends: cohttp.lwt-core, mirage-types, cstruct, mirage-tcpip-unix
-  Modules: Cohttp_mirage_io, Cohttp_mirage
-
-Library cohttp_mirage_xen
-  Build$: flag(mirage_xen)
-  Install$: flag(mirage_xen)
-  Path: mirage
-  Findlibname: mirage-xen
-  FindlibParent: cohttp
-  BuildDepends: cohttp.lwt-core, mirage-types, cstruct, mirage-tcpip-xen
-  Modules: Cohttp_mirage_io, Cohttp_mirage
-
 Library cohttp_async
   Build$: flag(async)
   Install$: flag(async)
   Path: async
   Findlibname: async
   FindlibParent: cohttp
-  BuildDepends: uri, cohttp, async_core (>= 109.12.00), async_unix, threads, async
+  BuildDepends: uri, cohttp, threads, async
   Modules: Cohttp_async
 
 Document cohttp
@@ -106,24 +88,6 @@ Document cohttp_async
   XOCamlbuildPath:      async
   XOCamlbuildLibraries: cohttp.async
 
-Document cohttp_mirage_unix
-  Title:                Cohttp Mirage docs
-  Type:                 ocamlbuild (0.3)
-  BuildTools+:          ocamldoc
-  Build$:               flag(mirage_unix)
-  Install:		true
-  XOCamlbuildPath:      mirage
-  XOCamlbuildLibraries: cohttp.mirage-unix
-
-Document cohttp_mirage_xen
-  Title:                Cohttp Mirage docs
-  Type:                 ocamlbuild (0.3)
-  BuildTools+:          ocamldoc
-  Build$:               flag(mirage_xen)
-  Install:		true
-  XOCamlbuildPath:      mirage
-  XOCamlbuildLibraries: cohttp.mirage-xen
-
 Executable test_parser
   Path:               lib_test
   MainIs:             test_parser.ml

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 34cfc630efe139056434de798589c0f0)
+# DO NOT EDIT (digest: d6d7846f359008f884c46f27d8e4b33a)
 # 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
@@ -53,29 +53,10 @@
 <lwt/*.ml{,i}>: pkg_uri.services
 <lwt/*.ml{,i}>: pkg_fieldslib
 <lwt/*.ml{,i}>: pkg_fieldslib.syntax
-# Library cohttp_mirage_unix
-"mirage/cohttp_mirage_unix.cmxs": use_cohttp_mirage_unix
-<mirage/*.ml{,i}>: pkg_mirage-tcpip-unix
-# Library cohttp_mirage_xen
-"mirage/cohttp_mirage_xen.cmxs": use_cohttp_mirage_xen
-<mirage/*.ml{,i}>: use_cohttp_lwt
-<mirage/*.ml{,i}>: use_cohttp
-<mirage/*.ml{,i}>: pkg_uri
-<mirage/*.ml{,i}>: pkg_mirage-types
-<mirage/*.ml{,i}>: pkg_cstruct
-<mirage/*.ml{,i}>: pkg_mirage-tcpip-xen
-<mirage/*.ml{,i}>: pkg_lwt
-<mirage/*.ml{,i}>: pkg_lwt.syntax
-<mirage/*.ml{,i}>: pkg_re
-<mirage/*.ml{,i}>: pkg_uri.services
-<mirage/*.ml{,i}>: pkg_fieldslib
-<mirage/*.ml{,i}>: pkg_fieldslib.syntax
 # Library cohttp_async
 "async/cohttp_async.cmxs": use_cohttp_async
 <async/*.ml{,i}>: use_cohttp
 <async/*.ml{,i}>: pkg_uri
-<async/*.ml{,i}>: pkg_async_core
-<async/*.ml{,i}>: pkg_async_unix
 <async/*.ml{,i}>: pkg_threads
 <async/*.ml{,i}>: pkg_async
 <async/*.ml{,i}>: pkg_re
@@ -219,8 +200,6 @@
 <lib_test/test_net_async.{native,byte}>: use_cohttp
 <lib_test/test_net_async.{native,byte}>: pkg_oUnit
 <lib_test/test_net_async.{native,byte}>: pkg_uri
-<lib_test/test_net_async.{native,byte}>: pkg_async_core
-<lib_test/test_net_async.{native,byte}>: pkg_async_unix
 <lib_test/test_net_async.{native,byte}>: pkg_threads
 <lib_test/test_net_async.{native,byte}>: pkg_async
 <lib_test/test_net_async.{native,byte}>: pkg_re
@@ -233,8 +212,6 @@
 <lib_test/test_net_async_http10.{native,byte}>: use_cohttp
 <lib_test/test_net_async_http10.{native,byte}>: pkg_oUnit
 <lib_test/test_net_async_http10.{native,byte}>: pkg_uri
-<lib_test/test_net_async_http10.{native,byte}>: pkg_async_core
-<lib_test/test_net_async_http10.{native,byte}>: pkg_async_unix
 <lib_test/test_net_async_http10.{native,byte}>: pkg_threads
 <lib_test/test_net_async_http10.{native,byte}>: pkg_async
 <lib_test/test_net_async_http10.{native,byte}>: pkg_re
@@ -247,8 +224,6 @@
 <lib_test/test_net_async_multi_get.{native,byte}>: use_cohttp
 <lib_test/test_net_async_multi_get.{native,byte}>: pkg_oUnit
 <lib_test/test_net_async_multi_get.{native,byte}>: pkg_uri
-<lib_test/test_net_async_multi_get.{native,byte}>: pkg_async_core
-<lib_test/test_net_async_multi_get.{native,byte}>: pkg_async_unix
 <lib_test/test_net_async_multi_get.{native,byte}>: pkg_threads
 <lib_test/test_net_async_multi_get.{native,byte}>: pkg_async
 <lib_test/test_net_async_multi_get.{native,byte}>: pkg_re
@@ -261,8 +236,6 @@
 <lib_test/test_net_async_server.{native,byte}>: use_cohttp
 <lib_test/test_net_async_server.{native,byte}>: pkg_oUnit
 <lib_test/test_net_async_server.{native,byte}>: pkg_uri
-<lib_test/test_net_async_server.{native,byte}>: pkg_async_core
-<lib_test/test_net_async_server.{native,byte}>: pkg_async_unix
 <lib_test/test_net_async_server.{native,byte}>: pkg_threads
 <lib_test/test_net_async_server.{native,byte}>: pkg_async
 <lib_test/test_net_async_server.{native,byte}>: pkg_re
@@ -273,8 +246,6 @@
 <lib_test/*.ml{,i}>: use_cohttp
 <lib_test/*.ml{,i}>: pkg_oUnit
 <lib_test/*.ml{,i}>: pkg_uri
-<lib_test/*.ml{,i}>: pkg_async_core
-<lib_test/*.ml{,i}>: pkg_async_unix
 <lib_test/*.ml{,i}>: pkg_threads
 <lib_test/*.ml{,i}>: pkg_async
 <lib_test/*.ml{,i}>: pkg_re
@@ -286,8 +257,6 @@
 <bin/cohttp_server_async.{native,byte}>: use_cohttp_async
 <bin/cohttp_server_async.{native,byte}>: use_cohttp
 <bin/cohttp_server_async.{native,byte}>: pkg_uri
-<bin/cohttp_server_async.{native,byte}>: pkg_async_core
-<bin/cohttp_server_async.{native,byte}>: pkg_async_unix
 <bin/cohttp_server_async.{native,byte}>: pkg_threads
 <bin/cohttp_server_async.{native,byte}>: pkg_async
 <bin/cohttp_server_async.{native,byte}>: pkg_re
@@ -297,8 +266,6 @@
 <bin/*.ml{,i}>: use_cohttp_async
 <bin/*.ml{,i}>: use_cohttp
 <bin/*.ml{,i}>: pkg_uri
-<bin/*.ml{,i}>: pkg_async_core
-<bin/*.ml{,i}>: pkg_async_unix
 <bin/*.ml{,i}>: pkg_threads
 <bin/*.ml{,i}>: pkg_async
 <bin/*.ml{,i}>: pkg_re

async/cohttp_async.ml

@@ -29,7 +29,6 @@ module IO = struct
 
   type 'a t = 'a Deferred.t
   let (>>=) = Deferred.(>>=)
-  let (>>) m n = m >>= fun _ -> n
   let return = Deferred.return
 
   type ic = Reader.t

cohttp/IO.mli

@@ -1,7 +1,6 @@
 module type S = sig
   type +'a t
   val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-  val (>>) : 'a t -> 'b t -> 'b t
   val return : 'a -> 'a t
 
   type ic

cohttp/META

@@ -1,37 +1,15 @@
 # OASIS_START
-# DO NOT EDIT (digest: c094b1d1abaf3376efc541edae3ee304)
-version = "0.9.14"
+# DO NOT EDIT (digest: 95c89cf60d0140ca94af2573df60a596)
+version = "0.9.15"
 description = "HTTP library for Lwt, Async and Mirage"
 requires = "re uri uri.services fieldslib fieldslib.syntax"
 archive(byte) = "cohttp.cma"
 archive(byte, plugin) = "cohttp.cma"
 archive(native) = "cohttp.cmxa"
 archive(native, plugin) = "cohttp.cmxs"
 exists_if = "cohttp.cma"
-package "mirage-xen" (
- version = "0.9.14"
- description = "HTTP library for Lwt, Async and Mirage"
- requires = "cohttp.lwt-core mirage-types cstruct mirage-tcpip-xen"
- archive(byte) = "cohttp_mirage_xen.cma"
- archive(byte, plugin) = "cohttp_mirage_xen.cma"
- archive(native) = "cohttp_mirage_xen.cmxa"
- archive(native, plugin) = "cohttp_mirage_xen.cmxs"
- exists_if = "cohttp_mirage_xen.cma"
-)
-
-package "mirage-unix" (
- version = "0.9.14"
- description = "HTTP library for Lwt, Async and Mirage"
- requires = "cohttp.lwt-core mirage-types cstruct mirage-tcpip-unix"
- archive(byte) = "cohttp_mirage_unix.cma"
- archive(byte, plugin) = "cohttp_mirage_unix.cma"
- archive(native) = "cohttp_mirage_unix.cmxa"
- archive(native, plugin) = "cohttp_mirage_unix.cmxs"
- exists_if = "cohttp_mirage_unix.cma"
-)
-
 package "lwt-core" (
- version = "0.9.14"
+ version = "0.9.15"
  description = "HTTP library for Lwt, Async and Mirage"
  requires = "lwt uri cohttp lwt.syntax"
  archive(byte) = "cohttp_lwt.cma"
@@ -42,7 +20,7 @@ package "lwt-core" (
 )
 
 package "lwt" (
- version = "0.9.14"
+ version = "0.9.15"
  description = "HTTP library for Lwt, Async and Mirage"
  requires = "cohttp.lwt-core unix lwt.unix lwt.ssl"
  archive(byte) = "cohttp_lwt_unix.cma"
@@ -53,9 +31,9 @@ package "lwt" (
 )
 
 package "async" (
- version = "0.9.14"
+ version = "0.9.15"
  description = "HTTP library for Lwt, Async and Mirage"
- requires = "uri cohttp async_core async_unix threads async"
+ requires = "uri cohttp threads async"
  archive(byte) = "cohttp_async.cma"
  archive(byte, plugin) = "cohttp_async.cma"
  archive(native) = "cohttp_async.cmxa"

cohttp/cookie.ml

@@ -16,9 +16,10 @@
  *
  *)
 
-(* We need a non-Unix date/time implementation to support other expiration
-   types *)
-type expiration = [ `Session ]
+type expiration = [ 
+  | `Session 
+  | `Max_age of int64
+]
 
 type cookie = string * string
 
@@ -28,11 +29,12 @@ module Set_cookie_hdr = struct
     expiration : expiration;
     domain : string option;
     path : string option;
-    secure : bool } with fields
+    secure : bool;
+    http_only: bool } with fields
 
   (* Does not check the contents of name or value for ';', ',', '\s', or name[0]='$' *)
-  let make ?(expiration=`Session) ?path ?domain ?(secure=false) cookie =
-    { cookie ; expiration ; domain ; path ; secure }
+  let make ?(expiration=`Session) ?path ?domain ?(secure=false) ?(http_only=false) cookie =
+    { cookie ; expiration ; domain ; path ; secure ; http_only }
 
   (* TODO: deprecated by RFC 6265 and almost certainly buggy without
      reference to cookie field *)
@@ -42,19 +44,24 @@ module Set_cookie_hdr = struct
     let attrs = match c.path with None -> attrs
       | Some p -> ("Path=" ^ p) :: attrs in
     let attrs = match c.expiration with
-      | `Session -> "Discard" :: attrs in
+      | `Session -> "Discard" :: attrs 
+      | `Max_age age -> ("Max-Age=" ^ (Int64.to_string age)) :: attrs
+   in
     let attrs = match c.domain with None -> attrs
       | Some d -> ("Domain=" ^ d) :: attrs in
       ("Set-Cookie2", String.concat "; " attrs)
 
   let serialize_1_0 c =
-    let attrs = if c.secure then ["secure"] else [] in
+    let attrs = if c.http_only then ["httponly"] else [] in
+    let attrs = if c.secure then "secure"::attrs else attrs in
     let attrs = match c.path with None -> attrs
       | Some p -> ("path=" ^ p) :: attrs in
     let attrs = match c.domain with None -> attrs
       | Some d -> ("domain=" ^ d) :: attrs in
     let attrs = match c.expiration with
-      | `Session -> attrs in
+      | `Session -> attrs
+      | `Max_age age -> ("Max-Age=" ^ (Int64.to_string age)) :: attrs
+    in
     let n, c = c.cookie in
     (* TODO: may be buggy, some UAs will ignore cookie-strings without '='*)
     let attrs = (n ^ (match c with "" -> ""
@@ -104,6 +111,7 @@ module Set_cookie_hdr = struct
         expiration = `Session;
         domain;
         path;
+        http_only=List.mem_assoc "httponly" attrs;
         secure = List.mem_assoc "secure" attrs;
       })::alist
     with (Failure "hd") -> alist
@@ -142,8 +150,7 @@ module Cookie_hdr = struct
              $else) *)
           let cookies = List.filter (fun s -> s.[0] != '$') comps in
           let split_pair nvp =
-            (* TODO: This is buggy for cookies with '=' in values *)
-            match Re_str.split_delim equals_re nvp with
+            match Re_str.bounded_split equals_re nvp 2 with
             | [] -> ("","")
             | n :: [] -> (n, "")
             | n :: v :: _ -> (n, v)