eta
/
danger-bird2
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
Browse Source

lisp code and stuff

master
eta 4 months ago
parent
5fdc0fc649
commit
8afc0732a0
3 changed files with 129 additions and 3 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 2
      ecl/Makefile
  2. 110
      ecl/clbird.lisp
  3. 20
      ecl/ecl.c

2
ecl/Makefile
View File

@ -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
View File

@ -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
View File

@ -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);

Write Preview
Loading…
Cancel
Save