]> matita.cs.unibo.it Git - helm.git/commitdiff
- removed Http_daemon.{start,start\}
authorStefano Zacchiroli <zack@upsilon.cc>
Mon, 29 May 2006 20:52:22 +0000 (20:52 +0000)
committerStefano Zacchiroli <zack@upsilon.cc>
Mon, 29 May 2006 20:52:22 +0000 (20:52 +0000)
DEVEL/ocaml-http/debian/changelog
DEVEL/ocaml-http/http_constants.ml
DEVEL/ocaml-http/http_constants.mli
DEVEL/ocaml-http/http_daemon.ml
DEVEL/ocaml-http/http_daemon.mli
DEVEL/ocaml-http/http_types.ml
DEVEL/ocaml-http/http_types.mli

index bdcfe15c23c38e303966e224211328a041d1d1c1..c9133945bf09e50d230f822fadf13cab942313fd 100644 (file)
@@ -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 <zack@debian.org>  Mon, 29 May 2006 22:22:51 +0200
 
index fa9f49536c8e0b6ed47d1b40213ddcaf56c59fb0..f45829ddca10b9ff4ea23ab27ec526484db61835 100644 (file)
@@ -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
 
+
index 46db79067c1a4f2cf653576ecb9406ff922f8de9..03d2ee42482a0f1a273c6114ef36623d98b8405d 100644 (file)
@@ -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
index 629d1286cfd7ea97be793e28bb01b8b891591455..2457c8a7337587336cda7603e4086f7d7ea47a15 100644 (file)
@@ -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)
index 59a408d8755699e2ac3454a3654e245b7625a778..2b7be19cb81204b2432a2eeb3b6acef68d94d1fa 100644 (file)
@@ -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
index 5c88b212ed010990015a936355824685f6d737d8..f31f81679bde7c3a3b86e16a967135e7b49d4e4c 100644 (file)
@@ -215,5 +215,6 @@ type daemon_spec = {
   root_dir: string option;
   exn_handler: (exn -> out_channel -> unit) option;
   timeout: int option;
+  auto_close: bool;
 }
 
index 8d58326550bfac4d54564fde11a17d9789ae5837..7206d18dce28c3a59c09a85cbf365643c0ab3ffd 100644 (file)
@@ -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} *)