Skip to content
Commits on Source (2)
Hide whitespace changes
Inline Side-by-side
conf/conf.c
View file @ a606bea0
......@@ -56,7 +56,7 @@
#include "conf/conf.h"
#include "filter/filter.h"
#include "sysdep/unix/unix.h"
#include "ecl/cldefs.h"
static jmp_buf conf_jmpbuf;
......@@ -278,6 +278,10 @@ config_do_commit(struct config *c, int type)
rt_commit(c, old_config);
DBG("protos_commit\n");
protos_commit(c, old_config, force_restart, type);
DBG("lisp\n");
if (c->lisp_load) {
clbird_load(c->lisp_load);
}
int obs = 0;
if (old_config)
......
conf/conf.h
View file @ a606bea0
......@@ -30,6 +30,7 @@ struct config {
const char *syslog_name; /* Name used for syslog (NULL -> no syslog) */
struct rtable_config *def_tables[NET_MAX]; /* Default routing tables for each network */
struct iface_patt *router_id_from; /* Configured list of router ID iface patterns */
const char *lisp_load; /* Path to Common Lisp source file to load (NULL -> don't load one) */
u32 router_id; /* Our Router ID */
u32 proto_default_debug; /* Default protocol debug mask */
......
ecl/clbird.lisp
View file @ a606bea0
(defpackage :bird-impl
(:use))
(defpackage :bird-filter
(:use))
(defpackage :bird
(:nicknames :b)
(:use :cl)
(:export :version))
(:export :version :deffilter))
(in-package :bird)
......@@ -46,7 +49,6 @@
(make-instance 'bird-route
:ptr ptr))
(defclass val-pair (bird-val) ())
(defclass val-quad (bird-val) ())
(defclass val-ip (bird-val) ())
......@@ -71,7 +73,6 @@
: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)
......@@ -116,10 +117,11 @@
(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)))
(when (and val1 val2)
(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."
......@@ -268,5 +270,20 @@
(gethash id +ea-code-to-keyword+ :unknown)
(maybe-make-bird-val val))))
(defmacro deffilter (name (route-name) &body body)
"Define a BIRD filter called NAME, with syntax similar to DEFUN. The route passed in as ROUTE-NAME is a BIRD-ROUTE object."
(let ((name-sym (intern (symbol-name name) 'bird-filter))
(rte-csym (gensym))
(rte-sym (gensym)))
`(let ((,rte-csym nil))
(defun ,name-sym (,rte-sym)
(let ((,route-name (if ,rte-csym
(progn
(setf (slot-value ,rte-csym 'bird::ptr) ,rte-sym)
,rte-csym)
(setf ,rte-csym (bird::make-route ,rte-sym)))))
(block nil
,@body))))))
(eval-when (:load-toplevel)
(format t "CL bird stuff is going brr!~%"))
ecl/cldefs.h
View file @ a606bea0
......@@ -39,5 +39,7 @@ 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**);
char* ecl_get_string_for(cl_object obj);
void clbird_load(char*);
#endif
ecl/ecl.c
View file @ a606bea0
......@@ -209,7 +209,7 @@ clbird_cidr4(cl_object o1, cl_object o2, cl_object o3, cl_object o4, cl_object l
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));
net_fill_ip4(na, _MI4(ret), ecl_to_fix(len));
struct f_val *res = ecl_alloc(sizeof(struct f_val));
res->type = T_NET;
res->val.net = na;
......@@ -381,3 +381,35 @@ clbird_init(int argc, char **argv)
ecl_init_module(NULL, clbird_native_lisp_init);
init_ecl_functions();
}
char*
ecl_get_string_for(cl_object obj) {
cl_object formatted = NULL;
ECL_HANDLER_CASE_BEGIN(ecl_process_env(), ecl_list1(ECL_T)) {
formatted = cl_princ_to_string(obj);
} ECL_HANDLER_CASE(1, condition) {
} ECL_HANDLER_CASE_END;
if (formatted == NULL) {
return "[error occurred printing Lisp object]";
}
assert(ECL_STRINGP(formatted));
if (!ecl_fits_in_base_string(formatted)) {
return "[Unicode error printing Lisp object]";
}
cl_object base = si_coerce_to_base_string(formatted);
char* ret = base->base_string.self;
return ret;
}
void
clbird_load(char *file)
{
ECL_HANDLER_CASE_BEGIN(ecl_process_env(), ecl_list1(ECL_T)) {
log(L_INFO "Loading Lisp: %s", file);
cl_load(1, ecls(file));
log(L_INFO "Lisp successfully loaded");
} ECL_HANDLER_CASE(1, condition) {
char* cond_fmt = ecl_get_string_for(condition);
log(L_WARN "Failed to load %s: %s", file, cond_fmt);
} ECL_HANDLER_CASE_END;
}
filter/config.Y
View file @ a606bea0
......@@ -315,9 +315,9 @@ CF_GRAMMAR
conf: filter_def ;
filter_def:
FILTER symbol { $2 = cf_define_symbol($2, SYM_FILTER, filter, NULL); cf_push_scope( $2 ); }
filter_body {
text {
struct filter *f = cfg_alloc(sizeof(struct filter));
*f = (struct filter) { .sym = $2, .root = $4 };
*f = (struct filter) { .sym = $2, .lisp_name = $4 };
$2->filter = f;
cf_pop_scope();
......@@ -431,17 +431,18 @@ filter:
cf_assert_symbol($1, SYM_FILTER);
$$ = $1->filter;
}
| filter_body {
| text {
struct filter *f = cfg_alloc(sizeof(struct filter));
*f = (struct filter) { .root = $1 };
*f = (struct filter) { .lisp_name = $1 };
$$ = f;
}
;
where_filter:
WHERE term {
/* Construct 'IF term THEN { ACCEPT; } ELSE { REJECT; }' */
$$ = f_new_where($2);
WHERE text {
struct filter *f = cfg_alloc(sizeof(struct filter));
*f = (struct filter) { .lisp_name = $2 };
$$ = f;
}
;
......
filter/f-util.c
View file @ a606bea0
......@@ -24,22 +24,10 @@ filter_name(const struct filter *filter)
return "ACCEPT";
else if (filter == FILTER_REJECT)
return "REJECT";
else if (!filter->sym)
return "(unnamed)";
else
return filter->sym->name;
return filter->lisp_name;
}
struct filter *f_new_where(struct f_inst *where)
{
struct f_inst *cond = f_new_inst(FI_CONDITION, where,
f_new_inst(FI_DIE, F_ACCEPT),
f_new_inst(FI_DIE, F_REJECT));
struct filter *f = cfg_allocz(sizeof(struct filter));
f->root = f_linearize(cond);
return f;
}
#define CA_KEY(n) n->name, n->fda.type
#define CA_NEXT(n) n->next
......
filter/filter.c
View file @ a606bea0
......@@ -43,6 +43,8 @@
#include "filter/filter.h"
#include "filter/f-inst.h"
#include "filter/data.h"
#include <ecl/ecl.h>
#include "ecl/cldefs.h"
/* Exception bits */
......@@ -272,7 +274,45 @@ f_run(const struct filter *filter, struct rte **rte, struct linpool *tmp_pool, i
return F_REJECT;
int rte_cow = ((*rte)->flags & REF_COW);
DBG( "Running filter `%s'...", filter->name );
DBG("Running filter %s...", filter->lisp_name);
clock_t begin = clock();
cl_object package = ecl_find_package("BIRD-FILTER");
assert(package != ECL_NIL);
cl_object sym = _ecl_intern(filter->lisp_name, package);
cl_object result = ECL_NIL;
cl_env_ptr env = ecl_process_env();
int failed = 0;
ECL_HANDLER_CASE_BEGIN(env, ecl_list1(ECL_T)) {
cl_object func = cl_symbol_function(sym);
result = cl_funcall(2, func, ecl_make_pointer(*rte));
} ECL_HANDLER_CASE(1, condition) {
char* err = ecl_get_string_for(condition);
DBG("failed: %s\n", err);
log_rl(&rl_runtime_err, L_ERR "Error executing Lisp filter %s: %s", filter->lisp_name, err);
failed = 1;
} ECL_HANDLER_CASE_END;
if (failed) {
return F_ERROR;
}
clock_t end = clock();
double time_spent = (double)(end - begin) / CLOCKS_PER_SEC;
if (ecl_eql(result, eclk("ACCEPT"))) {
DBG("accepted (%fms)\n", time_spent * 1000.0);
return F_ACCEPT;
} else if (ecl_eql(result, eclk("REJECT"))) {
DBG("rejected (%fms)\n", time_spent * 1000.0);
return F_REJECT;
}
char* ret = ecl_get_string_for(result);
DBG("returned %s (%fms)\n", ret, time_spent * 1000.0);
log_rl(&rl_runtime_err, L_ERR "Unexpected return value for Lisp filter %s: %s", filter->lisp_name, ret);
return F_ERROR;
/* Initialize the filter state */
filter_state = (struct filter_state) {
......@@ -285,7 +325,8 @@ f_run(const struct filter *filter, struct rte **rte, struct linpool *tmp_pool, i
LOG_BUFFER_INIT(filter_state.buf);
/* Run the interpreter itself */
enum filter_return fret = interpret(&filter_state, filter->root, NULL);
//enum filter_return fret = interpret(&filter_state, filter->root, NULL);
enum filter_return fret = F_ACCEPT;
if (filter_state.old_rta) {
/*
......@@ -432,7 +473,7 @@ filter_same(const struct filter *new, const struct filter *old)
return 0;
if ((!old->sym) && (!new->sym))
return f_same(new->root, old->root);
return strcmp(new->lisp_name, old->lisp_name) == 0;
if ((!old->sym) || (!new->sym))
return 0;
......@@ -467,7 +508,7 @@ filter_commit(struct config *new, struct config *old)
case SYM_FILTER:
if ((osym = cf_find_symbol(old, sym->name)) &&
(osym->class == SYM_FILTER) &&
f_same(sym->filter->root, osym->filter->root))
(strcmp(sym->filter->lisp_name, osym->filter->lisp_name) == 0))
sym->flags |= SYM_FLAG_SAME;
else
sym->flags &= ~SYM_FLAG_SAME;
......@@ -481,8 +522,7 @@ void filters_dump_all(void)
WALK_LIST(sym, config->symbols) {
switch (sym->class) {
case SYM_FILTER:
debug("Named filter %s:\n", sym->name);
f_dump_line(sym->filter->root, 1);
debug("Named filter %s: Lisp function %s\n", sym->name, sym->filter->lisp_name);
break;
case SYM_FUNCTION:
debug("Function %s:\n", sym->name);
......@@ -505,7 +545,7 @@ void filters_dump_all(void)
debug(" named filter %s\n", c->in_filter->sym->name);
} else {
debug("\n");
f_dump_line(c->in_filter->root, 2);
debug("Lisp function %s\n", c->in_filter->lisp_name);
}
}
}
......
filter/filter.h
View file @ a606bea0
......@@ -45,8 +45,8 @@ struct f_val;
/* The filter encapsulating structure to be pointed-to from outside */
struct f_line;
struct filter {
struct symbol *sym;
const struct f_line *root;
struct symbol *sym;
const char* lisp_name;
};
struct rte;
......
nest/cmds.c
View file @ a606bea0
......@@ -15,6 +15,7 @@
#include "lib/string.h"
#include "lib/resource.h"
#include "filter/filter.h"
#include "ecl/cldefs.h"
#include <ecl/ecl.h>
extern int shutting_down;
......@@ -110,17 +111,6 @@ cmd_eval(const struct f_line *expr)
cli_msg(23, "%s", buf.start);
}
char* ecl_get_string_for(cl_object obj) {
// FIXME: handle errors in the printer
cl_object formatted = cl_princ_to_string(obj);
assert(ECL_STRINGP(formatted));
if (!ecl_fits_in_base_string(formatted)) {
return NULL; // sad
}
cl_object base = si_coerce_to_base_string(formatted);
char* ret = base->base_string.self;
return ret;
}
void cmd_cl_eval(const char *obj)
{
......@@ -132,19 +122,18 @@ void cmd_cl_eval(const char *obj)
}
cl_object result = ECL_NIL;
char* err = NULL;
ECL_HANDLER_CASE_BEGIN(env, ecl_list1(ECL_T)) {
result = cl_eval(form);
} ECL_HANDLER_CASE(1, condition) {
char* err = ecl_get_string_for(condition);
cli_msg(8041, "runtime error: %s", err ? err : "wat");
return;
err = ecl_get_string_for(condition);
} ECL_HANDLER_CASE_END;
char* disp = ecl_get_string_for(result);
if (!disp) {
cli_msg(8043, "unicode what");
if (err) {
cli_msg(8041, "runtime error: %s", err);
return;
}
char* disp = ecl_get_string_for(result);
char* newline = "\n";
char* line = strtok(disp, newline);
while (line != NULL) {
......
nest/config.Y
View file @ a606bea0
......@@ -87,7 +87,7 @@ proto_postconfig(void)
CF_DECLS
CF_KEYWORDS(ROUTER, ID, HOSTNAME, PROTOCOL, TEMPLATE, PREFERENCE, DISABLED, DEBUG, ALL, OFF, DIRECT)
CF_KEYWORDS(ROUTER, ID, HOSTNAME, PROTOCOL, TEMPLATE, PREFERENCE, DISABLED, DEBUG, ALL, OFF, DIRECT, LISP)
CF_KEYWORDS(INTERFACE, IMPORT, EXPORT, FILTER, NONE, VRF, DEFAULT, TABLE, STATES, ROUTES, FILTERS)
CF_KEYWORDS(IPV4, IPV6, VPN4, VPN6, ROA4, ROA6, FLOW4, FLOW6, SADR, MPLS)
CF_KEYWORDS(RECEIVE, LIMIT, ACTION, WARN, BLOCK, RESTART, DISABLE, KEEP, FILTERED)
......@@ -151,6 +151,10 @@ idval:
}
;
conf: lisp_load ;
lisp_load: LISP text ';' { new_config->lisp_load = $2; } ;
conf: hostname_override ;
hostname_override: HOSTNAME text ';' { new_config->hostname = $2; } ;
......
nest/proto.c
View file @ a606bea0
......@@ -393,6 +393,7 @@ channel_roa_subscribe_filter(struct channel *c, int dir)
if (c->channel == &channel_bgp)
valid = dir ? !!c->in_table : !!c->out_table;
/*
struct filter_iterator fit;
FILTER_ITERATE_INIT(&fit, f, c->proto->pool);
......@@ -419,6 +420,7 @@ channel_roa_subscribe_filter(struct channel *c, int dir)
FILTER_ITERATE_END;
FILTER_ITERATE_CLEANUP(&fit);
*/
if (!valid && found)
log(L_WARN "%s.%s: Automatic RPKI reload not active for %s",
......