10 changed files with 620 additions and 324 deletions
@ -0,0 +1,3 @@ |
|||
src := ecl.c |
|||
obj := $(src-o-files) $(objdir)/$(s)/libclbird.a |
|||
$(all-daemon) |
|||
@ -0,0 +1,166 @@ |
|||
(defpackage :bird-impl |
|||
(:use)) |
|||
|
|||
(defpackage :bird |
|||
(:nicknames :b) |
|||
(:use :cl) |
|||
(:export :version)) |
|||
|
|||
(in-package :bird) |
|||
|
|||
(defclass bird-routing-table () |
|||
((ptr |
|||
:initarg :ptr))) |
|||
|
|||
(defmethod print-object ((obj bird-routing-table) stream) |
|||
(print-unreadable-object (obj stream :type t) |
|||
(with-slots (ptr) obj |
|||
(format stream "\"~A\"" (bird-impl::table-name ptr))))) |
|||
|
|||
(defun make-routing-table (ptr) |
|||
"Make a BIRD-ROUTING-TABLE from a foreign PTR." |
|||
(make-instance 'bird-routing-table |
|||
:ptr ptr)) |
|||
|
|||
(defclass bird-val () |
|||
((ptr |
|||
:initarg :ptr) |
|||
(ty |
|||
:initarg :ty))) |
|||
|
|||
(defun val-format (val) |
|||
"Formats VAL, a BIRD-VAL, to a string." |
|||
(bird-impl::format-val (slot-value val 'ptr))) |
|||
|
|||
(defmethod print-object ((obj bird-val) stream) |
|||
(print-unreadable-object (obj stream :type t) |
|||
(with-slots (ptr ty) obj |
|||
(format stream "~A \"~A\" ~A" (bird-impl::val-type-name ptr) (bird-impl::format-val ptr) ptr)))) |
|||
|
|||
(defclass bird-route () |
|||
((ptr |
|||
:initarg :ptr))) |
|||
|
|||
(defun make-route (ptr) |
|||
"Make a BIRD-ROUTE from a foreign PTR." |
|||
(make-instance 'bird-route |
|||
:ptr ptr)) |
|||
|
|||
|
|||
(defclass val-pair (bird-val) ()) |
|||
(defclass val-quad (bird-val) ()) |
|||
(defclass val-ip (bird-val) ()) |
|||
(defclass val-net (bird-val) ()) |
|||
|
|||
(defun bird-type-id-to-class (id) |
|||
"Returns a symbol for the given BIRD type ID. See filter/data.h." |
|||
(declare (fixnum id)) |
|||
(case id |
|||
(#x12 'val-pair) |
|||
(#x13 'val-quad) |
|||
(#x20 'val-ip) |
|||
(#x21 'val-net) |
|||
(t 'bird-val))) |
|||
|
|||
(defun make-bird-val (ptr) |
|||
"Make a BIRD-VAL from a foreign PTR." |
|||
(let* ((ty (bird-impl::val-type-id ptr)) |
|||
(cls (bird-type-id-to-class ty)) |
|||
(plain (make-instance 'bird-val |
|||
:ptr ptr |
|||
:ty ty))) |
|||
(change-class plain cls))) |
|||
|
|||
(defun maybe-make-bird-val (obj) |
|||
"If OBJ is a foreign pointer, run MAKE-BIRD-VAL on it; otherwise, return OBJ." |
|||
(if (typep obj 'si::foreign-data) |
|||
(make-bird-val obj) |
|||
obj)) |
|||
|
|||
(defun make-pair (cell) |
|||
"Make a VAL-PAIR from a cons CELL." |
|||
(make-bird-val (bird-impl::make-val cell))) |
|||
|
|||
(defun make-quad-int (int) |
|||
"Make a VAL-QUAD from a raw integer." |
|||
(make-bird-val (bird-impl::make-quad int))) |
|||
|
|||
(defun make-quad-octets (&rest octets) |
|||
"Make a VAL-QUAD from a list of four OCTETS." |
|||
(make-bird-val (bird-impl::make-val octets))) |
|||
|
|||
(defun cidr4 (o1 o2 o3 o4 prefix-len) |
|||
"Make a VAL-NET from 4 octets and a prefix length (i.e. o1.o2.o3.o4/prefix-len)" |
|||
(make-bird-val (bird-impl::cidr4 o1 o2 o3 o4 prefix-len))) |
|||
|
|||
(defun bird-equal (val1 val2) |
|||
"Returns T if VAL1 is the same thing as VAL2 (both BIRD-VALs)." |
|||
(check-type val1 bird-val) |
|||
(check-type val2 bird-val) |
|||
(bird-impl::val-same (slot-value val1 'ptr) |
|||
(slot-value val2 'ptr))) |
|||
|
|||
(defun bird-compare (val1 val2) |
|||
"Returns -1 (<), 0 (=), or 1 (>) as a comparison result for VAL1 and VAL2." |
|||
(check-type val1 bird-val) |
|||
(check-type val2 bird-val) |
|||
(bird-impl::val-compare (slot-value val1 'ptr) |
|||
(slot-value val2 'ptr))) |
|||
|
|||
(defun val< (val1 val2) (eql (bird-compare val1 val2) -1)) |
|||
(defun val> (val1 val2) (eql (bird-compare val1 val2) 1)) |
|||
(defun val= (val1 val2) (bird-equal val1 val2)) |
|||
(defun val>= (val1 val2) (member (bird-compare val1 val2) '(0 1))) |
|||
(defun val<= (val1 val2) (member (bird-compare val1 val2) '(0 -1))) |
|||
|
|||
(defun val~ (val1 val2) |
|||
"Returns T if VAL1 is in the range VAL2 (both BIRD-VALs)." |
|||
(check-type val1 bird-val) |
|||
(check-type val2 bird-val) |
|||
(bird-impl::val-in-range (slot-value val1 'ptr) |
|||
(slot-value val2 'ptr))) |
|||
|
|||
(defun routing-tables () |
|||
"Get all of the BIRD routing tables." |
|||
(mapcar #'make-routing-table (bird-impl::routing-tables))) |
|||
|
|||
(defun table-routes (table) |
|||
"Get the routes for the routing table TABLE." |
|||
(check-type table bird-routing-table) |
|||
(mapcar #'make-route (bird-impl::table-routes (slot-value table 'ptr)))) |
|||
|
|||
(defun table-routes-for (table prefix) |
|||
"Get the routes for the prefix PREFIX in the routing table TABLE." |
|||
(check-type table bird-routing-table) |
|||
(check-type prefix val-net) |
|||
(mapcar #'make-route (bird-impl::table-routes-net |
|||
(slot-value table 'ptr) |
|||
(slot-value prefix 'ptr)))) |
|||
|
|||
(defun route-attr (route attr) |
|||
"Get a route attribute." |
|||
(check-type route bird-route) |
|||
(maybe-make-bird-val (bird-impl::get-val attr (slot-value route 'ptr)))) |
|||
|
|||
(defmethod print-object ((obj bird-route) stream) |
|||
(print-unreadable-object (obj stream :type t) |
|||
(with-slots (ptr ty) obj |
|||
(format stream "for ~A proto ~A (~A)" |
|||
(val-format (route-attr obj :net)) |
|||
(val-format (route-attr obj :proto)) |
|||
ptr)))) |
|||
|
|||
(defun router-id () |
|||
"Returns the running BIRD router ID, as a VAL-QUAD." |
|||
(make-quad-int (bird-impl::router-id))) |
|||
|
|||
(defun version () |
|||
"Returns the running BIRD version, as a string." |
|||
(bird-impl::version)) |
|||
|
|||
(defun hostname () |
|||
"Returns the hostname BIRD is running on, as a string." |
|||
(bird-impl::hostname)) |
|||
|
|||
(eval-when (:load-toplevel) |
|||
(format t "CL bird stuff is going brr~%")) |
|||
@ -0,0 +1,43 @@ |
|||
/*
|
|||
* Embeddable Common Lisp support for BIRD |
|||
* |
|||
* (c) 2021 eta <hi@theta.eu.org> |
|||
*/ |
|||
|
|||
#ifndef _BIRD_CLDEFS_H_ |
|||
#define _BIRD_CLDEFS_H_ |
|||
|
|||
#include <ecl/ecl.h> |
|||
|
|||
#define ecls(x) ecl_make_simple_base_string(x,-1) |
|||
#define eclk(x) ecl_make_keyword(x) |
|||
#define eclcs(x) ecl_make_constant_base_string(x,-1) |
|||
|
|||
// from libclbird.a
|
|||
extern void clbird_native_lisp_init(cl_object); |
|||
|
|||
cl_object clbird_version(void); |
|||
cl_object clbird_hostname(void); |
|||
cl_object clbird_router_id(void); |
|||
cl_object clbird_nullptr(void); |
|||
cl_object clbird_format_val(cl_object obj); |
|||
cl_object clbird_get_val(cl_object which, cl_object rte_obj); |
|||
cl_object clbird_get_routing_tables(void); |
|||
cl_object clbird_get_table_name(cl_object obj); |
|||
cl_object clbird_val_type_name(cl_object val_obj); |
|||
cl_object clbird_val_type_id(cl_object val_obj); |
|||
cl_object clbird_get_table_routes_all(cl_object table_obj); |
|||
cl_object clbird_get_table_routes_net(cl_object table_obj, cl_object net_obj); |
|||
cl_object clbird_dotquad(cl_object o1, cl_object o2, cl_object o3, cl_object o4); |
|||
cl_object clbird_cidr4(cl_object o1, cl_object o2, cl_object o3, cl_object o4, cl_object len); |
|||
cl_object clbird_val_compare(cl_object val1_obj, cl_object val2_obj); |
|||
cl_object clbird_val_same(cl_object val1_obj, cl_object val2_obj); |
|||
cl_object clbird_val_in_range(cl_object val1_obj, cl_object val2_obj); |
|||
cl_object clbird_make_val(cl_object from); |
|||
cl_object clbird_make_quad(cl_object from); |
|||
cl_object ea_to_object(eattr *e); |
|||
cl_object clbird_get_eattrs(cl_object rte_obj); |
|||
void init_ecl_functions(void); |
|||
void clbird_init(int, char**); |
|||
|
|||
#endif |
|||
@ -0,0 +1,14 @@ |
|||
(require 'cmp) |
|||
|
|||
(defun compile-clbird (&optional (source "clbird.lisp") (afile "clbird.a")) |
|||
(let* ((src-length (length source)) |
|||
;; HACK(eta): what the heck |
|||
(c::+static-library-format+ "~a.a") |
|||
(cursed-obj-file (concatenate 'string |
|||
(subseq source 0 (- src-length 4)) |
|||
"o"))) |
|||
(compile-file source :system-p t) |
|||
(c::build-static-library afile |
|||
:lisp-files (list cursed-obj-file) |
|||
:init-name "clbird_native_lisp_init") |
|||
(quit))) |
|||
@ -0,0 +1,363 @@ |
|||
/*
|
|||
* Embeddable Common Lisp support for BIRD |
|||
* |
|||
* (c) 2021 eta <hi@theta.eu.org> |
|||
*/ |
|||
|
|||
#include <ecl/ecl.h> |
|||
|
|||
#include "nest/bird.h" |
|||
#include "lib/lists.h" |
|||
#include "lib/resource.h" |
|||
#include "lib/socket.h" |
|||
#include "lib/event.h" |
|||
#include "lib/timer.h" |
|||
#include "lib/string.h" |
|||
#include "nest/route.h" |
|||
#include "nest/protocol.h" |
|||
#include "nest/iface.h" |
|||
#include "nest/cli.h" |
|||
#include "nest/locks.h" |
|||
#include "conf/conf.h" |
|||
#include "filter/filter.h" |
|||
#include "filter/data.h" |
|||
#include "cldefs.h" |
|||
|
|||
cl_object |
|||
clbird_version() |
|||
{ |
|||
return eclcs(BIRD_VERSION); |
|||
} |
|||
cl_object |
|||
clbird_hostname() |
|||
{ |
|||
return ecls(config->hostname); |
|||
} |
|||
|
|||
cl_object |
|||
clbird_router_id() |
|||
{ |
|||
return ecl_make_fixnum(config->router_id); |
|||
} |
|||
|
|||
cl_object |
|||
clbird_nullptr() |
|||
{ |
|||
return ecl_make_pointer(NULL); |
|||
} |
|||
cl_object |
|||
clbird_format_val(cl_object obj) |
|||
{ |
|||
struct f_val *val = ecl_foreign_data_pointer_safe(obj); |
|||
buffer buf; |
|||
LOG_BUFFER_INIT(buf); |
|||
val_format(val, &buf); |
|||
return ecls(buf.start); |
|||
|
|||
} |
|||
cl_object |
|||
clbird_get_val(cl_object which, cl_object rte_obj) |
|||
{ |
|||
struct rte *rte = ecl_foreign_data_pointer_safe(rte_obj); |
|||
struct f_val *res = ecl_alloc(sizeof(struct f_val)); |
|||
struct rta *rta = rte->attrs; |
|||
cl_object ret = NULL; |
|||
|
|||
if (ecl_eql(which, eclk("FROM"))) { |
|||
res->type = T_IP; |
|||
res->val.ip = rta->from; |
|||
} |
|||
else if (ecl_eql(which, eclk("GW"))) { |
|||
res->type = T_IP; |
|||
res->val.ip = rta->nh.gw; |
|||
} |
|||
else if (ecl_eql(which, eclk("NET"))) { |
|||
res->type = T_NET; |
|||
res->val.net = rte->net->n.addr; |
|||
} |
|||
else if (ecl_eql(which, eclk("PROTO"))) { |
|||
ret = ecls(rta->src->proto->name); |
|||
} |
|||
else if (ecl_eql(which, eclk("SOURCE"))) { |
|||
res->type = T_ENUM_RTS; |
|||
res->val.i = rta->source; |
|||
} |
|||
else if (ecl_eql(which, eclk("SCOPE"))) { |
|||
res->type = T_ENUM_SCOPE; |
|||
res->val.i = rta->scope; |
|||
} |
|||
else if (ecl_eql(which, eclk("DEST"))) { |
|||
res->type = T_ENUM_RTD; |
|||
res->val.i = rta->dest; |
|||
} |
|||
else if (ecl_eql(which, eclk("IFNAME"))) { |
|||
ret = rta->nh.iface ? ecls(rta->nh.iface->name) : ECL_NIL; |
|||
} |
|||
else if (ecl_eql(which, eclk("IFINDEX"))) { |
|||
ret = rta->nh.iface ? ecl_make_fixnum(rta->nh.iface->index) : ECL_NIL; |
|||
} |
|||
else if (ecl_eql(which, eclk("WEIGHT"))) { |
|||
ret = ecl_make_fixnum(rta->nh.weight + 1); |
|||
} |
|||
else { |
|||
FEerror("Unknown route attribute ~A.", 1, which); |
|||
} |
|||
if (ret != NULL) { |
|||
return ret; |
|||
} |
|||
else { |
|||
return ecl_make_pointer(res); |
|||
} |
|||
} |
|||
cl_object |
|||
clbird_get_routing_tables() |
|||
{ |
|||
cl_object ret = ECL_NIL; |
|||
for (int i = 1; i < NET_MAX; i++) { |
|||
if (config->def_tables[i]) { |
|||
ret = ecl_cons(ecl_make_pointer(config->def_tables[i]->table), ret); |
|||
} |
|||
} |
|||
return ret; |
|||
} |
|||
cl_object |
|||
clbird_get_table_name(cl_object obj) |
|||
{ |
|||
rtable *table = ecl_foreign_data_pointer_safe(obj); |
|||
return ecls(table->name); |
|||
} |
|||
cl_object |
|||
clbird_val_type_name(cl_object val_obj) |
|||
{ |
|||
struct f_val *val = ecl_foreign_data_pointer_safe(val_obj); |
|||
return eclcs(f_type_name(val->type)); |
|||
} |
|||
cl_object |
|||
clbird_val_type_id(cl_object val_obj) |
|||
{ |
|||
struct f_val *val = ecl_foreign_data_pointer_safe(val_obj); |
|||
return ecl_make_fixnum(val->type); |
|||
} |
|||
cl_object |
|||
clbird_get_table_routes_all(cl_object table_obj) |
|||
{ |
|||
rtable *table = ecl_foreign_data_pointer_safe(table_obj); |
|||
cl_object ret = ECL_NIL; |
|||
FIB_WALK(&table->fib, net, n) |
|||
{ |
|||
for (rte *e = n->routes; e; e = e->next) { |
|||
ret = ecl_cons(ecl_make_pointer(e), ret); |
|||
} |
|||
} |
|||
FIB_WALK_END; |
|||
return ret; |
|||
} |
|||
cl_object |
|||
clbird_get_table_routes_net(cl_object table_obj, cl_object net_obj) |
|||
{ |
|||
rtable *table = ecl_foreign_data_pointer_safe(table_obj); |
|||
struct f_val *net_val = ecl_foreign_data_pointer_safe(net_obj); |
|||
if (net_val->type != T_NET) { |
|||
FEerror("TABLE-ROUTES-NET needs a prefix, not a ~A", 1, clbird_val_type_name(net_obj)); |
|||
} |
|||
const net_addr* na = net_val->val.net; |
|||
net* net = net_route(table, na); |
|||
if (!net) { |
|||
return ECL_NIL; |
|||
} |
|||
cl_object ret = ECL_NIL; |
|||
for (rte *e = net->routes; e; e = e->next) { |
|||
ret = ecl_cons(ecl_make_pointer(e), ret); |
|||
} |
|||
return ret; |
|||
} |
|||
cl_object |
|||
clbird_dotquad(cl_object o1, cl_object o2, cl_object o3, cl_object o4) |
|||
{ |
|||
cl_fixnum ret = 0; |
|||
ret |= ecl_to_fix(o1) << 24; |
|||
ret |= ecl_to_fix(o2) << 16; |
|||
ret |= ecl_to_fix(o3) << 8; |
|||
ret |= ecl_to_fix(o4); |
|||
return ecl_make_fixnum(ret); |
|||
} |
|||
cl_object |
|||
clbird_cidr4(cl_object o1, cl_object o2, cl_object o3, cl_object o4, cl_object len) |
|||
{ |
|||
cl_fixnum ret = 0; |
|||
ret |= ecl_to_fix(o1) << 24; |
|||
ret |= ecl_to_fix(o2) << 16; |
|||
ret |= ecl_to_fix(o3) << 8; |
|||
ret |= ecl_to_fix(o4); |
|||
net_addr *na = ecl_alloc(sizeof(net_addr)); |
|||
net_fill_ip4(na, ret, ecl_to_fix(len)); |
|||
struct f_val *res = ecl_alloc(sizeof(struct f_val)); |
|||
res->type = T_NET; |
|||
res->val.net = na; |
|||
return ecl_make_pointer(res); |
|||
} |
|||
cl_object |
|||
clbird_val_compare(cl_object val1_obj, cl_object val2_obj) |
|||
{ |
|||
struct f_val *val1 = ecl_foreign_data_pointer_safe(val1_obj); |
|||
struct f_val *val2 = ecl_foreign_data_pointer_safe(val2_obj); |
|||
cl_fixnum ret = val_compare(val1, val2); |
|||
if (ret == F_CMP_ERROR) { |
|||
FEerror("Comparison of raw BIRD values ~A (~A) and ~A (~A) failed.", 4, val1_obj, eclcs(f_type_name(val1->type)), val2_obj, eclcs(f_type_name(val2->type))); |
|||
} |
|||
return ecl_make_fixnum(ret); |
|||
} |
|||
cl_object |
|||
clbird_val_same(cl_object val1_obj, cl_object val2_obj) |
|||
{ |
|||
struct f_val *val1 = ecl_foreign_data_pointer_safe(val1_obj); |
|||
struct f_val *val2 = ecl_foreign_data_pointer_safe(val2_obj); |
|||
return val_same(val1, val2) ? ECL_T : ECL_NIL; |
|||
} |
|||
cl_object |
|||
clbird_val_in_range(cl_object val1_obj, cl_object val2_obj) |
|||
{ |
|||
struct f_val *val1 = ecl_foreign_data_pointer_safe(val1_obj); |
|||
struct f_val *val2 = ecl_foreign_data_pointer_safe(val2_obj); |
|||
cl_fixnum ret = val_in_range(val1, val2); |
|||
if (ret == F_CMP_ERROR) { |
|||
FEerror("Comparison of raw BIRD values ~A (~A) and ~A (~A) failed.", 4, val1_obj, eclcs(f_type_name(val1->type)), val2_obj, eclcs(f_type_name(val2->type))); |
|||
} |
|||
return ret ? ECL_T : ECL_NIL; |
|||
} |
|||
cl_object |
|||
clbird_make_quad(cl_object from) |
|||
{ |
|||
struct f_val *res = ecl_alloc(sizeof(struct f_val)); |
|||
res->type = T_QUAD; |
|||
res->val.i = ecl_to_fix(from); |
|||
return ecl_make_pointer(res); |
|||
} |
|||
cl_object |
|||
clbird_make_val(cl_object from) |
|||
{ |
|||
struct f_val *res = ecl_alloc(sizeof(struct f_val)); |
|||
if (ECL_FIXNUMP(from)) { |
|||
res->type = T_INT; |
|||
res->val.i = ecl_to_fix(from); |
|||
} |
|||
else if (ECL_STRINGP(from)) { |
|||
cl_object base = si_coerce_to_base_string(from); |
|||
res->type = T_STRING; |
|||
res->val.s = base->base_string.self; |
|||
} |
|||
else if (from == ECL_NIL || from == ECL_T) { |
|||
res->type = T_BOOL; |
|||
res->val.i = from == ECL_T ? 1 : 0; |
|||
} |
|||
else if (ECL_CONSP(from) && ECL_FIXNUMP(ECL_CONS_CAR(from)) && ECL_FIXNUMP(ECL_CONS_CDR(from))) { |
|||
res->type = T_PAIR; |
|||
res->val.i = ecl_to_fix(ECL_CONS_CAR(from)) << 16 | ecl_to_fix(ECL_CONS_CDR(from)); |
|||
} |
|||
else if (ECL_LISTP(from) && ecl_length(from) == 4) { |
|||
res->type = T_QUAD; |
|||
res->val.i = ecl_to_fix(ecl_elt(from, 0)) << 24 | ecl_to_fix(ecl_elt(from, 1)) << 16 | ecl_to_fix(ecl_elt(from, 2)) << 8 | ecl_to_fix(ecl_elt(from, 3)); |
|||
} |
|||
else { |
|||
FEerror("Don't know how to convert to BIRD value: ~A", 1, from); |
|||
} |
|||
return ecl_make_pointer(res); |
|||
} |
|||
cl_object |
|||
ea_to_object(eattr *e) |
|||
{ |
|||
struct f_val *res = ecl_alloc(sizeof(struct f_val)); |
|||
switch (e->type & EAF_TYPE_MASK) { |
|||
case EAF_TYPE_INT: |
|||
return ecl_make_fixnum(e->u.data); |
|||
case EAF_TYPE_ROUTER_ID: |
|||
res->type = T_QUAD; |
|||
res->val.i = e->u.data; |
|||
break; |
|||
case EAF_TYPE_OPAQUE: |
|||
return eclk("OPAQUE"); |
|||
case EAF_TYPE_IP_ADDRESS: |
|||
res->type = T_IP; |
|||
res->val.ip = *((ip_addr *) e->u.ptr->data); |
|||
break; |
|||
case EAF_TYPE_AS_PATH: |
|||
res->type = T_PATH; |
|||
res->val.ad = e->u.ptr; |
|||
break; |
|||
case EAF_TYPE_BITFIELD: |
|||
return ecl_make_fixnum(e->u.data); |
|||
break; |
|||
case EAF_TYPE_INT_SET: |
|||
res->type = T_CLIST; |
|||
res->val.ad = e->u.ptr; |
|||
break; |
|||
case EAF_TYPE_EC_SET: |
|||
res->type = T_ECLIST; |
|||
res->val.ad = e->u.ptr; |
|||
break; |
|||
case EAF_TYPE_LC_SET: |
|||
res->type = T_LCLIST; |
|||
res->val.ad = e->u.ptr; |
|||
break; |
|||
case EAF_TYPE_UNDEF: |
|||
return ECL_NIL; |
|||
break; |
|||
default: |
|||
FEerror("failed to translate BIRD dynamic attribute of type ~A", 1, ecl_make_fixnum(e->type)); |
|||
} |
|||
return ecl_make_pointer(res); |
|||
} |
|||
cl_object |
|||
clbird_get_eattrs(cl_object rte_obj) |
|||
{ |
|||
struct rte *rte = ecl_foreign_data_pointer_safe(rte_obj); |
|||
cl_object ret = ECL_NIL; |
|||
for (ea_list *eal = rte->attrs->eattrs; eal; eal=eal->next) { |
|||
for (int i = 0; i < eal->count; i++) { |
|||
eattr *e = &eal->attrs[i]; |
|||
cl_object id = ecl_make_fixnum(e->id); |
|||
cl_object attr = ecl_cons(id, ea_to_object(e)); |
|||
ret = ecl_cons(attr, ret); |
|||
} |
|||
} |
|||
return ret; |
|||
} |
|||
|
|||
void |
|||
init_ecl_functions() |
|||
{ |
|||
cl_object package = ecl_find_package("BIRD-IMPL"); |
|||
ecl_def_c_function(_ecl_intern("VERSION", package), clbird_version, 0); |
|||
ecl_def_c_function(_ecl_intern("HOSTNAME", package), clbird_hostname, 0); |
|||
ecl_def_c_function(_ecl_intern("ROUTER-ID", package), clbird_router_id, 0); |
|||
ecl_def_c_function(_ecl_intern("NULLPTR", package), clbird_nullptr, 0); |
|||
ecl_def_c_function(_ecl_intern("FORMAT-VAL", package), clbird_format_val, 1); |
|||
ecl_def_c_function(_ecl_intern("GET-VAL", package), clbird_get_val, 2); |
|||
ecl_def_c_function(_ecl_intern("ROUTING-TABLES", package), clbird_get_routing_tables, 0); |
|||
ecl_def_c_function(_ecl_intern("TABLE-NAME", package), clbird_get_table_name, 1); |
|||
ecl_def_c_function(_ecl_intern("TABLE-ROUTES", package), clbird_get_table_routes_all, 1); |
|||
ecl_def_c_function(_ecl_intern("TABLE-ROUTES-NET", package), clbird_get_table_routes_net, 2); |
|||
ecl_def_c_function(_ecl_intern("DOTQUAD", package), clbird_dotquad, 4); |
|||
ecl_def_c_function(_ecl_intern("CIDR4", package), clbird_cidr4, 5); |
|||
ecl_def_c_function(_ecl_intern("MAKE-VAL", package), clbird_make_val, 1); |
|||
ecl_def_c_function(_ecl_intern("MAKE-QUAD", package), clbird_make_quad, 1); |
|||
ecl_def_c_function(_ecl_intern("ROUTE-EATTRS", package), clbird_get_eattrs, 1); |
|||
ecl_def_c_function(_ecl_intern("VAL-TYPE-NAME", package), clbird_val_type_name, 1); |
|||
ecl_def_c_function(_ecl_intern("VAL-TYPE-ID", package), clbird_val_type_id, 1); |
|||
ecl_def_c_function(_ecl_intern("VAL-COMPARE", package), clbird_val_compare, 2); |
|||
ecl_def_c_function(_ecl_intern("VAL-SAME", package), clbird_val_same, 2); |
|||
ecl_def_c_function(_ecl_intern("VAL-IN-RANGE", package), clbird_val_in_range, 2); |
|||
} |
|||
|
|||
void |
|||
clbird_init(int argc, char **argv) |
|||
{ |
|||
ecl_set_option(ECL_OPT_TRAP_SIGSEGV, FALSE); |
|||
ecl_set_option(ECL_OPT_TRAP_SIGFPE, FALSE); |
|||
ecl_set_option(ECL_OPT_TRAP_SIGINT, FALSE); |
|||
ecl_set_option(ECL_OPT_TRAP_SIGILL, FALSE); |
|||
ecl_set_option(ECL_OPT_TRAP_INTERRUPT_SIGNAL, FALSE); |
|||
cl_boot(argc, argv); |
|||
ecl_init_module(NULL, clbird_native_lisp_init); |
|||
init_ecl_functions(); |
|||
} |
|||
Loading…
Reference in new issue