Plasma GitLab Archive
Projects Blog Knowledge

(* $Id: uq_resolver.ml 1219 2009-04-14 13:28:56Z ChriS $ *)

type 't engine_state =
  [ `Working of int
  | `Done of 't
  | `Error of exn
  | `Aborted
  ]

class type [ 't ] engine = object
  method state : 't engine_state
  method abort : unit -> unit
  method request_notification : (unit -> bool) -> unit
  method event_system : Unixqueue.event_system
end

exception Host_not_found of string

class type resolver =
object
  method host_by_name : 
           string -> Unixqueue.event_system -> Unix.host_entry engine
end

let default_resolver() : resolver =
object (self)
  method host_by_name host esys =
    let state =
      try
	let he = Unix.gethostbyname host in
	(`Done he)
      with Not_found ->
	(`Error(Host_not_found host)) in
    ( object
	method state = state
	method abort() = ()
	method request_notification _ = ()
	method event_system = esys
      end
    )
end


let cur_resolver = ref(default_resolver())

let current_resolver() = !cur_resolver

let set_current_resolver r = cur_resolver := r


let get_host_by_name ?(resolver = !cur_resolver) host =
  let esys = Unixqueue.create_unix_event_system() in
  let eng = resolver # host_by_name host esys in
  let eng_final = ref false in
  try
    Unixqueue.run esys;
    ( match eng#state with
	| `Done he ->
	    he
	| `Error e ->
	    eng_final := true;
	    raise e
	| _ ->
	    assert false
    )
  with
    | e when not !eng_final ->
	eng # abort();
	raise e

This web site is published by Informatikbüro Gerd Stolpmann
Powered by Caml