Browse Source

lisp code and stuff

master
eta 4 months ago
parent
commit
8afc0732a0
  1. 2
      ecl/Makefile
  2. 110
      ecl/clbird.lisp
  3. 20
      ecl/ecl.c

2
ecl/Makefile

@ -1,3 +1,3 @@
src := ecl.c
obj := $(src-o-files) $(objdir)/$(s)/libclbird.a
obj := $(src-o-files) $(objdir)/$(s)libclbird.a
$(all-daemon)

110
ecl/clbird.lisp

@ -71,6 +71,7 @@
:ty ty)))
(change-class plain cls)))
#+ecl
(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)
@ -137,6 +138,20 @@
(slot-value table 'ptr)
(slot-value prefix 'ptr))))
(defun for-each-route (table function)
"Run FUNCTION once for each route in TABLE."
(check-type table bird-routing-table)
(let ((route nil))
(bird-impl::for-table-routes
(slot-value table 'ptr)
(lambda (rte)
(let ((obj-rte (if route
(progn
(setf (slot-value route 'ptr) rte)
route)
(setf route (make-route rte)))))
(funcall function obj-rte))))))
(defun route-attr (route attr)
"Get a route attribute."
(check-type route bird-route)
@ -147,7 +162,7 @@
(with-slots (ptr ty) obj
(format stream "for ~A proto ~A (~A)"
(val-format (route-attr obj :net))
(val-format (route-attr obj :proto))
(route-attr obj :proto)
ptr))))
(defun router-id ()
@ -162,5 +177,96 @@
"Returns the hostname BIRD is running on, as a string."
(bird-impl::hostname))
(defun ea-code (proto id)
(logior (ash proto 8) id))
(defparameter +protocol-none+ 0)
(defparameter +protocol-babel+ 1)
(defparameter +protocol-bfd+ 2)
(defparameter +protocol-bgp+ 3)
(defparameter +protocol-device+ 4)
(defparameter +protocol-direct+ 5)
(defparameter +protocol-kernel+ 6)
(defparameter +protocol-ospf+ 7)
(defparameter +protocol-mrt+ 8)
(defparameter +protocol-perf+ 9)
(defparameter +protocol-pipe+ 10)
(defparameter +protocol-radv+ 11)
(defparameter +protocol-rip+ 12)
(defparameter +protocol-rpki+ 13)
(defparameter +protocol-static+ 14)
;; BGP protocol attributes
(defparameter +extended-attrs+
`((:bgp-origin ,(ea-code +protocol-bgp+ #x01))
(:bgp-as-path ,(ea-code +protocol-bgp+ #x02))
(:bgp-next-hop ,(ea-code +protocol-bgp+ #x03))
(:bgp-multi-exit-disc ,(ea-code +protocol-bgp+ #x04))
(:bgp-local-pref ,(ea-code +protocol-bgp+ #x05))
(:bgp-atomic-aggr ,(ea-code +protocol-bgp+ #x06))
(:bgp-aggregator ,(ea-code +protocol-bgp+ #x07))
(:bgp-community ,(ea-code +protocol-bgp+ #x08))
(:bgp-originator-id ,(ea-code +protocol-bgp+ #x09))
(:bgp-cluster-list ,(ea-code +protocol-bgp+ #x0a))
(:bgp-mp-reach-nlri ,(ea-code +protocol-bgp+ #x0e))
(:bgp-mp-unreach-nlri ,(ea-code +protocol-bgp+ #x0f))
(:bgp-ext-community ,(ea-code +protocol-bgp+ #x10))
(:bgp-as4-path ,(ea-code +protocol-bgp+ #x11))
(:bgp-as4-aggregator ,(ea-code +protocol-bgp+ #x12))
(:bgp-aigp ,(ea-code +protocol-bgp+ #x1a))
(:bgp-large-community ,(ea-code +protocol-bgp+ #x20))
(:gen-igp-metric ,(ea-code +protocol-none+ 0))
(:ospf-metric1 ,(ea-code +protocol-ospf+ 0))
(:ospf-metric2 ,(ea-code +protocol-ospf+ 1))
(:ospf-tag ,(ea-code +protocol-ospf+ 2))
(:ospf-router-id ,(ea-code +protocol-ospf+ 3))
(:kernel-source ,(ea-code +protocol-kernel+ 0))
(:kernel-metric ,(ea-code +protocol-kernel+ 1))
(:kernel-prefsrc ,(ea-code +protocol-kernel+ #x10))
(:kernel-realm ,(ea-code +protocol-kernel+ #x11))
(:kernel-scope ,(ea-code +protocol-kernel+ #x12))
(:kernel-metrics ,(ea-code +protocol-kernel+ #x20))
(:kernel-lock ,(ea-code +protocol-kernel+ #x21))
(:kernel-mtu ,(ea-code +protocol-kernel+ #x22))
(:kernel-window ,(ea-code +protocol-kernel+ #x23))
(:kernel-rtt ,(ea-code +protocol-kernel+ #x24))
(:kernel-rttvar ,(ea-code +protocol-kernel+ #x25))
(:kernel-sstresh ,(ea-code +protocol-kernel+ #x26))
(:kernel-cwnd ,(ea-code +protocol-kernel+ #x27))
(:kernel-advmss ,(ea-code +protocol-kernel+ #x28))
(:kernel-reordering ,(ea-code +protocol-kernel+ #x29))
(:kernel-hoplimit ,(ea-code +protocol-kernel+ #x2a))
(:kernel-initcwnd ,(ea-code +protocol-kernel+ #x2b))
(:kernel-features ,(ea-code +protocol-kernel+ #x2c))
(:kernel-rto-min ,(ea-code +protocol-kernel+ #x2d))
(:kernel-initrwnd ,(ea-code +protocol-kernel+ #x2e))
(:kernel-quickack ,(ea-code +protocol-kernel+ #x2f))
(:rip-metric ,(ea-code +protocol-rip+ 0))
(:rip-tag ,(ea-code +protocol-rip+ 1))
(:radv-preference ,(ea-code +protocol-radv+ 0))
(:radv-lifetime ,(ea-code +protocol-radv+ 1))
(:babel-metric ,(ea-code +protocol-babel+ 0))
(:babel-router-id ,(ea-code +protocol-babel+ 1))))
(defun ea-hash-table (&optional reverse)
(let ((ret (make-hash-table)))
(loop
for (kw code) in +extended-attrs+
do (let ((key (if reverse kw code))
(value (if reverse code kw)))
(setf (gethash key ret) value)))
ret))
(defparameter +ea-code-to-keyword+ (ea-hash-table))
(defparameter +ea-keyword-to-code+ (ea-hash-table t))
(defun route-eattrs (route)
"Get the extended attributes for ROUTE."
(check-type route bird-route)
(loop
for (id . val) in (bird-impl::route-eattrs (slot-value route 'ptr))
collect (cons
(gethash id +ea-code-to-keyword+ :unknown)
(maybe-make-bird-val val))))
(eval-when (:load-toplevel)
(format t "CL bird stuff is going brr~%"))
(format t "CL bird stuff is going brr!~%"))

20
ecl/ecl.c

@ -153,6 +153,25 @@ clbird_get_table_routes_all(cl_object table_obj)
return ret;
}
cl_object
clbird_for_table_routes_all(cl_object table_obj, cl_object func_obj)
{
rtable *table = ecl_foreign_data_pointer_safe(table_obj);
cl_object v = eclk("VOID");
FIB_WALK(&table->fib, net, n)
{
for (rte *e = n->routes; e; e = e->next) {
union cl_lispunion rte_obj;
rte_obj.d.t = t_foreign;
rte_obj.foreign.tag = v;
rte_obj.foreign.size = 0;
rte_obj.foreign.data = e;
cl_funcall(2, func_obj, &rte_obj);
}
}
FIB_WALK_END;
return ECL_NIL;
}
cl_object
clbird_get_table_routes_net(cl_object table_obj, cl_object net_obj)
{
rtable *table = ecl_foreign_data_pointer_safe(table_obj);
@ -336,6 +355,7 @@ init_ecl_functions()
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("FOR-TABLE-ROUTES", package), clbird_for_table_routes_all, 2);
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);

Loading…
Cancel
Save