From: Stefano Zacchiroli Date: Mon, 29 May 2006 20:52:22 +0000 (+0000) Subject: - removed Http_daemon.{start,start\} X-Git-Tag: 0.4.95@7852~1395 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=e8ca5a22b5e7174c27f1855c2687798544e2103e;p=helm.git - removed Http_daemon.{start,start\} --- diff --git a/DEVEL/ocaml-http/debian/changelog b/DEVEL/ocaml-http/debian/changelog index bdcfe15c2..c9133945b 100644 --- a/DEVEL/ocaml-http/debian/changelog +++ b/DEVEL/ocaml-http/debian/changelog @@ -1,6 +1,12 @@ ocaml-http (0.1.3-1) UNRELEASED; urgency=low * force bash as SHELL in Makefile, since we rely on bashisms + * removed Http_daemon.{start,start'}, they have been deprecated a while ago + in favour of Http_daemon.main + * added 'auto_close' to daemon specifications. When set to true (defaults to + false), makes ocaml-http close every connection with client just after + having executed a callback, no matter if that callback succeeds or fails + with an exception -- Stefano Zacchiroli Mon, 29 May 2006 22:22:51 +0200 diff --git a/DEVEL/ocaml-http/http_constants.ml b/DEVEL/ocaml-http/http_constants.ml index fa9f49536..f45829ddc 100644 --- a/DEVEL/ocaml-http/http_constants.ml +++ b/DEVEL/ocaml-http/http_constants.ml @@ -25,6 +25,7 @@ let crlf = "\r\n" ;; let default_addr = "0.0.0.0" let default_auth = None +let default_auto_close = false let default_callback = fun _ _ -> () let default_mode = `Fork let default_port = 80 @@ -32,3 +33,4 @@ let default_root_dir = None let default_exn_handler = Some (fun exn outchan -> ()) let default_timeout = Some 300 + diff --git a/DEVEL/ocaml-http/http_constants.mli b/DEVEL/ocaml-http/http_constants.mli index 46db79067..03d2ee424 100644 --- a/DEVEL/ocaml-http/http_constants.mli +++ b/DEVEL/ocaml-http/http_constants.mli @@ -34,6 +34,7 @@ val crlf: string val default_addr: string val default_auth: (string * Http_types.auth_info) option +val default_auto_close: bool val default_callback: Http_types.request -> out_channel -> unit val default_mode: Http_types.daemon_mode val default_port: int diff --git a/DEVEL/ocaml-http/http_daemon.ml b/DEVEL/ocaml-http/http_daemon.ml index 629d1286c..2457c8a73 100644 --- a/DEVEL/ocaml-http/http_daemon.ml +++ b/DEVEL/ocaml-http/http_daemon.ml @@ -297,68 +297,29 @@ let server_of_mode = function callbacks keep on living until the end or are them all killed immediatly? The right semantics should obviously be the first one *) -let handle_manual_auth outchan f = - try - f () - with - | Unauthorized realm -> respond_unauthorized ~realm outchan - | Again -> () - -let handle_auth req spec outchan = + (** - handle HTTP authentication + * - handle automatic closures of client connections *) +let invoke_callback req spec outchan = + let callback req outchan = + if spec.auto_close then + Http_misc.finally + (fun () -> try close_out outchan with Sys_error _ -> ()) + (fun () -> spec.callback req outchan) () + else + spec.callback req outchan in try (match (spec.auth, req#authorization) with - | None, _ -> spec.callback req outchan (* no auth required *) + | None, _ -> callback req outchan (* no auth required *) | Some (realm, `Basic (spec_username, spec_password)), Some (`Basic (username, password)) when (username = spec_username) && (password = spec_password) -> (* auth ok *) - spec.callback req outchan + callback req outchan | Some (realm, _), _ -> raise (Unauthorized realm)) (* auth failure *) with | Unauthorized realm -> respond_unauthorized ~realm outchan | Again -> () - (* TODO support also chroot to 'root', not only chdir *) - (* TODO deprecated: remove from future versions *) - (* curried request *) -let start - ?(addr = default_addr) ?(port = default_port) - ?(timeout = default_timeout) ?(mode = default_mode) ?root callback - = - Http_misc.warn - "Http_daemon.start is deprecated in favour of Http_daemon.main and will be removed in future versions of the library"; - chdir_to_document_root root; - let sockaddr = Http_misc.build_sockaddr (addr, port) in - let daemon_callback inchan outchan = - handle_manual_auth outchan (fun () -> - let (path, parameters) = safe_parse_request inchan outchan in - callback path parameters outchan; - flush outchan); - in - try - (server_of_mode mode) ~sockaddr ~timeout daemon_callback - with Quit -> () - - (* OO request *) - (* TODO deprecated: remove from future versions *) -let start' - ?(addr = default_addr) ?(port = default_port) - ?(timeout = default_timeout) ?(mode = default_mode) ?root callback -= - Http_misc.warn - "Http_daemon.start' is deprecated in favour of Http_daemon.main and will be removed in future versions of the library"; - chdir_to_document_root root; - let sockaddr = Http_misc.build_sockaddr (addr, port) in - let daemon_callback inchan outchan = - handle_manual_auth outchan (fun () -> - let req = safe_parse_request' inchan outchan in - callback req outchan; - flush outchan) - in - try - (server_of_mode mode) ~sockaddr ~timeout daemon_callback - with Quit -> () - let main spec = chdir_to_document_root spec.root_dir; let sockaddr = Http_misc.build_sockaddr (spec.address, spec.port) in @@ -371,7 +332,7 @@ let main spec = match next_req () with | Some req -> debug_print (sprintf "request #%d" n); - handle_auth req spec outchan; + invoke_callback req spec outchan; flush outchan; loop (n + 1) | None -> @@ -473,6 +434,7 @@ open Http_constants let default_spec = { address = default_addr; auth = default_auth; + auto_close = default_auto_close; callback = default_callback; mode = default_mode; port = default_port; @@ -483,6 +445,7 @@ let default_spec = { let daemon_spec ?(address = default_addr) ?(auth = default_auth) + ?(auto_close = default_auto_close) ?(callback = default_callback) ?(mode = default_mode) ?(port = default_port) ?(root_dir = default_root_dir) ?(exn_handler = default_exn_handler) ?(timeout = default_timeout) diff --git a/DEVEL/ocaml-http/http_daemon.mli b/DEVEL/ocaml-http/http_daemon.mli index 59a408d87..2b7be19cb 100644 --- a/DEVEL/ocaml-http/http_daemon.mli +++ b/DEVEL/ocaml-http/http_daemon.mli @@ -120,7 +120,8 @@ val main: Http_types.daemon_spec -> unit * - do not change to a root directory (i.e. keep cwd) * - 300 seconds timeout * - ignores exceptions - * - no authentication required *) + * - no authentication required + * - do not automatically close client connections after callback *) val default_spec: Http_types.daemon_spec (** currified daemon_spec constructor. Each parameter of this function @@ -129,6 +130,7 @@ val default_spec: Http_types.daemon_spec val daemon_spec: ?address:string -> ?auth:(string * Http_types.auth_info) option -> + ?auto_close:bool -> ?callback:(Http_types.request -> out_channel -> unit) -> ?mode:(Http_types.daemon_mode) -> ?port:int -> @@ -138,46 +140,25 @@ val daemon_spec: unit -> Http_types.daemon_spec - (** starts an HTTP daemon (deprecated function) - * - * @deprecated This function will be removed in future versions, please switch - * to Http_daemon.main below. - * - * see {!Http_types.daemon_spec} for a detailed description of parameters - * - * @param addr like the "address" field of Http_types.daemon_spec, defaults to - * the wildcard address "0.0.0.0" - * @param port like the "port" field of Http_types.daemon_spec, defaults to 80 - * @param timeout like the "timeout" field of Http_types.daemon_spec, defaults - * to Some 300 - * @param mode like the "mode" field of Http_types.daemon_spec, defaults to - * `Fork - * @param root like the "root_dir" field of Http_types.daemon_spec, defaults to - * None - * @param callback functional version of the "callback" field of - * Http_types.daemon_spec. 1st argument is the request path, 2nd argument - * the decoded query string, 3rd argument an output channel connect to the - * client - *) +(* +(** XXX + * This function has been deprecated for a while. Now it has been removed! *) val start: ?addr: string -> ?port: int -> ?timeout: int option -> ?mode: Http_types.daemon_mode -> ?root: string -> (string -> (string * string) list -> out_channel -> unit) -> unit +*) - (** starts an HTTP daemon (deprecated function) - * - * @deprecated This function will be removed in future versions, please switch - * to Http_daemon.main below. - * - * parameters as per {!Http_daemon.start} except for the callback, in this case - * it behaves as the "callback" field of Http_types.daemon_spec - *) +(* +(** XXX + * This function has been deprecated for a while. Now it has been removed! *) val start': ?addr: string -> ?port: int -> ?timeout: int option -> ?mode: Http_types.daemon_mode -> ?root: string -> (Http_types.request -> out_channel -> unit) -> unit +*) (** Object oriented interface to HTTP daemons. * @param addr address on which daemon will listen for connections diff --git a/DEVEL/ocaml-http/http_types.ml b/DEVEL/ocaml-http/http_types.ml index 5c88b212e..f31f81679 100644 --- a/DEVEL/ocaml-http/http_types.ml +++ b/DEVEL/ocaml-http/http_types.ml @@ -215,5 +215,6 @@ type daemon_spec = { root_dir: string option; exn_handler: (exn -> out_channel -> unit) option; timeout: int option; + auto_close: bool; } diff --git a/DEVEL/ocaml-http/http_types.mli b/DEVEL/ocaml-http/http_types.mli index 8d5832655..7206d18dc 100644 --- a/DEVEL/ocaml-http/http_types.mli +++ b/DEVEL/ocaml-http/http_types.mli @@ -418,6 +418,10 @@ type daemon_spec = { (** timeout in seconds after which an incoming HTTP request will be * terminated closing the corresponding TCP connection; None disable the * timeout *) + auto_close: bool; + (** whether ocaml-http will automatically close the connection with the + * client after callback has completed its execution. If set to true, close + * will be attempted no matter if the callback raises an exception or not *) } (** {2 OO representation of other HTTP entities} *)