68 lines
2.4 KiB
OCaml
68 lines
2.4 KiB
OCaml
(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
|
|
|
|
(* This file is part of Hop. *)
|
|
|
|
(* Hop 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 3 of the License, or (at your *)
|
|
(* option) any later version. *)
|
|
|
|
(* Hop 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 Hop. If not, see <http://www.gnu.org/licenses/>. *)
|
|
|
|
open Lwt
|
|
open Printf
|
|
open Sexp
|
|
open Datastructures
|
|
|
|
type factory_t = Sexp.t -> (Sexp.t, Sexp.t) Status.t Lwt.t
|
|
|
|
let classes = ref BytesMap.empty
|
|
|
|
let register_class name factory =
|
|
if BytesMap.mem name !classes
|
|
then (ignore (Log.error "Duplicate node class name" [Str name]);
|
|
Server_control.shutdown_now [litstr "Duplicate node class name"; Str name];
|
|
Lwt_unix.yield ())
|
|
else (ignore (Log.info "Registered node class" [Str name]);
|
|
classes := BytesMap.add name factory !classes;
|
|
return ())
|
|
|
|
let all_class_names () =
|
|
Datastructures.bytes_map_keys !classes
|
|
|
|
let lookup_class name =
|
|
try Some (BytesMap.find name !classes)
|
|
with Not_found -> None
|
|
|
|
let factory_handler n sexp =
|
|
match Message.message_of_sexp sexp with
|
|
| Message.Create (Str classname, arg, Str reply_sink, Str reply_name) ->
|
|
lwt reply =
|
|
match lookup_class classname with
|
|
| Some factory ->
|
|
(match_lwt factory arg with
|
|
| Status.Ok info ->
|
|
ignore (Log.info "Node create ok"
|
|
[Str classname; arg; Str reply_sink; Str reply_name; info]);
|
|
return (Message.create_ok info)
|
|
| Status.Problem explanation ->
|
|
ignore (Log.info "Node create failed"
|
|
[Str classname; arg; Str reply_sink; Str reply_name; explanation]);
|
|
return (Message.create_failed (Arr [litstr "constructor"; explanation])))
|
|
| None ->
|
|
ignore (Log.warn "Node class not found" [Str classname]);
|
|
return (Message.create_failed (Arr [litstr "factory"; litstr "class-not-found"]))
|
|
in
|
|
Node.post_ignore' reply_sink (Str reply_name) reply emptystr
|
|
| m ->
|
|
Util.message_not_understood "factory" m
|
|
|
|
let init () =
|
|
Node.bind_ignore (Node.name_of_bytes (Bytes.of_string "factory"), Node.make (Bytes.of_string "factory") factory_handler)
|