Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
53 lines (47 sloc) 1.5 KB
* (c) 2005-2010 Anastasia Gornostaeva
open Unix
open Xml
let proc ev event from (xml:element) (out:element -> unit) =
Event.sync (Event.send ev xml)
let sulci_rpc out in_chan out_chan () =
let xml = input_value in_chan in
match get_tagname xml with
| "iq" ->
let id = get_attr_s xml "id" in
let ev = Event.new_channel () in
Hooks.register_handle (Hooks.Id (id, proc ev));
out xml;
let reply = Event.sync (Event.receive ev) in
output_value out_chan reply;
flush out_chan;
close_out out_chan
| _ -> (* todo: figure our how to send *)
close_out out_chan
let _ =
let port = 5221 in
let inet_addr = inet_addr_any in
let sockaddr = ADDR_INET (inet_addr, port) in
let fd = socket PF_INET SOCK_STREAM 0 in
let () = setsockopt fd SO_REUSEADDR true in
let server out =
Unix.bind fd sockaddr;
Unix.listen fd 10;
while true do
let client, _ = Unix.accept fd in
let in_chan = Unix.in_channel_of_descr client
and out_chan = Unix.out_channel_of_descr client in
ignore (Thread.create (sulci_rpc out in_chan out_chan) ())
with Unix.Unix_error (code, syscall, _) ->
(Printf.sprintf "problem with %s: %s\n" syscall
(Unix.error_message code));
Thread.exit ()
let start out =
ignore (Thread.create server out)
Hooks.register_handle (Hooks.OnStart start)
Jump to Line
Something went wrong with that request. Please try again.