--- /dev/null
+#KEASRC = /tmp/kea/src/lib
+
+# Kea includes and boost
+CCOPT = -ccopt -I../../.. -ccopt -I$(KEASRC) -ccopt -I/usr/local/include
+CCOPT += -ccopt -DBOOST_ERROR_CODE_HEADER_ONLY
+CCOPT += -ccopt -DBOOST_SYSTEM_NO_DEPRECATED
+CCOPT += -ccopt -g -ccopt -fPIC -ccopt -dynamic
+
+OCAMLCC = ocamlc -cc g++ -ccopt -x -ccopt c++
+BOCAMLCC = ocamlc -cc g++ -ccopt -x -ccopt c++ -ccopt -DOCAML_CODE_BYTECODE
+NOCAMLCC = ocamlopt -cc g++ -ccopt -x -ccopt c++ -ccopt -DOCAML_CODE_NATIVE
+
+# Kea dhcp library
+LIBS = -lkea-dhcp++ -lkea-hooks -lkea-exceptions
+# ocaml
+BLIBS = $(LIBS) -lcamlrun -lcurses
+NLIBS = $(LIBS) -lasmrun -lcurses
+
+# Kea dependencies
+LDFLAGS += -L/usr/local/Cellar/botan/1.10.12/lib
+LDFLAGS += -L$(KEASRC)/dhcp/.libs
+LDFLAGS += -L$(KEASRC)/hooks/.libs
+LDFLAGS += -L$(KEASRC)/exceptions/.libs
+# ocaml
+LDFLAGS += -L/usr/local/lib/ocaml
+
+SRCS = dso.c opt.h opt.c pkt4.h pkt4.c
+
+OBJS = dso.o opt.o pkt4.o
+
+all: bytecode native
+
+bytecode: bhook.so btests
+
+native: nhook.so ntests
+
+.c.o:
+ $(OCAMLCC) $(CCOPT) -verbose -c $<
+
+hook.cmi: hook.mli
+ ocamlc -c hook.mli
+
+hook.cmo: hook.ml hook.cmi
+ ocamlc -c hook.ml
+
+hook.cmx: hook.ml hook.cmi
+ ocamlopt -c hook.ml
+
+bcamlcode.o: hook.cmo
+ ocamlc -output-obj -o bcamlcode.o hook.cmo
+
+ncamlcode.o: hook.cmx
+ ocamlopt -output-obj -o ncamlcode.o hook.cmx
+
+bhook.so: bcamlcode.o $(OBJS)
+ g++ -shared bcamlcode.o $(OBJS) $(LDFLAGS) $(BLIBS) -o bhook.so
+
+nhook.so: ncamlcode.o $(OBJS)
+ g++ -shared ncamlcode.o $(OBJS) $(LDFLAGS) $(NLIBS) -o nhook.so
+
+TESTLIBS = -lkea-dhcpsrv -lkea-dhcp++ -lkea-asiolink -lkea-cc
+TESTLIBS += -lkea-hooks -lkea-log -lkea-exceptions
+
+TESTLDFLAGS = -L/usr/local/Cellar/botan/1.10.12/lib
+TESTLDFLAGS += -L$(KEASRC)/dhcpsrv/.libs
+TESTLDFLAGS += -L$(KEASRC)/dhcp/.libs
+TESTLDFLAGS += -L$(KEASRC)/asiolink/.libs
+TESTLDFLAGS += -L$(KEASRC)/cc/.libs
+TESTLDFLAGS += -L$(KEASRC)/hooks/.libs
+TESTLDFLAGS += -L$(KEASRC)/log/.libs
+TESTLDFLAGS += -L$(KEASRC)/exceptions/.libs
+
+btests.o: tests.c
+ $(BOCAMLCC) $(CCOPT) -verbose -c tests.c
+ mv tests.o btests.o
+
+ntests.o: tests.c
+ $(NOCAMLCC) $(CCOPT) -verbose -c tests.c
+ mv tests.o ntests.o
+
+btests: btests.o
+ g++ btests.o $(TESTLDFLAGS) $(TESTLIBS) -o btests
+
+ntests: ntests.o
+ g++ ntests.o $(TESTLDFLAGS) $(TESTLIBS) -o ntests
+
+clean:
+ rm -f *.[oa] *.so *.cm[ixoa] *.cmxa [bn]tests
+
+.PHONY: all bytecode native
--- /dev/null
+Implementation notes for ocaml
+
+Manifest:
+ - opt.h opt.c: the C++ OptionPtr encapsulated into a ocaml custom block
+ with some method ported.
+
+ - pkt4.h pkt4.c: the C++ Pkt4Ptr encapsulated into a ocaml custom block
+ with some method ported.
+
+ one can complete these python types or/and new python type.
+
+ - dso.c: the kea framework and hook glue with initialization: on the
+ ocaml / C side it is a dynamic shared object providing the framework
+ and hook entry points, on the ocaml side it embeds a bytecode
+ intepreter or a native code runtime with the hook.ml compiled code.
+
+ - hook.mli and hook.ml: interface and implementation ocaml files
+ which defines the Option and Packet4 modules, and the hook handlers
+ written in ocaml.
+
+ - opt.o, pkt4.o, hook.cmo or hook.cmx, and dso.o are compiled into
+ [bn]hook.so the dynamic shared objects in bytecode and native modes.
+
+ - tests.c: source of test program which loads the [bn]hook.so
+ hook-libraries and exercise the pkt4_receive hook. It gives
+ independent executable [bn]tests.
+
+ - cshenv: C-shell script setting environment variables for a kea
+ distrib in /tmp/kea on OS X.
+
+ - Makefile: make config file for OS X.
+
+ - NOTES: the file.
+
+ocamlc doesn't know C++ and works only on .c files (and of course all
+the caml extensions). An option forces ocamlc to use a C++ compiler
+despite of the .c extension, and another silents clang warning...
+
+There is no entry point in the ocaml runtime to unload it. Not a big
+problem but it means memory leaks can become hard to track.
--- /dev/null
+setenv KEATOP /tmp/kea
+
+setenv KEASRC $KEATOP/src/lib
+
+setenv DYLD_LIBRARY_PATH $KEASRC/dhcpsrv/.libs:$KEASRC/eval/.libs:$KEASRC/dhcp_ddns/.libs:$KEASRC/stats/.libs:$KEASRC/hooks/.libs:$KEASRC/config/.libs:$KEASRC/dhcp/.libs:$KEASRC/asiolink/.libs:$KEASRC/dns/.libs:$KEASRC/cc/.libs:$KEASRC/cryptolink/.libs:$KEASRC/log/.libs:$KEASRC/util/threads/.libs:$KEASRC/util/.libs:$KEASRC/exceptions/.libs
--- /dev/null
+// Copyright (C) 2016 Internet Systems Consortium, Inc. ("ISC")
+//
+// This Source Code Form is subject to the terms of the Mozilla Public
+// License, v. 2.0. If a copy of the MPL was not distributed with this
+// file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#define CAML_NAME_SPACE
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+
+#include <hooks/hooks.h>
+
+#include <hooks/external/ocaml/opt.h>
+#include <hooks/external/ocaml/pkt4.h>
+
+#include <iostream>
+
+using namespace std;
+using namespace isc::data;
+using namespace isc::dhcp;
+using namespace isc::hooks;
+using namespace isc::ocaml;
+
+namespace {
+ // Pkt4 receive handler
+ value* pkt4_rcv_hndl;
+};
+
+extern "C" {
+
+// Framework functions
+
+// version
+int version() {
+ return (KEA_HOOKS_VERSION);
+}
+
+// load
+int load(LibraryHandle& handle) {
+ // Set the program name (default "kea")
+ ConstElementPtr program = handle.getParameter("program");
+ string progname = "kea";
+ if (program && program->getType() == Element::string) {
+ progname = program->stringValue();
+ } else {
+ cout << "no \"program\" parameter: using \"kea\"\n";
+ }
+ // Start ocaml
+ char* argv[2];
+ argv[0] = &progname[0];
+ argv[1] = NULL;
+ caml_startup(argv);
+
+ // Initialize types
+ caml_register_custom_operations(opt_ops);
+ caml_register_custom_operations(pkt4_ops);
+
+ // Get pkt4_rcv_hndl address
+ pkt4_rcv_hndl = caml_named_value("pkt4_receive");
+ if (pkt4_rcv_hndl) {
+ cout << "got pkt4_receive\n";
+ }
+
+ return (0);
+}
+
+// unload
+int unload() {
+ return (0);
+}
+
+// pkt4_receive hook
+int pkt4_receive(CalloutHandle& handle) {
+ CAMLparam0();
+ CAMLlocal2(query, result);
+
+ if (!pkt4_rcv_hndl) {
+ cerr << "pkt4_receive ocaml hook not available\n";
+ CAMLdrop;
+ return (0);
+ }
+ cout << "pkt4_receive enter\n";
+
+ Pkt4Ptr query4;
+ handle.getArgument("query4", query4);
+ if (!query4) {
+ cerr << "pkt4_receive: null query4\n";
+ CAMLdrop;
+ return (0);
+ }
+
+ query = caml_alloc_custom(pkt4_ops, sizeof(oc_pkt4), 0, 1);
+ if (!query) {
+ cerr << "caml_alloc_custom failed\n";
+ CAMLdrop;
+ return (0);
+ }
+ (static_cast<oc_pkt4*>(Data_custom_val(query)))->object = query4;
+
+ result = caml_callback_exn(*pkt4_rcv_hndl, query);
+ if (Is_exception_result(result)) {
+ cerr << "pkt4_receive raised an exception\n";
+ CAMLdrop;
+ return (0);
+ }
+ if (!Is_long(result)) {
+ cerr << "pkt4_receive did not return an integer\n";
+ CAMLdrop;
+ return (0);
+ }
+ CAMLdrop;
+ return (Int_val(result));
+}
+
+}
--- /dev/null
+(* Copyright (C) 2016 Internet Systems Consortium, Inc. ("ISC") *)
+(* *)
+(* This Source Code Form is subject to the terms of the Mozilla Public *)
+(* License, v. 2.0. If a copy of the MPL was not distributed with this *)
+(* file, You can obtain one at http://mozilla.org/MPL/2.0/. *)
+
+(* Kea option *)
+
+let print_enter n =
+ print_string "enter "; print_string n; print_newline()
+
+let print_leave n =
+ print_string "leave "; print_string n; print_newline()
+
+let _ = print_enter "opt"
+
+type opt
+
+module Option = struct
+ external factory : int -> int -> bytes -> opt = "opt_factory"
+
+ external toText : opt -> string = "opt_toText"
+
+ external getUniverse : opt -> int = "opt_getUniverse"
+
+ external toBinary : opt -> bytes = "opt_toBinary"
+
+ external getType : opt -> int = "opt_getType"
+
+ external len : opt -> int = "opt_len"
+
+ external getHeaderLen : opt -> int = "opt_getHeaderLen"
+
+ external addOption : opt -> opt -> unit = "opt_addOption"
+
+ external getOption : opt -> int -> opt option = "opt_getOption"
+
+ (* TODO: external getOptions : opt -> opt list *)
+
+ external delOption : opt -> int -> bool = "opt_delOption"
+
+ external setData : opt -> bytes -> unit = "opt_setData"
+
+ external setEncapsulatedSpace : opt -> string -> unit =
+ "opt_setEncapsulatedSpace"
+
+ external getEncapsulatedSpace : opt -> string =
+ "opt_getEncapsulatedSpace"
+end
+
+let _ = print_leave "opt"
+
+(* Kea DHCPv4 packet *)
+
+let _ = print_enter "pk4"
+
+type pkt4
+
+module Packet4 = struct
+ external toText : pkt4 -> string = "pkt4_toText"
+
+ external addOption : pkt4 -> opt -> unit = "pkt4_addOption"
+
+ external delOption : pkt4 -> int -> bool = "pkt4_delOption"
+
+ external len : pkt4 -> int = "pkt4_len"
+
+ external getType : pkt4 -> int = "pkt4_getType"
+
+ external setType : pkt4 -> int -> unit = "pkt4_setType"
+
+ external setTransid : pkt4 -> int -> unit = "pkt4_setTransid"
+
+ external getTransid : pkt4 -> int = "pkt4_getTransid"
+
+ external inClass : pkt4 -> string -> bool = "pkt4_inClass"
+
+ external addClass : pkt4 -> string -> unit = "pkt4_addClass"
+
+ external getOption : pkt4 -> int -> opt option = "pkt4_getOption"
+
+ external setIndex : pkt4 -> int -> unit = "pkt4_setIndex"
+
+ external getIndex : pkt4 -> int = "pkt4_getIndex"
+
+ external getIface : pkt4 -> string = "pkt4_getIface"
+
+ external setIface : pkt4 -> string -> unit = "pkt4_setIface"
+end
+
+let _ = print_leave "pkt4"
+
+(* Kea hook body *)
+
+let _ = print_enter "hook body"
+
+let next_step_continue = 0
+let next_step_skip = 1
+let next_step_drop = 2
+
+let pkt4_receive query4 =
+ print_string "pkt4_receive: handler is called with ";
+ print_string (Packet4.toText query4);
+ print_newline();
+ next_step_continue
+
+let _ = Callback.register "pkt4_receive" pkt4_receive
+
+let _ = print_leave "hook body"
--- /dev/null
+(* Copyright (C) 2016 Internet Systems Consortium, Inc. ("ISC") *)
+(* *)
+(* This Source Code Form is subject to the terms of the Mozilla Public *)
+(* License, v. 2.0. If a copy of the MPL was not distributed with this *)
+(* file, You can obtain one at http://mozilla.org/MPL/2.0/. *)
+
+(* Kea option *)
+
+type opt
+
+module Option : sig
+ external factory : int -> int -> bytes -> opt = "opt_factory"
+
+ external toText : opt -> string = "opt_toText"
+
+ external getUniverse : opt -> int = "opt_getUniverse"
+
+ external toBinary : opt -> bytes = "opt_toBinary"
+
+ external getType : opt -> int = "opt_getType"
+
+ external len : opt -> int = "opt_len"
+
+ external getHeaderLen : opt -> int = "opt_getHeaderLen"
+
+ external addOption : opt -> opt -> unit = "opt_addOption"
+
+ external getOption : opt -> int -> opt option = "opt_getOption"
+
+ (* TODO: external getOptions : opt -> opt list *)
+
+ external delOption : opt -> int -> bool = "opt_delOption"
+
+ external setData : opt -> bytes -> unit = "opt_setData"
+
+ external setEncapsulatedSpace : opt -> string -> unit =
+ "opt_setEncapsulatedSpace"
+
+ external getEncapsulatedSpace : opt -> string =
+ "opt_getEncapsulatedSpace"
+end
+
+(* Kea DHCPv4 packet *)
+
+type pkt4
+
+module Packet4 : sig
+ external toText : pkt4 -> string = "pkt4_toText"
+
+ external addOption : pkt4 -> opt -> unit = "pkt4_addOption"
+
+ external delOption : pkt4 -> int -> bool = "pkt4_delOption"
+
+ external len : pkt4 -> int = "pkt4_len"
+
+ external getType : pkt4 -> int = "pkt4_getType"
+
+ external setType : pkt4 -> int -> unit = "pkt4_setType"
+
+ external setTransid : pkt4 -> int -> unit = "pkt4_setTransid"
+
+ external getTransid : pkt4 -> int = "pkt4_getTransid"
+
+ external inClass : pkt4 -> string -> bool = "pkt4_inClass"
+
+ external addClass : pkt4 -> string -> unit = "pkt4_addClass"
+
+ (* TODO: getClasses *)
+
+ external getOption : pkt4 -> int -> opt option = "pkt4_getOption"
+
+ (* TODO getTimestamp *)
+
+ (* TODO set/getLocal/RemoteAddr/Port *)
+
+ external setIndex : pkt4 -> int -> unit = "pkt4_setIndex"
+
+ external getIndex : pkt4 -> int = "pkt4_getIndex"
+
+ external getIface : pkt4 -> string = "pkt4_getIface"
+
+ external setIface : pkt4 -> string -> unit = "pkt4_setIface"
+end
+
+val next_step_continue : int
+val next_step_skip : int
+val next_step_drop : int
+
+val pkt4_receive : pkt4 -> int
--- /dev/null
+// Copyright (C) 2016 Internet Systems Consortium, Inc. ("ISC")
+//
+// This Source Code Form is subject to the terms of the Mozilla Public
+// License, v. 2.0. If a copy of the MPL was not distributed with this
+// file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#define CAML_NAME_SPACE
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+
+#include <hooks/external/ocaml/opt.h>
+
+#include <iostream>
+#include <sstream>
+#include <string>
+
+using namespace std;
+using namespace isc::dhcp;
+using namespace isc::ocaml;
+
+namespace { // anonymous namespace
+
+// finalize
+void finalize(value opt) {
+ // This is a critical code to avoid memory leaks
+ cerr << "kea option finalize called\n";
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ self->object.reset();
+}
+
+// dummy deserialize
+uintnat deserialize(void*) {
+ // Should never be called
+ caml_failwith("attempt to deserialize a kea option");
+}
+
+// option operations
+struct custom_operations* init_opt_ops() {
+ static struct custom_operations ops;
+ static string id = "kea-opt";
+ ops.identifier = &id[0];
+ ops.finalize = finalize;
+ ops.compare = custom_compare_default;
+ ops.hash = custom_hash_default;
+ ops.serialize = custom_serialize_default;
+ // Define deserialize to be allowed to register
+ ops.deserialize = deserialize;
+ ops.compare_ext = custom_compare_ext_default;
+
+ return (&ops);
+}
+
+}
+
+namespace isc {
+namespace ocaml {
+
+struct custom_operations* opt_ops = init_opt_ops();
+
+extern "C" CAMLprim value opt_factory(value u, value typ, value bytes) {
+ CAMLparam3(u, typ, bytes);
+ CAMLlocal1(result);
+ Option::Universe universe;
+ ostringstream oss;
+ switch (Int_val(u)) {
+ case 4:
+ universe = Option::V4;
+ if (Int_val(typ) > 255) {
+ oss << "out of range type for DHCPv4: " << Int_val(typ);
+ caml_invalid_argument(oss.str().c_str());
+ }
+ break;
+ case 6:
+ universe = Option::V6;
+ break;
+ default:
+ oss << "universe must be 4 or 6 (not " << Int_val(u) << ")";
+ caml_invalid_argument(oss.str().c_str());
+ }
+ uint16_t type = static_cast<uint16_t>(Int_val(typ));
+ OptionBuffer data;
+ data.resize(static_cast<size_t>(caml_string_length(bytes)));
+ memmove(&data[0], String_val(bytes), data.size());
+ result = caml_alloc_custom(opt_ops, sizeof(oc_opt), 0, 1);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(result));
+ self->object.reset(new Option(universe, type, data));
+ CAMLreturn (result);
+}
+
+extern "C" CAMLprim value opt_toText(value opt) {
+ CAMLparam1(opt);
+ CAMLlocal1(result);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ result = caml_copy_string(self->object->toText().c_str());
+ CAMLreturn (result);
+}
+
+extern "C" CAMLprim value opt_getUniverse(value opt) {
+ CAMLparam1(opt);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ int ret = 0;
+ switch (self->object->getUniverse()) {
+ case Option::V4:
+ ret = 4;
+ break;
+ case Option::V6:
+ ret = 6;
+ break;
+ default: {
+ string msg = "getUniverse";
+ caml_raise_sys_error(caml_copy_string(msg.c_str()));
+ }
+ }
+ CAMLreturn (Val_int(ret));
+}
+
+extern "C" CAMLprim value opt_toBinary(value opt) {
+ CAMLparam1(opt);
+ CAMLlocal1(result);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ vector<uint8_t> bin = self->object->toBinary(0);
+ result = caml_alloc_string(static_cast<mlsize_t>(bin.size()));
+ memmove(String_val(result), &bin[0], bin.size());
+ CAMLreturn (result);
+}
+
+extern "C" CAMLprim value opt_getType(value opt) {
+ CAMLparam1(opt);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ CAMLreturn (Val_int(self->object->getType()));
+}
+
+extern "C" CAMLprim value opt_len(value opt) {
+ CAMLparam1(opt);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ CAMLreturn (Val_int(self->object->len()));
+}
+
+extern "C" CAMLprim value opt_getHeaderLen(value opt) {
+ CAMLparam1(opt);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ CAMLreturn (Val_int(self->object->getHeaderLen()));
+}
+
+extern "C" CAMLprim value opt_getData(value opt) {
+ CAMLparam1(opt);
+ CAMLlocal1(result);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ vector<uint8_t> data = self->object->getData();
+ result = caml_alloc_string(static_cast<mlsize_t>(data.size()));
+ memmove(String_val(result), &data[0], data.size());
+ CAMLreturn (result);
+}
+
+extern "C" CAMLprim value opt_addOption(value opt, value sub) {
+ CAMLparam2(opt, sub);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ oc_opt* const other = static_cast<oc_opt*>(Data_custom_val(sub));
+ self->object->addOption(other->object);
+ CAMLreturn (Val_unit);
+}
+
+extern "C" CAMLprim value opt_getOption(value opt, value typ) {
+ CAMLparam2(opt, typ);
+ CAMLlocal2(option, result);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ uint16_t type = static_cast<uint16_t>(Long_val(typ));
+ OptionPtr sub = self->object->getOption(type);
+ if (sub) {
+ option = caml_alloc_custom(opt_ops, sizeof(oc_opt), 0, 1);
+ (static_cast<oc_opt*>(Data_custom_val(option)))->object = sub;
+ result = caml_alloc(1, 0);
+ Store_field(result, 0, option);
+ } else {
+ result = Val_int(0);
+ }
+ CAMLreturn (result);
+}
+
+// TODO getOptions
+
+extern "C" CAMLprim value opt_delOption(value opt, value typ) {
+ CAMLparam2(opt, typ);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ uint16_t type = static_cast<uint16_t>(Long_val(typ));
+ bool ret = self->object->delOption(type);
+ CAMLreturn (Val_int(ret ? 1 : 0));
+}
+
+extern "C" CAMLprim value opt_setData(value opt, value bytes) {
+ CAMLparam2(opt, bytes);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ vector<uint8_t> data;
+ data.resize(static_cast<size_t>(caml_string_length(bytes)));
+ memmove(&data[0], String_val(bytes), data.size());
+ self->object->setData(data.begin(), data.end());
+ CAMLreturn (Val_unit);
+}
+
+extern "C" CAMLprim value opt_setEncapsulatedSpace(value opt, value name) {
+ CAMLparam2(opt, name);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ string space(String_val(name));
+ self->object->setEncapsulatedSpace(space);
+ CAMLreturn (Val_unit);
+}
+
+extern "C" CAMLprim value opt_getEncapsulatedSpace(value opt) {
+ CAMLparam1(opt);
+ CAMLlocal1(result);
+ oc_opt* const self = static_cast<oc_opt*>(Data_custom_val(opt));
+ string space = self->object->getEncapsulatedSpace();
+ result = caml_copy_string(space.c_str());
+ CAMLreturn (result);
+}
+
+} // end of namespace ocaml
+} // end of namespace isc
--- /dev/null
+// Copyright (C) 2016 Internet Systems Consortium, Inc. ("ISC")
+//
+// This Source Code Form is subject to the terms of the Mozilla Public
+// License, v. 2.0. If a copy of the MPL was not distributed with this
+// file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#ifndef OCAML_OPT_H
+#define OCAML_OPT_H 1
+
+#include <dhcp/option.h>
+
+namespace isc {
+namespace ocaml {
+
+// Ocaml option class
+class oc_opt {
+ oc_opt();
+
+public:
+ isc::dhcp::OptionPtr object;
+};
+
+extern "C" CAMLprim value opt_factory(value u, value typ, value bytes);
+extern "C" CAMLprim value opt_toText(value opt);
+extern "C" CAMLprim value opt_getUniverse(value opt);
+extern "C" CAMLprim value opt_toBinary(value opt);
+extern "C" CAMLprim value opt_getType(value opt);
+extern "C" CAMLprim value opt_len(value opt);
+extern "C" CAMLprim value opt_getHeaderLen(value opt);
+extern "C" CAMLprim value opt_getData(value opt);
+extern "C" CAMLprim value opt_addOption(value opt, value sub);
+extern "C" CAMLprim value opt_getOption(value opt, value typ);
+extern "C" CAMLprim value opt_delOption(value opt, value typ);
+extern "C" CAMLprim value opt_setData(value opt, value bytes);
+extern "C" CAMLprim value opt_setEncapsulatedSpace(value opt, value name);
+extern "C" CAMLprim value opt_getEncapsulatedSpace(value opt);
+
+CAMLextern struct custom_operations* opt_ops;
+
+} // end of namespace ocaml
+} // end of namespace isc
+
+#endif // OCAML_OPT_H
--- /dev/null
+// Copyright (C) 2016 Internet Systems Consortium, Inc. ("ISC")
+//
+// This Source Code Form is subject to the terms of the Mozilla Public
+// License, v. 2.0. If a copy of the MPL was not distributed with this
+// file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#define CAML_NAME_SPACE
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+
+#include <hooks/external/ocaml/opt.h>
+#include <hooks/external/ocaml/pkt4.h>
+
+#include <iostream>
+#include <string>
+
+using namespace std;
+using namespace isc::dhcp;
+using namespace isc::ocaml;
+
+namespace { // anonymous namespace
+
+// finalize
+void finalize(value pkt) {
+ // This is a critical code to avoid memory leaks
+ cerr << "kea v4 packet finalize called\n";
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ self->object.reset();
+}
+
+// dummy deserialize
+uintnat deserialize(void*) {
+ // Should never be called
+ caml_failwith("attempt to deserialize a kea v4 packet");
+}
+
+// v4 packet operations
+struct custom_operations* init_pkt4_ops() {
+ static struct custom_operations ops;
+ static string id = "kea-pkt4";
+ ops.identifier = &id[0];
+ ops.finalize = finalize;
+ ops.compare = custom_compare_default;
+ ops.hash = custom_hash_default;
+ ops.serialize = custom_serialize_default;
+ // Define deserialize to be allowed to register
+ ops.deserialize = deserialize;
+ ops.compare_ext = custom_compare_ext_default;
+
+ return (&ops);
+}
+
+}
+
+namespace isc {
+namespace ocaml {
+
+struct custom_operations* pkt4_ops = init_pkt4_ops();
+
+extern "C" CAMLprim value pkt4_toText(value pkt) {
+ CAMLparam1(pkt);
+ CAMLlocal1(result);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ result = caml_copy_string(self->object->toText().c_str());
+ CAMLreturn (result);
+}
+
+extern "C" CAMLprim value pkt4_addOption(value pkt, value sub) {
+ CAMLparam2(pkt, sub);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ oc_opt* const opt = static_cast<oc_opt*>(Data_custom_val(sub));
+ self->object->addOption(opt->object);
+ CAMLreturn (Val_unit);
+}
+
+extern "C" CAMLprim value pkt4_delOption(value pkt, value typ) {
+ CAMLparam2(pkt, typ);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ uint16_t type = static_cast<uint16_t>(Long_val(typ));
+ bool ret = self->object->delOption(type);
+ CAMLreturn (Val_int(ret ? 1 : 0));
+}
+
+extern "C" CAMLprim value pkt4_len(value pkt) {
+ CAMLparam1(pkt);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ CAMLreturn (Val_int(self->object->len()));
+}
+
+extern "C" CAMLprim value pkt4_getType(value pkt) {
+ CAMLparam1(pkt);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ CAMLreturn (Val_int(self->object->getType()));
+}
+
+extern "C" CAMLprim value pkt4_setType(value pkt, value type) {
+ CAMLparam1(pkt);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ self->object->setType(static_cast<uint8_t>(Int_val(type)));
+ CAMLreturn (Val_unit);
+}
+
+extern "C" CAMLprim value pkt4_setTransid(value pkt, value tid) {
+ CAMLparam1(pkt);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ self->object->setTransid(static_cast<uint8_t>(Int_val(tid)));
+ CAMLreturn (Val_unit);
+}
+
+extern "C" CAMLprim value pkt4_getTransid(value pkt) {
+ CAMLparam1(pkt);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ CAMLreturn (Val_int(self->object->getTransid()));
+}
+
+extern "C" CAMLprim value pkt4_inClass(value pkt, value cclass) {
+ CAMLparam2(pkt, cclass);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ const ClientClass& client_class(String_val(cclass));
+ bool ret = self->object->inClass(client_class);
+ CAMLreturn (Val_int(ret ? 1 : 0));
+}
+
+extern "C" CAMLprim value pkt4_addClass(value pkt, value cclass) {
+ CAMLparam2(pkt, cclass);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ const ClientClass& client_class(String_val(cclass));
+ self->object->addClass(client_class);
+ CAMLreturn (Val_unit);
+}
+
+// TODO getClasses
+
+extern "C" CAMLprim value pkt4_getOption(value pkt, value typ) {
+ CAMLparam2(pkt, typ);
+ CAMLlocal2(opt, result);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ uint16_t type = static_cast<uint16_t>(Long_val(typ));
+ OptionPtr sub = self->object->getOption(type);
+ if (sub) {
+ opt = caml_alloc_custom(opt_ops, sizeof(oc_opt), 0, 1);
+ (static_cast<oc_opt*>(Data_custom_val(opt)))->object = sub;
+ result = caml_alloc(1, 0);
+ Store_field(result, 0, opt);
+ } else {
+ result = Val_int(0);
+ }
+ CAMLreturn (result);
+}
+
+// TODO getTimestamp
+
+// TODO set/getLocal/RemoteAddr/Port
+
+extern "C" CAMLprim value pkt4_setIndex(value pkt, value idx) {
+ CAMLparam1(pkt);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ self->object->setIndex(static_cast<uint32_t>(Int_val(idx)));
+ CAMLreturn (Val_unit);
+}
+
+extern "C" CAMLprim value pkt4_getIndex(value pkt) {
+ CAMLparam1(pkt);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ CAMLreturn (Val_int(self->object->getIndex()));
+}
+
+extern "C" CAMLprim value pkt4_getIface(value pkt) {
+ CAMLparam1(pkt);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ string iface = self->object->getIface();
+ CAMLreturn (caml_copy_string(iface.c_str()));
+}
+
+extern "C" CAMLprim value pkt4_setIface(value pkt, value ifn) {
+ CAMLparam1(pkt);
+ oc_pkt4* const self = static_cast<oc_pkt4*>(Data_custom_val(pkt));
+ self->object->setIface(string(String_val(ifn)));
+ CAMLreturn (Val_unit);
+}
+
+} // end of namespace ocaml
+} // end of namespace isc
--- /dev/null
+// Copyright (C) 2016 Internet Systems Consortium, Inc. ("ISC")
+//
+// This Source Code Form is subject to the terms of the Mozilla Public
+// License, v. 2.0. If a copy of the MPL was not distributed with this
+// file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#ifndef OCAML_PKT4_H
+#define OCAML_PKT4_H 1
+
+#include <dhcp/pkt4.h>
+
+namespace isc {
+namespace ocaml {
+
+// Ocaml DHCPv4 packet class
+class oc_pkt4 {
+ oc_pkt4();
+
+public:
+ isc::dhcp::Pkt4Ptr object;
+};
+
+extern "C" CAMLprim value pkt4_toText(value pkt);
+extern "C" CAMLprim value pkt4_addOption(value pkt, value opt);
+extern "C" CAMLprim value pkt4_delOption(value pkt, value typ);
+extern "C" CAMLprim value pkt4_len(value pkt);
+extern "C" CAMLprim value pkt4_getType(value pkt);
+extern "C" CAMLprim value pkt4_setType(value pkt, value typ);
+extern "C" CAMLprim value pkt4_setTransid(value pkt, value tid);
+extern "C" CAMLprim value pkt4_getTransid(value pkt);
+extern "C" CAMLprim value pkt4_inClass(value pkt, value cclass);
+extern "C" CAMLprim value pkt4_addClass(value pkt, value cclass);
+extern "C" CAMLprim value pkt4_getOption(value pkt, value typ);
+extern "C" CAMLprim value pkt4_setIndex(value pkt, value idx);
+extern "C" CAMLprim value pkt4_getIndex(value pkt);
+extern "C" CAMLprim value pkt4_getIface(value pkt);
+extern "C" CAMLprim value pkt4_setIface(value pkt, value ifn);
+
+CAMLextern struct custom_operations* pkt4_ops;
+
+} // end of namespace ocaml
+} // end of namespace isc
+
+#endif // OCAML_PKT4_H
--- /dev/null
+// Copyright (C) 2016 Internet Systems Consortium, Inc. ("ISC")
+//
+// This Source Code Form is subject to the terms of the Mozilla Public
+// License, v. 2.0. If a copy of the MPL was not distributed with this
+// file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#include <cc/data.h>
+#include <dhcp/pkt4.h>
+#include <dhcpsrv/parsers/dhcp_parsers.h>
+#include <dhcpsrv/callout_handle_store.h>
+#include <hooks/hooks_manager.h>
+#include <log/logger_support.h>
+
+#include <boost/foreach.hpp>
+
+#include <iostream>
+
+#ifdef OCAML_CODE_BYTECODE
+#define HOOK_DSO_NAME "bhook.so"
+#endif
+#ifdef OCAML_CODE_NATIVE
+#ifdef HOOK_DSO_NAME
+#error "define either OCAML_CODE_BYTECODE or OCAML_CODE_NATIVE, not both"
+#endif
+#define HOOK_DSO_NAME "nhook.so"
+#endif
+#ifndef HOOK_DSO_NAME
+#error "define either OCAML_CODE_BYTECODE or OCAML_CODE_NATIVE"
+#endif
+
+using namespace std;
+using namespace isc;
+using namespace isc::asiolink;
+using namespace isc::data;
+using namespace isc::dhcp;
+using namespace isc::hooks;
+using namespace isc::log;
+
+// config fragment for hooks-libraries
+const string config =
+ "{ \"hooks-libraries\": ["
+ " { \"library\": \"" HOOK_DSO_NAME "\", "
+ " \"parameters\": "
+ " { \"program\": \"kea\" }"
+ " }] }";
+
+// main routine
+int main() {
+ // must be first
+ int hi_pkt4_receive = HooksManager::registerHook("pkt4_receive");
+ cout << "pkt4_receive is hook#" << hi_pkt4_receive << "\n";
+
+ initLogger();
+
+ // check if there is a library already loaded
+ vector<string> hooks_libraries = HooksManager::getLibraryNames();
+ if (!hooks_libraries.empty()) {
+ cerr << "hooks_libraries is not empty\n";
+ }
+
+ // parse config into json
+ ElementPtr json = Element::fromJSON(config);
+ if (!json) {
+ cerr << "fatal: fromJSON failed\n";
+ exit(-1);
+ }
+ cout << "config parsed\n";
+
+ // call the hooks-libraries parser
+ boost::shared_ptr<HooksLibrariesParser> parser;
+ try {
+ const map<string, ConstElementPtr>& cmap = json->mapValue();
+ if (cmap.empty()) {
+ cerr << "fatal: config map is empty\n";
+ exit(-1);
+ }
+ if (cmap.size() > 1) {
+ cerr << "config map has more than one element\n";
+ }
+ if (cmap.count("hooks-libraries") == 0) {
+ cerr << "fatal: no \"hooks-libraries\" in config\n";
+ exit(-1);
+ }
+ const ConstElementPtr& hl_value = cmap.find("hooks-libraries")->second;
+ if (!hl_value) {
+ cerr << "fatal: empty \"hooks-libraries\" value\n";
+ exit(-1);
+ }
+ parser.reset(new HooksLibrariesParser("hooks-libraries"));
+ parser->build(hl_value);
+ parser->commit();
+ cout << "config committed\n";
+ } catch (const Exception& ex) {
+ cerr << "fatal: config parsing failed: " << ex.what() << "\n";
+ exit(-1);
+ }
+
+ // check if the library was loaded
+ HookLibsCollection libraries;
+ bool changed = false;
+ parser->getLibraries(libraries, changed);
+ if (!changed) {
+ cerr << "commit didn't change libraries\n";
+ }
+ if (libraries.empty()) {
+ cerr << "fatal: no libraries\n";
+ exit(-1);
+ }
+ if (libraries.size() > 1) {
+ cerr << "more than one library\n";
+ }
+ cout << "library is \"" + libraries[0].first + "\"\n";
+ if (libraries[0].first != HOOK_DSO_NAME) {
+ cerr << "fatal: library is not \"" HOOK_DSO_NAME "\"\n";
+ exit(-1);
+ }
+ ConstElementPtr params = libraries[0].second;
+ if (!params) {
+ cerr << "no parameters\n";
+ } else {
+ cout << "got " << params->size() << " parameters\n";
+ }
+
+ // note we can't know this way if it was successfully loaded
+
+ // get the callout
+ if (!HooksManager::calloutsPresent(hi_pkt4_receive)) {
+ cerr << "fatal: no callout present for pkt4_receive\n";
+ exit(-1);
+ }
+
+ // from pkt4_unittests.cc
+ Pkt4Ptr pkt(new Pkt4(DHCPDISCOVER, 0x12345678));
+ const uint8_t macAddr[] = {0, 1, 2, 3, 4, 5};
+ vector<uint8_t> vectorMacAddr(macAddr, macAddr + sizeof(macAddr));
+ pkt->setHWAddr(6, 6, vectorMacAddr);
+ pkt->setHops(13);
+ // Transaction-id is already set.
+ pkt->setSecs(42);
+ pkt->setFlags(BOOTP_BROADCAST);
+ pkt->setCiaddr(IOAddress("192.0.2.1"));
+ pkt->setYiaddr(IOAddress("1.2.3.4"));
+ pkt->setSiaddr(IOAddress("192.0.2.255"));
+ pkt->setGiaddr(IOAddress("255.255.255.255"));
+ // Chaddr already set with setHWAddr().
+
+ // from dhcp4_srv.cc
+ CalloutHandlePtr co_handle = getCalloutHandle(pkt);
+ co_handle->deleteAllArguments();
+ co_handle->setArgument("query4", pkt);
+ cout << "calling pkt4_receive callout\n";
+ HooksManager::callCallouts(hi_pkt4_receive, *co_handle);
+ cout << "pkt4_receive callout status " << co_handle->getStatus() << "\n";
+ co_handle->getArgument("query4", pkt);
+
+ // TODO...
+
+ exit(0);
+}
--- /dev/null
+#KEASRC = /tmp/kea/src/lib
+
+# Kea includes and boost
+CPPFLAGS = -I../../.. -I$(KEASRC) -I/usr/local/include
+# python
+CPPFLAGS += -I/usr/local/Cellar/python3/3.5.1/Frameworks/Python.framework/Versions/3.5/include/python3.5m
+
+CXXFLAGS = -DBOOST_ERROR_CODE_HEADER_ONLY -DBOOST_SYSTEM_NO_DEPRECATED
+CXXFLAGS += -g -fPIC -dynamic -DNDEBUG -fwrapv
+
+# Kea dhcp library
+LIBS = -lkea-dhcp++ -lkea-hooks -lkea-exceptions
+# python
+LIBS += -lpython3.5m -ldl -framework CoreFoundation
+
+# Kea dependencies
+LDFLAGS = -L/usr/local/Cellar/botan/1.10.12/lib
+LDFLAGS += -L$(KEASRC)/dhcp/.libs
+LDFLAGS += -L$(KEASRC)/hooks/.libs
+LDFLAGS += -L$(KEASRC)/exceptions/.libs
+# python
+LDFLAGS += -L/usr/local/Cellar/python3/3.5.1/Frameworks/Python.framework/Versions/3.5/lib/python3.5/config-3.5m -lpython3.5m
+
+SRCS = dso.cc module.h module.cc poption.h poption.cc ppkt4.h ppkt4.cc
+
+OBJS = dso.o module.o poption.o ppkt4.o
+
+all: kea.so tests
+
+kea.so: $(OBJS)
+ g++ -shared $(OBJS) $(LDFLAGS) $(LIBS) -o kea.so
+
+TESTLIBS = -lkea-dhcpsrv -lkea-dhcp++ -lkea-asiolink -lkea-cc
+TESTLIBS += -lkea-hooks -lkea-log -lkea-exceptions
+
+TESTLDFLAGS = -L/usr/local/Cellar/botan/1.10.12/lib
+TESTLDFLAGS += -L$(KEASRC)/dhcpsrv/.libs
+TESTLDFLAGS += -L$(KEASRC)/dhcp/.libs
+TESTLDFLAGS += -L$(KEASRC)/asiolink/.libs
+TESTLDFLAGS += -L$(KEASRC)/cc/.libs
+TESTLDFLAGS += -L$(KEASRC)/hooks/.libs
+TESTLDFLAGS += -L$(KEASRC)/log/.libs
+TESTLDFLAGS += -L$(KEASRC)/exceptions/.libs
+
+tests: tests.o
+ g++ tests.o $(TESTLDFLAGS) $(TESTLIBS) -o tests
+
+clean:
+ rm -f *.o *.so tests
-Implementation notes fro python
+Implementation notes for python
Manifest:
- poption.h poption.cc: the C++ OptionPtr encapsulated into a python
- dso.cc: the kea framework and hook glue: on the kea / C side it is
a dynamic shared object providing the framework and hook entry points,
- on the python side it embbeds an interpreter which imports the
+ on the python side it embeds an interpreter which imports the
python script hook.py.
poption.o, ppkt4.o, module.o and dso.o are compiled into kea.so.