This commit was manufactured by cvs2svn to create branch 'init'.

[helm.git] / helm / DEVEL / ocaml-http / http_tcp_server.ml

diff --git a/helm/DEVEL/ocaml-http/http_tcp_server.ml b/helm/DEVEL/ocaml-http/http_tcp_server.ml
deleted file mode 100644 (file)
index 69da5c1..0000000
--- a/helm/DEVEL/ocaml-http/http_tcp_server.ml
+++ /dev/null
@@ -1,102 +0,0 @@
-
-  (** raised when a client timeouts *)
-exception Timeout;;
-
-let backlog = 10;;
-
-  (** if timeout is given (Some _) @return a new callback which establish
-  timeout_callback as callback for signal Sys.sigalrm and register an alarm
-  (expiring after timeout seconds) before invoking the real callback given. If
-  timeout is None, callback is returned unchanged. *)
-let wrap_callback_w_timeout ~callback ~timeout ~timeout_callback =
-  match timeout with
-  | None -> callback
-  | Some timeout -> (* wrap callback setting an handler for ALRM signal and an
-                    alarm that ring after timeout seconds *)
-      (fun inchan outchan ->
-        ignore (Sys.signal Sys.sigalrm (Sys.Signal_handle ~timeout_callback));
-        ignore (Unix.alarm timeout);
-        callback inchan outchan)
-
-let init_socket sockaddr =
-  let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
-  Unix.setsockopt suck Unix.SO_REUSEADDR true;
-  Unix.bind suck sockaddr;
-  Unix.listen suck backlog;
-  suck
-
-let init_callback callback timeout =
-  let timeout_callback signo =
-    if signo = Sys.sigalrm then
-      raise Timeout
-  in
-  wrap_callback_w_timeout ~callback ~timeout ~timeout_callback
-
-(*
-let init_socket_and_callback sockaddr callback timeout =
-  let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
-  Unix.setsockopt suck Unix.SO_REUSEADDR true;
-  Unix.bind suck sockaddr;
-  Unix.listen suck backlog;
-  let timeout_callback signo =
-    if signo = Sys.sigalrm then
-      raise Timeout
-  in
-  let callback = wrap_callback_w_timeout ~callback ~timeout ~timeout_callback in
-  (suck, callback)
-*)
-
-  (** tcp_server which use Unix.establish_server which in turn forks a child for
-  each request *)
-let ocaml_builtin ~sockaddr ~timeout callback =
-  let timeout_callback signo =
-    if signo = Sys.sigalrm then
-      exit 2
-  in
-  Unix.establish_server
-    (wrap_callback_w_timeout ~callback ~timeout ~timeout_callback)
-    sockaddr
-
-  (** tcp_server which doesn't fork, requests are server sequentially and in the
-  same address space of the calling process *)
-let simple ~sockaddr ~timeout callback =
-(*   let (suck, callback) = init_socket_and_callback sockaddr callback timeout in *)
-  let suck = init_socket sockaddr in
-  let callback = init_callback callback timeout in
-  while true do
-    let (client, _) = Unix.accept suck in
-      (* client is now connected *)
-    let (inchan, outchan) =
-      (Unix.in_channel_of_descr client, Unix.out_channel_of_descr client)
-    in
-    (try
-      callback inchan outchan;
-      ignore (Unix.alarm 0) (* reset alarm *)
-    with Timeout -> ());
-    close_out outchan (* this close also inchan, because socket is the same *)
-  done
-
-  (** tcp_server which creates a new thread for each request to be served *)
-let thread ~sockaddr ~timeout callback =
-(*   let (suck, callback) = init_socket_and_callback sockaddr callback timeout in *)
-  let suck = init_socket sockaddr in
-  let callback = init_callback callback timeout in
-  let callback (i, o) =
-    try
-      callback i o;
-      close_out o
-    with
-    | Timeout -> close_out o
-    | e ->
-        close_out o;
-        raise e
-  in
-  while true do
-    let (client, _) = Unix.accept suck in
-      (* client is now connected *)
-    let (inchan, outchan) =
-      (Unix.in_channel_of_descr client, Unix.out_channel_of_descr client)
-    in
-    Http_threaded_tcp_server.serve callback (inchan, outchan)
-  done
-