diff --git a/.merlin b/.merlin new file mode 100644 index 0000000000..25c051e053 --- /dev/null +++ b/.merlin @@ -0,0 +1,18 @@ +S async +S cohttp +S lib_test +S lwt + +PKG lwt +PKG lwt.syntax +PKG lwt.unix +PKG core +PKG async +PKG uri +PKG re.str + +B _build/ +B _build/lwt +B _build/lib_test +B _build/async +B _build/cohttp \ No newline at end of file diff --git a/CHANGES b/CHANGES index 68c6d9c6b3..e64a6bbe6e 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,12 @@ +0.9.12 (2013-11-28): +* Improve documentation for `Cohttp.Header`. +* Expose Fieldslib setters and getters for most of the `Cohttp` types (#38). +* `Cohttp.Set_cookie.t` is no longer an abstract type to make it easier to update (#38). +* [Lwt] ignore SIGPIPE unconditionally if using the Lwt/Unix module (#37). +* Rename `Cookie` creation parameters for consistency (interface breaking, see #44). +* Fix transfer-length detection (regression from 0.9.11 in #42). +* Add Merin editor file (#41). + 0.9.11 (2013-10-27): * Request module: When sending a request, add the port information in the host header field if available. * Request module: When parsing a request, add scheme, host and port information in the uri. diff --git a/_oasis b/_oasis index c6680dbda2..9a0bb8b156 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.3 Name: cohttp -Version: 0.9.11 +Version: 0.9.12 Synopsis: HTTP library for Lwt, Async and Mirage Authors: Anil Madhavapeddy, Stefano Zacchiroli, David Sheets, Thomas Gazagnaire, David Scott License: LGPL-2.0 with OCaml linking exception @@ -12,7 +12,7 @@ Library cohttp Findlibname: cohttp Pack: true Modules: IO, Code, Header, Cookie, Request, Response, Transfer, Accept, Accept_parser, Accept_lexer, Base64, Auth, Header_io, Transfer_io, Client - BuildDepends: re, uri (>= 1.3.8), uri.services + BuildDepends: re, uri (>= 1.3.8), uri.services, fieldslib, fieldslib.syntax Flag lwt Description: build the Lwt library diff --git a/_tags b/_tags index 8ce69af872..c28649bb0a 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: a952834f500b83eea06ca53d69394888) +# DO NOT EDIT (digest: 089787a6c5457a0274e3a8e4ceb59b20) # 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 @@ -33,6 +33,8 @@ : pkg_uri : pkg_re : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax # Library cohttp_lwt_unix "lwt/cohttp_lwt_unix.cmxs": use_cohttp_lwt_unix : pkg_lwt.unix @@ -48,6 +50,8 @@ : pkg_mirage-net : pkg_cstruct : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax # Library cohttp_async "async/cohttp_async.cmxs": use_cohttp_async : use_cohttp @@ -58,6 +62,8 @@ : pkg_async : pkg_re : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax # Executable test_parser : use_cohttp_lwt_unix : use_cohttp @@ -69,6 +75,8 @@ : pkg_lwt : pkg_lwt.ssl : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : custom # Executable test_accept : use_cohttp @@ -76,6 +84,8 @@ : pkg_uri : pkg_re : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : custom # Executable test_header : use_cohttp @@ -83,6 +93,8 @@ : pkg_uri : pkg_re : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : custom # Executable test_net_lwt : use_cohttp_lwt_unix @@ -95,6 +107,8 @@ : pkg_lwt : pkg_lwt.ssl : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : custom # Executable test_net_lwt_google : use_cohttp_lwt_unix @@ -106,6 +120,8 @@ : pkg_lwt : pkg_lwt.ssl : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : custom # Executable test_net_lwt_lastminute : use_cohttp_lwt_unix @@ -117,6 +133,8 @@ : pkg_lwt : pkg_lwt.ssl : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : custom # Executable test_net_lwt_server : use_cohttp_lwt_unix @@ -128,6 +146,8 @@ : pkg_lwt : pkg_lwt.ssl : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : custom # Executable test_net_lwt_multi_get : use_cohttp_lwt_unix @@ -139,6 +159,8 @@ : pkg_lwt : pkg_lwt.ssl : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : custom # Executable test_net_lwt_client_and_server : use_cohttp_lwt_unix @@ -150,6 +172,8 @@ : pkg_lwt : pkg_lwt.ssl : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : use_cohttp_lwt_unix : pkg_lwt.syntax : pkg_lwt.unix @@ -167,6 +191,8 @@ : pkg_async : pkg_re : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : custom # Executable test_net_async_http10 : use_cohttp_async @@ -179,6 +205,8 @@ : pkg_async : pkg_re : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : custom # Executable test_net_async_multi_get : use_cohttp_async @@ -191,6 +219,8 @@ : pkg_async : pkg_re : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : custom # Executable test_net_async_server : use_cohttp_async @@ -203,6 +233,8 @@ : pkg_async : pkg_re : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : use_cohttp_async : use_cohttp : pkg_oUnit @@ -213,8 +245,11 @@ : pkg_async : pkg_re : pkg_uri.services +: pkg_fieldslib +: pkg_fieldslib.syntax : custom # OASIS_STOP : syntax_camlp4o, pkg_lwt.syntax + or or : syntax_camlp4o, pkg_fieldslib.syntax : syntax_camlp4o, pkg_lwt.syntax true: annot, bin_annot, debug, strict_sequence, principal diff --git a/cohttp/META b/cohttp/META index da8e6fe90f..092824bca6 100644 --- a/cohttp/META +++ b/cohttp/META @@ -1,15 +1,15 @@ # OASIS_START -# DO NOT EDIT (digest: 42c241565f568101016fcd5589037ab2) -version = "0.9.11" +# DO NOT EDIT (digest: 6986af1ee7d3541b9e1fb0656ec3ac2c) +version = "0.9.12" description = "HTTP library for Lwt, Async and Mirage" -requires = "re uri uri.services" +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" ( - version = "0.9.11" + version = "0.9.12" description = "HTTP library for Lwt, Async and Mirage" requires = "uri re cohttp lwt.syntax mirage mirage-net cstruct" archive(byte) = "cohttp_mirage.cma" @@ -20,7 +20,7 @@ package "mirage" ( ) package "lwt" ( - version = "0.9.11" + version = "0.9.12" description = "HTTP library for Lwt, Async and Mirage" requires = "lwt.unix lwt uri cohttp lwt.ssl lwt.syntax" archive(byte) = "cohttp_lwt_unix.cma" @@ -31,7 +31,7 @@ package "lwt" ( ) package "async" ( - version = "0.9.11" + version = "0.9.12" 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/cohttp/accept.mli b/cohttp/accept.mli index 9893e44f77..534b739c60 100644 --- a/cohttp/accept.mli +++ b/cohttp/accept.mli @@ -1,3 +1,21 @@ +(* + Copyright (C) 2012, David Sheets + + Permission to use, copy, modify, and/or 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. +*) + type pv = Accept_types.pv = T of string | S of string type p = string * pv type media_range = diff --git a/cohttp/base64.ml b/cohttp/base64.ml index 9b391179a3..c0acac2504 100644 --- a/cohttp/base64.ml +++ b/cohttp/base64.ml @@ -1,16 +1,19 @@ (* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * 2010 Thomas Gazagnaire + * Copyright (c) 2006-2009 Citrix Systems Inc. + * Copyright (c) 2010 Thomas Gazagnaire * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. + * 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. * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. *) let code = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" diff --git a/cohttp/base64.mli b/cohttp/base64.mli index 46cc7c03dd..3486677c8c 100644 --- a/cohttp/base64.mli +++ b/cohttp/base64.mli @@ -1,15 +1,19 @@ (* - * Copyright (C) 2006-2009 Citrix Systems Inc. + * Copyright (c) 2006-2009 Citrix Systems Inc. + * Copyright (c) 2010 Thomas Gazagnaire * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. + * 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. * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. *) (** decode a string encoded in base64. Will leave trailing NULLs on the string diff --git a/cohttp/cookie.ml b/cohttp/cookie.ml index a43b2f29f3..4595734254 100644 --- a/cohttp/cookie.ml +++ b/cohttp/cookie.ml @@ -1,23 +1,20 @@ (* - OCaml HTTP - do it yourself (fully OCaml) HTTP daemon - - Copyright (C) <2012> Anil Madhavapeddy - Copyright (C) <2009> David Sheets - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU Library General Public License as - published by the Free Software Foundation, version 2. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this program; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 - USA -*) + * Copyright (C) <2012> Anil Madhavapeddy + * Copyright (C) <2009> David Sheets + * + * 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. + * + *) (* We need a non-Unix date/time implementation to support other expiration types *) @@ -31,13 +28,11 @@ module Set_cookie_hdr = struct expiration : expiration; domain : string option; path : string option; - secure : bool } + secure : bool } with fields (* Does not check the contents of name or value for ';', ',', '\s', or name[0]='$' *) - let make ?(expiry=`Session) ?path ?domain ?(secure=false) cookie = - { cookie = cookie; - expiration = expiry; domain = domain; - path = path; secure = secure } + let make ?(expiration=`Session) ?path ?domain ?(secure=false) cookie = + { cookie ; expiration ; domain ; path ; secure } (* TODO: deprecated by RFC 6265 and almost certainly buggy without reference to cookie field *) @@ -121,12 +116,7 @@ module Set_cookie_hdr = struct | _ -> (fun _ a -> a) ) hdr [] - let binding { cookie } = cookie let value { cookie=(_,v) } = v - let expiration { expiration } = expiration - let domain { domain } = domain - let path { path } = path - let is_secure { secure } = secure end module Cookie_hdr = struct diff --git a/cohttp/cookie.mli b/cohttp/cookie.mli index 2d1f516f08..9e23f7fc82 100644 --- a/cohttp/cookie.mli +++ b/cohttp/cookie.mli @@ -1,3 +1,21 @@ +(* + * Copyright (C) <2012> Anil Madhavapeddy + * Copyright (C) <2009> David Sheets + * + * 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. + * + *) + type expiration = [ `Session ] type cookie = string * string @@ -5,12 +23,17 @@ type cookie = string * string module Set_cookie_hdr : sig - type t + type t = { + cookie: cookie; + expiration : expiration; + domain : string option; + path : string option; + secure : 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 : - ?expiry:expiration -> + ?expiration:expiration -> ?path:string -> ?domain:string -> ?secure:bool -> cookie -> t @@ -22,7 +45,7 @@ module Set_cookie_hdr : sig val extract : Header.t -> (string * t) list (** Return the list of cookies sent by the server *) - val binding : t -> cookie + val cookie : t -> cookie (** The name-value binding *) val value : t -> string @@ -37,7 +60,7 @@ module Set_cookie_hdr : sig val path : t -> string option (** The path for which the cookie is valid, if any *) - val is_secure : t -> bool + val secure : t -> bool (** Has the cookie's secure attribute been set? *) end diff --git a/cohttp/header.mli b/cohttp/header.mli index 4fe87b598a..247fc64138 100644 --- a/cohttp/header.mli +++ b/cohttp/header.mli @@ -15,15 +15,43 @@ * *) +(** Map of HTTP header key and value(s) associated with them. Since HTTP + headers can contain duplicate keys, this structure can return a list + of values associated with a single key. *) type t + +(** Construct a fresh, empty map of HTTP headers *) val init : unit -> t + +(** Construct a fresh map of HTTP headers with a single key and value entry *) val init_with : string -> string -> t + +(** Add a key and value to an existing header map *) val add : t -> string -> string -> t + +(** Given an optional header, either update the existing one with + a key and value, or construct a fresh header with those values if + the header is [None] *) val add_opt : t option -> string -> string -> t + +(** Remove a key from the header map and return a fresh header set. The + original header parameter is not modified. *) val remove : t -> string -> t + +(** Replace a key from the header map if it exists. The original + header parameter is not modified. *) val replace : t -> string -> string -> t + +(** Retrieve a key from a header. If the header is one of the set of + headers defined to have list values, then all of the values are + concatenated into a single string separated by commas and returned. + If it is a singleton header, then the first value is selected and + no concatenation is performed. *) val get : t -> string -> string option + +(** Retrieve all of the values associated with a key *) val get_multi : t -> string -> string list + val iter : (string -> string list -> unit) -> t -> unit val map : (string -> string list -> string list) -> t -> t val fold : (string -> string -> 'a -> 'a) -> t -> 'a -> 'a diff --git a/cohttp/request.ml b/cohttp/request.ml index 9b697da17e..4d50469613 100644 --- a/cohttp/request.ml +++ b/cohttp/request.ml @@ -16,18 +16,12 @@ *) type t = { - headers: Header.t; - meth: Code.meth; - uri: Uri.t; - version: Code.version; - encoding: Transfer.encoding; -} - -let headers r = r.headers -let meth r = r.meth -let uri r = r.uri -let version r = r.version -let encoding r = r.encoding + mutable headers: Header.t; + mutable meth: Code.meth; + mutable uri: Uri.t; + mutable version: Code.version; + mutable encoding: Transfer.encoding; +} with fields let make ?(meth=`GET) ?(version=`HTTP_1_1) ?encoding ?headers uri = let headers = @@ -58,36 +52,6 @@ let make_for_client ?headers ?(chunked=true) ?(body_length=0) meth uri = in make ~meth ~encoding ?headers uri -module type T = sig - val headers : t -> Header.t - val meth : t -> Code.meth - (** Retrieve full HTTP request uri *) - val uri : t -> Uri.t - - (** Retrieve HTTP version, usually 1.1 *) - val version : t -> Code.version - - (** Retrieve the transfer encoding of this HTTP request *) - val encoding : t -> Transfer.encoding - - (** TODO *) - val params : t -> (string * string list) list - - (** TODO *) - val get_param : t -> string -> string option - - val make : ?meth:Code.meth -> ?version:Code.version -> - ?encoding:Transfer.encoding -> ?headers:Header.t -> - Uri.t -> t - - val make_for_client: - ?headers:Header.t -> - ?chunked:bool -> - ?body_length:int -> - Code.meth -> Uri.t -> t -end - - module type S = sig module IO : IO.S diff --git a/cohttp/request.mli b/cohttp/request.mli index 13fa469d54..34e8acc68c 100644 --- a/cohttp/request.mli +++ b/cohttp/request.mli @@ -21,7 +21,13 @@ the {!headers}, {!version}, {!meth} and {!uri}. The body is handled by the separate {!S} module type, as it is dependent on the IO implementation. *) -type t +type t = { + mutable headers: Header.t; + mutable meth: Code.meth; + mutable uri: Uri.t; + mutable version: Code.version; + mutable encoding: Transfer.encoding; +} with fields (** Retrieve the HTTP request headers *) val headers : t -> Header.t diff --git a/cohttp/response.ml b/cohttp/response.ml index 302d1e5f23..94103972d9 100644 --- a/cohttp/response.ml +++ b/cohttp/response.ml @@ -1,5 +1,5 @@ (* - * Copyright (c) 2012 Anil Madhavapeddy + * Copyright (c) 2012-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 @@ -20,12 +20,7 @@ type t = { headers: Header.t; version: Code.version; status: Code.status_code; -} - -let headers r = r.headers -let encoding r = r.encoding -let version r = r.version -let status r = r.status +} with fields let make ?(version=`HTTP_1_1) ?(status=`OK) ?(encoding=Transfer.Chunked) ?headers () = let headers = match headers with None -> Header.init () |Some h -> h in diff --git a/cohttp/response.mli b/cohttp/response.mli index f46a154a98..7beae082e1 100644 --- a/cohttp/response.mli +++ b/cohttp/response.mli @@ -15,7 +15,12 @@ * *) -type t +type t = { + encoding: Transfer.encoding; + headers: Header.t; + version: Code.version; + status: Code.status_code; +} with fields (** Retrieve response HTTP headers *) val headers : t -> Header.t diff --git a/cohttp/transfer.ml b/cohttp/transfer.ml index 70abc8f284..e92eff066f 100644 --- a/cohttp/transfer.ml +++ b/cohttp/transfer.ml @@ -35,6 +35,6 @@ let has_body = function | Chunked -> true | Fixed 0 -> false - | Unknown -> true + | Unknown -> false | Fixed _ -> true diff --git a/lib_test/client.sh b/lib_test/client.sh new file mode 100755 index 0000000000..ee23f65c2f --- /dev/null +++ b/lib_test/client.sh @@ -0,0 +1,2 @@ +#!/bin/bash +while true; do curl localhost:8080 > /dev/null 2>&1; done diff --git a/lib_test/test_header.ml b/lib_test/test_header.ml index 5362b63bfd..edf5061c7e 100644 --- a/lib_test/test_header.ml +++ b/lib_test/test_header.ml @@ -28,7 +28,7 @@ let valid_auth () = assert_equal (H.get_authorization h) (Some auth) let valid_set_cookie () = - let c = Cohttp.Cookie.Set_cookie_hdr.make ~expiry:`Session + let c = Cohttp.Cookie.Set_cookie_hdr.make ~expiration:`Session ~path:"/foo/bar" ~domain:"ocaml.org" ~secure:true ("key", "value") in let k, v = Cohttp.Cookie.Set_cookie_hdr.serialize ~version:`HTTP_1_0 c in diff --git a/lib_test/test_net_async_server.ml b/lib_test/test_net_async_server.ml index deef8d31eb..9f48fdbb6b 100644 --- a/lib_test/test_net_async_server.ml +++ b/lib_test/test_net_async_server.ml @@ -39,14 +39,11 @@ let handler ~body sock req =
  • Files
    • %s" |> Server.respond_with_string - | "/hello" -> Server.respond_with_string "hello world" - | "/hellopipe" -> let body = Pipe.of_list ["hello";"world"] in Server.respond_with_pipe body - | "/timer" -> let rd,wr = Pipe.create () in Pipe.write_without_pushback wr ""; @@ -55,14 +52,17 @@ let handler ~body sock req = Pipe.write_without_pushback wr (Time.to_string (Time.now ()) ^ "
    "); ); Server.respond_with_pipe rd - | _ -> Server.resolve_local_file ~docroot:"." ~uri |> Server.respond_with_file let make_net_server () = - Server.create (Tcp.on_port 8080) handler + Server.create ~on_handler_error:`Ignore (Tcp.on_port 8080) handler let _ = let _server = make_net_server () in + let () = every (sec 3.0) (fun () -> + Gc.compact (); + printf "live words: %d\n%!" (Gc.((stat()).Stat.live_words)) + ) in Scheduler.go () diff --git a/lib_test/test_parser.ml b/lib_test/test_parser.ml index 55e53021a9..e86b2e12bf 100644 --- a/lib_test/test_parser.ml +++ b/lib_test/test_parser.ml @@ -219,16 +219,14 @@ let get_substring oc buf = let b = String.create len in Lwt_bytes.blit_bytes_string buf 0 b 0 len; b - -let make_simple_req () = + +let write_req expected 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 (* Use the low-level write_header/footer API *) let buf = Lwt_bytes.create 4096 in let oc = oc_of_buffer buf in let body = Cohttp_lwt_body.body_of_string "foobar" in - let req = Request.make ~encoding:Transfer.Chunked ~headers:(Header.init_with "foo" "bar") (Uri.of_string "/foo/bar") in Request.write (fun req oc -> Cohttp_lwt_body.write_body (Request.write_body req oc) body ) req oc >>= fun () -> @@ -237,9 +235,24 @@ let make_simple_req () = * by re-using it *) let buf = Lwt_bytes.create 4096 in let oc = oc_of_buffer buf in - Request.write (fun req oc -> Request.write_body req oc "foobar") req oc >>= fun () -> - assert_equal expected (get_substring oc buf); - return () + Request.write (fun req oc -> Request.write_body req oc "foobar") req oc + >|= fun () -> + assert_equal expected (get_substring oc buf) + +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 + write_req expected req + +let mutate_simple_req () = + let open Cohttp in + let open Cohttp_lwt_unix 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 ~headers:(Header.init_with "foo" "bar") (Uri.of_string "/foo/bar") in + Request.set_meth req `POST; + write_req expected req let make_simple_res () = let open Cohttp in @@ -273,6 +286,7 @@ let test_cases = "basic_res_parse 2", (basic_res_parse basic_res_plus_crlf); "res_content_parse", res_content_parse; "make_simple_req", make_simple_req; + "mutate_simple_req", mutate_simple_req; "make_simple_res", make_simple_res; ] in List.map (fun (n,x) -> n >:: (fun () -> Lwt_unix.run (x ()))) tests diff --git a/lwt/cohttp_lwt_unix_io.ml b/lwt/cohttp_lwt_unix_io.ml index 7bc73fb66e..22975847ea 100644 --- a/lwt/cohttp_lwt_unix_io.ml +++ b/lwt/cohttp_lwt_unix_io.ml @@ -21,7 +21,9 @@ let check_debug norm_fn debug_fn = debug_fn with Not_found -> norm_fn - + +let () = Sys.(set_signal sigpipe Signal_ignore) + type 'a t = 'a Lwt.t let (>>=) = Lwt.bind let (>>) m n = m >>= fun _ -> n diff --git a/setup.ml b/setup.ml index 239043be21..5bcce30b47 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: de1f29b5f64f5ca6399876f1e90ec09a) *) +(* DO NOT EDIT (digest: 5034fb7227d1c4839f4277cf84844014) *) (* Regenerated by OASIS v0.3.0 Visit http://oasis.forge.ocamlcore.org for more information and @@ -5852,7 +5852,7 @@ let setup_t = ocaml_version = None; findlib_version = None; name = "cohttp"; - version = "0.9.11"; + version = "0.9.12"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -5929,7 +5929,9 @@ let setup_t = FindlibPackage ("uri", Some (OASISVersion.VGreaterEqual "1.3.8")); - FindlibPackage ("uri.services", None) + FindlibPackage ("uri.services", None); + FindlibPackage ("fieldslib", None); + FindlibPackage ("fieldslib.syntax", None) ]; bs_build_tools = [ExternalTool "ocamlbuild"]; bs_c_sources = []; @@ -6905,7 +6907,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.3.0"; - oasis_digest = Some "\142U\151z¯Ë\016Á廬¸\131ýå\019"; + oasis_digest = Some "t\016;ªYþ\024jÍTl\134t\t|="; oasis_exec = None; oasis_setup_args = []; setup_update = false; @@ -6913,6 +6915,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 6917 "setup.ml" +# 6919 "setup.ml" (* OASIS_STOP *) let () = setup ();;