*.cmo
*.cmx
*.cma
+*.cmxa
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_request.cmi \
- http_types.cmi http_daemon.cmi
-http_daemon.cmx: http_common.cmx http_misc.cmx http_request.cmx \
- http_types.cmx http_daemon.cmi
+http_daemon.cmo: http_common.cmi http_misc.cmi http_parser.cmi \
+ http_request.cmi http_types.cmi tcp_server.cmo 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_misc.cmo: http_misc.cmi
http_misc.cmx: http_misc.cmi
+http_parser.cmo: http_common.cmi http_parser.cmi
+http_parser.cmx: http_common.cmx http_parser.cmi
http_request.cmo: http_common.cmi http_request.cmi
http_request.cmx: http_common.cmx http_request.cmi
-http_response.cmo: http_common.cmi http_daemon.cmi http_types.cmi \
- http_response.cmi
-http_response.cmx: http_common.cmx http_daemon.cmx http_types.cmx \
- http_response.cmi
+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_types.cmo: http_types.cmi
http_types.cmx: http_types.cmi
+tcp_server.cmo: http_parser.cmi
+tcp_server.cmx: http_parser.cmx
http_common.cmi: http_types.cmi
http_daemon.cmi: http_types.cmi
http_request.cmi: http_types.cmi
--- /dev/null
+#use "tophttp";;
include Makefile.defs
-MODULES = http_common http_misc http_types http_request http_daemon http_response
+MODULES = http_common http_misc http_types http_request http_parser tcp_server http_daemon http_response
PUBLIC_MODULES = http_common http_types http_request http_daemon http_response
DESTDIR = $(shell $(OCAMLFIND) printconf stdlib)
OBJS_OPT = ../http.cmxa
EXAMPLES_OPTS = -I .. -linkpkg
-EXAMPLES = always_ok_daemon webfsd obj_foo dump_args timeout
+EXAMPLES = always_ok_daemon webfsd obj_foo dump_args timeout dont_fork
all: $(EXAMPLES)
opt: $(patsubst %,%.opt,$(EXAMPLES))
open Http_response;;
(* start an http daemon that alway respond with a 200 status code and an empty
content *)
-start (fun _ _ -> respond_with (new Http_response.response))
+start ~port:9999 (fun _ _ -> respond_with (new Http_response.response))
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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 General Public License for more details.
+
+ You should have received a copy of the GNU 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
+*)
+
+let callback req outchan =
+ output_string outchan "FOO\n";
+ flush outchan;
+ Unix.sleep 5;
+ Http_daemon.respond_error ~body:"AH AH AH :-P" outchan
+in
+Http_daemon.start' ~port:9999 ~fork:false callback
in
print_endline "Starting custom Http_daemon ...";
flush stdout;
-Http_daemon.start ~addr:"127.0.0.1" ~port:9999 callback
+Http_daemon.start ~port:9999 callback
let callback req outchan =
Http_daemon.respond_error ~body:(req#param "foo") outchan
in
-Http_daemon.start' ~addr:"127.0.0.1" ~port:9999 callback
+Http_daemon.start' ~port:9999 callback
output_string outchan "Here you are!\n";
flush outchan
in
-Http_daemon.start ~addr:"127.0.0.1" ~port:9999 ~timeout:(Some 10) callback
-
+Http_daemon.start ~port:9999 ~timeout:(Some 10) callback
exception Invalid_status of Http_types.status
let http_version = `HTTP_1_1
+let server_string = "OCaml HTTP Daemon"
+let crlf = "\r\n"
let string_of_version = function
| `HTTP_1_0 -> "HTTP/1.0"
exception Invalid_status of Http_types.status
val http_version: Http_types.version
+val server_string: string
+val crlf: string
val string_of_version: Http_types.version -> string
val version_of_string: string -> Http_types.version
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-open Neturl;;
open Printf;;
-let debug = false
+open Http_parser;;
+
+let debug = true
let debug_print str =
- prerr_endline ("DEBUG: " ^ str);
- flush stderr
+ if debug then begin
+ prerr_endline ("DEBUG: " ^ str);
+ flush stderr
+ end
let default_addr = "0.0.0.0"
let default_port = 80
let default_timeout = 300
-
-(*
-type url_syntax_option =
- Url_part_not_recognized
- | Url_part_allowed
- | Url_part_required
-
-* (1) scheme://user:password@host:port/path;params?query#fragment
-*)
-
-let request_uri_syntax = {
- url_enable_scheme = Url_part_not_recognized;
- url_enable_user = Url_part_not_recognized;
- url_enable_password = Url_part_not_recognized;
- url_enable_host = Url_part_not_recognized;
- url_enable_port = Url_part_not_recognized;
- url_enable_path = Url_part_required;
- url_enable_param = Url_part_not_recognized;
- url_enable_query = Url_part_allowed;
- url_enable_fragment = Url_part_not_recognized;
- url_enable_other = Url_part_not_recognized;
- url_accepts_8bits = false;
- url_is_valid = (fun _ -> true);
-}
-
-let crlf = "\r\n"
-
-exception Malformed_request of string
-exception Unsupported_method of string
-exception Malformed_request_URI of string
-exception Unsupported_HTTP_version of string
-exception Malformed_query of string
-exception Malformed_query_binding of string * string
-
- (** given a list of length 2
- @return a pair formed by the elements of the list
- @raise Assert_failure if the list length isn't 2
- *)
-let pair_of_2_sized_list = function
- | [a;b] -> (a,b)
- | _ -> assert false
-
- (** given an HTTP like query string (e.g. "name1=value1&name2=value2&...")
- @return a list of pairs [("name1", "value1"); ("name2", "value2")]
- @raise Malformed_query if the string isn't a valid query string
- @raise Malformed_query_binding if some piece of the query isn't valid
- *)
-let split_query_params =
- let (bindings_sep, binding_sep) = (Pcre.regexp "&", Pcre.regexp "=") in
- fun ~query ->
- let bindings = Pcre.split ~rex:bindings_sep query in
- if List.length bindings < 1 then
- raise (Malformed_query query);
- List.map
- (fun binding ->
- let pieces = Pcre.split ~rex:binding_sep binding in
- if List.length pieces <> 2 then
- raise (Malformed_query_binding (binding, query));
- pair_of_2_sized_list pieces)
- bindings
-
- (** given an input channel and a separator
- @return a line read from it (like Pervasives.input_line)
- line is returned only after reading a separator string; separator string isn't
- included in the returned value
- FIXME what about efficiency?, input is performed char-by-char
- *)
-let generic_input_line ~sep ~ic =
- let sep_len = String.length sep in
- if sep_len < 1 then
- failwith ("Separator '" ^ sep ^ "' is too short!")
- else (* valid separator *)
- let line = ref "" in
- let sep_pointer = ref 0 in
- try
- while true do
- if !sep_pointer >= String.length sep then (* line completed *)
- raise End_of_file
- else begin (* incomplete line: need to read more *)
- let ch = input_char ic in
- if ch = String.get sep !sep_pointer then (* next piece of sep *)
- incr sep_pointer
- else begin (* useful char *)
- for i = 0 to !sep_pointer - 1 do
- line := !line ^ (String.make 1 (String.get sep i))
- done;
- sep_pointer := 0;
- line := !line ^ (String.make 1 ch)
- end
- end
- done;
- assert false (* unreacheable statement *)
- with End_of_file ->
- if !line = "" then
- raise End_of_file
- else
- !line
-
- (** given an input channel, reads from it a GET HTTP request and
- @return a pair <path, query_params> where path is a string representing the
- requested path and query_params is a list of pairs <name, value> (the GET
- parameters)
- *)
-let parse_http_request =
- let patch_empty_path s = (if s = "" then "/" else s) in
- let pieces_sep = Pcre.regexp " " in
- fun ~ic ->
- let request_line = generic_input_line ~sep:crlf ~ic in
- if debug then
- debug_print ("request_line: '" ^ request_line ^ "'");
- match Pcre.split ~rex:pieces_sep request_line with
- | [meth; request_uri_raw; http_version] ->
- if meth <> "GET" then
- raise (Unsupported_method meth);
- (match http_version with
- | "HTTP/1.0" | "HTTP/1.1" -> ()
- | _ -> raise (Unsupported_HTTP_version http_version));
- let request_uri =
- try
- url_of_string request_uri_syntax request_uri_raw
- with Malformed_URL ->
- raise (Malformed_request_URI request_uri_raw)
- in
- let path =
- patch_empty_path (String.concat "/" (url_path request_uri))
- in
- let query_params =
- try split_query_params (url_query request_uri) with Not_found -> []
- in
- (path, query_params)
- | _ -> raise (Malformed_request request_line)
+let default_fork = true
(** send raw data on outchan, flushing it afterwards *)
let send_raw ~data outchan =
output_string outchan data;
flush outchan
-let send_CRLF = send_raw ~data:crlf
+let send_CRLF = send_raw ~data:Http_common.crlf
(** TODO perform some sanity test on header and value *)
-let send_header ~header ~value = send_raw ~data:(header ^ ": " ^ value ^ crlf)
+let send_header ~header ~value =
+ send_raw ~data:(header ^ ": " ^ value ^ Http_common.crlf)
let send_headers ~headers outchan =
List.iter (fun (header, value) -> send_header ~header ~value outchan) headers
string_of_int code;
Http_common.reason_phrase_of_code code ]
in
- send_raw ~data:(status_line ^ crlf)
+ send_raw ~data:(status_line ^ Http_common.crlf)
let send_status_line
?(version = Http_common.http_version) ?code ?status outchan
~code:(get_code_argument "Daemon.send_status_line" ~code ~status)
outchan
+ (* FIXME duplication of code between this and response#addBasicHeaders *)
let send_basic_headers
?(version = Http_common.http_version) ?code ?status outchan
=
~version ~code:(get_code_argument "Daemon.send_basic_headers" ~code ~status)
outchan;
send_headers
- ~headers:["Date", Http_misc.date_822 (); "Server", "OCaml HTTP Daemon"]
+ ~headers:["Date", Http_misc.date_822 (); "Server", Http_common.server_string]
outchan
(** internal: send a fooish body explaining in HTML form the 'reason phrase'
res#serialize outchan;
flush outchan
+ (* curried request *)
let start
?(addr = default_addr) ?(port = default_port)
- ?(timeout = Some default_timeout)
+ ?(timeout = Some default_timeout) ?(fork = default_fork)
callback
=
let sockaddr = Unix.ADDR_INET (Unix.inet_addr_of_string addr, port) in
- let timeout_callback signo =
- if signo = Sys.sigalrm then begin
- debug_print "TIMEOUT, exiting ...";
- exit 2
- end
- in
let daemon_callback inchan outchan =
- (match timeout with
- | Some timeout ->
- ignore (Sys.signal Sys.sigalrm (Sys.Signal_handle timeout_callback));
- ignore (Unix.alarm timeout)
- | None -> ());
try
- let (path, parameters) = parse_http_request inchan in
+ let (path, parameters) = Http_parser.parse_request inchan in
callback path parameters outchan;
flush outchan
with
sprintf "Malformed query element '%s' in query '%s'" binding query)
outchan
in
- Unix.establish_server daemon_callback sockaddr
+ match fork with
+ | true -> Tcp_server.ocaml_builtin ~sockaddr ~timeout daemon_callback
+ | false -> Tcp_server.simple ~sockaddr ~timeout daemon_callback
+ (* OO request *)
let start'
?(addr = default_addr) ?(port = default_port)
- ?(timeout = Some default_timeout)
+ ?(timeout = Some default_timeout) ?(fork = default_fork)
(callback: (Http_types.request -> out_channel -> unit))
=
let wrapper path params outchan =
let req = new Http_request.request ~path ~params in
callback req outchan
in
- start ~addr ~port ~timeout wrapper
+ start ~addr ~port ~timeout ~fork wrapper
module Trivial =
struct
receive as a first parameter the path required by the the HTTP client as a
string, and a list of pair <parameter, value> representing parameters passed
via GET. The last argument of the callback is an output_channel connected to
- the HTTP client to which the user can write directly. 'timeout' parameter
- sets a timeout for each request processed by the daemon, if it's set to None,
+ the HTTP client to which the user can write directly. 'timeout' parameter sets
+ a timeout for each request processed by the daemon, if it's set to None,
daemon waits forever for completed requests (use with care!), default is 5
- minute *)
+ minute. 'fork' parameter (default 'true') sets whether the daemon forks a
+ child for each request or not, if children aren't forked request are server
+ one at a time (backlog is 10) and callbacks live in the same address space of
+ the process invoking 'start' *)
val start:
- ?addr: string -> ?port: int -> ?timeout: int option ->
+ ?addr: string -> ?port: int -> ?timeout: int option -> ?fork: bool ->
(string -> (string * string) list -> out_channel -> unit) ->
unit
one is an out_channel as per 'start', but the secondo one is a Request.request
object *)
val start':
- ?addr: string -> ?port: int -> ?timeout: int option ->
+ ?addr: string -> ?port: int -> ?timeout: int option -> ?fork: bool ->
(Http_types.request -> out_channel -> unit) ->
unit
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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 General Public License for more details.
+
+ You should have received a copy of the GNU 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
+*)
+
+open Neturl;;
+
+exception Malformed_query of string
+exception Malformed_query_binding of string * string
+exception Unsupported_method of string
+exception Unsupported_HTTP_version of string
+exception Malformed_request_URI of string
+exception Malformed_request of string
+
+(*
+type url_syntax_option =
+ Url_part_not_recognized
+ | Url_part_allowed
+ | Url_part_required
+
+* (1) scheme://user:password@host:port/path;params?query#fragment
+*)
+
+let request_uri_syntax = {
+ url_enable_scheme = Url_part_not_recognized;
+ url_enable_user = Url_part_not_recognized;
+ url_enable_password = Url_part_not_recognized;
+ url_enable_host = Url_part_not_recognized;
+ url_enable_port = Url_part_not_recognized;
+ url_enable_path = Url_part_required;
+ url_enable_param = Url_part_not_recognized;
+ url_enable_query = Url_part_allowed;
+ url_enable_fragment = Url_part_not_recognized;
+ url_enable_other = Url_part_not_recognized;
+ url_accepts_8bits = false;
+ url_is_valid = (fun _ -> true);
+}
+
+ (** given a list of length 2
+ @return a pair formed by the elements of the list
+ @raise Assert_failure if the list length isn't 2
+ *)
+let pair_of_2_sized_list = function
+ | [a;b] -> (a,b)
+ | _ -> assert false
+
+ (** given an HTTP like query string (e.g. "name1=value1&name2=value2&...")
+ @return a list of pairs [("name1", "value1"); ("name2", "value2")]
+ @raise Malformed_query if the string isn't a valid query string
+ @raise Malformed_query_binding if some piece of the query isn't valid
+ *)
+let split_query_params =
+ let (bindings_sep, binding_sep) = (Pcre.regexp "&", Pcre.regexp "=") in
+ fun ~query ->
+ let bindings = Pcre.split ~rex:bindings_sep query in
+ if List.length bindings < 1 then
+ raise (Malformed_query query);
+ List.map
+ (fun binding ->
+ let pieces = Pcre.split ~rex:binding_sep binding in
+ if List.length pieces <> 2 then
+ raise (Malformed_query_binding (binding, query));
+ pair_of_2_sized_list pieces)
+ bindings
+
+ (** given an input channel and a separator
+ @return a line read from it (like Pervasives.input_line)
+ line is returned only after reading a separator string; separator string isn't
+ included in the returned value
+ FIXME what about efficiency?, input is performed char-by-char
+ *)
+let generic_input_line ~sep ~ic =
+ let sep_len = String.length sep in
+ if sep_len < 1 then
+ failwith ("Separator '" ^ sep ^ "' is too short!")
+ else (* valid separator *)
+ let line = ref "" in
+ let sep_pointer = ref 0 in
+ try
+ while true do
+ if !sep_pointer >= String.length sep then (* line completed *)
+ raise End_of_file
+ else begin (* incomplete line: need to read more *)
+ let ch = input_char ic in
+ if ch = String.get sep !sep_pointer then (* next piece of sep *)
+ incr sep_pointer
+ else begin (* useful char *)
+ for i = 0 to !sep_pointer - 1 do
+ line := !line ^ (String.make 1 (String.get sep i))
+ done;
+ sep_pointer := 0;
+ line := !line ^ (String.make 1 ch)
+ end
+ end
+ done;
+ assert false (* unreacheable statement *)
+ with End_of_file ->
+ if !line = "" then
+ raise End_of_file
+ else
+ !line
+
+ (** given an input channel, reads from it a GET HTTP request and
+ @return a pair <path, query_params> where path is a string representing the
+ requested path and query_params is a list of pairs <name, value> (the GET
+ parameters)
+ *)
+let parse_request =
+ let patch_empty_path s = (if s = "" then "/" else s) in
+ let pieces_sep = Pcre.regexp " " in
+ fun ic ->
+ let request_line = generic_input_line ~sep:Http_common.crlf ~ic in
+ match Pcre.split ~rex:pieces_sep request_line with
+ | [meth; request_uri_raw; http_version] ->
+ if meth <> "GET" then
+ raise (Unsupported_method meth);
+ (match http_version with
+ | "HTTP/1.0" | "HTTP/1.1" -> ()
+ | _ -> raise (Unsupported_HTTP_version http_version));
+ let request_uri =
+ try
+ url_of_string request_uri_syntax request_uri_raw
+ with Malformed_URL ->
+ raise (Malformed_request_URI request_uri_raw)
+ in
+ let path =
+ patch_empty_path (String.concat "/" (url_path request_uri))
+ in
+ let query_params =
+ try split_query_params (url_query request_uri) with Not_found -> []
+ in
+ (path, query_params)
+ | _ -> raise (Malformed_request request_line)
+
--- /dev/null
+
+(*
+ OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+ Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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 General Public License for more details.
+
+ You should have received a copy of the GNU 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
+*)
+
+exception Malformed_query of string
+exception Malformed_query_binding of string * string
+exception Unsupported_method of string
+exception Unsupported_HTTP_version of string
+exception Malformed_request_URI of string
+exception Malformed_request of string
+
+val parse_request: in_channel -> string * (string * string) list
let status_line_re = Pcre.regexp "^(HTTP/\d\.\d) (\d{3}) (.*)$" in
object (self)
val mutable version = Http_common.http_version
- val mutable code = default_code val mutable reason: string option = None
+ val mutable code = default_code
+ val mutable reason: string option = None
val contentsBuf = Buffer.create 1024
val headers = Hashtbl.create 11
method addContents s = Buffer.add_string contentsBuf s
method addContentsBuf b = Buffer.add_buffer contentsBuf b
- (** adds an header named 'name' with value 'value', if an header with the
- same name exists, the new value is considered an addition to the header as
- specified in RFC 2616, thus getting value for this header will return a
- comma separated list of values provided via 'addHeader' *)
method addHeader ~name ~value = Hashtbl.add headers name value
- (** set the value of header 'name' to 'value', removing all previous
- values if any *)
+ (* FIXME duplication of code between this and send_basic_headers *)
+ method addBasicHeaders =
+ self#addHeader ~name:"Date" ~value:(Http_misc.date_822 ());
+ self#addHeader ~name:"Server" ~value:(Http_common.server_string)
method replaceHeader ~name ~value = Hashtbl.replace headers name value
- (** remove the header named 'name', please note that this remove all
- values provided for this header *)
method removeHeader ~name = hashtbl_remove_all headers name
method hasHeader ~name = Hashtbl.mem headers name
- (** @return value of header 'name', if multiple values were provided for
- header 'name', the return value will be a comma separated list of
- provided values as stated in RFC 2616 *)
method header ~name =
if not (self#hasHeader name) then
raise (Header_not_found name);
String.concat ", " (List.rev (Hashtbl.find_all headers name))
- (** @return all headers as a list of pairs <name, value> *)
method headers =
List.rev
(Hashtbl.fold
method addContents: string -> unit
method addContentsBuf: Buffer.t -> unit
method addHeader: name:string -> value:string -> unit
+ method addBasicHeaders: unit
method replaceHeader: name:string -> value:string -> unit
method removeHeader: name:string -> unit
method hasHeader: name:string -> bool
--- /dev/null
+
+ (** 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 with Timeout -> ());
+ close_out outchan (* this close also inchan, because socket is the same *)
+ done
+
--- /dev/null
+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
projects / helm.git / commitdiff