From 56a4d3bac1e50ec7c33fc303c030c6b2218d0380 Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Wed, 18 Dec 2013 15:30:32 +0000 Subject: [PATCH 01/12] Remove `Cohttp_mirage` libraries, which have now moved to mirage/mirage-http-unix and mirage/mirage-http-xen. The previous libraries were being inconsistently compiled across Unix and Xen, and this split is required is disambiguate them. See mirage/mirage#161 for more information. --- CHANGES | 3 + README.md | 10 +- _oasis | 38 +------- _tags | 19 +--- cohttp/META | 32 +----- mirage/cohttp_mirage.ml | 69 ------------- mirage/cohttp_mirage.mli | 52 ---------- mirage/cohttp_mirage_io.ml | 74 -------------- mirage/cohttp_mirage_io.mli | 21 ---- mirage/cohttp_mirage_unix.mllib | 5 - mirage/cohttp_mirage_unix.odocl | 5 - mirage/cohttp_mirage_xen.mllib | 5 - mirage/cohttp_mirage_xen.odocl | 5 - myocamlbuild.ml | 7 +- setup.ml | 168 ++------------------------------ 15 files changed, 24 insertions(+), 489 deletions(-) delete mode 100644 mirage/cohttp_mirage.ml delete mode 100644 mirage/cohttp_mirage.mli delete mode 100644 mirage/cohttp_mirage_io.ml delete mode 100644 mirage/cohttp_mirage_io.mli delete mode 100644 mirage/cohttp_mirage_unix.mllib delete mode 100644 mirage/cohttp_mirage_unix.odocl delete mode 100644 mirage/cohttp_mirage_xen.mllib delete mode 100644 mirage/cohttp_mirage_xen.odocl diff --git a/CHANGES b/CHANGES index 5110df1281..805e937904 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,6 @@ +0.9.15 (trunk): +* Remove `Cohttp_mirage` libraries, which have now moved to `mirage/mirage-http-*` on GitHub. + 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. diff --git a/README.md b/README.md index fb971a4df1..78daf58d4b 100644 --- a/README.md +++ b/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. diff --git a/_oasis b/_oasis index 322d1213a1..bed9f45914 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ 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 License: ISC @@ -53,24 +53,6 @@ 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) @@ -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 diff --git a/_tags b/_tags index 9903d242f5..4da094d0d6 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 34cfc630efe139056434de798589c0f0) +# DO NOT EDIT (digest: c6f085d0be63f5d9d1a9cf1fb4ebdfa6) # 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,23 +53,6 @@ : pkg_uri.services : pkg_fieldslib : pkg_fieldslib.syntax -# Library cohttp_mirage_unix -"mirage/cohttp_mirage_unix.cmxs": use_cohttp_mirage_unix -: pkg_mirage-tcpip-unix -# Library cohttp_mirage_xen -"mirage/cohttp_mirage_xen.cmxs": use_cohttp_mirage_xen -: use_cohttp_lwt -: use_cohttp -: pkg_uri -: pkg_mirage-types -: pkg_cstruct -: pkg_mirage-tcpip-xen -: pkg_lwt -: pkg_lwt.syntax -: pkg_re -: pkg_uri.services -: pkg_fieldslib -: pkg_fieldslib.syntax # Library cohttp_async "async/cohttp_async.cmxs": use_cohttp_async : use_cohttp diff --git a/cohttp/META b/cohttp/META index fd77333f2e..1faeb75749 100644 --- a/cohttp/META +++ b/cohttp/META @@ -1,6 +1,6 @@ # OASIS_START -# DO NOT EDIT (digest: c094b1d1abaf3376efc541edae3ee304) -version = "0.9.14" +# DO NOT EDIT (digest: c014569304636ddc501c196b7bc4da21) +version = "0.9.15" description = "HTTP library for Lwt, Async and Mirage" requires = "re uri uri.services fieldslib fieldslib.syntax" archive(byte) = "cohttp.cma" @@ -8,30 +8,8 @@ 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,7 +31,7 @@ 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" archive(byte) = "cohttp_async.cma" diff --git a/mirage/cohttp_mirage.ml b/mirage/cohttp_mirage.ml deleted file mode 100644 index a00471807e..0000000000 --- a/mirage/cohttp_mirage.ml +++ /dev/null @@ -1,69 +0,0 @@ -(* - * Copyright (c) 2012-2013 Anil Madhavapeddy - * Copyright (c) 2013 Thomas Gazagnaire - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - * - *) - -open Lwt - -open Net - -module Net_IO = struct - - module IO = Cohttp_mirage_io - - let connect_uri uri = - fail (Failure "not implemented") - - let connect ?ssl ~host ~service () = - fail (Failure "not implemented") - - let close_in ic = () - let close_out ic = () - let close ic oc = ignore_result (Channel.close ic) - -end - -(* Build all the core modules from the [Cohttp_lwt] functors *) -module Request = Cohttp_lwt.Make_request(Cohttp_mirage_io) -module Response = Cohttp_lwt.Make_response(Cohttp_mirage_io) -module Client = Cohttp_lwt.Make_client(Cohttp_mirage_io)(Request)(Response)(Net_IO) -module Server_core = Cohttp_lwt.Make_server(Cohttp_mirage_io)(Request)(Response)(Net_IO) - -module type S = sig - include Cohttp_lwt.Server with module IO = Cohttp_mirage_io - val listen : ?timeout:float -> Net.Manager.t -> Net.Nettypes.ipv4_src -> t -> unit Lwt.t -end - -(* Extend the [Server_core] module with the Mirage-specific - functions *) -module Server = struct - include Server_core - let listen ?timeout mgr src spec = - (* TODO XXX the cancel-based timeout is almost certainly broken as the - * thread won't issue a Response *) - let cb = - match timeout with - | None -> fun dst ch -> callback spec ch ch - |Some tm -> - fun dst ch -> - let tmout = OS.Time.sleep tm in - let cb_t = callback spec ch ch in - tmout cb_t - in - Net.Channel.listen mgr (`TCPv4 (src, cb)) -end - -let listen = Server.listen diff --git a/mirage/cohttp_mirage.mli b/mirage/cohttp_mirage.mli deleted file mode 100644 index cf8a4d5f05..0000000000 --- a/mirage/cohttp_mirage.mli +++ /dev/null @@ -1,52 +0,0 @@ -(* - * Copyright (c) 2012 Anil Madhavapeddy - * Copyright (c) 2013 Thomas Gazagnaire - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - * - *) - -(** HTTP client and server using the [mirage-tcpip] interfaces. *) - -open Net - -(** The [Request] module holds the information about a HTTP request, - and also includes the {! Cohttp_mirage_io} functions to handle - large message bodies. *) -module Request : Cohttp_lwt.Request with module IO = Cohttp_mirage_io - -(** The [Response] module holds the information about a HTTP response, - and also includes the {! Cohttp_mirage_io} functions to handle - large message bodies. *) -module Response : Cohttp_lwt.Response with module IO = Cohttp_mirage_io - -(** The [Client] module implements an HTTP client interface. *) -module Client : Cohttp_lwt.Client with module IO = Cohttp_mirage_io - -(** The Mirage [S] module type defines the additional Mirage-specific - functions that are exposed by the {! Cohttp_lwt.Server} - interface. This is primarily the {! listen} function to actually - create the server instance and response to incoming requests. *) -module type S = sig - include Cohttp_lwt.Server with module IO = Cohttp_mirage_io - val listen : ?timeout:float -> Manager.t -> Nettypes.ipv4_src -> t -> unit Lwt.t -end - -(** The [Server] module implement the full Mirage HTTP server - interface, including the Mirage-specific functions defined in {! - S }. *) -module Server : S - -(** This [listen] call is the same as {! Server.listen}, but here for - compatibility with the Mirari build tool. *) -val listen : ?timeout:float -> Manager.t -> Nettypes.ipv4_src -> Server.t -> unit Lwt.t diff --git a/mirage/cohttp_mirage_io.ml b/mirage/cohttp_mirage_io.ml deleted file mode 100644 index a1f2188c76..0000000000 --- a/mirage/cohttp_mirage_io.ml +++ /dev/null @@ -1,74 +0,0 @@ -(* - * Copyright (c) 2012 Anil Madhavapeddy - * Copyright (c) 2013 Thomas Gazagnaire - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - * - *) - -(* open Cohttp *) - -open Net - -type 'a t = 'a Lwt.t -let (>>=) = Lwt.bind -let (>>) m n = m >>= fun _ -> n -let return = Lwt.return - -type ic = Channel.t -type oc = Channel.t - -let iter fn x = Lwt_list.iter_s fn x - -let read_line ic = - match_lwt Channel.read_line ic with - | [] -> return None - | bufs -> return (Some (Cstruct.copyv bufs)) - -let read ic len = - try_lwt - lwt iop = Channel.read_some ~len ic in - return (Cstruct.to_string iop) - with End_of_file -> return "" - -let read_exactly ic buf off len = - let rec read acc left = - match left with - | 0 -> return (List.rev acc) - | len -> - lwt iop = Channel.read_some ~len ic in - read (iop::acc) (left - (Cstruct.len iop)) - in - lwt iov = read [] len in - (* XXX TODO this is hyper slow! *) - let srcbuf = Cstruct.copyv iov in - String.blit srcbuf 0 buf off (String.length srcbuf); - return true - -let read_exactly ic len = - let buf = String.create len in - read_exactly ic buf 0 len >>= function - | true -> return (Some buf) - | false -> return None - -let write oc buf = - Channel.write_string oc buf 0 (String.length buf); - Channel.flush oc - -let write_line oc buf = - Channel.write_line oc buf; - Channel.flush oc - -let flush oc = - (* NOOP since we flush in the normal writer functions above *) - return () diff --git a/mirage/cohttp_mirage_io.mli b/mirage/cohttp_mirage_io.mli deleted file mode 100644 index 7628375382..0000000000 --- a/mirage/cohttp_mirage_io.mli +++ /dev/null @@ -1,21 +0,0 @@ -(* - * Copyright (c) 2013 Anil Madhavapeddy - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - * - *) - -include Cohttp.IO.S - with type 'a t = 'a Lwt.t - and type ic = Net.Channel.t - and type oc = Net.Channel.t diff --git a/mirage/cohttp_mirage_unix.mllib b/mirage/cohttp_mirage_unix.mllib deleted file mode 100644 index 3e41694fdc..0000000000 --- a/mirage/cohttp_mirage_unix.mllib +++ /dev/null @@ -1,5 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: d0f6996201bbf62f60a9db112ef4a615) -Cohttp_mirage_io -Cohttp_mirage -# OASIS_STOP diff --git a/mirage/cohttp_mirage_unix.odocl b/mirage/cohttp_mirage_unix.odocl deleted file mode 100644 index 3e41694fdc..0000000000 --- a/mirage/cohttp_mirage_unix.odocl +++ /dev/null @@ -1,5 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: d0f6996201bbf62f60a9db112ef4a615) -Cohttp_mirage_io -Cohttp_mirage -# OASIS_STOP diff --git a/mirage/cohttp_mirage_xen.mllib b/mirage/cohttp_mirage_xen.mllib deleted file mode 100644 index 3e41694fdc..0000000000 --- a/mirage/cohttp_mirage_xen.mllib +++ /dev/null @@ -1,5 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: d0f6996201bbf62f60a9db112ef4a615) -Cohttp_mirage_io -Cohttp_mirage -# OASIS_STOP diff --git a/mirage/cohttp_mirage_xen.odocl b/mirage/cohttp_mirage_xen.odocl deleted file mode 100644 index 3e41694fdc..0000000000 --- a/mirage/cohttp_mirage_xen.odocl +++ /dev/null @@ -1,5 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: d0f6996201bbf62f60a9db112ef4a615) -Cohttp_mirage_io -Cohttp_mirage -# OASIS_STOP diff --git a/myocamlbuild.ml b/myocamlbuild.ml index eb3f5fb33b..06a0b0a4a3 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -1,5 +1,5 @@ (* OASIS_START *) -(* DO NOT EDIT (digest: 13e3c9d1478882e81faae344a7b7cbb0) *) +(* DO NOT EDIT (digest: ca8e0a38bf49f8dce4ca0b65269ad0cb) *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) @@ -556,15 +556,12 @@ let package_default = ("cohttp", ["cohttp"], []); ("cohttp_lwt", ["lwt"], []); ("cohttp_lwt_unix", ["lwt"], []); - ("cohttp_mirage_unix", ["mirage"], []); - ("cohttp_mirage_xen", ["mirage"], []); ("cohttp_async", ["async"], []) ]; lib_c = []; flags = []; includes = [ - ("mirage", ["lwt"]); ("lwt", ["cohttp"]); ("lib_test", ["async"; "cohttp"; "lwt"]); ("bin", ["async"; "cohttp"]); @@ -575,7 +572,7 @@ let package_default = let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;; -# 579 "myocamlbuild.ml" +# 576 "myocamlbuild.ml" (* OASIS_STOP *) open Ocamlbuild_plugin diff --git a/setup.ml b/setup.ml index af3f7a9a60..4a2dda8852 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.3.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: fec775f955fd78de0170727ff96be945) *) +(* DO NOT EDIT (digest: 75c3d1222ef1b2479eba90cf2c0919a1) *) (* Regenerated by OASIS v0.4.0 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6723,9 +6723,7 @@ let setup_t = [ ("cohttp", OCamlbuildDocPlugin.doc_build "cohttp"); ("cohttp_lwt_unix", OCamlbuildDocPlugin.doc_build "lwt"); - ("cohttp_async", OCamlbuildDocPlugin.doc_build "async"); - ("cohttp_mirage_unix", OCamlbuildDocPlugin.doc_build "mirage"); - ("cohttp_mirage_xen", OCamlbuildDocPlugin.doc_build "mirage") + ("cohttp_async", OCamlbuildDocPlugin.doc_build "async") ]; install = InternalInstallPlugin.install; uninstall = InternalInstallPlugin.uninstall; @@ -6777,9 +6775,7 @@ let setup_t = [ ("cohttp", OCamlbuildDocPlugin.doc_clean "cohttp"); ("cohttp_lwt_unix", OCamlbuildDocPlugin.doc_clean "lwt"); - ("cohttp_async", OCamlbuildDocPlugin.doc_clean "async"); - ("cohttp_mirage_unix", OCamlbuildDocPlugin.doc_clean "mirage"); - ("cohttp_mirage_xen", OCamlbuildDocPlugin.doc_clean "mirage") + ("cohttp_async", OCamlbuildDocPlugin.doc_clean "async") ]; distclean = []; distclean_test = @@ -6834,7 +6830,7 @@ let setup_t = alpha_features = []; beta_features = []; name = "cohttp"; - version = "0.9.14"; + version = "0.9.15"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -7107,94 +7103,6 @@ let setup_t = lib_findlib_name = Some "lwt"; lib_findlib_containers = [] }); - Library - ({ - cs_name = "cohttp_mirage_unix"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = - [ - (OASISExpr.EBool true, false); - (OASISExpr.EFlag "mirage_unix", true) - ]; - bs_install = - [ - (OASISExpr.EBool true, false); - (OASISExpr.EFlag "mirage_unix", true) - ]; - bs_path = "mirage"; - bs_compiled_object = Best; - bs_build_depends = - [ - InternalLibrary "cohttp_lwt"; - FindlibPackage ("mirage-types", None); - FindlibPackage ("cstruct", None); - FindlibPackage ("mirage-tcpip-unix", None) - ]; - 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, [])] - }, - { - lib_modules = ["Cohttp_mirage_io"; "Cohttp_mirage"]; - lib_pack = false; - lib_internal_modules = []; - lib_findlib_parent = Some "cohttp"; - lib_findlib_name = Some "mirage-unix"; - lib_findlib_containers = [] - }); - Library - ({ - cs_name = "cohttp_mirage_xen"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = - [ - (OASISExpr.EBool true, false); - (OASISExpr.EFlag "mirage_xen", true) - ]; - bs_install = - [ - (OASISExpr.EBool true, false); - (OASISExpr.EFlag "mirage_xen", true) - ]; - bs_path = "mirage"; - bs_compiled_object = Best; - bs_build_depends = - [ - InternalLibrary "cohttp_lwt"; - FindlibPackage ("mirage-types", None); - FindlibPackage ("cstruct", None); - FindlibPackage ("mirage-tcpip-xen", None) - ]; - 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, [])] - }, - { - lib_modules = ["Cohttp_mirage_io"; "Cohttp_mirage"]; - lib_pack = false; - lib_internal_modules = []; - lib_findlib_parent = Some "cohttp"; - lib_findlib_name = Some "mirage-xen"; - lib_findlib_containers = [] - }); Library ({ cs_name = "cohttp_async"; @@ -7334,70 +7242,6 @@ let setup_t = doc_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"] }); - Doc - ({ - cs_name = "cohttp_mirage_unix"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - doc_type = (`Doc, "ocamlbuild", Some "0.3"); - doc_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - doc_build = - [ - (OASISExpr.ENot (OASISExpr.EFlag "docs"), false); - (OASISExpr.EFlag "docs", false); - (OASISExpr.EAnd - (OASISExpr.EFlag "docs", - OASISExpr.EFlag "mirage_unix"), - true) - ]; - doc_install = [(OASISExpr.EBool true, true)]; - doc_install_dir = "$docdir"; - doc_title = "Cohttp Mirage docs"; - doc_authors = []; - doc_abstract = None; - doc_format = OtherDoc; - doc_data_files = []; - doc_build_tools = - [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"] - }); - Doc - ({ - cs_name = "cohttp_mirage_xen"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - doc_type = (`Doc, "ocamlbuild", Some "0.3"); - doc_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - doc_build = - [ - (OASISExpr.ENot (OASISExpr.EFlag "docs"), false); - (OASISExpr.EFlag "docs", false); - (OASISExpr.EAnd - (OASISExpr.EFlag "docs", - OASISExpr.EFlag "mirage_xen"), - true) - ]; - doc_install = [(OASISExpr.EBool true, true)]; - doc_install_dir = "$docdir"; - doc_title = "Cohttp Mirage docs"; - doc_authors = []; - doc_abstract = None; - doc_format = OtherDoc; - doc_data_files = []; - doc_build_tools = - [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"] - }); Executable ({ cs_name = "test_parser"; @@ -8057,7 +7901,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.0"; - oasis_digest = Some "\nÄ&\131|à}\005}é\144\007\0209\028["; + oasis_digest = Some "\018Q>ý§BÂ\026ßGF\002ÑÂ\019Õ"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -8065,6 +7909,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 8069 "setup.ml" +# 7913 "setup.ml" (* OASIS_STOP *) let () = setup ();; From e0972afe3e0c21df4144b1402fd9f25fee646a9d Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 21 Dec 2013 21:05:43 -0800 Subject: [PATCH 02/12] httponly cookie attribute --- cohttp/cookie.ml | 11 +++++++---- cohttp/cookie.mli | 5 +++-- lib_test/test_header.ml | 4 ++-- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/cohttp/cookie.ml b/cohttp/cookie.ml index 4595734254..1517b95d81 100644 --- a/cohttp/cookie.ml +++ b/cohttp/cookie.ml @@ -28,11 +28,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 *) @@ -48,7 +49,8 @@ module Set_cookie_hdr = struct ("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 @@ -104,6 +106,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 diff --git a/cohttp/cookie.mli b/cohttp/cookie.mli index 9e23f7fc82..449829d466 100644 --- a/cohttp/cookie.mli +++ b/cohttp/cookie.mli @@ -28,14 +28,15 @@ module Set_cookie_hdr : sig expiration : expiration; domain : string option; path : string option; - secure : bool } with fields + secure : bool; + http_only : bool } with fields (** A header which a server sends to a client to request that the client returns the cookie in future requests, under certain conditions. *) val make : ?expiration:expiration -> ?path:string -> - ?domain:string -> ?secure:bool -> cookie -> t + ?domain:string -> ?secure:bool -> ?http_only:bool -> cookie -> t val serialize : ?version:[ `HTTP_1_0 | `HTTP_1_1 ] -> diff --git a/lib_test/test_header.ml b/lib_test/test_header.ml index edf5061c7e..2e875ea790 100644 --- a/lib_test/test_header.ml +++ b/lib_test/test_header.ml @@ -30,10 +30,10 @@ let valid_auth () = let valid_set_cookie () = let c = Cohttp.Cookie.Set_cookie_hdr.make ~expiration:`Session ~path:"/foo/bar" ~domain:"ocaml.org" - ~secure:true ("key", "value") in + ~secure:true ~http_only:true ("key", "value") in let k, v = Cohttp.Cookie.Set_cookie_hdr.serialize ~version:`HTTP_1_0 c in assert_equal ~printer:(fun x -> x) ~msg:"header key" "Set-Cookie" k; - assert_equal ~printer:(fun x -> x) ~msg:"header value" "key=value; domain=ocaml.org; path=/foo/bar; secure" v + assert_equal ~printer:(fun x -> x) ~msg:"header value" "key=value; domain=ocaml.org; path=/foo/bar; secure; httponly" v let valid_cookie () = let cookies = [ "foo", "bar"; "a", "b" ] in From 3272c99e421626039a0457a7725c91700729fed7 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 1 Jan 2014 22:36:24 -0800 Subject: [PATCH 03/12] fix cookie parsing to allow = in values --- cohttp/cookie.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cohttp/cookie.ml b/cohttp/cookie.ml index 4595734254..21e9864797 100644 --- a/cohttp/cookie.ml +++ b/cohttp/cookie.ml @@ -142,8 +142,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) From b34ececc6dfbc3d8d955f6b00481734cedb4029b Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 1 Jan 2014 22:38:40 -0800 Subject: [PATCH 04/12] update tests for case where '=' is in cookie value --- lib_test/test_header.ml | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/lib_test/test_header.ml b/lib_test/test_header.ml index edf5061c7e..9d9f95e9eb 100644 --- a/lib_test/test_header.ml +++ b/lib_test/test_header.ml @@ -35,6 +35,16 @@ let valid_set_cookie () = assert_equal ~printer:(fun x -> x) ~msg:"header key" "Set-Cookie" k; assert_equal ~printer:(fun x -> x) ~msg:"header value" "key=value; domain=ocaml.org; path=/foo/bar; secure" v +let cookie_printer x = + String.concat "; " (List.map (fun (x, y) -> x ^ ":" ^ y) x) + +let cookie_with_eq_val () = + let cookies = [("test","me=")] in + let (k, v) = Cohttp.Cookie.Cookie_hdr.serialize cookies in + let h = Cohttp.Header.of_list [ k, v ] in + let cookies = Cohttp.Cookie.Cookie_hdr.extract h in + assert_equal ~printer:cookie_printer cookies [("test", "me=")] + let valid_cookie () = let cookies = [ "foo", "bar"; "a", "b" ] in let k, v = Cohttp.Cookie.Cookie_hdr.serialize cookies in @@ -42,8 +52,8 @@ let valid_cookie () = assert_equal ~msg:"value" "foo=bar; a=b" v; let h = Cohttp.Header.of_list [ k, v ] in let cookies = Cohttp.Cookie.Cookie_hdr.extract h in - let printer x = String.concat "; " (List.map (fun (x, y) -> x ^ ":" ^ y) x) in - assert_equal ~printer ~msg:"headers" [ "foo", "bar"; "a", "b" ] cookies + assert_equal ~printer:cookie_printer + ~msg:"headers" [ "foo", "bar"; "a", "b" ] cookies (* returns true if the result list contains successes only. Copied from oUnit source as it isnt exposed by the mli *) @@ -63,6 +73,7 @@ let _ = "Valid Auth" >:: valid_auth; "Valid Set-Cookie" >:: valid_set_cookie; "Valid Cookie" >:: valid_cookie; + "Cookie with =" >:: cookie_with_eq_val; ] in let verbose = ref false in let set_verbose _ = verbose := true in From 4c4374c8c3c7515ab5fcf6f761635d2ac8503e74 Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Fri, 3 Jan 2014 20:37:28 +0000 Subject: [PATCH 05/12] Add @rgrinberg to the authors, and sync CHANGES --- CHANGES | 2 ++ _oasis | 2 +- myocamlbuild.ml | 12 ++++++++---- setup.ml | 31 +++++++++++++++++++------------ 4 files changed, 30 insertions(+), 17 deletions(-) diff --git a/CHANGES b/CHANGES index 805e937904..ec520ef731 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,7 @@ 0.9.15 (trunk): * 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). 0.9.14 (2013-12-15): * Install a `cohttp-server` binary that serves local directory contents via a web server (#54). diff --git a/_oasis b/_oasis index bed9f45914..8dc3013c94 100644 --- a/_oasis +++ b/_oasis @@ -2,7 +2,7 @@ OASISFormat: 0.3 Name: cohttp 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 diff --git a/myocamlbuild.ml b/myocamlbuild.ml index 06a0b0a4a3..c020e35166 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -1,5 +1,5 @@ (* OASIS_START *) -(* DO NOT EDIT (digest: ca8e0a38bf49f8dce4ca0b65269ad0cb) *) +(* DO NOT EDIT (digest: ba002535d7cd8c656b584c887c37635e) *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) @@ -368,7 +368,11 @@ module MyOCamlbuildFindlib = struct flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]); flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]); flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]); - flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]) + flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]); + flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]); + flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]); + flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]); + flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]); | _ -> () @@ -547,7 +551,7 @@ module MyOCamlbuildBase = struct end -# 550 "myocamlbuild.ml" +# 554 "myocamlbuild.ml" open Ocamlbuild_plugin;; let package_default = { @@ -572,7 +576,7 @@ let package_default = let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;; -# 576 "myocamlbuild.ml" +# 580 "myocamlbuild.ml" (* OASIS_STOP *) open Ocamlbuild_plugin diff --git a/setup.ml b/setup.ml index 4a2dda8852..bba652b91d 100644 --- a/setup.ml +++ b/setup.ml @@ -1,9 +1,9 @@ (* setup.ml generated for the first time by OASIS v0.3.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 75c3d1222ef1b2479eba90cf2c0919a1) *) +(* DO NOT EDIT (digest: 29383cfa9bb24981a6bcb6e69a98747c) *) (* - Regenerated by OASIS v0.4.0 + Regenerated by OASIS v0.4.1 Visit http://oasis.forge.ocamlcore.org for more information and documentation about functions used in this file. *) @@ -1614,6 +1614,12 @@ module OASISFeatures = struct create "section_object" beta (fun () -> s_ "Implement an object section.") + + + let dynrun_for_release = + create "dynrun_for_release" alpha + (fun () -> + s_ "Make '-setup-update dynamic' suitable for releasing project.") end module OASISUnixPath = struct @@ -2757,7 +2763,7 @@ module OASISFileUtil = struct end -# 2760 "setup.ml" +# 2766 "setup.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) @@ -2861,7 +2867,7 @@ module BaseEnvLight = struct end -# 2864 "setup.ml" +# 2870 "setup.ml" module BaseContext = struct (* # 22 "src/base/BaseContext.ml" *) @@ -5268,7 +5274,7 @@ module BaseSetup = struct end -# 5271 "setup.ml" +# 5277 "setup.ml" module InternalConfigurePlugin = struct (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *) @@ -6117,7 +6123,7 @@ module InternalInstallPlugin = struct end -# 6120 "setup.ml" +# 6126 "setup.ml" module OCamlbuildCommon = struct (* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *) @@ -6519,7 +6525,7 @@ module OCamlbuildDocPlugin = struct end -# 6522 "setup.ml" +# 6528 "setup.ml" module CustomPlugin = struct (* # 22 "src/plugins/custom/CustomPlugin.ml" *) @@ -6667,7 +6673,7 @@ module CustomPlugin = struct end -# 6670 "setup.ml" +# 6676 "setup.ml" open OASISTypes;; let setup_t = @@ -6848,7 +6854,8 @@ let setup_t = "Stefano Zacchiroli"; "David Sheets"; "Thomas Gazagnaire"; - "David Scott" + "David Scott"; + "Rudy Grinberg" ]; homepage = None; synopsis = "HTTP library for Lwt, Async and Mirage"; @@ -7900,8 +7907,8 @@ let setup_t = plugin_data = [] }; oasis_fn = Some "_oasis"; - oasis_version = "0.4.0"; - oasis_digest = Some "\018Q>ý§BÂ\026ßGF\002ÑÂ\019Õ"; + oasis_version = "0.4.1"; + oasis_digest = Some "\007\017²\019\027\026èm\002\132BM²³¼\132"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7909,6 +7916,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7913 "setup.ml" +# 7920 "setup.ml" (* OASIS_STOP *) let () = setup ();; From 8de4976f6e0d923539759f0050cd0f7b9a25434b Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Fri, 3 Jan 2014 20:56:14 +0000 Subject: [PATCH 06/12] Add a Max_age option for Cookie Partially addresses #70 --- CHANGES | 1 + cohttp/cookie.ml | 15 ++++++++++----- cohttp/cookie.mli | 17 +++++++++++++++-- lib_test/test_header.ml | 10 +++++++++- 4 files changed, 35 insertions(+), 8 deletions(-) diff --git a/CHANGES b/CHANGES index ec520ef731..feaf7bec4b 100644 --- a/CHANGES +++ b/CHANGES @@ -2,6 +2,7 @@ * 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). 0.9.14 (2013-12-15): * Install a `cohttp-server` binary that serves local directory contents via a web server (#54). diff --git a/cohttp/cookie.ml b/cohttp/cookie.ml index 97764a6584..c6daafaf8b 100644 --- a/cohttp/cookie.ml +++ b/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 @@ -43,7 +44,9 @@ 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) @@ -56,7 +59,9 @@ module Set_cookie_hdr = struct 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 "" -> "" diff --git a/cohttp/cookie.mli b/cohttp/cookie.mli index 449829d466..1675e3e7a0 100644 --- a/cohttp/cookie.mli +++ b/cohttp/cookie.mli @@ -16,8 +16,21 @@ * *) -type expiration = [ `Session ] - +(** Functions for the HTTP Cookie and Set-Cookie header fields. + Using the Set-Cookie header field, an HTTP server can pass name/value + pairs and associated metadata (called cookies) to a user agent. When + the user agent makes subsequent requests to the server, the user + agent uses the metadata and other information to determine whether to + return the name/value pairs in the Cookie header. *) + +(** Lifetime of the cookie after which the user agent discards it *) +type expiration = [ + | `Session (** Instructs the user agent to discard the cookie + unconditionally when the user agent terminates. *) + | `Max_age of int64 (** The value of the Max-Age attribute is delta-seconds, + the lifetime of the cookie in seconds, a decimal + non-negative integer. *) +] type cookie = string * string (** A cookie is simply a key/value pair send from the client to the server *) diff --git a/lib_test/test_header.ml b/lib_test/test_header.ml index 94ddba9772..a50a13f4f5 100644 --- a/lib_test/test_header.ml +++ b/lib_test/test_header.ml @@ -33,7 +33,15 @@ let valid_set_cookie () = ~secure:true ~http_only:true ("key", "value") in let k, v = Cohttp.Cookie.Set_cookie_hdr.serialize ~version:`HTTP_1_0 c in assert_equal ~printer:(fun x -> x) ~msg:"header key" "Set-Cookie" k; - assert_equal ~printer:(fun x -> x) ~msg:"header value" "key=value; domain=ocaml.org; path=/foo/bar; secure; httponly" v + assert_equal ~printer:(fun x -> x) ~msg:"header value" "key=value; domain=ocaml.org; path=/foo/bar; secure; httponly" v; + let c = Cohttp.Cookie.Set_cookie_hdr.make ~expiration:(`Max_age 100L) + ~path:"/foo/bar" ~domain:"ocaml.org" ("key", "value") in + let k, v = Cohttp.Cookie.Set_cookie_hdr.serialize ~version:`HTTP_1_0 c in + assert_equal ~printer:(fun x -> x) ~msg:"header key2" "Set-Cookie" k; + assert_equal ~printer:(fun x -> x) ~msg:"header value2" "key=value; Max-Age=100; domain=ocaml.org; path=/foo/bar" v; + let k, v = Cohttp.Cookie.Set_cookie_hdr.serialize ~version:`HTTP_1_1 c in + assert_equal ~printer:(fun x -> x) ~msg:"header key 1.1" "Set-Cookie2" k; + assert_equal ~printer:(fun x -> x) ~msg:"header value 1.1" "Domain=ocaml.org; Max-Age=100; Path=/foo/bar; Version=1" v let cookie_printer x = String.concat "; " (List.map (fun (x, y) -> x ^ ":" ^ y) x) From 3ff573bf6326a607fa451f212e790c164ba1dd22 Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Fri, 3 Jan 2014 21:04:16 +0000 Subject: [PATCH 07/12] Make the `Response` record fields mutable to match the `Request` Closes #67 --- CHANGES | 1 + cohttp/response.ml | 10 +++++----- cohttp/response.mli | 10 +++++----- 3 files changed, 11 insertions(+), 10 deletions(-) diff --git a/CHANGES b/CHANGES index feaf7bec4b..5534fbb948 100644 --- a/CHANGES +++ b/CHANGES @@ -3,6 +3,7 @@ * 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). 0.9.14 (2013-12-15): * Install a `cohttp-server` binary that serves local directory contents via a web server (#54). diff --git a/cohttp/response.ml b/cohttp/response.ml index 08b8d543af..2d38a84dbd 100644 --- a/cohttp/response.ml +++ b/cohttp/response.ml @@ -16,11 +16,11 @@ *) type t = { - encoding: Transfer.encoding; - headers: Header.t; - version: Code.version; - status: Code.status_code; - flush: bool; + mutable encoding: Transfer.encoding; + mutable headers: Header.t; + mutable version: Code.version; + mutable status: Code.status_code; + mutable flush: bool; } with fields let make ?(version=`HTTP_1_1) ?(status=`OK) ?(flush=false) ?(encoding=Transfer.Chunked) ?headers () = diff --git a/cohttp/response.mli b/cohttp/response.mli index b77aade878..f40ad30e5f 100644 --- a/cohttp/response.mli +++ b/cohttp/response.mli @@ -16,11 +16,11 @@ *) type t = { - encoding: Transfer.encoding; - headers: Header.t; - version: Code.version; - status: Code.status_code; - flush: bool; + mutable encoding: Transfer.encoding; + mutable headers: Header.t; + mutable version: Code.version; + mutable status: Code.status_code; + mutable flush: bool; } with fields (** Retrieve response HTTP headers *) From 222d8ac4af8f12888e42cb393d32d4e0a8666c93 Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Fri, 3 Jan 2014 21:48:11 +0000 Subject: [PATCH 08/12] Improve ocamldoc --- cohttp/response.mli | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/cohttp/response.mli b/cohttp/response.mli index f40ad30e5f..23c69e8f5e 100644 --- a/cohttp/response.mli +++ b/cohttp/response.mli @@ -15,6 +15,14 @@ * *) +(** HTTP/1.1 response handling *) + +(** This contains the metadata for a HTTP/1.1 response header, including + the {!encoding}, {!headers}, {!version}, {!status} code and whether to + {!flush} the connection after every body chunk (useful for server-side + events and other long-lived connection protocols). The body is handled by + the separate {!S} module type, as it is dependent on the IO + implementation. *) type t = { mutable encoding: Transfer.encoding; mutable headers: Header.t; From cc0cddf4f225b342a321f9a97f094ad17ba462cf Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Thu, 9 Jan 2014 14:03:34 +0000 Subject: [PATCH 09/12] Fix compilation with Async 109.58.00 (Async_core no longer exists) Closes #77 --- CHANGES | 1 + Makefile | 2 +- _oasis | 2 +- _tags | 18 +----------------- cohttp/META | 4 ++-- lib_test/test_net_async.ml | 6 +++--- setup.ml | 10 +++------- 7 files changed, 12 insertions(+), 31 deletions(-) diff --git a/CHANGES b/CHANGES index 5534fbb948..2d7b8fc45a 100644 --- a/CHANGES +++ b/CHANGES @@ -4,6 +4,7 @@ * 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). 0.9.14 (2013-12-15): * Install a `cohttp-server` binary that serves local directory contents via a web server (#54). diff --git a/Makefile b/Makefile index 4133448965..580df381a8 100644 --- a/Makefile +++ b/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)" "" diff --git a/_oasis b/_oasis index 8dc3013c94..0124f97ce1 100644 --- a/_oasis +++ b/_oasis @@ -59,7 +59,7 @@ Library cohttp_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 diff --git a/_tags b/_tags index 4da094d0d6..80b28b932f 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: c6f085d0be63f5d9d1a9cf1fb4ebdfa6) +# 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 @@ -57,8 +57,6 @@ "async/cohttp_async.cmxs": use_cohttp_async : use_cohttp : pkg_uri -: pkg_async_core -: pkg_async_unix : pkg_threads : pkg_async : pkg_re @@ -202,8 +200,6 @@ : use_cohttp : pkg_oUnit : pkg_uri -: pkg_async_core -: pkg_async_unix : pkg_threads : pkg_async : pkg_re @@ -216,8 +212,6 @@ : use_cohttp : pkg_oUnit : pkg_uri -: pkg_async_core -: pkg_async_unix : pkg_threads : pkg_async : pkg_re @@ -230,8 +224,6 @@ : use_cohttp : pkg_oUnit : pkg_uri -: pkg_async_core -: pkg_async_unix : pkg_threads : pkg_async : pkg_re @@ -244,8 +236,6 @@ : use_cohttp : pkg_oUnit : pkg_uri -: pkg_async_core -: pkg_async_unix : pkg_threads : pkg_async : pkg_re @@ -256,8 +246,6 @@ : use_cohttp : pkg_oUnit : pkg_uri -: pkg_async_core -: pkg_async_unix : pkg_threads : pkg_async : pkg_re @@ -269,8 +257,6 @@ : use_cohttp_async : use_cohttp : pkg_uri -: pkg_async_core -: pkg_async_unix : pkg_threads : pkg_async : pkg_re @@ -280,8 +266,6 @@ : use_cohttp_async : use_cohttp : pkg_uri -: pkg_async_core -: pkg_async_unix : pkg_threads : pkg_async : pkg_re diff --git a/cohttp/META b/cohttp/META index 1faeb75749..e7ae11e9a4 100644 --- a/cohttp/META +++ b/cohttp/META @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: c014569304636ddc501c196b7bc4da21) +# 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" @@ -33,7 +33,7 @@ package "lwt" ( package "async" ( 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" diff --git a/lib_test/test_net_async.ml b/lib_test/test_net_async.ml index 9f2e6f9ecf..0e4bdc8bfc 100644 --- a/lib_test/test_net_async.ml +++ b/lib_test/test_net_async.ml @@ -50,7 +50,7 @@ let make_net_post_req () = let test_cases = (* TODO: can multiple async tests run with separate Schedulers? Is there * an Async-aware oUnit instead? *) - let _ = Async_core.Scheduler.within' ( + let _ = Scheduler.within' ( fun () -> Monitor.try_with ( fun () -> make_net_req () >>= make_net_post_req) >>= @@ -59,7 +59,7 @@ let test_cases = (* TODO: how to dump out top-level errors in a nicer way? *) Printf.fprintf stderr "err %s.\n%!" (Exn.backtrace ()); return () |Ok _ -> - Async_unix.Shutdown.exit 0 + Shutdown.exit 0 ) in - Async_unix.Scheduler.go () + Scheduler.go () diff --git a/setup.ml b/setup.ml index bba652b91d..a2bee368e5 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.3.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 29383cfa9bb24981a6bcb6e69a98747c) *) +(* DO NOT EDIT (digest: 60b0b0af12512c3428e4892c1b4fcea7) *) (* Regenerated by OASIS v0.4.1 Visit http://oasis.forge.ocamlcore.org for more information and @@ -7133,10 +7133,6 @@ let setup_t = [ FindlibPackage ("uri", None); InternalLibrary "cohttp"; - FindlibPackage - ("async_core", - Some (OASISVersion.VGreaterEqual "109.12.00")); - FindlibPackage ("async_unix", None); FindlibPackage ("threads", None); FindlibPackage ("async", None) ]; @@ -7908,7 +7904,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.1"; - oasis_digest = Some "\007\017²\019\027\026èm\002\132BM²³¼\132"; + oasis_digest = Some "öéE'²\"e\018y\025ÆÅ`QÖö"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7916,6 +7912,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7920 "setup.ml" +# 7916 "setup.ml" (* OASIS_STOP *) let () = setup ();; From b4f1208b402a14dff837feecfea7ed5d62218aaa Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Thu, 9 Jan 2014 14:28:40 +0000 Subject: [PATCH 10/12] Make HTTP Header handling case-insensitive (by forcing lowercase) Closes #75 --- CHANGES | 1 + cohttp/header.ml | 48 +++++++++++++++++++++++++++++++++-------- lib_test/test_parser.ml | 4 ++-- 3 files changed, 42 insertions(+), 11 deletions(-) diff --git a/CHANGES b/CHANGES index 2d7b8fc45a..10c6e4cb94 100644 --- a/CHANGES +++ b/CHANGES @@ -5,6 +5,7 @@ * 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). 0.9.14 (2013-12-15): * Install a `cohttp-server` binary that serves local directory contents via a web server (#54). diff --git a/cohttp/header.ml b/cohttp/header.ml index 420e08cbd0..be070e380f 100644 --- a/cohttp/header.ml +++ b/cohttp/header.ml @@ -17,12 +17,24 @@ * *) -module StringMap = Map.Make(String) +module LString : sig + type t + val of_string: string -> t + val to_string: t -> string + val compare: t -> t -> int +end = struct + type t = string + let of_string x = String.lowercase x + let to_string x = x + let compare a b = String.compare a b +end + +module StringMap = Map.Make(LString) type t = string list StringMap.t let user_agent = "ocaml-cohttp" (* TODO: include version from build system *) -let headers_with_list_values = [ +let headers_with_list_values = List.map LString.of_string [ "accept";"accept-charset";"accept-encoding";"accept-language"; "accept-ranges";"allow";"cache-control";"connection";"content-encoding"; "content-language";"expect";"if-match";"if-none-match";"pragma"; @@ -30,32 +42,50 @@ let headers_with_list_values = [ "vary";"via";"warning";"www-authenticate"; ] -let init () = StringMap.empty -let init_with k v = StringMap.singleton k [v] +let init () = + StringMap.empty + +let init_with k v = + StringMap.singleton (LString.of_string k) [v] + let add h k v = + let k = LString.of_string k in try StringMap.add k (v::(StringMap.find k h)) h with Not_found -> StringMap.add k [v] h + let add_opt h k v = match h with |None -> init_with k v |Some h -> add h k v -let remove h k = StringMap.remove k h -let replace h k v = StringMap.add k [v] h + +let remove h k = + let k = LString.of_string k in + StringMap.remove k h + +let replace h k v = + let k = LString.of_string k in + StringMap.add k [v] h + let get = let lhm = List.fold_left (fun m k -> StringMap.add k () m) StringMap.empty headers_with_list_values in fun h k -> + let k = LString.of_string k in try let v = StringMap.find k h in if StringMap.exists (fun k' () -> k=k') lhm then Some (String.concat "," v) else Some (List.hd v) with Not_found | Failure _ -> None -let get_multi h k = try StringMap.find k h with Not_found -> [] -let map fn h = StringMap.mapi fn h + +let get_multi h k = + let k = LString.of_string k in + try StringMap.find k h with Not_found -> [] + +let map fn h = StringMap.mapi (fun k v -> fn (LString.to_string k) v) h let iter fn h = ignore(map fn h) let fold fn h acc = StringMap.fold - (fun k v acc -> List.fold_left (fun acc v -> fn k v acc) acc v) + (fun k v acc -> List.fold_left (fun acc v -> fn (LString.to_string k) v acc) acc v) h acc let of_list l = List.fold_left (fun h (k,v) -> add h k v) (init ()) l diff --git a/lib_test/test_parser.ml b/lib_test/test_parser.ml index e86b2e12bf..0dbc3d2f4f 100644 --- a/lib_test/test_parser.ml +++ b/lib_test/test_parser.ml @@ -125,7 +125,7 @@ let basic_res_parse res () = assert_equal (Response.status res) `OK; let headers = Response.headers res in assert_equal (Header.get headers "connection") (Some "close"); - assert_equal (Header.get headers "accept-ranges") (Some "none"); + assert_equal (Header.get headers "Accept-ranges") (Some "none"); assert_equal (Header.get headers "content-type") (Some "text/html; charset=UTF-8"); return () @@ -243,7 +243,7 @@ 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 req = Request.make ~encoding:Transfer.Chunked ~headers:(Header.init_with "Foo" "bar") (Uri.of_string "/foo/bar") in write_req expected req let mutate_simple_req () = From 43cc7598f8536d74fc6b0dc8addcf1fc883cd6a8 Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Fri, 10 Jan 2014 00:15:51 +0000 Subject: [PATCH 11/12] Remove the `>>` operator as it was unused and had incorrect precedence Closes #79 --- CHANGES | 1 + async/cohttp_async.ml | 1 - cohttp/IO.mli | 1 - lwt/cohttp_lwt_unix_io.ml | 1 - 4 files changed, 1 insertion(+), 3 deletions(-) diff --git a/CHANGES b/CHANGES index 10c6e4cb94..08a7c91f32 100644 --- a/CHANGES +++ b/CHANGES @@ -6,6 +6,7 @@ * 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). diff --git a/async/cohttp_async.ml b/async/cohttp_async.ml index 5a1e26a60b..f396d866da 100644 --- a/async/cohttp_async.ml +++ b/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 diff --git a/cohttp/IO.mli b/cohttp/IO.mli index 25e729c773..43f8e20974 100644 --- a/cohttp/IO.mli +++ b/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 diff --git a/lwt/cohttp_lwt_unix_io.ml b/lwt/cohttp_lwt_unix_io.ml index 8b8ef7d23c..9d5c1f82f6 100644 --- a/lwt/cohttp_lwt_unix_io.ml +++ b/lwt/cohttp_lwt_unix_io.ml @@ -26,7 +26,6 @@ let () = Sys.(set_signal sigpipe Signal_ignore) type 'a t = 'a Lwt.t let (>>=) = Lwt.bind -let (>>) m n = m >>= fun _ -> n let return = Lwt.return type ic = Lwt_io.input_channel From f56fbb0cd46a6318ed416afd39eeffb84a554ea3 Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Sat, 11 Jan 2014 21:00:54 +0000 Subject: [PATCH 12/12] release 0.9.15 Closes #80 --- CHANGES | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index 08a7c91f32..ec2fa96826 100644 --- a/CHANGES +++ b/CHANGES @@ -1,4 +1,4 @@ -0.9.15 (trunk): +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).