Browse Source

moar functions

master
eta 4 months ago
parent
commit
e8b321fa78
  1. 116
      sysdep/unix/main.c

116
sysdep/unix/main.c

@ -961,14 +961,35 @@ clbird_get_table_name(cl_object obj)
return ecls(table->name);
}
cl_object
clbird_get_table_routes(cl_object table_obj, cl_object pfx_obj, cl_object len_obj)
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_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);
cl_fixnum prefix = ecl_to_fix(pfx_obj);
cl_fixnum len = ecl_to_fix(len_obj);
net_addr na = {0};
net_fill_ip4(&na, prefix, len);
net* net = net_route(table, &na);
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));
}
net_addr* na = net_val->val.net;
net* net = net_route(table, na);
if (!net) {
return ECL_NIL;
}
@ -988,6 +1009,80 @@ clbird_dotquad(cl_object o1, cl_object o2, cl_object o3, cl_object o4)
ret |= ecl_to_fix(o4);
return ecl_make_integer(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 = cfg_alloc(sizeof(net_addr));
net_fill_ip4(na, ret, ecl_to_fix(len));
struct f_val *res = cfg_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_integer(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_val(cl_object from)
{
struct f_val *res = cfg_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);
}
void
init_ecl_functions()
@ -1001,8 +1096,15 @@ init_ecl_functions()
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, 3);
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("VAL-TYPE-NAME", package), clbird_val_type_name, 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);
}
/*

Loading…
Cancel
Save