add some useful functions

sysdep/unix/main.c

@@ -854,6 +854,7 @@ parse_args(int argc, char **argv)
 }
 
 #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)
 
 cl_object
@@ -861,11 +862,147 @@ clbird_version()
 {
 	return eclcs(BIRD_VERSION);
 }
+cl_object
+clbird_hostname()
+{
+	return ecls(config->hostname);
+}
+
+cl_object
+clbird_router_id()
+{
+	return ecl_make_integer(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 = cfg_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_integer(rta->nh.iface->index) : ECL_NIL;
+	}
+	else if (ecl_eql(which, eclk("WEIGHT"))) {
+		ret = ecl_make_integer(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_get_table_routes(cl_object table_obj, cl_object pfx_obj, cl_object len_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);
+	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_integer(ret);
+}
+
 void
 init_ecl_functions()
 {
 	cl_object package = ecl_make_package(eclcs("BIRD"), ECL_NIL, ECL_NIL, ECL_NIL);
-	ecl_def_c_function(_ecl_intern("version", package), clbird_version, 0);
+	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, 3);
+	ecl_def_c_function(_ecl_intern("DOTQUAD", package), clbird_dotquad, 4);
 }
 
 /*