From: Stefano Zacchiroli Date: Sun, 17 Nov 2002 16:19:07 +0000 (+0000) Subject: renamed tcp_server module in http_tcp_server to avoid future X-Git-Tag: V_0_0_3~2 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=dfc2157c1067b9958c182b25df103744cc8feb27;p=helm.git renamed tcp_server module in http_tcp_server to avoid future name clashes --- diff --git a/helm/DEVEL/ocaml-http/.depend b/helm/DEVEL/ocaml-http/.depend index ba64340b1..04dfd8ca1 100644 --- a/helm/DEVEL/ocaml-http/.depend +++ b/helm/DEVEL/ocaml-http/.depend @@ -1,9 +1,9 @@ http_common.cmo: http_types.cmi http_common.cmi http_common.cmx: http_types.cmx http_common.cmi http_daemon.cmo: http_common.cmi http_misc.cmi http_parser.cmi \ - http_request.cmi http_types.cmi tcp_server.cmi http_daemon.cmi + http_request.cmi http_tcp_server.cmi http_types.cmi http_daemon.cmi http_daemon.cmx: http_common.cmx http_misc.cmx http_parser.cmx \ - http_request.cmx http_types.cmx tcp_server.cmx http_daemon.cmi + http_request.cmx http_tcp_server.cmx http_types.cmx http_daemon.cmi http_misc.cmo: http_misc.cmi http_misc.cmx: http_misc.cmi http_parser.cmo: http_common.cmi http_parser.cmi @@ -14,10 +14,10 @@ http_response.cmo: http_common.cmi http_daemon.cmi http_misc.cmi \ http_types.cmi http_response.cmi http_response.cmx: http_common.cmx http_daemon.cmx http_misc.cmx \ http_types.cmx http_response.cmi +http_tcp_server.cmo: http_tcp_server.cmi +http_tcp_server.cmx: http_tcp_server.cmi http_types.cmo: http_types.cmi http_types.cmx: http_types.cmi -tcp_server.cmo: tcp_server.cmi -tcp_server.cmx: tcp_server.cmi http_common.cmi: http_types.cmi http_daemon.cmi: http_types.cmi http_request.cmi: http_types.cmi diff --git a/helm/DEVEL/ocaml-http/Makefile b/helm/DEVEL/ocaml-http/Makefile index 31f63cf97..22eb5fb80 100644 --- a/helm/DEVEL/ocaml-http/Makefile +++ b/helm/DEVEL/ocaml-http/Makefile @@ -1,6 +1,6 @@ include Makefile.defs -MODULES = http_common http_misc http_types http_request http_parser tcp_server http_daemon http_response +MODULES = http_common http_misc http_types http_request http_parser http_tcp_server http_daemon http_response PUBLIC_MODULES = http_common http_types http_request http_daemon http_response DESTDIR = $(shell $(OCAMLFIND) printconf stdlib) diff --git a/helm/DEVEL/ocaml-http/http_daemon.ml b/helm/DEVEL/ocaml-http/http_daemon.ml index c26d284ea..8dfc83e50 100644 --- a/helm/DEVEL/ocaml-http/http_daemon.ml +++ b/helm/DEVEL/ocaml-http/http_daemon.ml @@ -296,8 +296,8 @@ let start outchan in match fork with - | true -> Tcp_server.ocaml_builtin ~sockaddr ~timeout daemon_callback - | false -> Tcp_server.simple ~sockaddr ~timeout daemon_callback + | true -> Http_tcp_server.ocaml_builtin ~sockaddr ~timeout daemon_callback + | false -> Http_tcp_server.simple ~sockaddr ~timeout daemon_callback (* OO request *) let start' diff --git a/helm/DEVEL/ocaml-http/http_tcp_server.ml b/helm/DEVEL/ocaml-http/http_tcp_server.ml new file mode 100644 index 000000000..44e4df1d5 --- /dev/null +++ b/helm/DEVEL/ocaml-http/http_tcp_server.ml @@ -0,0 +1,54 @@ + + (** raised when a client timeouts *) +exception Timeout;; + + (** 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) + + (** Http_daemon.start function low level 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 + + (** Http_daemon.start function low level 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 = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in + Unix.setsockopt suck Unix.SO_REUSEADDR true; + Unix.bind suck sockaddr; + Unix.listen suck 10; + let timeout_callback signo = + if signo = Sys.sigalrm then + raise Timeout + in + let callback = wrap_callback_w_timeout ~callback ~timeout ~timeout_callback in + while true do + let (suck, _) = Unix.accept suck in + (* client is now connected *) + let (inchan, outchan) = + (Unix.in_channel_of_descr suck, Unix.out_channel_of_descr suck) + in + (try + callback inchan outchan; + ignore (Unix.alarm 0) + with Timeout -> ()); + close_out outchan (* this close also inchan, because socket is the same *) + done + diff --git a/helm/DEVEL/ocaml-http/http_tcp_server.mli b/helm/DEVEL/ocaml-http/http_tcp_server.mli new file mode 100644 index 000000000..230b838a2 --- /dev/null +++ b/helm/DEVEL/ocaml-http/http_tcp_server.mli @@ -0,0 +1,8 @@ +val ocaml_builtin: + sockaddr:Unix.sockaddr -> timeout:int option -> + (in_channel -> out_channel -> unit) -> + unit +val simple: + sockaddr:Unix.sockaddr -> timeout:int option -> + (in_channel -> out_channel -> unit) -> + unit diff --git a/helm/DEVEL/ocaml-http/tcp_server.ml b/helm/DEVEL/ocaml-http/tcp_server.ml deleted file mode 100644 index 44e4df1d5..000000000 --- a/helm/DEVEL/ocaml-http/tcp_server.ml +++ /dev/null @@ -1,54 +0,0 @@ - - (** raised when a client timeouts *) -exception Timeout;; - - (** 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) - - (** Http_daemon.start function low level 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 - - (** Http_daemon.start function low level 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 = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in - Unix.setsockopt suck Unix.SO_REUSEADDR true; - Unix.bind suck sockaddr; - Unix.listen suck 10; - let timeout_callback signo = - if signo = Sys.sigalrm then - raise Timeout - in - let callback = wrap_callback_w_timeout ~callback ~timeout ~timeout_callback in - while true do - let (suck, _) = Unix.accept suck in - (* client is now connected *) - let (inchan, outchan) = - (Unix.in_channel_of_descr suck, Unix.out_channel_of_descr suck) - in - (try - callback inchan outchan; - ignore (Unix.alarm 0) - with Timeout -> ()); - close_out outchan (* this close also inchan, because socket is the same *) - done - diff --git a/helm/DEVEL/ocaml-http/tcp_server.mli b/helm/DEVEL/ocaml-http/tcp_server.mli deleted file mode 100644 index 230b838a2..000000000 --- a/helm/DEVEL/ocaml-http/tcp_server.mli +++ /dev/null @@ -1,8 +0,0 @@ -val ocaml_builtin: - sockaddr:Unix.sockaddr -> timeout:int option -> - (in_channel -> out_channel -> unit) -> - unit -val simple: - sockaddr:Unix.sockaddr -> timeout:int option -> - (in_channel -> out_channel -> unit) -> - unit